R/read_evaluation_sheet.R

In bjoleary/dxr: Diagnostic Product Evaluation in R

#' Read Evaluation
#'
#' @param filepath The filepath of the evaluation data to be read in from excel
#'
#' @return The panel data, equivalent to what was generated by
#'   \code{build_evaluation_sheet()}, read in from excel.
#' @export
#'
read_evaluation <- function(filepath) {
  if (
    stringr::str_detect(
      string = filepath,
      pattern = stringr::regex(".*\\.xlsx$"),
      negate = TRUE
    )
  ) {
    stop("Only \".xlsx\" files are supported at this time.")
  } else {
    method <- "excel"
  }
  list(
    evaluation_metadata =
      read_evaluation_metadata(
        filepath = filepath,
        method = method
      ),
    sample_blinding =
      read_sample_blinding(
        filepath = filepath,
        method = method
      ),
    evaluation_table =
      read_evaluation_data(
        filepath = filepath,
        method = method
      )
  )
}
read_evaluation_data <- function(filepath, method = "excel") {
  if (method == "excel") {
    read_evaluation_data_excel(filepath)
  } else {
    stop("Only method = \"excel\" is supported at this time.")
  }
}
read_evaluation_data_excel <- function(filepath) {
  # Set column type to "text" for every column except datetime observation
  # Start by grabbing the column names
  suppressMessages(
    column_types <-
      readxl::read_xlsx(
        path = filepath,
        sheet = "evaluation_data",
        col_types = "text",
        col_names = FALSE,
        n_max = 1,
        .name_repair = "universal"
      ) %>%
      tidyr::pivot_longer(
        cols = dplyr::everything()
      ) %>%
      dplyr::pull(.data$value)
  )
  # Which one is a date?
  datetime_column <- which(column_types == "datetime_observation")
  # Set them all to text
  column_types <- rep("text", max(seq_along(column_types)))
  # Set the datetime column to date
  column_types[[datetime_column]] <- "date"
  # Read in the data
  readxl::read_xlsx(
    path = filepath,
    sheet = "evaluation_data",
    col_types = column_types
  )
}
read_evaluation_metadata <- function(filepath, method = "excel") {
  if (method == "excel") {
    read_evaluation_metadata_excel(filepath)
  } else {
    stop("Only method = \"excel\" is supported at this time.")
  }
}
read_evaluation_metadata_excel <- function(filepath) {
  metadata <-
    readxl::read_xlsx(
      path = filepath,
      sheet = "evaluation_metadata",
      col_types = c("text", "text")
    )
  # Remember what order things were in
  sort_order <- metadata$name
  # Set aside some rows that should not be touched
  do_not_touch <- c("evaluation_name", "evaluation_description")
  parking_lot <-
    metadata %>%
    dplyr::filter(.data$name %in% do_not_touch) %>%
    dplyr::mutate(
      value =
        dplyr::case_when(
          .data$value == "None" ~ as.list(NA_character_),
          TRUE ~ as.list(as.character(.data$value))
        )
    )
  # Process the blinded row
  logical_metadata <-
    metadata %>%
    dplyr::filter(.data$name == "blinded") %>%
    dplyr::mutate(value = as.list(as.logical(.data$value)))
  # Process the other rows
  metadata <-
    metadata %>%
    dplyr::filter(!(.data$name %in% c(do_not_touch, "blinded"))) %>%
    dplyr::mutate(
      # Replace "None" with NA
      value = dplyr::case_when(
        .data$value == "None" ~ NA_character_,
        TRUE ~ .data$value
      )
    ) %>%
    # # Split strings into vectors by the "; " characters
    dplyr::mutate(
      value =
        strsplit(
          x = .data$value,
          split = "; ",
          fixed = TRUE
        )
    )

  # Combine, sort, and return
  dplyr::left_join(
    tibble::enframe(
      x = sort_order,
      name = NULL,
      value = "name"
    ),
    dplyr::bind_rows(
      parking_lot,
      logical_metadata,
      metadata
    ),
    by = c("name" = "name")
  )
}
read_evaluation_metadata_csv <- function(filepath) {

}
read_sample_blinding <- function(filepath, method = "excel") {
  if (method == "excel") {
    read_sample_blinding_excel(filepath)
  } else {
    stop("Only method = \"excel\" is supported at this time.")
  }
}
read_sample_blinding_excel <- function(filepath) {
  readxl::read_xlsx(
    path = filepath,
    sheet = "sample_blinding",
    col_types = c("text", "text")
  )
}
read_sample_blinding_csv <- function(filepath) {

}