fix bug; improve coverage

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: pomp
 Type: Package
 Title: Statistical Inference for Partially Observed Markov Processes
-Version: 4.6.1.0
-Date: 2023-01-11
+Version: 4.6.1.1
+Date: 2023-01-13
 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")),

R/covariate_table.R

@@ -94,10 +94,8 @@ setMethod(
   "covariate_table",
   signature=signature(times="numeric"),
   definition=function (..., order = c("linear", "constant"), times) {
-
     order <- match.arg(order)
     env <- parent.frame(2)
-
     tryCatch(
       covariate_table_internal(...,times=times,order=order,env=env),
       error = function (e) pStop("covariate_table",conditionMessage(e))
@@ -112,10 +110,8 @@ setMethod(
   "covariate_table",
   signature=signature(times="character"),
   definition=function (..., order = c("linear", "constant"), times) {
-
     order <- match.arg(order)
     env <- parent.frame(2)
-
     tryCatch(
       covariate_table_internal(...,.timevar=times,order=order,env=env),
       error = function (e) pStop("covariate_table",conditionMessage(e))

R/melt.R

@@ -35,7 +35,22 @@ setMethod(
   "melt",
   signature=signature(data="ANY"),
   definition=function (data, ...) {
-    data.frame(value=data)
+    if (is.null(names(data))) {
+      data.frame(
+        value=data,
+        row.names=NULL,
+        check.names=FALSE,
+        fix.empty.names=FALSE
+      )
+    } else {
+      data.frame(
+        name=names(data),
+        value=data,
+        row.names=NULL,
+        check.names=FALSE,
+        fix.empty.names=FALSE
+      )
+    }
   }
 )
 
@@ -48,6 +63,7 @@ setMethod(
   signature=signature(data="array"),
   definition=function (data, ...) {
     dn <- dimnames(data)
+    if (is.null(dn)) dn <- vector(mode="list",length=length(dim(data)))
     nullnames <- which(unlist(lapply(dn,is.null)))
     dn[nullnames] <- lapply(nullnames,\(i)seq_len(dim(data)[i]))
     labels <- expand.grid(dn,KEEP.OUT.ATTRS=FALSE,stringsAsFactors=FALSE)

R/obs.R

@@ -61,6 +61,6 @@ setMethod(
   "obs",
   signature=signature(object="listie"),
   definition=function (object, vars, ...) {
-    lapply(object,obs)
+    lapply(object,obs,vars=vars)
   }
 )

R/pfilter.R

@@ -30,7 +30,7 @@
 ##' @param filter.mean logical; if \code{TRUE}, the filtering means are calculated for the state variables and parameters.
 ##'
 ##' @param filter.traj logical; if \code{TRUE}, a filtered trajectory is returned for the state variables and parameters.
-##' See \code{\link{filter.traj}} for more information.
+##' See \code{\link{filter_traj}} for more information.
 ##'
 ##' @param save.states character;
 ##' If \code{save.states="unweighted"}, the state-vector for each unweighted particle at each time is saved.

R/pmcmc.R

@@ -32,7 +32,7 @@
 ##' \item{\code{pmcmc}}{repeats the calculation, beginning with the last state}
 ##' \item{\code{\link{continue}}}{continues the \code{pmcmc} calculation}
 ##' \item{\code{plot}}{produces a series of diagnostic plots}
-##' \item{\code{\link{filter.traj}}}{extracts a random sample from the smoothing distribution}
+##' \item{\code{\link{filter_traj}}}{extracts a random sample from the smoothing distribution}
 ##' \item{\code{\link{traces}}}{produces an \code{\link[coda]{mcmc}} object, to which the various \pkg{coda} convergence diagnostics can be applied}
 ##' }
 ##'

R/states.R

@@ -64,6 +64,6 @@ setMethod(
   "states",
   signature=signature(object="listie"),
   definition=function (object, vars, ...) {
-    lapply(object,states)
+    lapply(object,states,vars=vars)
   }
 )

tests/concat.R

@@ -9,6 +9,10 @@ gompertz() -> gompertz
 ou2() -> ou2
 pomp:::concat(a=ou2,c(b=gompertz,c=ou2))
 c(a=ou2,c(b=gompertz,c=ou2)) |> class()
+c(a=ou2,b=ou2(alpha_1=-11)) -> pomps
+pomps |> coef()
+pomps |> obs(vars="y1") |> melt() |> head()
+pomps |> states(vars="x2") |> melt() |> head()
 
 replicate(2,pfilter(gompertz,Np=10)) |> class()
 do.call(c,replicate(2,pfilter(gompertz,Np=10))) -> pfs
@@ -34,3 +38,4 @@ stopifnot(
   rownames(cc)==names(coef(pfs[[1]])),
   colnames(cc)==names(pfs)
 )
+

tests/concat.Rout.save

@@ -50,6 +50,36 @@ $c
 [1] "pompList"
 attr(,"package")
 [1] "pomp"
+> c(a=ou2,b=ou2(alpha_1=-11)) -> pomps
+> pomps |> coef()
+         .id
+parameter    a     b
+  alpha_1  0.8 -11.0
+  alpha_2 -0.5  -0.5
+  alpha_3  0.3   0.3
+  alpha_4  0.9   0.9
+  sigma_1  3.0   3.0
+  sigma_2 -0.5  -0.5
+  sigma_3  2.0   2.0
+  tau      1.0   1.0
+  x1_0    -3.0  -3.0
+  x2_0     4.0   4.0
+> pomps |> obs(vars="y1") |> melt() |> head()
+  .L1 variable time value
+1   a       y1    1 -4.05
+2   a       y1    2  1.83
+3   a       y1    3 -1.32
+4   a       y1    4  6.64
+5   a       y1    5  6.58
+6   a       y1    6  7.54
+> pomps |> states(vars="x2") |> melt() |> head()
+  .L1 variable time value
+1   a       x2    1  4.25
+2   a       x2    2  6.84
+3   a       x2    3  7.59
+4   a       x2    4  6.49
+5   a       x2    5  1.84
+6   a       x2    6 -1.57
 > 
 > replicate(2,pfilter(gompertz,Np=10)) |> class()
 [1] "list"
@@ -89,3 +119,4 @@ $b2
 +   colnames(cc)==names(pfs)
 + )
 > 
+> 

tests/helpers.R

@@ -95,3 +95,11 @@ stopifnot(
   all.equal(z1,z2,check.attributes=FALSE),
   all.equal(z1,z3,check.attributes=FALSE)
 )
+
+list(
+  a=1:5,
+  b=c(a=5,b=2),
+  c=array(rnorm(3),dim=3,dimnames=list(name=NULL)),
+  d=array(rnorm(3),dim=3),
+  e=array(rnorm(2),dim=2,dimnames=list(name=LETTERS[14:15]))
+) |> melt()

tests/helpers.Rout.save

@@ -286,3 +286,27 @@ Error : in 'melt': refusing to melt data of incompatible types.
 +   all.equal(z1,z3,check.attributes=FALSE)
 + )
 > 
+> list(
++   a=1:5,
++   b=c(a=5,b=2),
++   c=array(rnorm(3),dim=3,dimnames=list(name=NULL)),
++   d=array(rnorm(3),dim=3),
++   e=array(rnorm(2),dim=2,dimnames=list(name=LETTERS[14:15]))
++ ) |> melt()
+   .L1      value name Var1
+1    a  1.0000000 <NA>   NA
+2    a  2.0000000 <NA>   NA
+3    a  3.0000000 <NA>   NA
+4    a  4.0000000 <NA>   NA
+5    a  5.0000000 <NA>   NA
+6    b  5.0000000    a   NA
+7    b  2.0000000    b   NA
+8    c  1.1692565    1   NA
+9    c -1.3578778    2   NA
+10   c -1.0923684    3   NA
+11   d  0.1172689 <NA>    1
+12   d  0.3549312 <NA>    2
+13   d  1.6241228 <NA>    3
+14   e  1.3449047    N   NA
+15   e  0.3683851    O   NA
+>