More ddp options

NEWS.md

@@ -40,6 +40,8 @@ be directly added to this file to describe the related changes.
 
 - Allowed user-supplied regularization functions
 
+- Allowed driver-specific initial values and parameters
+
 - Errors that occur while running simulations are now caught so they do not
   prevent an optimization from finishing
 
@@ -51,6 +53,9 @@ be directly added to this file to describe the related changes.
   parameter lists are alphabetized, equals signs are aligned, and module names
   are preserved
 
+- Fixed a bug where calling `objective_function` with
+  `dependent_arg_function = NULL` and `verbose_mode = TRUE` caused an error
+
 # Changes in BioCroValidation Version 0.2.0 (2025-05-23)
 
 - Added 2002 and 2005 SoyFACE biomass and standard deviation data.

R/combine_lists.R

@@ -0,0 +1,9 @@
+# Helping function for overwriting elements of a base list with elements of a
+# second list; here we assume that both lists have names, and that the names of
+# new_list is a subset of the names of base_list
+combine_lists <- function(base_list, new_list) {
+    for (element_name in names(new_list)) {
+        base_list[[element_name]] <- new_list[[element_name]]
+    }
+    base_list
+}

R/objective_function.R

@@ -19,7 +19,11 @@ objective_function <- function(
 )
 {
     # Check the data-driver pairs
-    check_data_driver_pairs(base_model_definition, data_driver_pairs)
+    check_data_driver_pairs(
+        base_model_definition,
+        data_driver_pairs,
+        verbose_startup
+    )
 
     # Check the arguments to be varied
     check_args_to_vary(

R/objective_function_helpers.R

@@ -46,8 +46,14 @@ get_model_runner <- function(
     # Build the runner
     tryCatch({
             partial_func <- BioCro::partial_run_biocro(
-                base_model_definition[['initial_values']],
-                base_model_definition[['parameters']],
+                combine_lists(
+                    base_model_definition[['initial_values']],
+                    ddp[['initial_values']]
+                ),
+                combine_lists(
+                    base_model_definition[['parameters']],
+                    ddp[['parameters']]
+                ),
                 ddp[['drivers']],
                 base_model_definition[['direct_modules']],
                 base_model_definition[['differential_modules']],

R/objective_function_input_checks.R

@@ -4,7 +4,7 @@
 
 # Helping function for checking the data-driver pairs; will throw an error if
 # a problem is detected, and will otherwise be silent with no return value.
-check_data_driver_pairs <- function(base_model_definition, data_driver_pairs) {
+check_data_driver_pairs <- function(base_model_definition, data_driver_pairs, verbose) {
     # There must be at least one data-driver pair
     if (length(data_driver_pairs) < 1) {
         stop('`data_driver_pairs` must have at least one element')
@@ -37,7 +37,7 @@ check_data_driver_pairs <- function(base_model_definition, data_driver_pairs) {
     }
 
     # Only required or optional elements should be provided
-    optional_elements <- 'data_stdev'
+    optional_elements <- c('data_stdev', 'initial_values', 'parameters')
 
     acceptable_elements <- c(required_elements, optional_elements)
 
@@ -117,12 +117,132 @@ check_data_driver_pairs <- function(base_model_definition, data_driver_pairs) {
         stop(msg)
     }
 
+    # When provided, the driver-specific initial values and parameters must be
+    # lists
+    iv_is_list <- sapply(data_driver_pairs, function(x) {
+        iv <- x[['initial_values']]
+
+        if (!is.null(iv)) {
+            is.list(iv) && !is.null(names(iv))
+        } else {
+            TRUE
+        }
+    })
+
+    if (any(!iv_is_list)) {
+        stop(
+            'When provided, the driver-specific initial values must be a list ',
+            'of named elements'
+        )
+    }
+
+    param_is_list <- sapply(data_driver_pairs, function(x) {
+        param <- x[['parameters']]
+
+        if (!is.null(param)) {
+            is.list(param) && !is.null(names(param))
+        } else {
+            TRUE
+        }
+    })
+
+    if (any(!param_is_list)) {
+        stop(
+            'When provided, the driver-specific parameters must be a list ',
+            'of named elements'
+        )
+    }
+
+    # Names of driver-specific initial values and parameter names must be the
+    # same for all data-driver pairs
+    iv_names <- lapply(data_driver_pairs, function(x) {
+        sort(names(x[['initial_values']]))
+    })
+
+    if (length(unique(iv_names)) > 1) {
+        msg <- paste0(
+            'The following driver-specific initial value names were provided ',
+            'in the data-driver pairs:\n',
+            paste(
+                names(iv_names), ':',
+                sapply(iv_names, function(x) {paste(x, collapse = ', ')}),
+                collapse = '\n'
+            ),
+            '\nWhen provided, these names must be the same for each set of ',
+            'drivers'
+        )
+
+        stop(msg)
+    }
+
+    param_names <- lapply(data_driver_pairs, function(x) {
+        sort(names(x[['parameters']]))
+    })
+
+    if (length(unique(param_names)) > 1) {
+        msg <- paste0(
+            'The following driver-specific parameter names were provided ',
+            'in the data-driver pairs:\n',
+            paste(
+                names(param_names), ':',
+                sapply(param_names, function(x) {paste(x, collapse = ', ')}),
+                collapse = '\n'
+            ),
+            '\nWhen provided, these names must be the same for each set of ',
+            'drivers'
+        )
+
+        stop(msg)
+    }
+
+    # Each driver-specific initial value and parameter must be included in the
+    # base model definition
+    iv_names_to_check <- unique(unlist(iv_names))
+
+    iv_names_okay <-
+        iv_names_to_check %in% names(base_model_definition[['initial_values']])
+
+    if (!all(iv_names_okay)) {
+        bad_names <- iv_names_to_check[!iv_names_okay]
+
+        msg <- paste(
+            'The following driver-specific initial values are not included in',
+            'the base model definition:',
+            paste0('"', bad_names, '"', collapse = ', ')
+        )
+
+        stop(msg)
+    }
+
+    param_names_to_check <- unique(unlist(param_names))
+
+    param_names_okay <-
+        param_names_to_check %in% names(base_model_definition[['parameters']])
+
+    if (!all(param_names_okay)) {
+        bad_names <- param_names_to_check[!param_names_okay]
+
+        msg <- paste(
+            'The following driver-specific parameters are not included in',
+            'the base model definition:',
+            paste0('"', bad_names, '"', collapse = ', ')
+        )
+
+        stop(msg)
+    }
+
     # Each set of drivers must form a valid dynamical system along with the
     # base model definition
     valid_definitions <- sapply(data_driver_pairs, function(ddp) {
         BioCro::validate_dynamical_system_inputs(
-            base_model_definition[['initial_values']],
-            base_model_definition[['parameters']],
+            combine_lists(
+                base_model_definition[['initial_values']],
+                ddp[['initial_values']]
+            ),
+            combine_lists(
+                base_model_definition[['parameters']],
+                ddp[['parameters']]
+            ),
             ddp[['drivers']],
             base_model_definition[['direct_modules']],
             base_model_definition[['differential_modules']],
@@ -141,6 +261,27 @@ check_data_driver_pairs <- function(base_model_definition, data_driver_pairs) {
         stop(msg)
     }
 
+    # Print driver-specific initial values and parameters, if necessary
+    if (verbose) {
+        cat('\nDriver-specific initial values:\n\n')
+
+        if (all(sapply(iv_names, is.null))) {
+            cat('  None\n')
+        } else {
+            iv <- lapply(data_driver_pairs, function(x) {x[['initial_values']]})
+            utils::str(iv)
+        }
+
+        cat('\nDriver-specific parameters:\n\n')
+
+        if (all(sapply(param_names, is.null))) {
+            cat('  None\n')
+        } else {
+            param <- lapply(data_driver_pairs, function(x) {x[['parameters']]})
+            utils::str(param)
+        }
+    }
+
     return(invisible(NULL))
 }
 
@@ -175,7 +316,12 @@ check_args_to_vary <- function(
         utils::str(independent_args)
 
         cat('\nThe dependent arguments and their initial values:\n\n')
-        utils::str(dependent_arg_function(independent_args))
+
+        if (is.null(dependent_arg_function)) {
+            cat('  None\n')
+        } else {
+            utils::str(dependent_arg_function(independent_args))
+        }
     }
 
     # Make sure no drivers were specified

man/objective_function.Rd

@@ -55,8 +55,8 @@
   \item{data_driver_pairs}{
     A list of named elements, where each element is a "data-driver pair." A
     data-driver pair is a list with three required elements: \code{data},
-    \code{drivers}, and \code{weight}. Optionally, it may also have a
-    \code{data_stdev} element.
+    \code{drivers}, and \code{weight}. Optionally, it may also have elements
+    named \code{data_stdev}, \code{initial_values}, and \code{parameters}.
 
     The \code{data} element must be a data frame with one column named
     \code{time}, whose values follow BioCro's definition of
@@ -76,6 +76,13 @@
     should represent the standard deviation associated with each entry in
     \code{data}. If \code{data_stdev} is not supplied, all standard deviations
     will be set to 1.
+
+    The optional \code{initial_values} and \code{parameters} elements must be
+    named lists of driver-specific initial values and parameters, respectively,
+    that will overwrite the default values specified in the
+    \code{base_model_definition}. When driver-specific \code{initial_values} are
+    provided, they must be provided for each of the data-driver pairs; the same
+    rule applies for driver-specific \code{parameters}.
   }
 
   \item{independent_args}{
@@ -185,7 +192,10 @@
           simulation must be compared to associated sets of observed data. Here,
           this is handled through the \code{data_driver_pairs}, which allows the
           user to specify which drivers and data sets should be compared to each
-          other.
+          other. Optionally, it is also possible to specify different initial
+          values or parameters for each set of drivers; for example, the
+          atmospheric CO2 concentration may need to change for different years,
+          or soil properties may need to change for different locations.
 
     \item \strong{Complicated normalization:} Care must be taken to ensure that
           certain years or output variables are not over-valued in the error
@@ -622,18 +632,21 @@ if (require(BioCro)) {
 
   # The data-driver pairs can now be created by associating each data set with
   # its corresponding weather data. Here we will weight the 2005 data twice as
-  # heavily as the 2002 data.
+  # heavily as the 2002 data. Note that we also specify different atmospheric
+  # CO2 concentrations for each year.
   data_driver_pairs <- list(
     ambient_2002 = list(
       data       = process_table(soyface_biomass[['ambient_2002']]),
       data_stdev = process_table(soyface_biomass[['ambient_2002_std']]),
       drivers    = BioCro::soybean_weather[['2002']],
+      parameters = list(Catm = with(BioCro::catm_data, {Catm[year == '2002']})),
       weight     = 1
     ),
     ambient_2005 = list(
       data       = process_table(soyface_biomass[['ambient_2005']]),
       data_stdev = process_table(soyface_biomass[['ambient_2005_std']]),
       drivers    = BioCro::soybean_weather[['2005']],
+      parameters = list(Catm = with(BioCro::catm_data, {Catm[year == '2005']})),
       weight     = 2
     )
   )