diff --git a/R/village.R b/R/village.R index 15bf018..af570cc 100755 --- a/R/village.R +++ b/R/village.R @@ -80,7 +80,7 @@ village <- R6::R6Class("village", village_data <- self$StateRecords[[length(self$StateRecords)]]$clone(deep=TRUE) # Update the date in the state record to reflect the current date village_data$date <- date - self$winik_mgr$increment_winik_ages() + self$winik_mgr$propagate() # Run each of the models for (model in self$models) { # Create a read only copy of the last state so that users can make decisions off of it diff --git a/R/winik.R b/R/winik.R index 7ed5d48..084b8b0 100644 --- a/R/winik.R +++ b/R/winik.R @@ -18,41 +18,43 @@ #' @field health A percentage value of the winik's current health #' @section Methods: #' \describe{ -#' \item{\code{initialize()}}{Create a new winik} -#' \item{\code{get_gender()}}{} -#' \item{\code{get_age()}}{Returns age in terms of years} #' \item{\code{as_tibble()}}{Represents the current state of the winik as a tibble} +#' \item{\code{get_age()}}{Returns age in terms of years} +#' \item{\code{get_gender()}}{} +#' \item{\code{get_last_birth()}}{Get the number of days since the winik last gave birth} +#' \item{\code{initialize()}}{Create a new winik} +#' \item{\code{propagate()}}{Runs every day} #' } winik <- R6::R6Class("winik", - public = list(identifier = NULL, + public = list(age=NULL, + alive=NULL, + children=NULL, + father_id=NULL, first_name=NULL, + gender=NULL, + health=NULL, + identifier = NULL, last_name=NULL, - age=NULL, mother_id=NULL, - father_id=NULL, - profession=NULL, partner=NULL, - children=NULL, - gender=NULL, - alive=NULL, - health=NULL, + profession=NULL, #' Create a new winik #' #' @description Used to created new winik objects. #' #' @export + #' @param age The age of the winik + #' @param alive Boolean whether the winik is alive or not + #' @param children An ordered list of of the children from this winik + #' @param gender The gender of the winik #' @param identifier The winik's identifier #' @param first_name The winik's first name #' @param last_name The winik's last naem - #' @param age The age of the winik #' @param mother_id The identifier of the winik's monther #' @param father_id The identifier of the winik' father #' @param partner The identifier of the winik's partner - #' @param children A list of identifiers of the children from this winik #' @param profession The winik's profession - #' @param gender The gender of the winik - #' @param alive Boolean whether the winik is alive or not #' @param health A percentage value of the winik's current health #' @return A new winik object initialize = function(identifier=NULL, @@ -62,7 +64,7 @@ winik <- R6::R6Class("winik", mother_id=NA, father_id=NA, partner=NA, - children=list(), + children=vector(mode = "character"), gender=NA, profession=NA, alive=TRUE, @@ -77,7 +79,7 @@ winik <- R6::R6Class("winik", self$profession <- profession self$gender <- gender self$partner <- partner - self$children <-children + self$children <- children self$health <- health }, @@ -90,6 +92,58 @@ winik <- R6::R6Class("winik", return (self$alive) }, + #' Handles logic for the winik that's done each day + #' + #' @return None + propagate = function() { + self$age <- self$age + 1 + }, + + #' Gets the number of days from the last birth. This is also + #' the age of the most recently born winik + #' + #' @return The number of days since last birth + get_last_birth = function() { + if(length(self$children) > 0) { + # This works because the children list is sorted + return (self$children[[1]]$age) + } + return (0) + }, + + #' Adds a child to the winik. This mehtod ensures that the + #' 'children' vector is ordered. + #' + #' @param child The Winik object representing the child + #' @return None + add_child = function(child) { + + # HACK TURN THIS INTO ANYTHING ELSE + bubble_sort <- function() { + children_length <- length(self$children) + if(children_length<= 1) { + return() + } + for (i in 1:children_length) { + j_len <- children_length-1 + for (j in 1:j_len) { + if (self$children[[j]]$age > self$children[[j+1]]$age) { + temp <- self$children[j+1] + self$children[j+1] <- self$children[j] + self$children[j] <- temp + } + } + } + } + + if (length(self$children) == 0) { + self$children <- c(self$children, child) + } else { + self$children <- append(self$children, child, after = 0) + bubble_sort() + } + }, + #' Returns a tibble representation of the winik #' #' @description I hope there's a more scalable way to do this in R; Adding every new attribute to this diff --git a/R/winik_manager.R b/R/winik_manager.R index ea5ec68..ef06f7e 100644 --- a/R/winik_manager.R +++ b/R/winik_manager.R @@ -6,17 +6,17 @@ #' @field winiks A list of winiks #' @section Methods: #' \describe{ -#' \item{\code{initialize()}}{Creates a new manager} -#' \item{\code{propegate()}}{Advances the winik one timestep} -#' \item{\code{get_winik()}}{Retrieves a minik from the manager} -#' \item{\code{get_living_winiks()}}{Returns the winik objects for winiks that are alive} #' \item{\code{add_winik()}}{Adds a winik to the manager} -#' \item{\code{remove_winik()}}{Removes a winik from the manager} +#' \item{\code{get_average_age()}}{Returns the average age in years of the winiks} +#' \item{\code{get_living_winiks()}}{Returns the winik objects for winiks that are alive} #' \item{\code{get_states()}}{Returns all of the villager states in a vector} +#' \item{\code{get_winik()}}{Retrieves a minik from the manager} #' \item{\code{get_winik_index()}}{Retrieves the index of a winik in the internal list} -#' \item{\code{get_average_age()}}{Returns the average age in years of the winiks} -#' \item{\code{increment_winik_ages()}}{Increases the age of each winik by a day} +#' \item{\code{initialize()}}{Creates a new manager} #' \item{\code{load()}}{Loads winiks from disk} +#' \item{\code{propegate()}}{Advances the winik one timestep} +#' \item{\code{propagate()}}{Runs every day} +#' \item{\code{remove_winik()}}{Removes a winik from the manager} #' } winik_manager <- R6::R6Class("winik_manager", public = list(winiks = NULL, @@ -149,13 +149,26 @@ winik_manager <- R6::R6Class("winik_manager", return (average_age_days/364) }, - #' Increases the age of the winik by one day - #' @details Iterates over all of the winiks that the manager is managing and - #' increases the age by a single day. + #' Winik manager code that needs to run every day #' @return None - increment_winik_ages = function() { + propagate = function() { for (living_winik in self$get_living_winiks()) { - living_winik$age <- living_winik$age + 1 + living_winik$propagate() + } + }, + + #' Takes all of the winiks in the manager and reconstructs the children + #' @return None + add_children = function() { + for (winik in self$winiks) { + if(!is.na(winik$mother_id)) { + mother <- self$get_winik(winik$mother_id) + mother$add_child(winik) + } + if(!is.na(winik$father_id)) { + father <- self$get_winik(winik$father_id) + father$add_child(winik) + } } }, @@ -181,5 +194,6 @@ winik_manager <- R6::R6Class("winik_manager", health=winiks_row$health) self$add_winik(new_winik) } + self$add_children() } )) diff --git a/tests/testthat/test-integrated.R b/tests/testthat/test-integrated.R index 1110c32..517e6d9 100644 --- a/tests/testthat/test-integrated.R +++ b/tests/testthat/test-integrated.R @@ -184,15 +184,8 @@ test_that("winiks profession can change based on age", { # Check to see that the professions are correct village_winik_mgr <- new_siumulator$villages[[1]]$winik_mgr - print(plains_village$StateRecords[[1]]$winik_states) - print(village_winik_mgr$get_winik("male1")) - print(village_winik_mgr$get_winik("male1")$profession) - print(village_winik_mgr$get_winik("male1")$profession) - print(village_winik_mgr$get_winik("male1")$profession) - testthat::expect_equal(village_winik_mgr$get_winik("male1")$profession, "Forager") testthat::expect_equal(village_winik_mgr$get_winik("male2")$profession, "Fisher") testthat::expect_equal(village_winik_mgr$get_winik("female1")$profession, "Farmer") testthat::expect_equal(village_winik_mgr$get_winik("female2")$profession, "Child") - }) diff --git a/tests/testthat/test-winik.R b/tests/testthat/test-winik.R index 202437a..5892d96 100644 --- a/tests/testthat/test-winik.R +++ b/tests/testthat/test-winik.R @@ -26,3 +26,27 @@ test_that("is_alive returns true or false", { is_alive <- test_winik$is_alive() expect_true(isTRUE(is_alive) || isFALSE(is_alive)) }) + +test_that("get_last_birth returns the age of the youngest winik", { + mother_winik <- winik$new(age = 10000, + first_name = "Mother", + health = 80) + + daughter_winik <- winik$new(age = 10, + first_name = "Susan", + health = 100) + mother_winik$add_child(daughter_winik) + testthat::expect_equal(mother_winik$get_last_birth(), 10) + + son_winik <- winik$new(age = 1, + first_name = "Garry", + health = 100) + mother_winik$add_child(son_winik) + testthat::expect_equal(mother_winik$get_last_birth(), 1) + + son2_winik <- winik$new(age = 15, + first_name = "Garry", + health = 100) + mother_winik$add_child(son2_winik) + testthat::expect_equal(mother_winik$get_last_birth(), 1) +}) diff --git a/tests/testthat/test-winik_manager.R b/tests/testthat/test-winik_manager.R index 4ce2b92..1efd0ee 100644 --- a/tests/testthat/test-winik_manager.R +++ b/tests/testthat/test-winik_manager.R @@ -132,18 +132,61 @@ test_that("the manager can load winiks from disk", { testthat::expect_equal(jim_morrison$age, 27) }) -test_that("increment_winik_ages increases the age of the winik by one day", { +test_that("propagate increases the age of the winik by one day", { winik_mgr <- winik_manager$new() winik_mgr$load("test-files/test-winiks.csv") for (living_winik in winik_mgr$get_living_winiks()) { testthat::expect_equal(living_winik$age, 35) } - winik_mgr$increment_winik_ages() + winik_mgr$propagate() for (living_winik in winik_mgr$get_living_winiks()) { testthat::expect_equal(living_winik$age, 36) } }) +test_that("the winik manager can properly add children to parents", { + winik_mgr <- winik_manager$new() + + # Create two sets of parents + mother_1 = winik$new(identifier="mother1", alive=TRUE) + mother_2 = winik$new(identifier="mother2", alive=TRUE) + father_1 = winik$new(identifier="father1", alive=TRUE) + father_2 = winik$new(identifier="father2", alive=TRUE) + winik_mgr$add_winik(mother_1) + winik_mgr$add_winik(mother_2) + winik_mgr$add_winik(father_1) + winik_mgr$add_winik(father_2) + # Connect the mom and dads + winik_mgr$connect_winiks(mother_1, father_1) + winik_mgr$connect_winiks(mother_2, father_2) + + # Make sure that they're really connected + testthat::expect_equal(mother_1$partner, father_1$identifier) + testthat::expect_equal(father_1$partner, mother_1$identifier) + testthat::expect_equal(mother_2$partner, father_2$identifier) + testthat::expect_equal(father_2$partner, mother_2$identifier) + + + # Create two children for the first set of parents + child1 = winik$new(identifier="child1", alive=TRUE, mother_id = mother_1$identifier, father_id = father_1$identifier) + child2 = winik$new(identifier="child2", alive=TRUE, mother_id = mother_1$identifier, father_id = father_1$identifier) + # Create another two for the other parents + child3 = winik$new(identifier="child3", alive=TRUE, mother_id = mother_2$identifier, father_id = father_2$identifier) + child4 = winik$new(identifier="child4", alive=TRUE, mother_id = mother_2$identifier, father_id = father_2$identifier) + + winik_mgr$add_winik(child1) + winik_mgr$add_winik(child2) + winik_mgr$add_winik(child3) + winik_mgr$add_winik(child4) + + # Use the winik manager to add the children to the parents + winik_mgr$add_children() + testthat::expect_length(mother_1$children, 2) + testthat::expect_length(father_1$children, 2) + testthat::expect_length(mother_2$children, 2) + testthat::expect_length(father_2$children, 2) +}) + #test_that("add_partner connects one winik to another", { # female_winik <- winik$new() # male_winik <- winik$new()