R/clean_params.R

In CausalQueries: Make, Update, and Query Binary Causal Models

#' Check parameters sum to 1 in param_set; normalize if needed; add names if needed
#'
#' @param parameters_df A \code{data.frame}. This object is first generated by  \code{\link{make_model}}.
#' @param warning Logical. Whether to print warning (if any) in console. Defaults to TRUE
#' @return A parameters \code{data.frame}  with names and where parameters sum to 1.
#' @keywords internal
#' @examples
#' \donttest{
#' model <- make_model('X->Y')
#' model$parameters_df$param_value <- 1:6
#' CausalQueries:::clean_params(model$parameters_df, warning = TRUE)
#'}

clean_params <- function(parameters_df, warning = TRUE) {

    if(nrow(parameters_df) == 0){
      message("parameters_df is empty")
      return(parameters_df)
    }

    # Check positive
    if (min(parameters_df$priors) < 0)
        stop("Negative alpha arguments for priors are not allowed")

    # Check positive
    if (min(parameters_df$param_value) < 0)
        stop("Negative arguments for parameters not allowed")

    # Normalize parameters if needed
    for (j in unique(parameters_df$param_set)) {
        A <- parameters_df$param_set == j
        check <- sum(parameters_df$param_value[A])

        if (!isTRUE(all.equal(check, 1))) {

            if (warning)
                message(paste0("Parameters in set ", j, " do not sum to 1. Using normalized parameters"))
            parameters_df$param_value[A] <- parameters_df$param_value[A]/check
        }
    }

    parameters_df
}



#' Clean parameter vector
#'
#' @inheritParams CausalQueries_internal_inherit_params
#' @keywords internal
#' @return A vector of named parameters summing to 1.
clean_param_vector <- function(model, parameters) {

    parameters <- as.vector(parameters)

    if(!is.atomic(parameters)) {
      stop("parameters should be a vector")
    }

    model$parameters_df$param_value <- parameters
    x <- clean_params(model$parameters_df, warning = FALSE)$param_value
    names(x) <- model$parameters_df$param_names
    x
}