From c6cbf56935f89d322e35d85ac4404a7b8099dbe9 Mon Sep 17 00:00:00 2001 From: Martin Elff Date: Thu, 14 Apr 2022 18:25:19 +0200 Subject: [PATCH] Fixed bug in 'blockMatrix' and make it check for argument validity --- pkg/DESCRIPTION | 4 ++-- pkg/R/blockMatrices.R | 20 +++++++++++++++++++- pkg/inst/ChangeLog | 3 +++ 3 files changed, 24 insertions(+), 3 deletions(-) diff --git a/pkg/DESCRIPTION b/pkg/DESCRIPTION index ecc3613..74b3fa1 100644 --- a/pkg/DESCRIPTION +++ b/pkg/DESCRIPTION @@ -1,8 +1,8 @@ Package: mclogit Type: Package Title: Multinomial Logit Models, with or without Random Effects or Overdispersion -Version: 0.9.4.1 -Date: 2022-04-11 +Version: 0.9.4.2 +Date: 2022-04-14 Author: Martin Elff Maintainer: Martin Elff Description: Provides estimators for multinomial logit models in their diff --git a/pkg/R/blockMatrices.R b/pkg/R/blockMatrices.R index 2b40a69..377a138 100644 --- a/pkg/R/blockMatrices.R +++ b/pkg/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") } diff --git a/pkg/inst/ChangeLog b/pkg/inst/ChangeLog index 1894299..329647e 100755 --- a/pkg/inst/ChangeLog +++ b/pkg/inst/ChangeLog @@ -1,3 +1,6 @@ +2022-04-13: + - Fixed bug in 'blockMatrix' and make it check for argument validity + 2022-04-11: - Hotfix of prediction method