R Under development (unstable) (2024-12-07 r87428 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.

> 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 <- panelPomp:::panelRandomWalk(U=2,N=5)
> po <- ppo[[1]]
> 
> ep <- wQuotes("Error : in ''mif2'': ")
> et <- wQuotes(" (''mif2,panelPomp-method'')\n")
> ## test checks for missing arguments
> test(wQuotes(ep,"''data'' is a required argument.\n"),
+      mif2(Np=10,rw.sd=rw_sd(sigmaX=0.05,X.0=0.5),cooling.fraction.50=0.5))
[1] TRUE
> test(wQuotes(ep,"Missing ''Np'' argument.",et),
+      mif2(ppo,rw.sd=rw_sd(sigmaX=0.05,X.0=0.5),cooling.fraction.50=0.5))
[1] TRUE
> test(wQuotes(ep,"Missing ''rw.sd'' argument.",et),
+      mif2(ppo,Np=10,cooling.fraction.50=0.5))
[1] TRUE
> test(wQuotes(ep,"Missing ''cooling.fraction.50'' argument.",et),
+      mif2(ppo,Np=10,rw.sd=rw_sd(sigmaX=0.05,X.0=0.5)))
[1] TRUE
> test(wQuotes(ep,"pomp's ''mif2'' error message: in ''mif2'': the following ",
+              "parameter(s), given random walks in ''rw.sd'', are not present ",
+              "in ''params'': ''X.0''. (panelPomp:::mif2.internal)\n"),
+      mif2(panelPomp(unit_objects(ppo)),Np=10,rw.sd=rw_sd(sigmaX=0.05,X.0=0.5),
+          cooling.fraction.50=0.5,sh=shared(ppo)))
[1] TRUE
> 
> # Testing error message if a parameter is both shared and specific
> test(wQuotes(ep,"a parameter cannot be both shared and specific!", et),
+      mif2(panelPomp(unit_objects(ppo),shared=coef(po)),Np=10,sp=specific(ppo),
+           rw.sd=rw_sd(sigmaX=0.05,X.0=0.5),cooling.fraction.50=0.5))
[1] TRUE
> ## assign parameters
> test(# no start (get from object)
+   traces(as(mif2(ppo,Np=10,rw.sd=rw_sd(X.0=0.2),cooling.fraction.50=0.5,
+                  cooling.type="geometric"),"list")[[1]])[1,-1],
+   c(ppo@shared,get_col(ppo@specific,1,1)))
[1] TRUE
> test(# start shared & specific
+   traces(as(mif2(ppo,sh=2*ppo@shared,sp=2*ppo@specific,Np=10,
+                  rw.sd=rw_sd(X.0=0.2),cooling.fraction.50=0.5,
+                  cooling.type="geometric"),"list")[[1]])[1,-1],
+   2*c(ppo@shared,get_col(ppo@specific,1,1)))
[1] TRUE
> test(# start shared only
+   traces(as(mif2(ppo,shared.start=2*ppo@shared,Np=10,rw.sd=rw_sd(X.0=0.2),
+                  cooling.fraction.50=0.5,cooling.type="geometric"),
+             "list")[[1]])[1,-1],
+   c(2*ppo@shared,get_col(ppo@specific,1,1)))
[1] TRUE
> test(# start specific only
+   traces(as(mif2(ppo,sp=2*ppo@specific,Np=10,rw.sd=rw_sd(X.0=0.2),
+                  cooling.fraction.50=0.5,cooling.type="geometric"),
+             "list")[[1]])[1,-1],
+   c(ppo@shared,2*get_col(ppo@specific,1,1)))
[1] TRUE
> test(# start with list
+   traces(as(mif2(ppo,st=list(shared=2*ppo@shared,specific=2*ppo@specific),
+                  Np=10,rw.sd=rw_sd(X.0=0.2),cooling.fraction.50=0.5,
+                  cooling.type="geometric"),"list")[[1]])[1,-1],
+   2*c(ppo@shared,get_col(ppo@specific,1,1)))
[1] TRUE
> test(# start with numeric vector
+   traces(as(mif2(
+     ppo,
+     st=setNames(c(ppo@shared,ppo@specific),
+                 c(names(ppo@shared),"X.0[rw1]","X.0[rw2]")),
+     Np=10,rw.sd=rw_sd(X.0=0.2),
+     cooling.fraction.50=0.5,
+     cooling.type="geometric"),"list")[[1]])[1,-1],
+   c(ppo@shared,get_col(ppo@specific,1,1)))
[1] TRUE
> ## resolve multiple params
> test(wQuotes(ep,"specify EITHER ''start'' only OR ''shared.start'' and/or",
+              " ''specific.start''. (''mif2,panelPomp-method'')\n"),
+      mif2(ppo,shared=2*ppo@shared,
+           start=list(specific=ppo@specific,shared=ppo@shared),Np=10,
+           rw.sd=rw_sd(X.0=0.2),cooling.fraction.50=0.5,
+           cooling.type="geometric"))
[1] TRUE
> test(wQuotes(ep,"specify EITHER ''start'' only OR ''shared.start'' and/or",
+              " ''specific.start''. (''mif2,panelPomp-method'')\n"),
+      mif2(ppo,specific=2*ppo@specific,
+           start=list(shared=ppo@shared,specific=ppo@specific),Np=10,
+           rw.sd=rw_sd(X.0=0.2),cooling.fraction.50=0.5,
+           cooling.type="geometric"))
[1] TRUE
> test(wQuotes(ep,"specify EITHER ''start'' only OR ''shared.start'' and/or",
+              " ''specific.start''. (''mif2,panelPomp-method'')\n"),
+      mif2(ppo,sh=2*ppo@shared,sp=2*ppo@specific,
+           st=list(shared=ppo@shared,specific=ppo@specific),
+           Np=10,rw.sd=rw_sd(sigmaX=0.05,X.0=0.5),cooling.fraction.50=0.5,
+           cooling.type="geometric"))
[1] TRUE
> ## wrong unit names
> test(wQuotes(ep,"specific parameter column-names must match the names of the ",
+              "units\n"),
+      {sp <- ppo@specific
+      colnames(sp) <- paste0(colnames(sp), "_")
+      mif2(ppo,Np=10,sp=sp,rw.sd=rw_sd(X.0=0.2),cooling.fraction.50=0.5,
+           cooling.type="geometric")})
[1] TRUE
> ## wrong unit-specific names
> test(wQuotes(ep,"pomp's ''mif2'' error message: in ''mif2'': the following ",
+              "parameter(s), given random walks in ''rw.sd'', are not present ",
+              "in ''params'': ''X.0''. (panelPomp:::mif2.internal)\n"),
+      {sp <- ppo@specific
+      rownames(sp) <- c("some_wrong_name")
+      mif2(ppo,Np=10,sp=sp,rw.sd=rw_sd(X.0=0.2),cooling.fraction.50=0.5,
+           cooling.type="geometric")})
[1] TRUE
> ##  wrong shared names
> test(wQuotes(ep,"pomp's ''mif2'' error message: in ''mif2'': in ''rprocess'': ",
+              "variable 'sigmaY' not found among the parameters. ",
+              "(panelPomp:::mif2.internal)\n"),
+      mif2(ppo,Np=10,sh=c(sth=0),rw.sd=rw_sd(X.0=0.2),cooling.fraction.50=0.5,
+           cooling.type="geometric"))
[1] TRUE
> 
> mf <- mif2(ppo,Np=10,rw.sd=rw_sd(X.0=0.2),
+            cooling.fraction.50=0.5,cooling.type="geometric")
> mf <- mif2(mf,Nmif=2,start=coef(mf))
> 
> wQuotes(ep,"specify EITHER ''start'' only OR ''shared.start'' and/or",
+         " ''specific.start''. (''mif2,mif2d.ppomp-method'')\n") -> err
> test(err,mif2(mf,Nmif=2,start=coef(mf),sh=2*ppo@shared,sp=2*ppo@specific))
[1] TRUE
> test(err,mif2(mf,Nmif=2,start=coef(mf),sp=2*ppo@specific))
[1] TRUE
> test(err,mif2(mf,Nmif=2,start=coef(mf),sh=2*ppo@shared))
[1] TRUE
> test(dim(traces(mf)),c(3L,7L))
[1] TRUE
> test(dim(traces(mf,c("loglik","sigmaY"))),c(3L,2L))
[1] TRUE
> test(dim(traces(mf,c("loglik","sigmaY","X.0"))),c(3L,4L))
[1] TRUE
> test(dim(traces(mf,c("loglik","unitLoglik"))),c(3L,3L))
[1] TRUE
> 
> # Testing if parameter is both shared and specific (mif2d)
> sh_pars <- c("sigmaX" = 1, "sigmaY" = 1)
> sp_pars <- rbind(mf@specific, c(1, 1))
> rownames(sp_pars) <- c(rownames(mf@specific), "sigmaX")
> test(
+   wQuotes(ep,"a parameter cannot be both shared and specific! (''mif2,mif2d.ppomp-method'')\n"),
+   mif2(mf, Nmif = 2, shared.start = sh_pars, specific.start = sp_pars)
+ )
[1] TRUE
> 
> ## 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 
   1.07    0.17    3.98