Add support for getting the number of days since the last birth

zizroc · Feb 16, 2021 · 4190173 · 4190173
1 parent ea99dae
commit 4190173
Show file tree

Hide file tree

Showing 6 changed files with 167 additions and 39 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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()