version 0.9.4.2

DESCRIPTION

@@ -2,8 +2,8 @@ Package: mclogit
 Type: Package
 Title: Multinomial Logit Models, with or without Random Effects or
         Overdispersion
-Version: 0.9.4
-Date: 2022-04-10
+Version: 0.9.4.2
+Date: 2022-04-14
 Author: Martin Elff
 Maintainer: Martin Elff <mclogit@elff.eu>
 Description: Provides estimators for multinomial logit models in their
@@ -22,6 +22,6 @@ URL: http://mclogit.elff.eu,https://github.com/melff/mclogit/
 BugReports: https://github.com/melff/mclogit/issues
 RoxygenNote: 7.1.1
 NeedsCompilation: no
-Packaged: 2022-04-11 09:03:13 UTC; elff
+Packaged: 2022-04-19 15:39:59 UTC; elff
 Repository: CRAN
-Date/Publication: 2022-04-11 09:42:34 UTC
+Date/Publication: 2022-04-19 16:22:35 UTC

MD5

@@ -1,16 +1,16 @@
-ff7022ea9ef40efbfa662cfd2610bc45 *DESCRIPTION
+cd2b8e9f3dc844ae6fc1e5d551eda3b5 *DESCRIPTION
 253457c7632c75e465a2a23d604b0a49 *NAMESPACE
 5f46b25a049e81e86774e78cd294ff89 *R/AIC-mclogit.R
 7b1e9ee3e3ef8d915b8cd2485db79b62 *R/anova-mclogit.R
-a807d113ca4268914fc1db4e4ef06d01 *R/blockMatrices.R
+93500a8be28832c880c99ea0bbfcbb24 *R/blockMatrices.R
 dacab808f8b9ce42192cf24ea874652a *R/emmeans.R
 fa959f9bebaf365d4cf273e33f4cebde *R/formula-utils.R
 e83609e43103c2645274bd60bd3badf0 *R/getSummary-mblogit.R
 a78012b2522420f4e4fcc38760d5fe85 *R/getSummary-mclogit.R
-e11e37f4f188bb196ea42d18e13b084b *R/mblogit.R
+e408f51d78128fb90e2cd6a833c2dcc9 *R/mblogit.R
 f814c3a2ac1bd0a7a0d953085bb68f4d *R/mclogit-dispersion.R
 9b50da844676fa0ac31cc173f5472c02 *R/mclogit-fit.R
-b51de5b3adbc3f99092523c75703ea98 *R/mclogit.R
+855b2785b462b728ffc3418b38d8e5b4 *R/mclogit.R
 78830475ad62c28b244985c0b1d60429 *R/mmclogit-fitPQLMQL.R
 457a0140aed815ca117ea94b2599e3b2 *R/zzz.R
 1961639f6f4f7f9efffa91b624b3d060 *build/partial.rdb
@@ -19,7 +19,7 @@ fe44b1179e12537413f7fd898a7c5ee2 *data/Transport.rda
 ed465db40af36367e177732466dfb56b *demo/00Index
 8d2478382a70e25be6cf209394748af2 *demo/mclogit.test.R
 40dc38ba49744a8f05ca9463b8e54c28 *demo/test-mblogit-random-nonnested.R
-c56d05155b9512de6f949ecbefe6f6cd *inst/ChangeLog
+e5226b5d99550a6873a9dc449939d5a2 *inst/ChangeLog
 2f897237099dc581ac88952ae4870f9a *inst/NEWS.Rd
 c05ff442f7a2312ff8f3d6b5aa96ddeb *man/Transport.Rd
 0fa123411869d0d1646b5b58b5a9ad6d *man/dispersion.Rd

R/blockMatrices.R

@@ -1,6 +1,24 @@
-blockMatrix <- function(x=list(),nrow=1,ncol=1){
+all_equal <- function(x) length(unique(x)) == 1
+
+blockMatrix <- function(x=list(),nrow,ncol,horizontal=TRUE){
     if(!is.list(x)) x <- list(x)
+    if(horizontal){
+        if(missing(nrow)) nrow <- 1
+        if(missing(ncol)) ncol <- length(x)
+    }
+    else {
+        if(missing(nrow)) nrow <- length(x)
+        if(missing(ncol)) ncol <- 1
+    }
     y <- matrix(x,nrow=nrow,ncol=ncol)
+    ncols <- apply(y,1:2,ncol)
+    nrows <- apply(y,1:2,nrow)
+    ncols <- array(sapply(y,ncol),dim=dim(y))
+    nrows <- array(sapply(y,nrow),dim=dim(y))
+    nrows_equal <- apply(nrows,1,all_equal)
+    ncols_equal <- apply(ncols,2,all_equal)
+    if(!all(nrows_equal)) stop("Non-matching numbers of rows")
+    if(!all(ncols_equal)) stop("Non-matching numbers of columns")
     structure(y,class="blockMatrix")
 }
 

R/mblogit.R

@@ -842,7 +842,7 @@ predict.mmblogit <- function(object, newdata=NULL,type=c("link","response"),se.f
         olevels <- lapply(orig.groups,levels)
         randstruct <- lapply(1:nn,function(k){
             group.labels <- random[[k]]$groups
-            groups <- mf[group.labels]
+            groups <- rmf[group.labels]
             groups <- lapply(groups,as.factor)
             nlev <- length(groups)
             if(nlev > 1){

R/mclogit.R

@@ -809,7 +809,7 @@ predict.mmclogit <- function(object, newdata=NULL,type=c("link","response"),se.f
         olevels <- lapply(orig.groups,levels)
         randstruct <- lapply(1:nn,function(k){
             group.labels <- random[[k]]$groups
-            groups <- mf[group.labels]
+            groups <- rmf[group.labels]
             groups <- lapply(groups,as.factor)
             nlev <- length(groups)
             if(nlev > 1){
@@ -1026,7 +1026,14 @@ fuseMat <- function(x){
     else
         y <- x
 
-    do.call(rbind,y)
+    y <- do.call(rbind,y)
+    # The following looks redundant, but appears to
+    # be necessary to avoid a bug that prevents the 
+    # resulting matrix be correctly inverted
+    sparse.x <- sapply(x,inherits,"sparseMatrix")
+    if(any(sparse.x))
+        y <- as(y,"sparseMatrix")
+    return(y)
 }
 
 cbindList <- function(x) do.call(cbind,x)

inst/ChangeLog

@@ -1,3 +1,9 @@
+2022-04-13:
+  - Fixed bug in 'blockMatrix' and make it check for argument validity
+
+2022-04-11:
+  - Hotfix of prediction method
+
 2022-04-10:
   - Fix handling of singular initial covariance matrices in PQLMQL_innerFit
   - Issue a warning if models with random effects are compared using anova