Merge pull request #233 from canmod/change-names

Change names

Author: stevencarlislewalker

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: macpan2
 Title: Fast and Flexible Compartmental Modelling
-Version: 1.13.0
+Version: 1.14.0
 Authors@R: c(
   person("Steve Walker", email="swalk@mcmaster.ca", role=c("cre", "aut")),
   person("Weiguang Guan", role="aut"),

R/change_models.R

@@ -2,15 +2,20 @@
 ChangeModelDefaults = function() {
   self = ChangeModel()
 
+  self$change_list = list()
+  
   self$flow_frame = function() {
-    ## TODO: check for change_list
-    (self$change_list
+    cl = self$change_list
+    if (length(cl) == 0L) return(self$empty_flow_frame)
+    (cl
       |> method_apply("flow_frame")
       |> bind_rows()
     )
   }
   self$change_frame = function() {
-    (self$change_list
+    cl = self$change_list
+    if (length(cl) == 0L) return(self$empty_change_frame)
+    (cl
       |> method_apply("change_frame")
       |> bind_rows()
     )
@@ -46,5 +51,20 @@ ChangeModelDefaults = function() {
       |> unique()
     )
   }
+  self$duplicated_change_names = function() {
+    frame = self$flow_frame()
+    dups = frame$change[duplicated(frame$change)]
+    return(dups)
+  }
+  self$check = function() {
+    dups = self$duplicated_change_names()
+    if (length(dups) > 0L) {
+      stop(
+          "The following names are duplicates:\n   "
+        , paste(dups, collapse = "   \n")
+      )
+    }
+    NULL
+  }
   return_object(self, "ChangeModelDefaults")
 }

R/formula_list_generators.R

@@ -90,17 +90,20 @@ ChangeModel = function() {
   # list of formula expressions to be added to an `after` list
   self$after_loop = function() list()
 
+  self$empty_flow_frame = empty_frame("size", "change", "rate", "abs_rate")
+  self$empty_change_frame = empty_frame("state", "change")
+  
   # one row per flow
   #  size : aka name of the from compartment
   #  change : absolute flow rate name
   #  rate : string with expression for the per-capita flow rate
   #  abs_rate : string with expression for the absolute flow rate
-  self$flow_frame = function() empty_frame("size", "change", "rate", "abs_rate")
+  self$flow_frame = function() self$empty_flow_frame
 
   # one row per term in a state update expression
   #  state : name of the state being updated
   #  change : string with the term in the expression that updates that state
-  self$change_frame = function() empty_frame("state", "change")
+  self$change_frame = function() self$empty_change_frame
 
   # character vector of ChangeComponent class names used in the model
   self$change_classes = function() character()
@@ -264,7 +267,7 @@ SimpleChangeModel = function(before = list(), during = list(), after = list()) {
   }
   self$before_loop = function() self$before
   self$after_loop = function() self$after
-  
+  self$check()
   return_object(self, "SimpleChangeModel")
 }
 
@@ -278,6 +281,7 @@ AllFormulaChangeModel = function(before = list(), during = list(), after = list(
   self$before_flows = function() self$during
   self$after_loop = function() self$after
 
+  self$check()
   return_object(self, "AllFormulaChangeModel")
 }
 
@@ -489,13 +493,21 @@ get_change_model = function(before, during, after) {
   AllFormulaChangeModel(before, during, after)
 }
 force_expr_list = function(x) {
+  is_change_component = function(x) inherits(x, "ChangeComponent")
+  is_valid = function(x) isTRUE(is_two_sided(x) | is_change_component(x))
   if (is_two_sided(x)) return(list(x))
-  if (inherits(x, "ChangeComponent")) return(list(x))
+  if (is_change_component(x)) return(list(x))
   if (!is.list(x)) {
-    ## TODO: should make more sense!
+    ## TODO: msg should make more sense to humans
     stop("Argument must be a formula, change component, or a list of such objects.")
   }
-  ## TODO: check that we have a list of valid components
+  invalid = !vapply(x, is_valid, logical(1L))
+  if (any(invalid)) {
+    stop(
+        "The expressions at the following positions are invalid: "
+      , paste(which(invalid), collapse = ", ")
+    )
+  }
   return(x)
 }
 

R/tmb_model_editors.R

@@ -86,6 +86,7 @@ mp_tmb_insert = function(model
   model = assert_cls(model, "TMBModelSpec", match.call(), "?mp_tmb_model_spec")
   valid$char1$check(phase)
   at = valid$num1$assert(at)
+  expressions = force_expr_list(expressions)
 
   model = model$copy()
   model[[phase]] = append(model[[phase]], expressions, after = at - 1L)
@@ -124,6 +125,7 @@ mp_tmb_update = function(model
   model = assert_cls(model, "TMBModelSpec", match.call(), "?mp_tmb_model_spec")
   valid$char1$check(phase)
   at = valid$num1$assert(at)
+  expressions = force_expr_list(expressions)
 
   model = model$copy()
   where = at - 1L + seq_along(expressions)

README.Rmd

@@ -47,7 +47,7 @@ repos = c('https://canmod.r-universe.dev', 'https://cloud.r-project.org')
 install.packages('macpan2', repos = repos)
 ```
 
-This command will install the current version of `macpan2`. For projects in production that need to keep track of specific versions of `macpan2`, snapshots and other reproducibility information can be obtained [here](https://canmod.r-universe.dev/api). Please see [this article](https://ropensci.org/blog/2022/01/06/runiverse-renv/) for an explanation of how to manage reproducibility using `r-universe`.
+This command will install the current version of `macpan2`. For projects in production that need to keep track of specific versions of `macpan2`, snapshots and other reproducibility information can be obtained [here](https://canmod.r-universe.dev/apis). Please see [this article](https://ropensci.org/blog/2022/01/06/runiverse-renv/) for an explanation of how to manage reproducibility using `r-universe`.
 
 To get the latest development version of `macpan2`, or if the above command fails for some reason, an alternative command to install is the following.
 ```

README.md

@@ -149,7 +149,7 @@ library(dplyr)
  |> mp_simulator(time_steps = 50, outputs = c("I", "infection"))
  |> mp_trajectory()
  |> mutate(quantity = case_match(matrix
-    , "I" ~ "Prevalance"
+    , "I" ~ "Prevalence"
     , "infection" ~ "Incidence"
   ))
  |> ggplot() 

man/figures/plot-tmb-si-1.png

@@ -0,0 +1,12 @@
+test_that("repeated flow names get flagged", {
+  expect_error(
+      mp_tmb_model_spec(
+          during = list(
+              mp_per_capita_flow("S", "I", "beta * I", "repeated_flow_name")
+            , mp_per_capita_flow("I", "R", "gamma"   , "repeated_flow_name")
+          )
+        , default = list(S = 1 - 1e-5, I = 1e-5, beta = 0.25, gamma = 0.1)
+      )
+    , "The following names are duplicates"
+  )
+})

tests/testthat/test-repeat-flows.R

@@ -622,7 +622,7 @@ fit <- sir_simulator$optimize$nlminb()
 
 Here is a reasonably difficult problem -- fit an SIR model to weekly measles incidence data from London UK over about six decades.
 
-<!-- FIXME: store data locally, don't rely on IIDA ... -->
+<!-- FIXME: store data locally, don't rely on IIDDA ... -->
 ```{r sir_plot, fig.width=6}
 measles = read.csv(
   file.path(