Fix for #143

RGLab · Nov 12, 2020 · cbce94d · cbce94d
1 parent b2650e2
commit cbce94d
Show file tree

Hide file tree

Showing 4 changed files with 24 additions and 17 deletions.
diff --git 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 = "[email protected]", role = c("aut", "cre")),
             person("Greg", "Finak", email="[email protected]", role='aut'),
             person("Masanao", "Yajima", email="[email protected]", role='aut'))

diff --git 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
@@ -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
@@ -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