R/qc_database.R

In hemoshear/assayr2: Tools for analyzing assay data

# qc_database.R

#' Get warning codes for a vector of run identifiers
#'
#' @param db_conn RSQLite connection object
#' @param tx_run A character identifier representing the experiment
#' @return DataFrame of warning codes for the identifiers provided
#' @export tx_run2warning_code
#'
tx_run2warning_code <- function(db_conn, tx_run) {
  if (length(tx_run) > 1) {
    tx_run_set <- purrr::map_chr(tx_run, ~shQuote(.)) %>% paste(collapse = ",")
  } else {
    tx_run_set <- shQuote(tx_run)
  }
  query <- paste0("SELECT * FROM warning_codes WHERE tx_run IN (", tx_run_set, ")")
  RSQLite::dbGetQuery(db_conn, query)
}

#' Get warning message for a set of warning codes
#'
#' @param db_conn RSQLite connection
#' @param warning_codes Character vector of warning codes separated by a comma
#' @export get_warning_message
get_warning_message <- function(db_conn, warning_codes) {
  warning_messages <- RSQLite::dbGetQuery(db_conn, "SELECT * FROM warning_messages")
  this_warning_code_set <- warning_codes %>%
    strsplit(split = "\\,") %>%
    .[[1]] %>%
    as.integer()
  messages <- warning_messages[warning_messages$warning_code %in%
    this_warning_code_set, ]$warning_message
  names(messages) <- warning_messages[warning_messages$warning_code %in%
    this_warning_code_set, ]$warning_code
  messages
}

#' Get QC warnings associated with a particular curve
#'
#' @param tx_run A character vector of length >= 1 where each element
#'    is a run identifier
#' @param db_path A character vector representing a path to a SQLite file
#' @return List where each key is a tx_run string and each
#'    value is a named character vector, where keys are
#'    error codes and values are messages
#' @examples
#' \dontrun{
#' get_qc_warnings(c('H004232_PAU0607', 'H003833_PAU0602-1'), db_path='qc-warnings.sqlite')
#' }
#' @export
get_qc_warnings <- function(tx_run, db_path = "qc-warnings.sqlite") {
  db_conn <- RSQLite::dbConnect(RSQLite::SQLite(), db_path)
  warning_codes <- tx_run2warning_code(db_conn, tx_run)
  res <- purrr::map(warning_codes$warning_code, ~get_warning_message(db_conn, .))
  names(res) <- warning_codes$tx_run
  RSQLite::dbDisconnect(db_conn)
  res
}

qc_warnings_query2data_frame <- function(l) {
  assertthat::assert_that(length(l) == 1, msg = "Only lists of length 1 are supported")
  error_codes_plot_label <- l[[1]] %>% names() %>% paste0(collapse = ",")
  tx_run <- names(l)
  error_codes <- l[[1]] %>%
    names() %>%
    paste0(". ") %>%
    paste0(l[[1]] %>% unlist(), collapse = "\n")
  data.frame(
    warning_code_plot_label = error_codes_plot_label,
    tx_run = tx_run,
    warning_message_plot_text = error_codes
  )
}

#' Get a table of mappings from warning codes to human-readable messages
#'
#' @param db_path Path to SQLite db file
#' @return Data frame with two columns: warning_code and warning_message
#' @export 
get_warning_message_table <- function(db_path = "qc-warnings.sqlite") {
  db_conn <- RSQLite::dbConnect(RSQLite::SQLite(), db_path)
  res <- RSQLite::dbGetQuery(db_conn, "SELECT * FROM warning_messages")
  RSQLite::dbDisconnect(db_conn)
  res
}