Add a village manager to ocontain villages

zizroc · Jun 6, 2024 · 259464b · 259464b
1 parent a7982e8
commit 259464b
Show file tree

Hide file tree

Showing 10 changed files with 193 additions and 39 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -47,6 +47,7 @@ Suggests:
     rmarkdown,
     testthat,
     roxygen2,
+    pandoc,
 URL: https://github.com/zizroc/villager/
 BugReports: https://github.com/zizroc/villager/issues/
 VignetteBuilder: knitr
diff --git a/NAMESPACE b/NAMESPACE
@@ -8,6 +8,7 @@ export(resource)
 export(resource_manager)
 export(simulation)
 export(village)
+export(village_manager)
 export(village_state)
 importFrom(R6,R6Class)
 importFrom(readr,write_csv)

diff --git a/R/simulation.R b/R/simulation.R
@@ -12,7 +12,7 @@
 simulation <- R6::R6Class("simulation",
   public = list(
     length = NA,
-    villages = NA,
+    village_mgr = NA,
     writer = NA,
 
     #' Creates a new Simulation instance
@@ -24,7 +24,7 @@ simulation <- R6::R6Class("simulation",
     initialize = function(length,
                           villages,
                           writer = villager::data_writer$new()) {
-      self$villages <- villages
+      self$village_mgr <- village_manager$new(villages)
       self$length <- length
       self$writer <- writer
     },
@@ -33,16 +33,16 @@ simulation <- R6::R6Class("simulation",
     #'
     #' @return None
     run_model = function() {
-      for (village in self$villages) {
+      for (village in self$village_mgr$get_villages()) {
         village$set_initial_state()
       }
       # Loop over each village and run the user defined initial condition function. Index off of 1 because the
       # initial condition is set at 0
       current_step <- 1
       while (current_step <= self$length) {
         # Iterate the villages a single time step
-        for (village in self$villages) {
-          village$propagate(current_step)
+        for (village in self$village_mgr$get_villages()) {
+          village$propagate(current_step, self$village_mgr)
           self$writer$write(village$current_state, village$name)
         }
         current_step <- current_step + 1

diff --git a/R/village.R b/R/village.R
@@ -13,6 +13,8 @@
 #'   }
 village <- R6::R6Class("village",
   public = list(
+    #' @field name Unique identifier for the village
+    identifier = NA,
     #' @field name An optional name for the village
     name = NA,
     #' @field initial_condition A function that sets the initial state of the village
@@ -47,7 +49,7 @@ village <- R6::R6Class("village",
       self$initial_condition <- initial_condition
       self$agent_mgr <- agent_manager$new(agent_class)
       self$resource_mgr <- resource_manager$new(resource_class)
-
+      self$identifier <- uuid::UUIDgenerate()
       # Check to see if the user supplied a single model, outside of a list
       # If so, put it in a vector because other code expects 'models' to be a list
       if (!is.list(models) && !is.null(models)) {
@@ -69,7 +71,7 @@ village <- R6::R6Class("village",
     #' to set initial conditions. See the set_initial_state method.
     #' @param current_step The current time step
     #' @return None
-    propagate = function(current_step) {
+    propagate = function(current_step, village_mgr) {
       # Create a new state representing this slice in time. Since many of the
       # values will be the same as the previous state, clone the previous state
       self$current_state <- self$previous_state$clone(deep = TRUE)
@@ -79,7 +81,7 @@ village <- R6::R6Class("village",
       for (model in self$models) {
         # Create a read only copy of the last state so that users can make decisions off of it
         self$previous_state <- self$current_state$clone(deep = TRUE)
-        model(self$current_state, self$previous_state, self$model_data, self$agent_mgr, self$resource_mgr
+        model(self$current_state, self$previous_state, self$model_data, self$agent_mgr, self$resource_mgr, village_mgr
         )
       }
       self$current_state$agent_states <- self$agent_mgr$get_states()

diff --git a/R/village_manager.R b/R/village_manager.R
@@ -0,0 +1,52 @@
+#' @export
+#' @title Village Manager
+#' @docType class
+#' @description This object manages all of the villages. It acts as an interface to them
+#' @section Methods:
+#' \describe{
+#'   \item{\code{initialize()}}{Creates a new manager}
+#'   \item{\code{get_villages()}}{Gets all of the villages that the manager has}
+#'   \item{\code{get_village()}}{Retrieves a specific village from the manager, by name}
+#'   \item{\code{add_village()}}{Adds a village to the manager}
+#'   }
+village_manager <- R6::R6Class(
+  "village_manager",
+  public = list(
+    #' @field villages A list of village objects
+    villages = NULL,
+    #' Creates a new, village manager
+    #' @description Get a new instance of a village_manager
+    initialize = function(villages) {
+      self$villages <- villages
+    },
+
+    #' Gets all of the managed villages
+    #'
+    #' @return A list of resources
+    get_villages = function() {
+      return(self$villages)
+    },
+
+    #' Gets a village given a village name
+    #'
+    #' @param name The name of the requested village
+    #' @return A village object
+    get_village = function(name) {
+      for (village in self$village) {
+        if (village$name == name) {
+          return(village)
+        }
+      }
+    },
+
+    #' Adds a village to the manager.
+    #'
+    #' @param ... The villages to add
+    #' @return None
+    add_resource = function(...) {
+      for (new_village in list(...)) {
+        self$villages <- append(self$villages, new_village)
+      }
+    }
+  )
+)
diff --git a/tests/testthat/test-integrated.R b/tests/testthat/test-integrated.R
@@ -2,7 +2,7 @@
 
 test_that("models can add agents each day", {
   # Create a model that creates a new agent each day
-  population_model <- function(current_state, previous_state, model_data, agent_mgr, resource_mgr) {
+  population_model <- function(current_state, previous_state, model_data, agent_mgr, resource_mgr, village_mgr) {
     new_agent <- agent$new()
     agent_mgr$add_agent(new_agent)
   }
@@ -15,20 +15,23 @@ test_that("models can add agents each day", {
   # Run for 5 days
   new_siumulator <- simulation$new(6, villages = list(plains_village))
   new_siumulator$run_model()
-  testthat::expect_length(new_siumulator$villages[[1]]$agent_mgr$agents, 6)
-  ending_population <- new_siumulator$villages[[1]]$agent_mgr$get_living_population()
+  test_villages <- new_siumulator$village_mgr$get_villages()
+  testthat::expect_equal(length(test_villages), 1)
+  testthat::expect_length(test_villages[[1]]$agent_mgr$agents, 6)
+  ending_population <- test_villages[[1]]$agent_mgr$get_living_population()
   testthat::expect_equal(ending_population, 6)
 })
 
 test_that("models can add and change resource quantities", {
   # Create a model that creates a stock of corn
   # At the end of three days, make sure that there are 6 corn stocks
   initial_condition <- function(current_state, model_data, agent_mgr, resource_mgr) {
+    print("123")
     crop_resource <- resource$new(name = "corn", quantity = 0)
     resource_mgr$add_resource(crop_resource)
   }
 
-  deterministic_crop_stock_model <- function(current_state, previous_state, model_data, agent_mgr, resource_mgr) {
+  deterministic_crop_stock_model <- function(current_state, previous_state, model_data, agent_mgr, resource_mgr, village_mgr) {
     corn <- resource_mgr$get_resource("corn")
     corn$quantity <- corn$quantity + 3
   }
@@ -37,7 +40,8 @@ test_that("models can add and change resource quantities", {
   plains_village  <- village$new("Test_Village", initial_condition, models = deterministic_crop_stock_model)
   new_siumulator <- simulation$new(3, villages = list(plains_village))
   new_siumulator$run_model()
-  last_record <- new_siumulator$villages[[1]]$current_state
+  last_record <- new_siumulator$village_mgr$get_villages()[[1]]$current_state
+  print(last_record$resource_states)
   corn <- last_record$resource_states %>% dplyr::filter(name == "corn")
   testthat::expect_equal(corn$quantity, 9)
 })
@@ -55,7 +59,7 @@ test_that("models can change resoources based on information from the agent_mana
     agent_mgr$add_agent(agent$new())
   }
 
-  crop_stock_model <- function(current_state, previous_state, model_data, agent_mgr, resource_mgr) {
+  crop_stock_model <- function(current_state, previous_state, model_data, agent_mgr, resource_mgr, village_mgr) {
     crops <- resource_mgr$get_resource("crops")
     # Each villager eats 2 crops each day
     crops$quantity <- crops$quantity - 2 * agent_mgr$get_living_population()
@@ -67,8 +71,8 @@ test_that("models can change resoources based on information from the agent_mana
   new_siumulator$run_model()
 
   # Check to see if the correct number are left
-  record_length <- length(new_siumulator$villages[[1]]$StateRecords)
-  last_record <- new_siumulator$villages[[1]]$current_state
+  record_length <- length(new_siumulator$village_mgr$get_villages()[[1]]$StateRecords)
+  last_record <- new_siumulator$village_mgr$get_villages()[[1]]$current_state
   crops <- last_record$resource_states %>% dplyr::filter(name == "crops")
   testthat::expect_equal(crops$quantity, 8)
 })
@@ -84,7 +88,7 @@ test_that("models can have dynamics based on agent behavior", {
   }
 
   # Create a model where agents are added if there is extra food available
-  crop_stock_model <- function(current_state, previous_state, model_data, agent_mgr, resource_mgr) {
+  crop_stock_model <- function(current_state, previous_state, model_data, agent_mgr, resource_mgr, village_mgr) {
     crops <- resource_mgr$get_resource("crops")
     crops$quantity <- crops$quantity + 1
     if (crops$quantity - agent_mgr$get_living_population() > 0) {
@@ -98,8 +102,8 @@ test_that("models can have dynamics based on agent behavior", {
   new_siumulator$run_model()
 
   # Check to see if the correct number are left
-  record_length <- length(new_siumulator$villages[[1]]$StateRecords)
-  last_record <- new_siumulator$villages[[1]]$StateRecords[[record_length]]
+  record_length <- length(new_siumulator$village_mgr$get_villages()[[1]]$StateRecords)
+  last_record <- new_siumulator$village_mgr$get_villages()[[1]]$StateRecords[[record_length]]
   testthat::expect_equal(plains_village$agent_mgr$get_living_population(), 5)
 })
 
@@ -117,7 +121,7 @@ test_that("agents and resources can have properties changed in models", {
   }
 
   # Create a model where agents are set to alive/dead
-  crop_stock_model <- function(current_state, previous_state, model_data, agent_mgr, resource_mgr) {
+  crop_stock_model <- function(current_state, previous_state, model_data, agent_mgr, resource_mgr, village_mgr) {
     # If it's not the first year, then set two agents to the dead state
     agent_1 <- agent_mgr$get_agent("dead_agent_1")
     agent_2 <- agent_mgr$get_agent("dead_agent_2")
@@ -133,7 +137,7 @@ test_that("agents and resources can have properties changed in models", {
   new_siumulator$run_model()
 
   # Check to see if the correct number are left
-  last_record <- new_siumulator$villages[[1]]$current_state
+  last_record <- new_siumulator$village_mgr$get_villages()[[1]]$current_state
   testthat::expect_equal(plains_village$resource_mgr$get_resource("marine")$quantity,
                          50)
   testthat::expect_equal(plains_village$agent_mgr$get_living_population(), 2)
@@ -153,7 +157,7 @@ test_that("agents profession can change based on age", {
     agent_manager$add_agent(agent$new(identifier = "female2", age = 2292, alive = TRUE, gender = "Female"))
   }
 
-  agent_model <- function(current_state, previous_state, model_data, agent_mgr, resource_mgr) {
+  agent_model <- function(current_state, previous_state, model_data, agent_mgr, resource_mgr, village_mgr) {
     # Get the new list of living agents and assign professions
     for (living_agent in agent_mgr$get_living_agents()) {
       if (living_agent$age >= 14610) {
@@ -179,7 +183,7 @@ test_that("agents profession can change based on age", {
   new_siumulator$run_model()
 
   # Check to see that the professions are correct
-  village_agent_mgr <- new_siumulator$villages[[1]]$agent_mgr
+  village_agent_mgr <- new_siumulator$village_mgr$get_villages()[[1]]$agent_mgr
   testthat::expect_equal(village_agent_mgr$get_agent("male1")$profession, "Forager")
   testthat::expect_equal(village_agent_mgr$get_agent("male2")$profession, "Fisher")
   testthat::expect_equal(village_agent_mgr$get_agent("female1")$profession, "Farmer")

diff --git a/tests/testthat/test-readme.R b/tests/testthat/test-readme.R
@@ -32,7 +32,7 @@ test_that("the first example properly sets the profession of the agents", {
   simulator <- simulation$new(4745, list(small_village))
   simulator$run_model()
 
-  for (agent in simulator$villages[[1]]$agent_mgr$get_living_agents()) {
+  for (agent in simulator$village_mgr$get_villages()[[1]]$agent_mgr$get_living_agents()) {
     testthat::expect_equal(agent$profession, "Farmer")
   }
 })

diff --git a/tests/testthat/test-simulation.R b/tests/testthat/test-simulation.R
@@ -6,19 +6,19 @@ test_that("the consrtructor works", {
   village <- village$new(name = "Random Population Village", initial_condition = initial_condition)
 
   mayan_simulation <- simulation$new(4, villages = c(village))
-  testthat::expect_length(mayan_simulation$villages, 1)
+  testthat::expect_length(mayan_simulation$village_mgr$get_villages(), 1)
 })
 
 test_that("the number of villages added is correct", {
   initial_condition <- function(current_state, model_ata, population_manager, resource_mgr) {
   }
   coastal_village <- village$new("Test_Village", initial_condition)
   simulator <- simulation$new(2, villages = list(coastal_village))
-  testthat::expect_length(simulator$villages, 1)
+  testthat::expect_length(simulator$village_mgr$get_villages(), 1)
 
   # Check with a second village
   plains_village  <- village$new("Test plains village", initial_condition)
   valley_village  <- village$new("Test valley village", initial_condition)
   new_siumulator <- simulation$new(2, villages = list(valley_village, plains_village))
-  testthat::expect_length(new_siumulator$villages, 2)
+  testthat::expect_length(new_siumulator$village_mgr$get_villages(), 2)
 })
diff --git a/tests/testthat/test-village.R b/tests/testthat/test-village.R
@@ -13,7 +13,7 @@ test_that("the initial models can properly set village states", {
   simulator <- simulation$new(1, villages = list(new_village))
   simulator$run_model()
 
-  last_record <- simulator$villages[[1]]$current_state$resource_states
+  last_record <- simulator$village_mgr$get_villages()[[1]]$current_state$resource_states
 
   # Check that the initial state of corn is 5
   corn_row <- match("corn", last_record$name)
@@ -38,7 +38,7 @@ test_that("the initial condition is properly set", {
   new_village <- village$new("Test_Village", initial_condition)
   simulator <- simulation$new(1, villages = list(new_village))
   simulator$run_model()
-  last_record <- simulator$villages[[1]]$current_state$resource_states
+  last_record <- simulator$village_mgr$get_villages()[[1]]$current_state$resource_states
   # Check that the initial state of corn is 5
   corn_row <- match("corn", last_record$name)
   corn_row <- last_record[corn_row, ]
@@ -55,7 +55,7 @@ test_that("propagate runs a custom model", {
     resource_mgr$add_resource(resource$new(name = "corn", quantity = 5))
   }
 
-  corn_model <- function(curent_state, previous_state, model_data, agent_mgr, resource_mgr) {
+  corn_model <- function(curent_state, previous_state, model_data, agent_mgr, resource_mgr, village_mgr) {
       if (curent_state$step == 3) {
         # On the third day add 5 corn
         corn_resource <- resource_mgr$get_resource("corn")
@@ -67,7 +67,7 @@ test_that("propagate runs a custom model", {
   simulator <- simulation$new(3, villages = list(new_village))
   simulator$run_model()
 
-  last_record <- simulator$villages[[1]]$current_state$resource_states
+  last_record <- simulator$village_mgr$get_villages()[[1]]$current_state$resource_states
 
   corn_row <- match("corn", last_record$name)
   corn_row <- last_record[corn_row, ]
@@ -80,12 +80,12 @@ test_that("propagate runs multiple custom models", {
     resource_mgr$add_resource(resource$new(name = "salmon", quantity = 1))
   }
 
-  corn_model <- function(curent_state, previous_state, model_data, agent_mgr, resource_mgr) {
+  corn_model <- function(curent_state, previous_state, model_data, agent_mgr, resource_mgr, village_mgr) {
     corn <- resource_mgr$get_resource("corn")
     corn$quantity <- corn$quantity + 1
   }
 
-  salmon_model <- function(curent_state, previous_state, model_data, agent_mgr, resource_mgr) {
+  salmon_model <- function(curent_state, previous_state, model_data, agent_mgr, resource_mgr, village_mgr) {
     salmon <- resource_mgr$get_resource("salmon")
     salmon$quantity <- salmon$quantity + 1
   }
@@ -94,9 +94,9 @@ test_that("propagate runs multiple custom models", {
 
   simulator <- simulation$new(2, villages = list(new_village))
   simulator$run_model()
-  testthat::expect_length(simulator$villages, 1)
+  testthat::expect_length(simulator$village_mgr$get_villages(), 1)
 
-  last_record <- simulator$villages[[1]]$current_state$resource_states
+  last_record <- simulator$village_mgr$get_villages()[[1]]$current_state$resource_states
   corn_row <- match("corn", last_record$name)
   corn_row <- last_record[corn_row, ]
   salmon_row <- match("salmon", last_record$name)
@@ -112,12 +112,12 @@ test_that("The previous state is recorded", {
     resource_mgr$add_resource(resource$new(name = "salmon", quantity = 1))
   }
 
-  corn_model <- function(curent_state, previous_state, model_data, agent_mgr, resource_mgr) {
+  corn_model <- function(curent_state, previous_state, model_data, agent_mgr, resource_mgr, village_mgr) {
     corn <- resource_mgr$get_resource("corn")
     corn$quantity <- corn$quantity + 1
   }
 
-  salmon_model <- function(curent_state, previous_state, model_data, agent_mgr, resource_mgr) {
+  salmon_model <- function(curent_state, previous_state, model_data, agent_mgr, resource_mgr, village_mgr) {
     salmon <- resource_mgr$get_resource("salmon")
     salmon$quantity <- salmon$quantity + 1
   }
@@ -126,9 +126,9 @@ test_that("The previous state is recorded", {
 
   simulator <- simulation$new(2, villages = list(new_village))
   simulator$run_model()
-  testthat::expect_length(simulator$villages, 1)
+  testthat::expect_length(simulator$village_mgr$get_villages(), 1)
 
-  last_record <- simulator$villages[[1]]$current_state$resource_states
+  last_record <- simulator$village_mgr$get_villages()[[1]]$current_state$resource_states
   corn_row <- match("corn", last_record$name)
   corn_row <- last_record[corn_row, ]
   salmon_row <- match("salmon", last_record$name)