Improved 'getSummary()' methods.

pkg/DESCRIPTION

@@ -1,8 +1,8 @@
 Package: memisc
 Type: Package
 Title: Management of Survey Data and Presentation of Analysis Results
-Version: 0.99.25.7
-Date: 2020-07-14
+Version: 0.99.26
+Date: 2020-07-28
 Author: Martin Elff (with contributions from Christopher N. Lawrence, Dave Atkins, Jason W. Morgan, Achim Zeileis)
 Maintainer: Martin Elff <memisc@elff.eu>
 Description: An infrastructure for the management of survey data including

pkg/NAMESPACE

@@ -143,6 +143,8 @@ S3method(getSummary,survreg)
 S3method(getSummary,tobit)
 S3method(getSummary,weibreg)
 S3method(getSummary_expcoef,glm)
+S3method(getSummary,clm)
+S3method(getSummary,clmm)
 S3method(sort,data.frame)
 S3method(sort,data.set)
 S3method(print,memisc_mtable)

pkg/R/rabind.R

@@ -0,0 +1,22 @@
+rabind2 <- function(x,y){
+    if(!length(x)) return(y)
+    else if(!length(y)) return(x)
+    else {
+        rnx <- rownames(x)
+        rny <- rownames(y)
+        nrx <- nrow(x)
+        nry <- nrow(y)
+        dimx <- dim(x)[-1]
+        dimy <- dim(y)[-1]
+        stopifnot(all(dimx==dimy))
+        dimnx <- dimnames(x)[-1]
+        dimny <- dimnames(y)[-1]
+        x <- array(x,dim=c(nrx,prod(dimx)))
+        y <- array(y,dim=c(nry,prod(dimy)))
+        z <- rbind(x,y)
+        dim(z) <- c(nrx+nry,dimx)
+        dimnames(z) <- c(list(c(rnx,rny)),
+                         dimnx)
+        return(z)
+    }
+}

pkg/R/yz-getSummary-merMod.R

@@ -1,12 +1,14 @@
 setSummaryTemplate(lmerMod = c("Log-likelihood" = "($logLik:f#)",
                      "Deviance" = "($deviance:f#)",
                      "AIC" = "($AIC:f#)",
-                     "BIC" = "($BIC:f#)"))
+                     "BIC" = "($BIC:f#)",
+                     N     = "($N:d)"))
 
 setSummaryTemplate(glmerMod = c("Log-likelihood" = "($logLik:f#)",
                                "Deviance" = "($deviance:f#)",
                                "AIC" = "($AIC:f#)",
-                               "BIC" = "($BIC:f#)"))
+                               "BIC" = "($BIC:f#)",
+                               N     = "($N:d)"))
 
 getSummary.merMod <- function (obj, alpha = 0.05, ...) {
 
@@ -33,8 +35,7 @@ getSummary.merMod <- function (obj, alpha = 0.05, ...) {
 
   varcor <- smry$varcor
 
-  VarPar <- list()
-  VarPar.names <- c()
+  VarPar <- NULL
 
   for(i in seq_along(varcor)){
     vc.i <- varcor[[i]]
@@ -54,9 +55,7 @@ getSummary.merMod <- function (obj, alpha = 0.05, ...) {
     dimnames(vp.i) <- list(c(vrnames.i,cvnames.i),
                            c("est","se","stat","p","lwr","upr"),
                            names(obj@frame)[1])
-    VarPar <- c(VarPar,list(vp.i))
-    VarPar.names <- c(VarPar.names,
-                      paste0("Var(",lv.i,")"))
+    VarPar <- rabind2(VarPar,vp.i)
   }
   if(smry$sigma!=1){
     vp.i <- matrix(NA,nrow=1,ncol=6)
@@ -65,10 +64,8 @@ getSummary.merMod <- function (obj, alpha = 0.05, ...) {
     dimnames(vp.i) <- list("Var(residual)",
                            c("est","se","stat","p","lwr","upr"),
                            names(obj@frame)[1])
-    VarPar <- c(list(vp.i),VarPar)
-    VarPar.names <- c("Var(residual)",VarPar.names)
+    VarPar <- rabind2(VarPar,vp.i)
   }
-  names(VarPar) <- VarPar.names
 
   ## Factor levels.
   xlevels <- list()
@@ -85,20 +82,19 @@ getSummary.merMod <- function (obj, alpha = 0.05, ...) {
   AIC <- AIC(obj)
   BIC <- BIC(obj)
 
-  N <- c(Total=nobs(obj))
   G <-as.integer(smry$ngrps)
   names(G) <- names(smry$ngrps)
-  G <- c(N,G)
 
   sumstat <- c(logLik = ll,
                deviance = deviance,
                AIC = AIC,
-               BIC = BIC)
+               BIC = BIC,
+               N=nobs(obj))
   ## Return model summary.
 
   ans <- list(coef= coef)
 
-  ans <- c(ans,VarPar)
+  ans <- c(ans,list(Variances=VarPar))
 
   ans <- c(ans,       
            list(Groups = G,

pkg/R/yz-getSummary-ordinal.R

@@ -93,8 +93,8 @@ getSummary.clmm <- function(obj,
                            ...){
 
   smry <- summary(obj)
-  # N <- if(length(weights(obj))) sum(weights(obj))
-  # else smry$nobs
+  N <- if(length(weights(obj))) sum(weights(obj))
+       else nrow(obj$model)
 
   prmtable <- coef(smry)
 
@@ -126,8 +126,8 @@ getSummary.clmm <- function(obj,
 
   varcor <- lapply(obj$ST,tcrossprod)
 
-  VarPar <- list()
-  VarPar.names <- c()
+  VarPar <- NULL
+    
   for(i in seq_along(varcor)){
     vc.i <- varcor[[i]]
     lv.i <- names(varcor)[i]
@@ -146,12 +146,9 @@ getSummary.clmm <- function(obj,
     dimnames(vp.i) <- list(c(vrnames.i,cvnames.i),
                            c("est","se","stat","p","lwr","upr"),
                            names(obj$model)[1])
-    VarPar <- c(VarPar,list(vp.i))
-    VarPar.names <- c(VarPar.names,
-                      paste0("Var(",lv.i,")"))
-  }
-  names(VarPar) <- VarPar.names
-  ans <- c(ans,VarPar)
+    VarPar <- rabind2(VarPar,vp.i)
+ }
+  ans <- c(ans,list(Variances=VarPar))
 
   # null.model <- update(obj, .~1)
 
@@ -181,21 +178,21 @@ getSummary.clmm <- function(obj,
     Nagelkerke <- NA
   # }
 
-  # AIC <- AIC(obj)
+  AIC <- AIC(obj)
   # BIC <- AIC(obj,k=log(N))
   sumstat <- c(
     # LR            = LR,
-    df            = df,
+    # df            = df,
     # p             = p,
     logLik        = ll,
-    deviance      = dev#,
+    deviance      = dev,
     # Aldrich.Nelson = Aldrich.Nelson,
     # McFadden      = McFadden,
     # Cox.Snell       = Cox.Snell,
     # Nagelkerke    = Nagelkerke,
-  #   AIC           = AIC,
+    AIC           = AIC,
   #   BIC           = BIC,
-  #   N             = N
+    N             = N
   )
 
   ans <- c(ans,

pkg/inst/ChangeLog

@@ -1,3 +1,7 @@
+2020-07-28:
+   - Added 'mtable' support for 'clmm' objects (package "ordinal"") and improved
+     support for 'merMod' objects (package "lme4").
+
 2020-07-14:
    - Made sure that variable labels are retained by 'as.vector' and
      'as.data.frame' even for items with 'interval' or 'ratio' level of
@@ -6,7 +10,7 @@
 2020-07-05:
    - Made 'deduplicate_labels' methods for "data.set"-objects a bit more
      resilient
-     
+
 2020-07-05:
    - Fixed bug in the creation of codebooks
 
@@ -37,7 +41,7 @@
      "labelled" as they occur in some imported tibbles.
    - 'as.item()' now drops non-unique labelled values when applied to a
      "labelled", "haven_labelled", or "haven_labelled_spss" object.
-	
+
 2020-06-05:
    - With 'codebook()' it is now possible to disable the display of unweighted
      data summaries.

pkg/inst/NEWS.Rd

@@ -168,11 +168,16 @@
             being run.
      \item  \code{as.item()} now drops non-unique labelled values when applied to a
             "labelled", "haven_labelled", or "haven_labelled_spss" object.
-      \item \code{spss.system.file()} no takes into account metadata about
+     \item \code{spss.system.file()} no takes into account metadata about
             measurement levels ("nominal", "ordinal", or "scale") to set
             the \code{measurement()} attributes of the items in
-            the resulting \code{"importer"} and \code{"data.set"} objects.
-    }
+            the resulting \code{"importer"} and \code{"data.set"}
+            objects.
+     \item \code{mtable()} now handles objects of class "clmm" (from package "ordinal")
+           and the handling of objects of class "merMod" (from package "lme4")
+           is more consistent with those of class "glm" (e.g. the number of
+           observations is shown).
+     }
   }
   \subsection{BUGFIXES}{
   \itemize{