Skip to content

Commit

Permalink
full unit test coverage for spatPomp()
Browse files Browse the repository at this point in the history
  • Loading branch information
@ionides
ionides committed Apr 22, 2024
1 parent c65486f commit 351d8f3
Show file tree
Hide file tree
Showing 3 changed files with 94 additions and 13 deletions.
32 changes: 19 additions & 13 deletions R/spatPomp.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -236,17 +236,20 @@ setMethod(
'time column of the observation data.frame')
}
}

## make covariates into a dataframe that pomp would expect
unit_covarnames <- NULL ## could get overwritten soon
if(missing(shared_covarnames)) shared_covarnames <- NULL
if(!missing(covar)){
upos_cov <- match(unitname, names(covar))
tpos_cov <- match(tcovar, names(covar))
cov_col_order <- c()
if(missing(shared_covarnames)) unit_covarnames <- names(covar)[-c(upos_cov, tpos_cov)]
else {
cov_col_order <- c()
if(missing(shared_covarnames)) {
if(is.na(upos_cov)) pStop_(ep, "for unit-specific covariates, there should be a column with the unit name matching the data")
shared_covarnames <- NULL
unit_covarnames <- names(covar)[-c(upos_cov, tpos_cov)]
} else {
if(!is.na(upos_cov)) pStop_(ep, sQuote("shared_covarnames"), " currently supported only when there are no unit-specific covariates")
pos_shared_cov <- match(shared_covarnames, names(covar))
unit_covarnames <- names(covar)[-c(upos_cov, tpos_cov, pos_shared_cov)]
unit_covarnames <- NULL
cov_col_order <- c(cov_col_order, shared_covarnames)
}
if(length(unit_covarnames) > 0){
Expand All @@ -267,17 +270,19 @@ setMethod(
pomp_covar <- pomp::covariate_table(covar, times=tcovar)
}
} else {
# return an empty covariate table
unit_covarnames <- NULL
shared_covarnames <- NULL
pomp_covar <- pomp::covariate_table()
}

## Get all names before call to pomp().
if(!missing(unit_statenames)) pomp_statenames <- paste0(rep(unit_statenames,each=U),seq_len(U))
if(length(unit_statenames)>0) pomp_statenames <- paste0(rep(unit_statenames,each=U),seq_len(U))
else pomp_statenames <- NULL
if (!missing(covar)){
if(missing(shared_covarnames)) pomp_covarnames <- paste0(rep(unit_covarnames,each=U),seq_len(U))
if(is.null(shared_covarnames)) pomp_covarnames <- paste0(rep(unit_covarnames,each=U),seq_len(U))
else {
if(length(unit_covarnames) == 0) pomp_covarnames <- shared_covarnames
else pomp_covarnames <- c(shared_covarnames, paste0(rep(unit_covarnames,each=U),seq_len(U)))
}
}
else pomp_covarnames <- NULL
Expand Down Expand Up @@ -379,10 +384,11 @@ setMethod(
upos_cov <- match(unitname, names(covar))
tpos_cov <- match(tcovar, names(covar))
cov_col_order <- c()
if(missing(shared_covarnames)) unit_covarnames <- names(covar)[-c(upos_cov, tpos_cov)]
if(length(shared_covarnames)==0) unit_covarnames <- names(covar)[-c(upos_cov, tpos_cov)]
else {
if(!is.na(upos_cov)) pStop_(ep, sQuote("shared_covarnames"), " currently supported only when there are no unit-specific covariates")
pos_shared_cov <- match(shared_covarnames, names(covar))
unit_covarnames <- names(covar)[-c(upos_cov, tpos_cov, pos_shared_cov)]
unit_covarnames <- NULL
cov_col_order <- c(cov_col_order, shared_covarnames)
}
if(length(unit_covarnames) > 0){
Expand All @@ -405,7 +411,7 @@ setMethod(
if (missing(t0)) t0 <- data@t0
if (missing(rinit)) rinit <- data@rinit
if (missing(rprocess)) rprocess <- data@rprocess
else if (is.null(rprocess)) rprocess <- new("rprocPlugin")
else if (is.null(rprocess)) rprocess <- new("rprocPlugin")
if (missing(dprocess)) dprocess <- data@dprocess
if (missing(rmeasure)) rmeasure <- data@rmeasure
if (missing(dmeasure)) dmeasure <- data@dmeasure
Expand All @@ -415,7 +421,7 @@ setMethod(
if (missing(eunit_measure)) eunit_measure <- data@eunit_measure
if (missing(runit_measure)) runit_measure <- data@runit_measure
if (missing(skeleton)) skeleton <- data@skeleton
else if (is.null(skeleton)) skeleton <- new("skelPlugin")
else if (is.null(skeleton)) skeleton <- new("skelPlugin")
if (missing(rprior)) rprior <- data@rprior
if (missing(dprior)) dprior <- data@dprior
if (missing(partrans)) partrans <- data@partrans
Expand Down
33 changes: 33 additions & 0 deletions tests/bm.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -356,16 +356,49 @@ print("The following deliver error messages, to test them")
try(spatPomp(data=as.data.frame(b_model),units=NULL),outFile=stdout())
try(spatPomp("test on type character"))

try(spatPomp())
b_data <- as.data.frame(b_model)
try(spatPomp(data=b_data,times="time",units="unit"))
try(spatPomp(data=b_data,times="NONSENSE",units="unit",t0=0))
try(spatPomp(data=b_data,times="time",units="NONSENSE",t0=0))
spatPomp(data=b_data,times="time",units="unit",t0=0,params=list(coef(b_model)))
b_data2 <- b_data
names(b_data2) <- c("time","unit","X","X")
try(spatPomp(data=b_data2,times="time",units="unit"))
b_data_only_model <- spatPomp(data=b_data,times="time",units="unit",
t0=0)

# test error messages for covariates with data.frame class for spatPomp()
b_covar_error <- data.frame(time_name_error=0:2,Z=3:5)
try(spatPomp(data=b_data,times="time",units="unit",t0=0,covar=b_covar_error))

b_unit_covar_names_error <- data.frame(time=c(0:2,0:2),JUNK=rep(c("U1","U2"),each=3), Z=rep(3:5,times=2))
try(spatPomp(data=b_data,times="time",units="unit",t0=0,
covar=b_unit_covar_names_error))

b_shared_covar <- data.frame(time=0:2,Z=3:5)
model_shared_covar <- spatPomp(data=b_data,times="time",units="unit",
t0=0,covar=b_shared_covar, shared_covarnames="Z")

b_unit_covar <- data.frame(time=c(0:2,0:2),unit=rep(c("U1","U2"),each=3),
Z=rep(3:5,times=2))
model_unit_covar <- spatPomp(data=b_data,times="time",units="unit",t0=0,covar=b_unit_covar,skeleton=NULL,partrans=NULL,unit_accumvars <- "JUNK")

try(spatPomp(data=b_data,times="time",units="unit",t0=0,covar=b_unit_covar,shared_covarnames ="JUNK"))

# test spatPomp warnings with argument of class spatPomp

# perhaps surprisingly, this gives no error
spatPomp(model_unit_covar,timename="JUNK",unitname="JUNK",
unit_accumvars="JUNK", globals=Csnippet("JUNK"),
partrans=NULL,skeleton=NULL)

try(spatPomp(data=model_unit_covar,covar=b_covar_error))

spatPomp(model_shared_covar)



## -----------------------------------------------------------------
## using bm to test behavior of inference methods when logLik = -Inf
## _________________________________________________________________
Expand Down
42 changes: 42 additions & 0 deletions tests/bm.Rout.save
View file
Original file line number Diff line number Diff line change
Expand Up @@ -540,20 +540,62 @@ Error : in spatPomp : ‘times’ should be a single name identifying the column
> try(spatPomp("test on type character"))
Error : in ‘spatPomp’: ‘data’ must be a data frame or an object of class ‘spatPomp’.
>
> try(spatPomp())
Error : in ‘spatPomp’: ‘data’ is a required argument
> b_data <- as.data.frame(b_model)
> try(spatPomp(data=b_data,times="time",units="unit"))
Error : in ‘spatPomp’: ‘t0’ is a required argument
> try(spatPomp(data=b_data,times="NONSENSE",units="unit",t0=0))
Error : in ‘spatPomp’: ‘times’ does not identify a single column of ‘data’ by name.
> try(spatPomp(data=b_data,times="time",units="NONSENSE",t0=0))
Error : in ‘spatPomp’: ‘units’ does not identify a single column of ‘data’ by name.
> spatPomp(data=b_data,times="time",units="unit",t0=0,params=list(coef(b_model)))
<object of class ‘spatPomp’>
> b_data2 <- b_data
> names(b_data2) <- c("time","unit","X","X")
> try(spatPomp(data=b_data2,times="time",units="unit"))
Error : in ‘spatPomp’: names of data variables must be unique.
> b_data_only_model <- spatPomp(data=b_data,times="time",units="unit",
+ t0=0)
>
> # test error messages for covariates with data.frame class for spatPomp()
> b_covar_error <- data.frame(time_name_error=0:2,Z=3:5)
> try(spatPomp(data=b_data,times="time",units="unit",t0=0,covar=b_covar_error))
Error : in ‘spatPomp’: ‘covariate’ data.frame should have a time column with the same name as the time column of the observation data.frame
>
> b_unit_covar_names_error <- data.frame(time=c(0:2,0:2),JUNK=rep(c("U1","U2"),each=3), Z=rep(3:5,times=2))
> try(spatPomp(data=b_data,times="time",units="unit",t0=0,
+ covar=b_unit_covar_names_error))
Error : in ‘spatPomp’: for unit-specific covariates, there should be a column with the unit name matching the data
>
> b_shared_covar <- data.frame(time=0:2,Z=3:5)
> model_shared_covar <- spatPomp(data=b_data,times="time",units="unit",
+ t0=0,covar=b_shared_covar, shared_covarnames="Z")
>
> b_unit_covar <- data.frame(time=c(0:2,0:2),unit=rep(c("U1","U2"),each=3),
+ Z=rep(3:5,times=2))
> model_unit_covar <- spatPomp(data=b_data,times="time",units="unit",t0=0,covar=b_unit_covar,skeleton=NULL,partrans=NULL,unit_accumvars <- "JUNK")
NOTE: The provided object is available for use by POMP basic components.
>
> try(spatPomp(data=b_data,times="time",units="unit",t0=0,covar=b_unit_covar,shared_covarnames ="JUNK"))
Error : in ‘spatPomp’: ‘shared_covarnames’ currently supported only when there are no unit-specific covariates
>
> # test spatPomp warnings with argument of class spatPomp
>
> # perhaps surprisingly, this gives no error
> spatPomp(model_unit_covar,timename="JUNK",unitname="JUNK",
+ unit_accumvars="JUNK", globals=Csnippet("JUNK"),
+ partrans=NULL,skeleton=NULL)
<object of class ‘spatPomp’>
>
> try(spatPomp(data=model_unit_covar,covar=b_covar_error))
Error : ‘covariate’ data.frame should have a time column with the same name as the observation data
>
> spatPomp(model_shared_covar)
<object of class ‘spatPomp’>
>
>
>
> ## -----------------------------------------------------------------
> ## using bm to test behavior of inference methods when logLik = -Inf
> ## _________________________________________________________________
Expand Down

0 comments on commit 351d8f3

Please sign in to comment.