Adding entity to the model

.vscode/c_cpp_properties.json

@@ -7,7 +7,8 @@
                 "/usr/local/include",
                 "/usr/lib/R/site-library/cpp11/include",
                 "/usr/lib/R/site-library/Rcpp/include",
-                "/usr/share/R/include"
+                "/usr/share/R/include",
+                "inst/include/epiworld"
             ],
             "intelliSenseMode": "linux-gcc-x64",
             "compilerPath": "/usr/bin/gcc",

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: epiworldR
 Type: Package
 Title: Fast Agent-Based Epi Models
-Version: 0.2-0
+Version: 0.2-0 (dev)
 Date: 2024-04-27
 Authors@R: c(
   person("Derek", "Meyer", role=c("aut","cre"), 

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method("[",epiworld_agents)
+S3method("[",epiworld_entities)
 S3method(add_tool,epiworld_model)
 S3method(add_tool_n,epiworld_model)
 S3method(add_virus,epiworld_model)
@@ -97,6 +98,7 @@ export(ModelSIRMixing)
 export(ModelSIS)
 export(ModelSISD)
 export(ModelSURV)
+export(add_entity_n)
 export(add_globalevent)
 export(add_tool)
 export(add_tool_agent)
@@ -108,10 +110,16 @@ export(agents_from_edgelist)
 export(agents_smallworld)
 export(change_state)
 export(clone_model)
+export(entity)
+export(entity_add_agent)
+export(entity_rm_agent)
 export(get_agents)
 export(get_agents_data_ncols)
 export(get_agents_states)
 export(get_agents_tools)
+export(get_entities)
+export(get_entity_name)
+export(get_entity_size)
 export(get_generation_time)
 export(get_hist_tool)
 export(get_hist_total)

NEWS.md

@@ -2,6 +2,7 @@
 
 * Adds the new mixing models `ModelSIRMixing` and `ModelSEIRMixing`.
 
+* Ports the `Entity` class. Entities are used to group agents within a model.
 
 # epiworldR 0.1-0`
 

R/cpp11.R

@@ -104,6 +104,42 @@ get_today_total_cpp <- function(model) {
   .Call(`_epiworldR_get_today_total_cpp`, model)
 }
 
+get_entities_cpp <- function(model) {
+  .Call(`_epiworldR_get_entities_cpp`, model)
+}
+
+get_entity_cpp <- function(entities, idx) {
+  .Call(`_epiworldR_get_entity_cpp`, entities, idx)
+}
+
+entity_cpp <- function(name) {
+  .Call(`_epiworldR_entity_cpp`, name)
+}
+
+entity_size_cpp <- function(entity) {
+  .Call(`_epiworldR_entity_size_cpp`, entity)
+}
+
+entity_add_agent_cpp <- function(entity, agent, model) {
+  .Call(`_epiworldR_entity_add_agent_cpp`, entity, agent, model)
+}
+
+entity_rm_agent_cpp <- function(entity, idx) {
+  .Call(`_epiworldR_entity_rm_agent_cpp`, entity, idx)
+}
+
+entity_get_name_cpp <- function(entity) {
+  .Call(`_epiworldR_entity_get_name_cpp`, entity)
+}
+
+add_entity_cpp <- function(model, entity) {
+  .Call(`_epiworldR_add_entity_cpp`, model, entity)
+}
+
+add_entity_cpp_n <- function(model, entity, n) {
+  .Call(`_epiworldR_add_entity_cpp_n`, model, entity, n)
+}
+
 ModelSURV_cpp <- function(name, prevalence, efficacy_vax, latent_period, prob_symptoms, prop_vaccinated, prop_vax_redux_transm, infect_period, prop_vax_redux_infect, surveillance_prob, transmission_rate, prob_death, prob_noreinfect) {
   .Call(`_epiworldR_ModelSURV_cpp`, name, prevalence, efficacy_vax, latent_period, prob_symptoms, prop_vaccinated, prop_vax_redux_transm, infect_period, prop_vax_redux_infect, surveillance_prob, transmission_rate, prob_death, prob_noreinfect)
 }

R/entity.R

@@ -0,0 +1,163 @@
+
+stopifnot_entity <- function(entity) {
+  if (!inherits(entity, "epiworld_entity")) {
+    stop("Argument 'entity' must be an entity object.")
+  }
+}
+
+#' Get entities
+#' 
+#' Entities in `epiworld` are objects that can contain agents.
+#' @param model Model object of class `epiworld_model`.
+#' 
+#' @details 
+#' Epiworld entities are especially useful for mixing models, particularly
+#' [ModelSIRMixing] and [ModelSEIRMixing].
+#' 
+#' @name entities
+#' @export 
+#' @examples 
+#' # Creating a mixing model
+#' mymodel <- ModelSIRMixing(
+#'  name = "My model",
+#'  n = 10000,
+#'  prevalence = .001,
+#'  contact_rate = 10,
+#'  transmission_rate = .1,
+#'  recovery_rate = 1/7,
+#'  contact_matrix = matrix(c(.9, .1, .1, .9), 2, 2)
+#' )
+#' 
+#' ent1 <- entity("First")
+#' ent2 <- entity("Second")
+#' 
+#' add_entity_n(mymodel, ent1, 5000)
+#' add_entity_n(mymodel, ent2, 5000)
+#' 
+#' run(mymodel, ndays = 100, seed = 1912)
+get_entities <- function(model) {
+  stopifnot_model(model)
+  structure(
+    get_entities_cpp(model),
+    class = c("epiworld_entities"),
+    model = model
+  )
+}
+
+#' @export 
+#' @rdname entities
+#' @param x Object of class `epiworld_entities`.
+#' @param i Integer index.
+`[.epiworld_entities` <- function(x, i) {
+
+  stopifnot_entity(x)
+
+  if (i > get_entity_size(x)) {
+    stop("Index out of bounds.")
+  }
+
+  structure(
+    get_entity_cpp(x, i),
+    class = c("epiworld_entity"),
+    model = x$model
+  )
+
+}
+
+#' @export 
+#' @param name Character scalar. Name of the entity.
+#' @return 
+#' - The function `entity` creates an entity object.
+#' @rdname entities
+entity <- function(name) {
+
+  structure(
+    entity_cpp(name),
+    class = "epiworld_entity"
+  )
+
+}
+
+#' @export 
+#' @rdname entities
+#' @param entity Entity object of class `epiworld_entity`.
+#' @return
+#' - The function `get_entity_size` returns the number of agents in the entity.
+get_entity_size <- function(entity) {
+  stopifnot_entity(entity)
+  get_entity_size_cpp(entity)
+}
+
+#' @export
+#' @rdname entities
+#' @return 
+#' - The function `get_entity_name` returns the name of the entity.
+get_entity_name <- function(entity) {
+  stopifnot_entity(entity)
+  get_entity_name_cpp(entity)
+}
+
+#' @export
+#' @rdname entities
+#' @param agent Agent object of class `epiworld_agent`.
+#' @return 
+#' - The function `entity_add_agent` adds an agent to the entity.
+entity_add_agent <- function(
+  entity,
+  agent,
+  model = attr(entity, "model")
+  ) {
+
+  stopifnot_entity(entity)
+  stopifnot_agent(agent)
+  entity_add_agent_cpp(entity, agent, model)
+
+  invisible(entity)
+
+}
+
+#' @export
+#' @rdname entities
+#' @return 
+#' - The function `entity_rm_agent` removes an agent from the entity.
+entity_rm_agent <- function(
+  entity,
+  id
+) {
+
+  stopifnot_entity(entity)
+  stopifnot_agent(agent)
+  entity_rm_agent_cpp(entity, agent)
+
+  invisible(entity)
+
+}
+
+# #' @export
+# #' @rdname entities
+# #' @return 
+# #' - The function `rm_entity` removes an entity from the model.
+# rm_entity <- function(model, id) {
+
+#   stopifnot_model(model)
+#   rm_entity_cpp(model, entity)
+
+#   invisible(model)
+# }
+
+#' @export
+#' @rdname entities
+#' @param n Integer scalar. Number of randomly assigned agents.
+add_entity_n <- function(
+  model,
+  entity,
+  n
+) {
+
+  stopifnot_model(model)
+  stopifnot_entity(entity)
+  add_entity_n_cpp(model, entity, n)
+
+  invisible(model)
+
+}