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. > 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,...) > > pg <- panelGompertz(U=5,N=3) > pg <- panelPomp(pg[1:3]) > pgl <- as(pg,"list") > g <- pgl[[1]]; coef(g) <- c(shared(pg), specific(pg)[,1]) > coef(g) r sigma K tau X.0 0.1 0.1 1.0 0.1 1.0 > coef(pg) r sigma K[unit1] tau[unit1] X.0[unit1] K[unit2] tau[unit2] 0.1 0.1 1.0 0.1 1.0 1.0 0.1 X.0[unit2] K[unit3] tau[unit3] X.0[unit3] 1.0 1.0 0.1 1.0 > coef(panelPomp(pg,shared=NULL)) K[unit1] tau[unit1] X.0[unit1] K[unit2] tau[unit2] X.0[unit2] K[unit3] 1.0 0.1 1.0 1.0 0.1 1.0 1.0 tau[unit3] X.0[unit3] 0.1 1.0 > coef(panelPomp(pg,specific=names(coef(g)))) K[unit1] tau[unit1] X.0[unit1] r[unit1] sigma[unit1] K[unit2] 1.0 0.1 1.0 0.1 0.1 1.0 tau[unit2] X.0[unit2] r[unit2] sigma[unit2] K[unit3] tau[unit3] 0.1 1.0 0.1 0.1 1.0 0.1 X.0[unit3] r[unit3] sigma[unit3] 1.0 0.1 0.1 > coef(panelPomp(pg,shared=c(r=0.1,sigma=0.1,K=1))) r sigma K tau[unit1] X.0[unit1] tau[unit2] X.0[unit2] 0.1 0.1 1.0 0.1 1.0 0.1 1.0 tau[unit3] X.0[unit3] 0.1 1.0 > coef(panelPomp(pg,specific=c("r","K","tau","X.0"))) sigma K[unit1] tau[unit1] X.0[unit1] r[unit1] K[unit2] tau[unit2] 0.1 1.0 0.1 1.0 0.1 1.0 0.1 X.0[unit2] r[unit2] K[unit3] tau[unit3] X.0[unit3] r[unit3] 1.0 0.1 1.0 0.1 1.0 0.1 > try(panelPomp(pg,specific=c("tau","X.0"),params=c(r=3,K=1))) Error : in 'panelPomp': specify EITHER 'params' OR 'shared' and/or 'specific'. > stopifnot(all.equal(coef(panelPomp(pg,params=coef(g))),coef(g))) > try(panelPomp(pg,params=list(bob=3,nancy="A"))) Error : in 'panelPomp': 'params' must be a named numeric vector > try(panelPomp(pg,shared=c("r","K"))) Error : in 'panelPomp': 'shared' must be a named numeric vector or NULL > try(panelPomp(pg,specific=c(0.3))) Error : in 'panelPomp': if given as a vector, 'specific' must have names > coef(panelPomp(pg,specific=c(r=0.3))) sigma r[unit1] r[unit2] r[unit3] 0.1 0.3 0.3 0.3 > try(panelPomp(pg,specific="h")) Error : in 'panelPomp': the following parameters are to be treated as specific, but no values for them are specified: 'h' > try(panelPomp(pg,specific="h",shared=c(r=33))) Error : in 'panelPomp': the following parameters are to be treated as specific, but no values for them are specified: 'h' > try(panelPomp(pg,specific=list(r=0.3,K=9))) Error : in 'panelPomp': 'specific' must be furnished as a numeric matrix, a numeric vector, or a character vector > coef(panelPomp(pg,specific=c("tau","X.0"),shared=c(r=3,K=1))) r K tau[unit1] X.0[unit1] tau[unit2] X.0[unit2] tau[unit3] 3.0 1.0 0.1 1.0 0.1 1.0 0.1 X.0[unit3] 1.0 > try(panelPomp(setNames(pgl,c("a","b","")))) Error : in 'panelPomp': empty unit names are not permitted > coef(pgl[[2]]) <- c(h=3) > try(po <- panelPomp(pgl)) Warning message: in 'panelPomp': NAs in specific parameters > try(panelPomp(pgl[[1]])) Error : in 'panelPomp': 'object' must be either a 'panelPomp' object or a list of 'pomp' objects. > > > > ppo <- panelRandomWalk(U=2,N=5) > pos <- as(ppo,"list") > pPs <- coef(ppo, format = 'list') > all_sh <- c(pPs$sh,get_col(pPs$sp,col=1,rows=seq_along(dim(pPs$sp)[1]))) > > noparams <- lapply(unit_objects(ppo),pomp,params=numeric(0)) > > > ep <- "Error : in ''panelPomp'': " > ## test checks for missing arguments in panelPomp function > test(wQuotes(ep,"''object'' is a required argument.\n"), + panelPomp()) [1] TRUE > test(wQuotes(ep,"''object'' must be either a ''panelPomp'' object or a list of", + " ''pomp'' objects.","\n"), + panelPomp(list(a=1))) [1] TRUE > test(wQuotes(ep,"specify EITHER ''params'' OR ''shared'' and/or ''specific''.", + "\n"), + panelPomp(pos,sh=2*pPs$sh,sp=2*pPs$sp,params=pPs)) [1] TRUE > > > ## test construction of pParams slot ... > ## ... when is(object,"pompList") ... > test(as(panelPomp(pos,params=coef(ppo)),"data.frame"), + as(ppo,"data.frame")) [1] TRUE > # noparams > test(obs(unit_objects(panelPomp(noparams))[[1]]), + obs(lapply(pos,`coef<-`,value=numeric(0))[[1]]) ) [1] TRUE > # someparams > test(as(panelPomp(ppo,params=coef(ppo)),"data.frame"), + as(ppo,"data.frame")) [1] TRUE > > test(wQuotes(ep,"''object'' is a required argument.\n"), + panelPomp(shared=ppo@shared,specific=ppo@specific)) [1] TRUE > > test(wQuotes(ep, + "column names of ''specific'' must correspond to names of units", + "\n"), + {sp_rw2 <- ppo@specific + colnames(sp_rw2) <- c("rw1","rw3") + panelPomp(ppo,shared=ppo@shared,specific=sp_rw2)}) [1] TRUE > > test(wQuotes(ep,"a parameter cannot be both shared and specific!\n"), + panelPomp(ppo,shared=ppo@shared,specific=c("X.0","sigmaX"))) [1] TRUE > > test(wQuotes( + "Error in validObject(.Object) : \n invalid class *panelPomp* object: a ", + "parameter cannot be both shared and specific!\n"), + {sp_sigma <- ppo@specific + rownames(sp_sigma) <- "sigmaX" + panelPomp(ppo,shared=ppo@shared,specific=sp_sigma)}) [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 0.57 0.04 4.32