From c06291ac5a4fcfcb65872f26c4e062c339bd7c2e Mon Sep 17 00:00:00 2001 From: Thomas Thelen Date: Mon, 2 Nov 2020 23:31:19 -0800 Subject: [PATCH 1/2] Add support for loading resources from disk --- R/resource_manager.R | 21 +++++++++++++++++--- tests/testthat/test-files/test-resources.csv | 5 +++++ tests/testthat/test-resource_manager.R | 19 ++++++++++++++++++ 3 files changed, 42 insertions(+), 3 deletions(-) create mode 100644 tests/testthat/test-files/test-resources.csv diff --git a/R/resource_manager.R b/R/resource_manager.R index f196c2a..2f5c881 100644 --- a/R/resource_manager.R +++ b/R/resource_manager.R @@ -12,6 +12,7 @@ #' \item{\code{remove_resource()}}{Removes a resource from the manager} #' \item{\code{get_resource_index()}}{Retrieves the index of the resource} #' \item{\code{get_states()}}{Returns a list of states} +#' \item{\code{load()}}{Loads a csv file of resources and adds them to the manager.} #' } resource_manager <- R6::R6Class("resource_manager", public = list(resources = NULL, @@ -66,9 +67,23 @@ resource_manager <- R6::R6Class("resource_manager", #' #' @return A list of data frames get_states = function() { - vector_states = vector(length = length(self$resources)) + states = list(length = length(self$resources)) # Create a data frame to hold the states - for (res in self$resources) - vector_states <- append(vector_states, res$as_tibble()) + for (res in self$resources) { + states <- append(vector_states, res$as_tibble()) + } + return (bind_rows(states)) + }, + + #' Loads a csv file of resources into the manager + #' + #' @param file_name The path to the csv file + #' @return None + load = function(file_name) { + resources <- read.csv(file_name) + for(i in 1:nrow(resources)) { + resource_row <- resources[i,] + self$add_resource(resource$new(name=resource_row$name, quantity=resource_row$quantity)) + } } )) diff --git a/tests/testthat/test-files/test-resources.csv b/tests/testthat/test-files/test-resources.csv new file mode 100644 index 0000000..c10d096 --- /dev/null +++ b/tests/testthat/test-files/test-resources.csv @@ -0,0 +1,5 @@ +name,quantity +maize,10 +salmon,5 +trout,1 +cashews,0 diff --git a/tests/testthat/test-resource_manager.R b/tests/testthat/test-resource_manager.R index 409a28e..038e80e 100644 --- a/tests/testthat/test-resource_manager.R +++ b/tests/testthat/test-resource_manager.R @@ -85,3 +85,22 @@ test_that("the manager removes resources", { resource_mgr$remove_resource(resource_1_name) testthat::expect_length(resource_mgr$resources, 2) }) + +test_that("the manager can load resources from disk", { + resource_mgr <- resource_manager$new() + file_path = "test-files/test-resources.csv" + resource_mgr$load(file_path) + + # Test that the resources exist with the expected quantities + corn <- resource_mgr$get_resource("maize") + testthat::expect_equal(corn$quantity, 10) + + corn <- resource_mgr$get_resource("salmon") + testthat::expect_equal(corn$quantity, 5) + + corn <- resource_mgr$get_resource("cashews") + testthat::expect_equal(corn$quantity, 0) + + corn <- resource_mgr$get_resource("trout") + testthat::expect_equal(corn$quantity, 1) +}) From b045bcd1a86568bff9d4be2afbcd40f5d1153a1a Mon Sep 17 00:00:00 2001 From: Thomas Thelen Date: Tue, 3 Nov 2020 22:12:40 -0800 Subject: [PATCH 2/2] Fix state writing --- R/resource_manager.R | 13 +++++-- tests/testthat/test-village.R | 73 +++++++++++++++++++++++++++-------- 2 files changed, 65 insertions(+), 21 deletions(-) diff --git a/R/resource_manager.R b/R/resource_manager.R index 2f5c881..b4aa539 100644 --- a/R/resource_manager.R +++ b/R/resource_manager.R @@ -67,12 +67,17 @@ resource_manager <- R6::R6Class("resource_manager", #' #' @return A list of data frames get_states = function() { - states = list(length = length(self$resources)) # Create a data frame to hold the states - for (res in self$resources) { - states <- append(vector_states, res$as_tibble()) + state_tibble <- tibble::tibble() + for (i in seq_along(self$resources)) { + if (i ==1) { + state_tibble <- self$resources[[i]]$as_tibble() + } + else { + state_tibble <- rbind(state_tibble, self$resources[[i]]$as_tibble()) + } } - return (bind_rows(states)) + return (state_tibble) }, #' Loads a csv file of resources into the manager diff --git a/tests/testthat/test-village.R b/tests/testthat/test-village.R index fb1c23e..9cba05f 100644 --- a/tests/testthat/test-village.R +++ b/tests/testthat/test-village.R @@ -4,9 +4,10 @@ test_that("propagate doesn't copy the initial state on year 1", { # Check that the initial state is passed into the user's model on the first year # This makes sure that models can set initial states inside their code - test_model <- function(currentState, previousState, modelData, population_manager) { + test_model <- function(currentState, previousState, modelData, population_manager, resource_mgr) { if(currentState$year == 1) - currentState$carryingCapacity <- 999 + resource_mgr$add_resource(resource$new(name="corn", quantity=5)) + resource_mgr$add_resource(resource$new(name="salmon", quantity=6)) } new_state <- VillageState$new() @@ -14,38 +15,76 @@ test_that("propagate doesn't copy the initial state on year 1", { simulator <- Simulation$new(length = 2, villages = list(new_village)) simulator$run_model() - # Check that the initial state is 999 - testthat::expect_equal(simulator$villages[[1]]$StateRecords[[1]]$carryingCapacity, 999) + last_record <- simulator$villages[[1]]$StateRecords[[1]]$resource_states + # Check that the initial state of corn is 5 + corn_row <- match("corn", last_record$name) + corn_row<- last_record[corn_row,] + + testthat::expect_equal(corn_row$quantity, 5) # Check that it was copied to the second day's state - testthat::expect_equal(simulator$villages[[1]]$StateRecords[[1]]$carryingCapacity, 999) + salmon_row <-match("salmon", last_record$name) + salmon_row<- last_record[salmon_row,] + testthat::expect_equal(salmon_row$quantity, 6) }) test_that("propagate runs a custom model", { - random_crop_stock_model <- function(currentState, previousState, modelData, population_manager) { - currentState$cropStock <- 11 + corn_model <- function(currentState, previousState, modelData, population_manager, resource_mgr) { + if(currentState$year == 1) { + resource_mgr$add_resource(resource$new(name="corn", quantity=5)) + } + else { + if (currentState$year == 3) { + # On the third year add 5 corn + corn_resource <- resource_mgr$get_resource("corn") + corn_resource$quantity <- corn_resource$quantity + 5 + } + } } new_state <- VillageState$new() - new_village <- BaseVillage$new(initialState=new_state, models=random_crop_stock_model) - simulator <- Simulation$new(length = 2, villages = list(new_village)) + new_village <- BaseVillage$new(initialState=new_state, models=corn_model) + simulator <- Simulation$new(length = 3, villages = list(new_village)) simulator$run_model() - testthat::expect_equal(simulator$villages[[1]]$StateRecords[[2]]$cropStock, 11) + + last_record <- simulator$villages[[1]]$StateRecords[[3]]$resource_states + + corn_row <- match("corn", last_record$name) + corn_row<- last_record[corn_row,] + testthat::expect_equal(corn_row$quantity, 10) }) test_that("propagate runs multiple custom models", { - random_crop_stock_model <- function(currentState, previousState, modelData, population_manager) { - currentState$cropStock <- 11 + corn_model <- function(currentState, previousState, modelData, population_manager, resource_mgr) { + if(currentState$year == 1) { + resource_mgr$add_resource(resource$new(name="corn", quantity=5)) + } + else { + corn <- resource_mgr$get_resource("corn") + corn$quantity <-corn$quantity + 1 + } } - random_fish_stock_model <- function(currentState, previousState, modelData, population_manager) { - currentState$fishStock <- 3 + salmon_model <- function(currentState, previousState, modelData, population_manager, resource_mgr) { + if(currentState$year == 1) { + resource_mgr$add_resource(resource$new(name="salmon", quantity=1)) + } + else { + salmon <- resource_mgr$get_resource("salmon") + salmon$quantity <-salmon$quantity + 1 + } } new_state <- VillageState$new() - new_village <- BaseVillage$new(initialState=new_state, models=list(random_crop_stock_model, random_fish_stock_model)) + new_village <- BaseVillage$new(initialState=new_state, models=list(corn_model, salmon_model)) simulator <- Simulation$new(length = 2, villages = list(new_village)) simulator$run_model() testthat::expect_length(simulator$villages, 1) - testthat::expect_equal(new_village$StateRecords[[2]]$cropStock, 11) - testthat::expect_equal(new_village$StateRecords[[2]]$fishStock, 3) + + last_record <- simulator$villages[[1]]$StateRecords[[2]]$resource_states + corn_row <- match("corn", last_record$name) + corn_row<- last_record[corn_row,] + salmon_row <- match("salmon", last_record$name) + salmon_row<- last_record[salmon_row,] + testthat::expect_equal(corn_row$quantity, 6) + testthat::expect_equal(salmon_row$quantity, 2) })