diff --git a/.gitignore b/.gitignore index eb777ffc..13df4aff 100644 --- a/.gitignore +++ b/.gitignore @@ -23,3 +23,5 @@ docs config.log config.status + +.vscode diff --git a/.vscode/c_cpp_properties.json b/.vscode/c_cpp_properties.json deleted file mode 100644 index 2b240b0c..00000000 --- a/.vscode/c_cpp_properties.json +++ /dev/null @@ -1,20 +0,0 @@ -{ - "configurations": [ - { - "includePath": [ - "${workspaceFolder}/**", - "/usr/include", - "/usr/local/include", - "/usr/lib/R/site-library/cpp11/include", - "/usr/lib/R/site-library/Rcpp/include", - "/usr/share/R/include", - "inst/include/epiworld" - ], - "intelliSenseMode": "linux-gcc-x64", - "compilerPath": "/usr/bin/gcc", - "cStandard": "c17", - "cppStandard": "gnu++17" - } - ], - "version": 4 -} diff --git a/.vscode/settings.json b/.vscode/settings.json deleted file mode 100644 index 296aa280..00000000 --- a/.vscode/settings.json +++ /dev/null @@ -1,66 +0,0 @@ -{ - "files.associations": { - "array": "cpp", - "atomic": "cpp", - "bit": "cpp", - "*.tcc": "cpp", - "bitset": "cpp", - "cctype": "cpp", - "chrono": "cpp", - "clocale": "cpp", - "cmath": "cpp", - "compare": "cpp", - "concepts": "cpp", - "cstdarg": "cpp", - "cstddef": "cpp", - "cstdint": "cpp", - "cstdio": "cpp", - "cstdlib": "cpp", - "cstring": "cpp", - "ctime": "cpp", - "cwchar": "cpp", - "cwctype": "cpp", - "deque": "cpp", - "map": "cpp", - "unordered_map": "cpp", - "vector": "cpp", - "exception": "cpp", - "algorithm": "cpp", - "functional": "cpp", - "iterator": "cpp", - "memory": "cpp", - "memory_resource": "cpp", - "numeric": "cpp", - "optional": "cpp", - "random": "cpp", - "ratio": "cpp", - "regex": "cpp", - "string": "cpp", - "string_view": "cpp", - "system_error": "cpp", - "tuple": "cpp", - "type_traits": "cpp", - "utility": "cpp", - "fstream": "cpp", - "initializer_list": "cpp", - "iosfwd": "cpp", - "istream": "cpp", - "limits": "cpp", - "new": "cpp", - "numbers": "cpp", - "ostream": "cpp", - "ranges": "cpp", - "sstream": "cpp", - "stdexcept": "cpp", - "streambuf": "cpp", - "typeinfo": "cpp", - "thread": "cpp", - "cinttypes": "cpp" - }, - "editor.indentSize": "tabSize", - "[r]": { - "editor.tabSize": 2, - "editor.insertSpaces": true, - "editor.detectIndentation": false - } -} diff --git a/NAMESPACE b/NAMESPACE index 888d6780..cd90337c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -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) diff --git a/R/cpp11.R b/R/cpp11.R index 3113ec6d..71c54686 100644 --- a/R/cpp11.R +++ b/R/cpp11.R @@ -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) } diff --git a/R/global-actions.R b/R/global-actions.R index e305a298..f195c015 100644 --- a/R/global-actions.R +++ b/R/global-actions.R @@ -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)) } diff --git a/R/model-methods.R b/R/model-methods.R index 29d68559..57ce2f14 100644 --- a/R/model-methods.R +++ b/R/model-methods.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 diff --git a/man/epiworld-methods.Rd b/man/epiworld-methods.Rd index ac2c0147..049b4289 100644 --- a/man/epiworld-methods.Rd +++ b/man/epiworld-methods.Rd @@ -11,6 +11,8 @@ \alias{summary.epiworld_model} \alias{get_states} \alias{get_param} +\alias{add_param} +\alias{add_param.epiworld_model} \alias{set_param} \alias{set_name} \alias{get_name} @@ -44,6 +46,10 @@ get_states(x) get_param(x, pname) +add_param(x, pname, pval) + +\method{add_param}{epiworld_model}(x, pname, pval) + set_param(x, pname, pval) set_name(x, mname) @@ -127,6 +133,10 @@ distributed (see details).} of class \code{epiworld_model}. } +\itemize{ +\item \code{add_param} returns the model with the added parameter invisibly. +} + \itemize{ \item The \code{set_param} function does not return a value but instead alters a parameter value. diff --git a/man/global-actions.Rd b/man/global-events.Rd similarity index 88% rename from man/global-actions.Rd rename to man/global-events.Rd index e47f02b9..eb7b0959 100644 --- a/man/global-actions.Rd +++ b/man/global-events.Rd @@ -1,8 +1,9 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/global-actions.R -\name{global-actions} -\alias{global-actions} +\name{global-events} +\alias{global-events} \alias{globalevent_tool} +\alias{global-actions} \alias{epiworld_globalevent_set_param} \alias{epiworld_globalevent_tool} \alias{epiworld_globalevent_tool_logit} @@ -12,7 +13,8 @@ \alias{globalevent_set_params} \alias{globalevent_fun} \alias{add_globalevent} -\title{Global Actions} +\alias{rm_globalevent} +\title{Global Events} \usage{ globalevent_tool(tool, prob, name = get_name_tool(tool), day = -99) @@ -33,7 +35,9 @@ globalevent_set_params( globalevent_fun(fun, name = deparse(substitute(fun)), day = -99) -add_globalevent(model, action) +add_globalevent(model, event, action = NULL) + +rm_globalevent(model, event) } \arguments{ \item{tool}{An object of class \link{tool}.} @@ -56,7 +60,12 @@ add_globalevent(model, action) \item{model}{An object of class \link{epiworld_model}.} -\item{action}{A global action.} +\item{event}{The event to be added or removed. If it is to add, then +it should be an object of class \code{epiworld_globalevent}. If it is to remove, +it should be an integer with the position of the event in the model +(starting from zero).} + +\item{action}{(Deprecated) use \code{event} instead.} } \value{ \itemize{ @@ -70,11 +79,16 @@ add_globalevent(model, action) \itemize{ \item The function \code{add_globalevent} returns the model with the added -action. +event +} + +\itemize{ +\item The function \code{rm_globalevent} returns the model with the removed +event. } } \description{ -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. } @@ -122,7 +136,7 @@ epitool <- tool( ) -# Adding a global action +# Adding a global event vaccine_day_20 <- globalevent_tool(epitool, .2, day = 20) add_globalevent(model_sirconn, vaccine_day_20) diff --git a/src/cpp11.cpp b/src/cpp11.cpp index 1ea60e82..3cfb0623 100644 --- a/src/cpp11.cpp +++ b/src/cpp11.cpp @@ -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>(model), cpp11::as_cpp>(pname), cpp11::as_cpp>(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}, diff --git a/src/model.cpp b/src/model.cpp index 34e84951..38ab79dd 100644 --- a/src/model.cpp +++ b/src/model.cpp @@ -159,6 +159,15 @@ SEXP set_param_cpp(SEXP model, std::string pname, double val) { return model; } +[[cpp11::register]] +SEXP add_param_cpp(SEXP model, std::string pname, double val) { + + external_pointer> ptr(model); + ptr->add_param(val, pname); + + return model; +} + [[cpp11::register]] SEXP set_name_cpp(SEXP model, std::string mname) { external_pointer> ptr(model);