new 'names' argument for 'parmat'

kingaa · Oct 5, 2021 · c0fa6c7 · c0fa6c7
1 parent 984501a
commit c0fa6c7
Show file tree

Hide file tree

Showing 7 changed files with 48 additions and 13 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: pomp
 Type: Package
 Title: Statistical Inference for Partially Observed Markov Processes
-Version: 4.0.4.2
-Date: 2021-09-24
+Version: 4.0.5.0
+Date: 2021-10-05
 Authors@R: c(person(given=c("Aaron","A."),family="King",
 		role=c("aut","cre"),email="[email protected]"),
 	  person(given=c("Edward","L."),family="Ionides",role=c("aut")),

diff --git a/R/parmat.R b/R/parmat.R
@@ -6,21 +6,22 @@
 ##'
 ##' @param params named numeric vector or matrix of parameters.
 ##' @param nrep number of replicates (columns) desired.
+##' @param names optional character; column names.
 ##' @return \code{parmat} returns a matrix consisting of \code{nrep} copies of
 ##' \code{params}.
 ##' @author Aaron A. King
 ##' @example examples/ricker-bifdiag.R
 ##' @export
-parmat <- function (params, nrep = 1) {
+parmat <- function (params, nrep = 1, names = NULL) {
   d <- dim(params)
   if (is.null(d) || length(d) == 1) {
     matrix(data=params,nrow=length(params),ncol=nrep,
-      dimnames=list(variable=names(params),rep=NULL))
+      dimnames=list(variable=names(params),rep=names))
   } else if (length(d) == 2) {
     matrix(data=params,nrow=nrow(params),ncol=ncol(params)*nrep,
-      dimnames=list(variable=rownames(params),rep=NULL))
+      dimnames=list(variable=rownames(params),rep=names))
   } else {
     matrix(data=params,nrow=nrow(params),ncol=prod(d[-1])*nrep,
-      dimnames=list(variable=rownames(params),rep=NULL))
+      dimnames=list(variable=rownames(params),rep=names))
   }
 }
diff --git a/inst/NEWS b/inst/NEWS
@@ -1,5 +1,10 @@
 _N_e_w_s _f_o_r _p_a_c_k_a_g_e '_p_o_m_p'
 
+_C_h_a_n_g_e_s _i_n '_p_o_m_p' _v_e_r_s_i_o_n _4._0._5:
+
+        • ‘parmat’ now takes an optional argument, ‘names’, which
+          allows the user to name the parameter sets.
+
 _C_h_a_n_g_e_s _i_n '_p_o_m_p' _v_e_r_s_i_o_n _4._0._4:
 
         • The ensemble adjusted Kalman filter (‘eakf’) has been

diff --git a/inst/NEWS.Rd b/inst/NEWS.Rd
@@ -1,5 +1,10 @@
 \name{NEWS}
 \title{News for package `pomp'}
+\section{Changes in \pkg{pomp} version 4.0.5}{
+  \itemize{
+    \item \code{parmat} now takes an optional argument, \code{names}, which allows the user to name the parameter sets.
+  }
+}
 \section{Changes in \pkg{pomp} version 4.0.4}{
   \itemize{
     \item The ensemble adjusted Kalman filter (\code{eakf}) has been refactored.

diff --git a/man/parmat.Rd b/man/parmat.Rd
diff --git a/tests/parmat.R b/tests/parmat.R
@@ -7,8 +7,19 @@ p
 p["b",] <- 1:3
 p <- parmat(p,2)
 p
-theta <- array(1:30,dim=c(5,3,2),dimnames=list(head(letters,5),NULL,NULL))
+theta <- array(
+  1:30,dim=c(5,3,2),
+  dimnames=list(head(letters,5),head(LETTERS,3),NULL)
+)
 p <- parmat(theta,2)
 p
-theta <- array(1:30,dim=c(5,3,2,1,1,1),dimnames=list(head(letters,5),NULL,NULL))
-stopifnot(all.equal(p,parmat(theta,2)))
+theta <- array(
+  1:30,
+  dim=c(5,3,2,1,1,1),
+  dimnames=list(head(letters,5),head(LETTERS,3),NULL)
+)
+q <- parmat(theta,2,names=head(LETTERS,12))
+stopifnot(
+  all.equal(p,parmat(theta,2)),
+  p==q
+)
diff --git a/tests/parmat.Rout.save b/tests/parmat.Rout.save
@@ -38,7 +38,10 @@ variable [,1] [,2] [,3] [,4] [,5] [,6]
        b    1    2    3    1    2    3
        c    4    4    4    4    4    4
        d    5    5    5    5    5    5
-> theta <- array(1:30,dim=c(5,3,2),dimnames=list(head(letters,5),NULL,NULL))
+> theta <- array(
++   1:30,dim=c(5,3,2),
++   dimnames=list(head(letters,5),head(LETTERS,3),NULL)
++ )
 > p <- parmat(theta,2)
 > p
         rep
@@ -48,6 +51,14 @@ variable [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
        c    3    8   13   18   23   28    3    8   13    18    23    28
        d    4    9   14   19   24   29    4    9   14    19    24    29
        e    5   10   15   20   25   30    5   10   15    20    25    30
-> theta <- array(1:30,dim=c(5,3,2,1,1,1),dimnames=list(head(letters,5),NULL,NULL))
-> stopifnot(all.equal(p,parmat(theta,2)))
+> theta <- array(
++   1:30,
++   dim=c(5,3,2,1,1,1),
++   dimnames=list(head(letters,5),head(LETTERS,3),NULL)
++ )
+> q <- parmat(theta,2,names=head(LETTERS,12))
+> stopifnot(
++   all.equal(p,parmat(theta,2)),
++   p==q
++ )
 >