R Under development (unstable) (2024-09-06 r87103 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> ## test codes in R/panelPomp_methods.R
> if (file.exists("_options.R")) source("_options.R")
> library(panelPomp,quietly=TRUE)
> 
> TESTS_PASS <- NULL
> test <- function(expr1,expr2,all="TESTS_PASS",env=parent.frame(),...)
+   panelPomp:::test(expr1,expr2,all=all,env=env,...)
> 
> ppo <- panelRandomWalk(U=2,N=5)
> pP2 <- list(shared=c(sigmaX=1,sigmaY=2),
+             specific=matrix(c(0,0.1),nr=1,
+                             dimnames=list(param="X.0",unit=c("rw1","rw2"))))
> ppo <- panelPomp(unit_objects(ppo),shared=pP2$shared,specific=pP2$specific)
> # other definitions from old test file
> pg <- panelGompertz(U=3,N=5)
> pgl <- as(pg,"list")
> g <- pgl[[1]]; coef(g) <- c(shared(pg), specific(pg)[,1])
> pp <- panelPomp(list(g,g),shared=pg@shared,
+                 specific=pg@specific[,1:2])
> 
> ## coef,panelPomp-method
> test(coef(ppo),
+      setNames(c(1,2,0,0.1),c("sigmaX","sigmaY","X.0[rw1]","X.0[rw2]")))
[1] TRUE
> 
> ## coef<-,panelPomp-method
> test(coef(ppo),{coef(ppo) <- 2*coef(ppo);coef(ppo) <- coef(ppo)/2;coef(ppo)})
[1] TRUE
> test(coef(ppo),
+      {coef(ppo) <- as.list(
+        setNames(c(1,2,0,0.1),c("sigmaX","sigmaY","X.0[rw1]","X.0[rw2]")))
+      coef(ppo)})
[1] TRUE
> wQuotes("Error : in ''coef<-'': part of ''value'' is not part of ",
+                "''coef(object)''.\n") -> err
> test(coef(ppo) <- c(ppo@shared,xsh=5),err)
[1] TRUE
> test(coef(ppo) <- c(coef(ppo),xsh=5),err)
[1] TRUE
> test({coef(ppo) <- setNames(
+   c(coef(ppo),5,6),c(names(coef(ppo)),
+                      sprintf("xsp[rw1]"),sprintf("xsp[rw2]")))},err)
[1] TRUE
> test({coef(ppo) <- setNames(
+   c(coef(ppo),5,6,7),c(names(coef(ppo)),
+                        sprintf("xsp[rw1]"),sprintf("xsp[rw2]"),"xsh"))},err)
[1] TRUE
> test({coef(ppo) <- setNames(
+   c(coef(ppo)[-c(1:2)],5,6),c(names(coef(ppo)[-c(1:2)]),
+                               sprintf("xsp[rw1]"),sprintf("xsp[rw2]")))},err)
[1] TRUE
> wQuotes("Error : in ''coef<-'': part of ''coef(object)'' is not specified ",
+                "in ''value''.\n") -> err
> test(coef(ppo) <- coef(ppo)[-c(1:2)],err)
[1] TRUE
> test(coef(ppo) <- ppo@shared,err)
[1] TRUE
> ## test length,panelPomp-method
> test(length(ppo),2L)
[1] TRUE
> ## test names,panelPomp-method
> test(names(ppo),c("rw1","rw2"))
[1] TRUE
> ## test coef(..., format = 'list'),panelPomp-method
> test(coef(ppo, format = 'list'),list(shared=ppo@shared,specific=ppo@specific))
[1] TRUE
> ## test pParams function
> ## all sh
> test(toParamList(coef(ppo)[grep("^.+\\[.+?\\]$",names(coef(ppo)),perl=TRUE,
+                             value=TRUE,invert=TRUE)]),
+      list(shared=ppo@shared,specific=array(numeric(0),dim=c(0,0))))
[1] TRUE
> ## all sp
> test(list(shared=numeric(0),specific=ppo@specific),
+      toParamList(coef(ppo)[grep("^.+\\[.+?\\]$",names(coef(ppo)),perl=TRUE,
+                             value=TRUE)]))
[1] TRUE
> ## both sh & sp
> test(toParamList(coef(ppo)),list(shared=ppo@shared,specific=ppo@specific))
[1] TRUE
> 
> # Test error message if toParamList used on data.frame / list
> test(
+   wQuotes("Error : in ''toParamList'': ", "input is already a list.\n"),
+   toParamList(data.frame('par1' = 1, 'par2' = 2))
+ )
[1] TRUE
> 
> # Test error message if toParamList used on matrix
> test(
+   wQuotes("Error : in ''toParamList'': ", "input must be a vector.\n"),
+   toParamList(matrix(c(1, 2, 3)))
+ )
[1] TRUE
> 
> ## test unit_objects,panelPomp-method
> test(unit_objects(ppo),ppo@unit_objects)
[1] TRUE
> coef(ppo[["rw1"]])
sigmaX sigmaY    X.0 
     1      2      0 
> ## test print function (tested in 'print-results.Rout.save')
> ## test show function (tested in 'print-results.Rout.save')
> ## test window,panelPomp-method
> test(length(ppo[1])==1L)
[1] TRUE
> test(setNames(c(1,2,0),c("sigmaX","sigmaY",sprintf("X.0[rw1]"))),
+      coef(ppo[1]))
[1] TRUE
> test(lapply(as(window(ppo,start=2),"list"),time),list(rw1=c(2,3,4,5),rw2=c(2,3,4,5)))
[1] TRUE
> test(lapply(as(window(ppo,end=2),"list"),time),list(rw1=c(1,2),rw2=c(1,2)))
[1] TRUE
> test(length(window(ppo[1:2],start=1,end=2)),2L)
[1] TRUE
> test(lapply(as(window(ppo[1],start=1,end=2),"list"),time),list(rw1=c(1,2)))
[1] TRUE
> 
> 
> 
> ## as(,'list') returns list of units with parameters
> test(as(pg,"list")[[1]]@data,pg@unit_objects[[1]]@data)
[1] TRUE
> 
> ## as(,'pompList')
> test(as(pg,'pompList')[[1]]@data,pg@unit_objects[[1]]@data)
[1] TRUE
> 
> ## test as(,'data.frame')
> test(dim(as(pg,"data.frame")),c(15L,4L))
[1] TRUE
> test(names(as(pg,"data.frame")),c("t","Y","X","unit"))
[1] TRUE
> 
> ## show
> show(ppo)
<object of class 'panelPomp'>
panel of 2 units 
parameter(s):
$shared
sigmaX sigmaY 
     1      2 

$specific
     unit
param rw1 rw2
  X.0   0 0.1

summary of first panel unit ("rw1"):
<object of class 'pomp'>
> show(panelPomp(unit_objects(ppo)))
<object of class 'panelPomp'>
panel of 2 units 
parameter(s) unspecified
summary of first panel unit ("rw1"):
<object of class 'pomp'>
> 
> ## check whether all tests passed
> all(get(eval(formals(test))$all))
[1] TRUE
> if (!all(get(eval(formals(test))$all))) stop("Not all tests passed!")
> 
> proc.time()
   user  system elapsed 
   0.56    0.09    4.14