R/function_mapping.R

In albgarre/bioinactivation: Mathematical Modelling of (Dynamic) Microbial Inactivation

#' Mapping of Simulation Model Functions
#'
#' Provides information about the function for dynamic predictions associated
#' to a valid \code{simulation_model} key.
#' If \code{simulation_model} is missing or \code{NULL}, a character vector
#' of valid model keys is provided.
#' This function is designed as an assistant for using the functions
#' \code{\link{predict_inactivation}} and
#' \code{\link{fit_dynamic_inactivation}}.
#' For the adjustment of isothermal experiments with the function
#' \code{\link{fit_isothermal_inactivation}}, use the function
#' \code{\link{get_isothermal_model_data}}.
#'
#'
#' @param simulation_model (optional) character with a valid model key or
#'        \code{NULL}.
#'
#' @return If simulation_model is \code{NULL} or missing, a character vector of
#'      possible names. Otherwise, a list including information of the relevant
#'      function:
#'      \itemize{
#'          \item ode: Pointer to the function defining the model ode.
#'          \item cost: Pointer to the function calculating the error of the
#'                approximation.
#'          \item dtemp: logical defining whether the function requires the
#'                       definition of the first derivative of temperature.
#'          \item variables: a character vector defining which entry variables
#'                           are needed by the model.
#'          \item variables_priv: for internal use only.
#'          \item parameters: character vector with the parameters needed by
#'                            the model.
#'          }
#'
#' @export
#'
#' @seealso \code{\link{predict_inactivation}},
#'          \code{\link{fit_dynamic_inactivation}}
#'

get_model_data <- function(simulation_model = NULL) {

  function_map <- list(Bigelow = list(ode = dBigelow_model,
                                      dtemp = FALSE,
                                      variables = "N",
                                      variables_priv = "N",
                                      parameters = c("D_R", "z", "temp_ref")
  ),

  #                          Bigelow_full = list(ode = dBigelow_model_full,
  #                                                    dtemp = TRUE,
  #                                                    variable = "N",
  #                                                    parameters = c("D_R", "z",
  #                                                                   "temp_ref")
  #                                                    ),

  Mafart = list(ode = dMafart_model,
                dtemp = FALSE,
                variables = "N",
                variables_priv = "N",
                parameters = c("delta_ref",
                               "temp_ref", "z",
                               "p")
  ),
  Metselaar = list(ode = dMetselaar_model,
                   dtemp = FALSE,
                   variables = "N",
                   variables_priv = "N",
                   parameters = c("D_R",
                                  "temp_ref", "z",
                                  "p", "Delta")
  ),


  #                          Weibull_Mafart_full = list(ode = dMafart_model_full,
  #                                                     dtemp = TRUE,
  #                                                     variable = "N",
  #                                                     parameters = c("delta_ref",
  #                                                                    "temp_ref",
  #                                                                    "z", "p")
  #                                                     ),

  Geeraerd = list(ode = dGeeraerd_model,
                  dtemp = FALSE,
                  variables = c("N", "C_c"),
                  variables_priv = c("N", "C_c"),
                  parameters = c("D_R", "z", "N_min",
                                 "temp_ref")
  ),

  Geeraerd_oneStep = list(ode = NA,
                          dtemp = FALSE,
                          variables = c("logS"),
                          variables_priv = c("logS"),
                          parameters = c("logC0", "a", "z")
  ),

  Peleg = list(ode = dPeleg_model,
               dtemp = FALSE,
               variables = "N",
               variables_priv = "logS",
               parameters = c("k_b", "temp_crit",
                              "n")
  ),
  Arrhenius = list(ode = dArrhenius_model,
                   dtemp = FALSE,
                   variables = "N",
                   variables_prov = "N",
                   parameters = c("k_ref", "temp_ref",
                                  "Ea"))

  #                          Weibull_Peleg_full = list(ode = dPeleg_model_full,
  #                                                    dtemp = TRUE,
  #                                                    variable = "N",
  #                                                    parameters = c("k_b",
  #                                                                   "temp_crit",
  #                                                                   "n")
  #                                                    )
  )

  if (is.null(simulation_model)) {
    return(names(function_map))

  } else {

    function_data <- function_map[[simulation_model]]

    if (is.null(function_data)) {
      stop(paste("Unknown simulation model", simulation_model))

    } else {
      return(function_data)

    }
  }
}

#' Correctness Check of Model Parameters
#'
#' Makes 3 checks of compatibility between the input parameters for the
#' adjustment and the DOF of the inactivation model selected.
#' \itemize{
#'      \item Check of equal length of model DOF and input DOF. Raises a
#'            warning if failed.
#'      \item Check that every single one of the input DOF is a model DOF.
#'            Raises a warning if failed.
#'      \item Check that every single one of the model DOF are defined as
#'            an input DOF.}
#'
#' @param simulation_model character with a valid model key.
#' @param known_params named vector or list with the dof of the model
#'                     known.
#' @param starting_points named vector or list with the dof of the model to
#'                        be adjusted.
#' @param adjust_vars logical specifying whether the model variables need to
#'                    be included in the check (not used for isothermal
#'                    fit)
#'
check_model_params <- function(simulation_model, known_params,
                               starting_points, adjust_vars) {

  model_data <- get_model_data(simulation_model)

  variable_names <- paste0(model_data$variables, "0")

  if (adjust_vars) {
    model_dof <- c(model_data$parameters, variable_names)
  } else {
    model_dof <- c(model_data$parameters)
  }


  #- Check of lengths

  in_length <- length(known_params) + length(starting_points)

  if (length(model_dof) != in_length) {

    warning_msg <- paste0("Length of known_params + starting_points (",
                          in_length, ") not equal to model_dof (",
                          length(model_dof), ").")

    warning(warning_msg)
  }

  #- Check for input param names

  in_dof <- names(c(known_params, starting_points))

  for (each_dof in in_dof) {

    if (!(each_dof %in% model_dof)) {

      warning(paste0("Unknown input DoF: ", each_dof))
    }
  }

  #- Check for missing params

  for (each_dof in model_dof) {

    if (!(each_dof %in% in_dof)) {

      stop(paste("DOF ", each_dof, "not defined."))
    }
  }
}