R/param_df.R

In statnet/EpiModel: Mathematical Modeling of Infectious Disease Dynamics

#' Get the `param.df` formated type of a value
#' @noRd
param.df_type <- function(x) {
  if (is.logical(x)) {
    "logical"
  } else if (is.numeric(x)) {
    "numeric"
  } else {
    "character"
  }
}

#' Coerce a value to a `param.df` type
#' @noRd
as_param.df_type <- function(x, type) {
  if (type == "logical") {
    as.logical(x)
  } else if (type == "numeric") {
    as.numeric(x)
  } else {
    as.character(x)
  }
}

#' List the recognized `param.df` types
#' @noRd
list_param.df_types <- function() {
  c("numeric", "logical", "character")
}

#' @title Parameters List for Stochastic Network Models from a Formatted
#'        Data Frame
#'
#' @description Sets the epidemic parameters for stochastic network models with
#'              \code{\link{netsim}} using a specially formatted data frame of
#'              parameters.
#'
#' @param long.param.df A \code{data.frame} of parameters. See details for the
#'                      expected format.
#'
#' @return A list object of class \code{param.net}, which can be passed to
#'         \code{\link{netsim}}.
#'
#' @section long.param.df:
#' It is possible to set input parameters using a specifically formatted
#' \code{data.frame} object. The first 3 columns of this \code{data.frame} must
#' be:
#' \itemize{
#'  \item \code{param}: The name of the parameter. If this is a non-scalar
#'    parameter (a vector of length > 1), end the parameter name with the
#'    position on the vector (e.g., \code{"p_1"}, \code{"p_2"}, ...).
#'  \item \code{value}: the value for the parameter (or the value of the
#'    parameter in the Nth position if non-scalar).
#'  \item \code{type}: a character string containing either \code{"numeric"},
#'    \code{"logical"}, or \code{"character"} to define the parameter object
#'    class.
#' }
#'
#' In addition to these 3 columns, the \code{data.frame} can contain any number
#' of other columns, such as \code{details} or \code{source} columns to document
#' parameter meta-data. However, these extra columns will not be used by
#' EpiModel.
#'
#' @export
param.net_from_table <- function(long.param.df) {
  # Checks
  if (!all(c("param", "value", "type") %in% names(long.param.df))) {
    stop(
      "The `data.frame` must contain the following 3 columns:\n",
      "'param', 'value'", " and 'type"
    )
  }
  if (!all(long.param.df$type %in% list_param.df_types())) {
    stop("The `type` column must contain only: ",
         paste0(list_param.df_types(), collapse = ", "))
  }
  check_params_names(long.param.df$param)

  duplicated_params <- duplicated(long.param.df$param)
  duplicated_params <- long.param.df$param[duplicated_params]
  if (length(duplicated_params) > 0) {
    stop("The following parameters are duplicated: `",
         paste0(duplicated_params, collapse = "`, `"), "`")
  }

  # To flat params
  flat.params <- Map(as_param.df_type, long.param.df$value, long.param.df$type)
  names(flat.params) <- long.param.df$param

  # To param.list
  param <- unflatten_params(flat.params)
  class(param) <- c("param.net", "list")

  return(param)
}


#' Coerce a list of parameters to a `long.param.df`
#'
#' @param params A list of parameters to be formatted into a `long.param.df`
#'
#' @inheritSection param.net_from_table long.param.df
#'
#' @return  A \code{data.frame} of parameters.
#'
#' @export
param.net_to_table <- function(params) {
  flat_params <- flatten_params(params)
  check_params_names(names(flat_params))
  dplyr::tibble(
    param = names(flat_params),
    value = vapply(flat_params, as.character, ""),
    type = vapply(flat_params, param.df_type, "")
  )
}