Small improvements

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"), 

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.

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()

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,22 +158,22 @@ 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
 #' @returns 
 #' - 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))
 
 }
 

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)))
 
 }