Porting add_param and rm_globalevent (#47)

* Adding missing ports

* Removing vscode settings

* Removing .vscode from repo

Author: gvegayon

.gitignore

@@ -23,3 +23,5 @@ docs
 
 config.log
 config.status
+
+.vscode

.vscode/c_cpp_properties.json

@@ -2,6 +2,7 @@
 
 S3method("[",epiworld_agents)
 S3method("[",epiworld_entities)
+S3method(add_param,epiworld_model)
 S3method(add_tool,epiworld_model)
 S3method(add_virus,epiworld_model)
 S3method(add_virus,epiworld_seir)
@@ -108,6 +109,7 @@ export(ModelSISD)
 export(ModelSURV)
 export(add_entity)
 export(add_globalevent)
+export(add_param)
 export(add_tool)
 export(add_tool_agent)
 export(add_tool_n)
@@ -175,6 +177,7 @@ export(plot_reproductive_number)
 export(queuing_off)
 export(queuing_on)
 export(rm_entity)
+export(rm_globalevent)
 export(rm_tool)
 export(rm_virus)
 export(run)

.vscode/settings.json

@@ -308,6 +308,10 @@ set_param_cpp <- function(model, pname, val) {
   .Call(`_epiworldR_set_param_cpp`, model, pname, val)
 }
 
+add_param_cpp <- function(model, pname, val) {
+  .Call(`_epiworldR_add_param_cpp`, model, pname, val)
+}
+
 set_name_cpp <- function(model, mname) {
   .Call(`_epiworldR_set_name_cpp`, model, mname)
 }

NAMESPACE

@@ -1,14 +1,15 @@
 
-#' Global Actions
+#' Global Events
 #'
-#' Global actions are functions that are executed at each time step of the
+#' Global events are functions that are executed at each time step of the
 #' simulation. They are useful for implementing interventions, such as
 #' vaccination, isolation, and social distancing by means of tools.
 #'
 #' @export
 #' @param prob Numeric scalar. A probability between 0 and 1.
 #' @param tool An object of class [tool].
-#' @name global-actions
+#' @name global-events
+#' @aliases global-actions
 #' @examples
 #' # Simple model
 #' model_sirconn <- ModelSIRCONN(
@@ -32,7 +33,7 @@
 #' )
 #'
 #'
-#' # Adding a global action
+#' # Adding a global event
 #' vaccine_day_20 <- globalevent_tool(epitool, .2, day = 20)
 #' add_globalevent(model_sirconn, vaccine_day_20)
 #'
@@ -98,7 +99,7 @@ globalaction_tool <- function(...) {
 }
 
 #' @export
-#' @rdname global-actions
+#' @rdname global-events
 #' @param vars Integer vector. The position of the variables in the model.
 #' @param coefs Numeric vector. The coefficients of the logistic regression.
 #' @details The function `globalevent_tool_logit` allows to specify a logistic
@@ -143,7 +144,7 @@ globalaction_tool_logit <- function(...) {
 #' @export
 #' @param param Character scalar. The name of the parameter to be set.
 #' @param value Numeric scalar. The value of the parameter.
-#' @rdname global-actions
+#' @rdname global-events
 #' @details The function `globalevent_set_param` allows to set a parameter of
 #' the model. The parameter is specified by its name `param` and the value by
 #' `value`.
@@ -180,7 +181,7 @@ globalaction_set_params <- function(...) {
 }
 
 #' @export
-#' @rdname global-actions
+#' @rdname global-events
 #' @param fun Function. The function to be executed.
 #' @details The function `globalevent_fun` allows to specify a function to be
 #' executed at a given day. The function object must receive an object of class
@@ -258,11 +259,15 @@ print.epiworld_globalevent <- function(x, ...) {
 }
 
 #' @export
-#' @param action A global action.
+#' @param action (Deprecated) use `event` instead.
+#' @param event The event to be added or removed. If it is to add, then
+#' it should be an object of class `epiworld_globalevent`. If it is to remove,
+#' it should be an integer with the position of the event in the model
+#' (starting from zero).
 #' @param day Integer. The day (step) at which the action is executed (see details).
 #' @param model An object of class [epiworld_model].
 #' @param name Character scalar. The name of the action.
-#' @rdname global-actions
+#' @rdname global-events
 #' @seealso epiworld-model
 #' @details The function `add_globalevent` adds a global action to a model.
 #' The model checks for actions to be executed at each time step. If the added
@@ -271,12 +276,31 @@ print.epiworld_globalevent <- function(x, ...) {
 #' the action is executed at the specified time step.
 #' @returns
 #' - The function `add_globalevent` returns the model with the added
-#' action.
-add_globalevent <- function(model, action) {
+#' event
+add_globalevent <- function(model, event, action = NULL) {
 
-  if (length(attr(action, "tool")))
-    add_tool(model, attr(action, "tool"))
+  if (missing(event) && !missing(action)) {
+    event <- action
+    warning("The argument `action` is deprecated. Use `event` instead.")
+  }
+
+  stopifnot_model(model)
+
+  if (length(attr(event, "tool")))
+    add_tool(model, attr(event, "tool"))
+
+  invisible(add_globalevent_cpp(model, event))
+
+}
+
+#' @export
+#' @rdname global-events
+#' @returns
+#' - The function `rm_globalevent` returns the model with the removed
+#' event.
+rm_globalevent <- function(model, event) {
 
-  invisible(add_globalevent_cpp(model, action))
+  stopifnot_model(model)
+  invisible(rm_globalevent_cpp(model, event))
 
 }

R/cpp11.R

@@ -210,6 +210,19 @@ get_param.epiworld_model <- function(x, pname) {
 }
 
 
+#' @export
+#' @rdname epiworld-methods
+#' @returns
+#' - `add_param` returns the model with the added parameter invisibly.
+add_param <- function(x, pname, pval) UseMethod("add_param")
+
+#' @export
+#' @rdname epiworld-methods
+add_param.epiworld_model <- function(x, pname, pval) {
+  invisible(add_param_cpp(x, pname, pval))
+}
+
+
 #' @export
 #' @param pval Numeric. Value of the parameter.
 #' @returns
@@ -221,7 +234,6 @@ set_param <- function(x, pname, pval) UseMethod("set_param")
 #' @export
 set_param.epiworld_model <- function(x, pname, pval) {
   invisible(set_param_cpp(x, pname, pval))
-  invisible(x)
 }
 
 #' @export

R/global-actions.R

@@ -545,6 +545,13 @@ extern "C" SEXP _epiworldR_set_param_cpp(SEXP model, SEXP pname, SEXP val) {
   END_CPP11
 }
 // model.cpp
+SEXP add_param_cpp(SEXP model, std::string pname, double val);
+extern "C" SEXP _epiworldR_add_param_cpp(SEXP model, SEXP pname, SEXP val) {
+  BEGIN_CPP11
+    return cpp11::as_sexp(add_param_cpp(cpp11::as_cpp<cpp11::decay_t<SEXP>>(model), cpp11::as_cpp<cpp11::decay_t<std::string>>(pname), cpp11::as_cpp<cpp11::decay_t<double>>(val)));
+  END_CPP11
+}
+// model.cpp
 SEXP set_name_cpp(SEXP model, std::string mname);
 extern "C" SEXP _epiworldR_set_name_cpp(SEXP model, SEXP mname) {
   BEGIN_CPP11
@@ -1020,6 +1027,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_epiworldR_ModelSURV_cpp",                        (DL_FUNC) &_epiworldR_ModelSURV_cpp,                        13},
     {"_epiworldR_add_entity_cpp",                       (DL_FUNC) &_epiworldR_add_entity_cpp,                        2},
     {"_epiworldR_add_globalevent_cpp",                  (DL_FUNC) &_epiworldR_add_globalevent_cpp,                   2},
+    {"_epiworldR_add_param_cpp",                        (DL_FUNC) &_epiworldR_add_param_cpp,                         3},
     {"_epiworldR_add_tool_agent_cpp",                   (DL_FUNC) &_epiworldR_add_tool_agent_cpp,                    5},
     {"_epiworldR_add_tool_cpp",                         (DL_FUNC) &_epiworldR_add_tool_cpp,                          2},
     {"_epiworldR_add_virus_agent_cpp",                  (DL_FUNC) &_epiworldR_add_virus_agent_cpp,                   5},