R/validate_contingency_table.R

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

#' @title
#'   Check if contingency table parameters are sufficient and valid to
#'   calculate an odds ratio
#'
#' @description
#'
#'   The \code{validate_contingency_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 .A,.B,.C,.D
#'   Integer: counts of outcomes.
#'
#' @param .nexp
#'   Integer: the total number exposed to the factor.
#'
#' @param .nref
#'   Integer: the total number not exposed to the factor (referent).
#'
#' @details
#'
#'  A contingency table is shown here.
#'
#'  \tabular{lccc}{
#'             \tab Outcome+ \tab Outcome- \tab Total \cr
#'    Exposed  \tab A        \tab B        \tab nexp  \cr
#'    Referent \tab C        \tab D        \tab nref  \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_contingency_table <- function(.A = NA, .B = NA,
                                       .C = NA, .D = NA,
                                       .nexp = NA, .nref = NA) {
  # Check if all table parameters are missing.
  if (all(is.na(c(.A, .B, .C, .D, .nexp, .nref)))) {
    status <- "Error: missing all table parameters."
    table_type <- "NA: contingency table incomplete."
    return(list(
      is_valid = FALSE,
      status = status,
      table_type = table_type
    ))
    # Check if data input are numeric.
  } else if (all(class(c(.A, .B, .C, .D, .nexp, .nref)) != "numeric")) {
    status <- "Error: table parameters are not of type 'numeric'."
    table_type <- "NA: prevalence table incomplete."
    return(list(
      is_valid = FALSE,
      status = status,
      table_type = table_type
    ))
    # Check if data input are of type integer
    # TO-DO: Debug logic for checking type integer
  # } else if (any(c(.A, .B, .C, .D, .nexp, .nref) -
  #                  floor(c(.A, .B, .C, .D, .nexp, .nref)) != 0)) {
  #   status <- "Error: table parameter(s) are not of type 'integer'."
  #   table_type <- "NA: contingency table incomplete."
  #   return(list(
  #     is_valid = FALSE,
  #     status = status,
  #     table_type = table_type
  #   ))
    # Check if totals are missing.
  } else if ((any(is.na(c(.A, .B))) && is.na(.nexp)) ||
               (any(is.na(c(.C, .D))) && is.na(.nref))) {
    status <- "Error: missing group totals."
    table_type <- "NA: contingency table incomplete."
    return(list(
      is_valid = FALSE,
      status = status,
      table_type = table_type
    ))
  } else if (all(!is.na(c(.A, .C, .nexp, .nref))) ||
               all(!is.na(c(.B, .D, .nexp, .nref)))) {
    table_type <- "con_table_pos_tot"
  } else if (all(!is.na(c(.A, .B, .C, .D)))) {
    table_type <- "con_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 contingency table."

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