R/validate_prevalence_table.R

In iAM-AMR/sawmill: Process Queries from the CEDAR Database

#' @title
#'   Check if the prevalence table parameters are sufficient and valid to
#'   calculate an odds ratio
#'
#' @description
#'   The \code{validate_prevalence_table()} function determines if the set of
#'   provided parameters match a set of parameters (a 'grain') that is
#'   sufficient to calculate an odds ratio and its confidence intervals.
#'   Additionally, it checks if those parameters are valid.
#'
#' @param .P,.Q,.R,.S
#'   Numeric: prevalence of outcomes.
#'
#' @param .nexp
#'   Numeric: the total number exposed to the factor.
#'
#' @param .nref
#'   Numeric: the total number not exposed to the factor.
#'
#' @details
#'
#'  A prevalence table is shown here.
#'
#'  \tabular{lccc}{
#'             \tab Outcome+ \tab Outcome- \tab Total \cr
#'    Exposed  \tab P\%      \tab Q\%      \tab M1    \cr
#'    Referent \tab R\%      \tab S\%      \tab M2    \cr
#'  }
#'
#'  See \code{\link{check_grain}} for more details.
#'
#' @return
#'   A list of three values: is_valid (logical), status (string), and table_type
#'   (string).
#'
#' @export


validate_prevalence_table <- function(.P = NA, .Q = NA,
                                      .R = NA, .S = NA,
                                      .nexp = NA, .nref = NA) {

  # Check if all table parameters are missing.
  if (all(is.na(c(.P, .Q, .R, .S, .nexp, .nref)))) {
    status <- "Error: missing all table parameters."
    table_type <- "NA: prevalence table incomplete."
    return(list(
      is_valid = FALSE,
      status = status,
      table_type = table_type
    ))
    # Check if data input are numeric.
  } else if (all(class(c(.P, .Q, .R, .S, .nexp, .nref)) != "numeric")) {
    status <- "Error: table parameter(s) are not of type 'numeric'."
    table_type <- "NA: prevalence table incomplete."
    return(list(
      is_valid = FALSE,
      status = status,
      table_type = table_type
    ))
    # Check if totals are missing.
  } else if (any(is.na(c(.nexp, .nref)))) {
    status <- "Error: missing group totals."
    table_type <- "NA: prevalence table incomplete."
    return(list(
      is_valid = FALSE,
      status = status,
      table_type = table_type
    ))
    # If positive-total table is present, default type to 'prev_table_pos_tot'
  } else if ((!is.na(.P) && !is.na(.R))) {
    table_type <- "prev_table_pos_tot"
    # Otherwise, if negative-total is present, set type to 'prev_table_neg_tot'
  } else if ((!is.na(.Q) && !is.na(.S)) && (is.na(.P) || is.na(.R))) {
    table_type <- "prev_table_neg_tot"
  } else {
    status <- "Error: could not determine table type."
    table_type <- "NA: could not determine table type."
    return(list(
      is_valid = FALSE,
      status = status,
      table_type = table_type
    ))
  }

  status <- "OK: parameters pass checks for prevalence table."

  return(list(
    is_valid = TRUE,
    status = status,
    table_type = table_type
  ))
}