diff --git a/DESCRIPTION b/DESCRIPTION index 673cdf3..1675e92 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: MAST Type: Package Title: Model-based Analysis of Single Cell Transcriptomics -Version: 1.17.1 -Date: 2020-03-21 +Version: 1.17.2 +Date: 2020-11-1 Authors@R: c(person("Andrew", "McDavid", email = "Andrew_McDavid@urmc.rochester.edu", role = c("aut", "cre")), person("Greg", "Finak", email="gfinak@fredhutch.org", role='aut'), person("Masanao", "Yajima", email="myajima@fredhutch.org", role='aut')) diff --git a/R/LmWrapper.R b/R/LmWrapper.R index 451451f..52c1716 100644 --- a/R/LmWrapper.R +++ b/R/LmWrapper.R @@ -54,7 +54,7 @@ setMethod('coef', signature=c(object='LMlike'), function(object, which, singular stopifnot(which %in% c('C', 'D')) co <- object@defaultCoef if(which=='C' & object@fitted['C']){ - co <- coef(object@fitC) + co[names(coef(object@fitC))] <- coef(object@fitC) } if(which=='D' & object@fitted['D']){ diff --git a/R/ZlmFit.R b/R/ZlmFit.R index e5ab89c..650f89c 100644 --- a/R/ZlmFit.R +++ b/R/ZlmFit.R @@ -3,9 +3,9 @@ Glue <- function(...) abind(..., rev.along=0) #'@importFrom plyr rbind.fill collectSummaries <- function(listOfSummaries){ summaries <- list() - #summaries[['coefC']] <- do.call(rbind, lapply(listOfSummaries, '[[', 'coefC')) - summaries[['coefC']] <- as.matrix(do.call(plyr::rbind.fill,lapply(lapply(listOfSummaries,"[[", "coefC"),function(x)as.data.frame(t(x))))) - rownames(summaries[['coefC']])<-names(listOfSummaries) + summaries[['coefC']] <- do.call(rbind, lapply(listOfSummaries, '[[', 'coefC')) + #summaries[['coefC']] <- as.matrix(do.call(plyr::rbind.fill,lapply(lapply(listOfSummaries,"[[", "coefC"),function(x)as.data.frame(t(x))))) + rownames(summaries[['coefC']]) <- names(listOfSummaries) summaries[['vcovC']] <- do.call(Glue, lapply(listOfSummaries, '[[', 'vcovC')) summaries[['df.resid']] <- do.call(rbind, lapply(listOfSummaries, '[[', 'df.resid')) summaries[['df.null']] <- do.call(rbind, lapply(listOfSummaries, '[[', 'df.null')) @@ -14,10 +14,10 @@ collectSummaries <- function(listOfSummaries){ summaries[['dispersionNoshrink']] <- do.call(rbind, lapply(listOfSummaries, '[[', 'dispersionNoshrink')) summaries[['converged']] <- do.call(rbind, lapply(listOfSummaries, '[[', 'converged')) summaries[['loglik']] <- do.call(rbind, lapply(listOfSummaries, '[[', 'loglik')) - #summaries[['coefD']] <- do.call(rbind, lapply(listOfSummaries, '[[', 'coefD')) + summaries[['coefD']] <- do.call(rbind, lapply(listOfSummaries, '[[', 'coefD')) summaries[['vcovD']] <- do.call(Glue, lapply(listOfSummaries, '[[', 'vcovD')) - summaries[['coefD']] <-as.matrix(do.call(plyr::rbind.fill,lapply(lapply(listOfSummaries,"[[", "coefD"),function(x)as.data.frame(t(x))))) - rownames(summaries[['coefD']])<-names(listOfSummaries) + #summaries[['coefD']] <-as.matrix(do.call(plyr::rbind.fill,lapply(lapply(listOfSummaries,"[[", "coefD"),function(x)as.data.frame(t(x))))) + rownames(summaries[['coefD']]) <- names(listOfSummaries) summaries diff --git a/R/lmWrapper-glmer.R b/R/lmWrapper-glmer.R index a900ecd..6569334 100644 --- a/R/lmWrapper-glmer.R +++ b/R/lmWrapper-glmer.R @@ -274,22 +274,29 @@ setMethod('vcov', signature=c(object='LMERlike'), function(object, which, ...){ vc }) +demangle_names = function(x){ + names(x) = str_replace_all(names(x), fixed('`'), '') + x +} + if(getRversion() >= "2.15.1") globalVariables(c('fixef', 'lmer', 'glmer')) #' @describeIn LMERlike return the coefficients. The horrendous hack is attempted to be undone. #' @param singular \code{logical}. Should NA coefficients be returned? setMethod('coef', signature=c(object='LMERlike'), function(object, which, singular=TRUE, ...){ stopifnot(which %in% c('C', 'D')) co <- setNames(rep(NA, ncol(model.matrix(object))), colnames(model.matrix(object))) - if(which=='C' & object@fitted['C']){ - co <- lme4::fixef(object@fitC)} - else if(object@fitted['D']){ - co <- lme4::fixef(object@fitD) + co = object@defaultCoef + if(which == 'C' & object@fitted['C']){ + lm_co = lme4::fixef(object@fitC) + + } else if(object@fitted['D']){ + lm_co = lme4::fixef(object@fitD) + } else{ + lm_co = co } + co[names(demangle_names(lm_co))] = demangle_names(lm_co) if(!singular) co <- co[!is.na(co)] - conm <- names(co) - ## because of backtick shenanigans - names(co) <- str_replace_all(conm, fixed('`'), '') - co + co }) ##' @describeIn LMERlike return the log-likelihood