diff --git a/DESCRIPTION b/DESCRIPTION index a2866d5f..fa41cc40 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: epiworldR Type: Package Title: Fast Agent-Based Epi Models -Version: 0.0-3 +Version: 0.0-3.9000 Date: 2023-08-29 Authors@R: c( person("Derek", "Meyer", role=c("aut","cre"), diff --git a/NEWS.md b/NEWS.md index 10180f85..b8fe38f3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,9 +1,17 @@ +# epiworldR 0.0-3.9000 (development version) + +* Added missing checks of tool class when adding a model with `add_too_n`. + +* Various small improvements. + + # epiworldR 0.0-3 * Added the following models: `ModelSEIRD`, `ModelSEIRDCONN`, `ModelSIRD`, `ModelSIRDCONN`, and `ModelSISD`. * Fixed a bug reported on issue [6](https://github.com/UofUEpiBio/epiworldR/issues/6). + # epiworldR 0.0-2 * Added a `NEWS.md` file to track changes to the package. diff --git a/R/global-actions.R b/R/global-actions.R index 3b2f6590..d6ec4487 100644 --- a/R/global-actions.R +++ b/R/global-actions.R @@ -99,8 +99,16 @@ globalaction_tool_logit <- function( name = get_name_tool(tool), day = -99 ) { + stopifnot_tool(tool) + structure( - globalaction_tool_logit_cpp(tool, vars, coefs, name, day), + globalaction_tool_logit_cpp( + tool, + as.integer(vars), + as.double(coefs), + name, + as.integer(day) + ), class = c("epiworld_globalaction_tool_logit", "epiworld_globalaction"), tool = tool, call = match.call() @@ -121,10 +129,15 @@ globalaction_set_params <- function( ) { structure( - globalaction_set_param_cpp(param, value, name, day), + globalaction_set_param_cpp( + param, + as.double(value), + name, + as.integer(day) + ), class = c("epiworld_globalaction_set_param", "epiworld_globalaction"), param = param, - value = value, + value = as.double(value), call = match.call() ) } @@ -171,7 +184,7 @@ globalaction_fun <- function( ) { structure( - globalaction_fun_cpp(fun, name, day), + globalaction_fun_cpp(fun, name, as.integer(day)), class = c("epiworld_globalaction_fun", "epiworld_globalaction"), fun = fun, call = match.call() diff --git a/R/tool.R b/R/tool.R index bafbf710..f92644d7 100644 --- a/R/tool.R +++ b/R/tool.R @@ -141,8 +141,11 @@ add_tool <- function(model, tool, proportion) UseMethod("add_tool") #' @export add_tool.epiworld_model <- function(model, tool, proportion) { - add_tool_cpp(model, tool, proportion) + + stopifnot_tool(tool) + add_tool_cpp(model, tool, as.double(proportion)) invisible(model) + } #' @export @@ -155,8 +158,11 @@ add_tool_n <- function(model, tool, n) UseMethod("add_tool_n") #' @export add_tool_n.epiworld_model <- function(model, tool, n) { - add_tool_n_cpp(model, tool, n) + + stopifnot_tool(tool) + add_tool_n_cpp(model, tool, as.integer(n)) invisible(model) + } #' @export @@ -164,13 +170,10 @@ add_tool_n.epiworld_model <- function(model, tool, n) { #' - The `rm_tool` function removes the specified tool from a model. #' @rdname tool rm_tool <- function(model, tool_pos) { - invisible(rm_tool_cpp(model, tool_pos)) -} -#' @export -#' @rdname tool -rm_tool <- function(model, tool_pos) { - invisible(rm_tool_cpp(model, tool_pos)) + stopifnot_model(model) + invisible(rm_tool_cpp(model, as.integer(tool_pos))) + } # Tool functions --------------------------------------------------------------- @@ -253,7 +256,7 @@ tool_fun_logit <- function(vars, coefs, model) { stopifnot_model(model) structure( - tool_fun_logit_cpp(vars, coefs, model), + tool_fun_logit_cpp(as.integer(vars), as.double(coefs), model), class = "epiworld_tool_fun", builder = "tool_fun_logit", vars = vars, @@ -295,7 +298,7 @@ print.epiworld_tool_fun <- function(x, ...) { set_susceptibility_reduction <- function(tool, prob) { stopifnot_tool(tool) - set_susceptibility_reduction_cpp(tool, prob) + set_susceptibility_reduction_cpp(tool, as.double(prob)) } @@ -340,7 +343,7 @@ set_susceptibility_reduction_fun <- function(tool, model, tfun) { set_transmission_reduction <- function(tool, prob) { stopifnot_tool(tool) - set_transmission_reduction_cpp(tool, prob) + set_transmission_reduction_cpp(tool, as.double(prob)) } @@ -374,7 +377,7 @@ set_transmission_reduction_fun <- function(tool, model, tfun) { set_recovery_enhancer <- function(tool, prob) { stopifnot_tool(tool) - set_recovery_enhancer_cpp(tool, prob) + set_recovery_enhancer_cpp(tool, as.double(prob)) } @@ -409,7 +412,7 @@ set_recovery_enhancer_fun <- function(tool, model, tfun) { set_death_reduction <- function(tool, prob) { stopifnot_tool(tool) - set_death_reduction_cpp(tool, prob) + set_death_reduction_cpp(tool, as.double(prob)) } diff --git a/R/virus.R b/R/virus.R index 170c36de..7770e115 100644 --- a/R/virus.R +++ b/R/virus.R @@ -362,7 +362,7 @@ virus_fun_logit <- function(vars, coefs, model) { structure( virus_fun_logit_cpp(vars, coefs, model), - class = "epiworld_virus_fun", + class = "epiworld_virus_fun", builder = "virus_fun_logit", vars = vars, coefs = coefs, @@ -402,7 +402,7 @@ print.epiworld_virus_fun <- function(x, ...) { set_prob_infecting <- function(virus, prob) { stopifnot_virus(virus) - invisible(set_prob_infecting_cpp(virus, prob)) + invisible(set_prob_infecting_cpp(virus, as.numeric(prob))) } @@ -444,7 +444,7 @@ set_prob_infecting_fun <- function(virus, model, vfun) { set_prob_recovery <- function(virus, prob) { stopifnot_virus(virus) - invisible(set_prob_recovery_cpp(virus, prob)) + invisible(set_prob_recovery_cpp(virus, as.numeric(prob))) } @@ -478,7 +478,7 @@ set_prob_recovery_fun <- function(virus, model, vfun) { set_prob_death <- function(virus, prob) { stopifnot_virus(virus) - invisible(set_prob_death_cpp(virus, prob)) + invisible(set_prob_death_cpp(virus, as.numeric(prob))) } @@ -511,7 +511,7 @@ set_prob_death_fun <- function(virus, model, vfun) { set_incubation <- function(virus, incubation) { stopifnot_virus(virus) - invisible(set_incubation_cpp(virus, incubation)) + invisible(set_incubation_cpp(virus, as.numeric(incubation))) }