From 351d8f36165181348a3c2486df8dfdbe15bf7c07 Mon Sep 17 00:00:00 2001 From: Ed Ionides Date: Sun, 21 Apr 2024 22:48:35 -0400 Subject: [PATCH] full unit test coverage for spatPomp() --- R/spatPomp.R | 32 +++++++++++++++++++------------- tests/bm.R | 33 +++++++++++++++++++++++++++++++++ tests/bm.Rout.save | 42 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 94 insertions(+), 13 deletions(-) diff --git a/R/spatPomp.R b/R/spatPomp.R index 0d11a3f..67ea6c1 100644 --- a/R/spatPomp.R +++ b/R/spatPomp.R @@ -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){ @@ -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 @@ -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){ @@ -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 @@ -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 diff --git a/tests/bm.R b/tests/bm.R index 12c8c7b..2f90fc5 100644 --- a/tests/bm.R +++ b/tests/bm.R @@ -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 ## _________________________________________________________________ diff --git a/tests/bm.Rout.save b/tests/bm.Rout.save index 3e8256c..20540b5 100644 --- a/tests/bm.Rout.save +++ b/tests/bm.Rout.save @@ -540,6 +540,8 @@ 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 @@ -547,6 +549,8 @@ Error : in ‘spatPomp’: ‘t0’ is a required argument 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))) + > b_data2 <- b_data > names(b_data2) <- c("time","unit","X","X") > try(spatPomp(data=b_data2,times="time",units="unit")) @@ -554,6 +558,44 @@ 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) + +> +> 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) + +> +> +> > ## ----------------------------------------------------------------- > ## using bm to test behavior of inference methods when logLik = -Inf > ## _________________________________________________________________