In OuhscBbmc/trawler: Inspect a dataset

library(knitr)

# cat("Working directory: ", getwd())
report_render_start_time <- Sys.time()
opts_chunk$set(
  results    = 'show',
  warning    = TRUE
)

echo_chunks <- FALSE

requireNamespace("dplyr")
requireNamespace("DT")

path_checks <-
  if (params$path_checks == "not-set") {
    system.file("derived/biochemical.rds", package = "trawler")
  } else {
    params$path_checks
  }

checkmate::assert_character(path_checks, any.missing = FALSE, len = 1)
checkmate::assert_file_exists(path_checks, extension = "rds")

palette_summary <- list(warm = "#fde0ef", hot = "#f1b6da", header = "#555") #http://colrd.com/palette/18841/

checks <- base::readRDS(path_checks)

Overview {.tabset .tabset-fade}

Instructions

1. Work through each line in the table to discover & correct entry mistakes in the database. Be aware that a single mistake may manifest in multiple rows/checks; fixing one value may clear several rows.
2. Click the record id value in a row to be taken to the participant's Event Grid in REDCap (i.e., the 'stop light page').
3. Double-check that your manual corrections in REDCap are reflected in r checks$path_output_rule. Be careful not to move this file to somewhere unsafe.
4. To help discover the dataflow and problematic location, use the
   • project's codebook in REDCap,
   • the data pipeline files, and
   • the report code.
5. If you create a new rule or smell check, make sure the error message won't reveal any PHI.

Rules {.tabset .tabset-fade}

r checks$rule_status

A rule is very exact. Each record is examined to determine if it passes each specific rule. The first tab summarizes the r nrow(checks$rules) defined for this dataset. The second tab details the exact record and rule for each of the r sum(checks$rules$violation_count) violations.

Rule Summary

ds_rule_summary <-
  checks$rules |>
  dplyr::arrange(.data$priority, .data$check_name)

ds_rule_summary |>
  dplyr::mutate(
    check_name            = gsub("_", " ", check_name),
  ) |>
  dplyr::select(
    `Rule Name`           = .data$check_name,
    `Priority`            = .data$priority,
    `Error Message`       = .data$error_message,
    `Violation Count`     = .data$violation_count,
  ) |>
  knitr::kable(
    align     = "lrlr",
    escape    = FALSE,
    format    = "html"
  ) |>
  kableExtra::kable_styling(
    bootstrap_options = c("hover", "condensed", "responsive"), #"striped",
    full_width        = FALSE,
    position          = "left"
  ) |>
  kableExtra::row_spec(
    row         = 0,
    bold        = TRUE,
    color       = "white",
    background  = palette_summary$header
  ) |>
  kableExtra::row_spec(
    row         = seq_len(nrow(ds_rule_summary)),
    color       = "#555"
  ) |>
  kableExtra::row_spec(
    row         = which(ds_rule_summary$violation_count > 0 & ds_rule_summary$priority == 1L),
    bold        = TRUE,
    background  = palette_summary$hot
  ) |>
  kableExtra::row_spec(
    row         = which(ds_rule_summary$violation_count > 0 & ds_rule_summary$priority > 1L),
    bold        = TRUE,
    background  = palette_summary$warm
  )

Rule Detail

ds_violation <- 
  if (0L == sum(checks$rules$violation_count)) {
    tibble::tibble(
      `Rule Name`           = character(0),
      `Priority`            = character(0),
      `Error Message`       = character(0),
      `Record ID`           = character(0),
      `Data Collector`      = character(0),
      `Baseline Date`       = character(0),
    ) 
  } else {
    checks$rules |>
      # dput(file = "/home/wibeasley/Documents/hlo/vasquez-frontera-1/aaa.txt")
      dplyr::select(
        .data$check_name,
        .data$error_message,
        .data$priority,
        .data$results,
      ) |>
      tidyr::unnest(results) |>
      dplyr::mutate(
        check_name        = gsub("_", " ", .data$check_name),
      ) |>
      dplyr::mutate(
        # DT provides a drop down filter for factors.
        check_name        = factor(.data$check_name),
        error_message     = factor(.data$error_message),
        data_collector    = factor(.data$data_collector),
      ) |>
      dplyr::select(
        `Rule Name`           = .data$check_name,
        `Priority`            = .data$priority,
        `Error Message`       = .data$error_message,
        `Record ID`           = .data$record_id_linked,
        # `Record ID`           = .data$record_id,
        `Data Collector`      = .data$data_collector,
        `Baseline Date`       = .data$baseline_date,
      ) 
  }

  ds_violation |>
  {\(d)
    DT::datatable(
      data         = d,
      filter       = "top",
      caption      = paste("Violations at", Sys.time()),
      escape       = FALSE,
      options      = list(
        pageLength = 30,
        dom = "tip",
        columnDefs   = list(list(className = 'dt-center', targets = 5:6)),
        initComplete = DT::JS(
          "function(settings, json) {",
          "$(this.api().table().header()).css({'background-color': '#555', 'color': '#fff'});",
          "}"
        )
      )
    )
  }()

Inactive Rules

`r nrow(checks$rules_inactive)` rules(s) are disabled for this report: wzxhzdk:7 To enable/disable a rule, set the `active` element in the yaml checks file to "true" or "false".

Smells {.tabset .tabset-fade}

r checks$smell_status

A smell test won't validate a specific record (like the rules above), but it will make sure the overall dataset smells as expected.

Smell Summary

ds_smell_result_pretty <-
  checks$smells |>
  dplyr::transmute(
    check_name            = gsub("_", " ", check_name),
    priority,             # = wrap_violation(n, priority),
    description,
    boundaries            = sprintf(.data$bounds_template, .data$bound_lower, .data$bound_upper),
    value                 = sprintf(.data$value_template , .data$value),
    pass
    # n
  ) |>
  dplyr::arrange(priority, check_name)

ds_smell_result_pretty |>
  dplyr::select(
    "Smell Name"           = check_name,
    "Priority"             = priority,
    "The dataset smells fresh when (the)..."     = description,
    "Legal Boundaries"     = boundaries,
    "Value"                = value,
    "Pass"                 = pass,
  ) |>
  knitr::kable(
    align     = "lrllrl",
    escape    = FALSE,
    format    = "html"
  ) |>
  kableExtra::kable_styling(
    bootstrap_options = c("hover", "condensed", "responsive"), #"striped",
    full_width        = FALSE,
    position          = "left"
  ) |>
  kableExtra::row_spec(
    row         = 0,
    bold        = TRUE,
    color       = "white",
    background  = palette_summary$header
  ) |>
  kableExtra::row_spec(
    row         = seq_len(nrow(ds_smell_result_pretty)),
    color       = "#555"
  ) |>
  kableExtra::row_spec(
    row         = which(!ds_smell_result_pretty$pass & ds_smell_result_pretty$priority == 1L),
    bold        = TRUE,
    background  = palette_summary$hot
  ) |>
  kableExtra::row_spec(
    row         = which(!ds_smell_result_pretty$pass & ds_smell_result_pretty$priority >= 2L),
    bold        = TRUE,
    background  = palette_summary$warm
  )

Inactive Smells

`r nrow(checks$smells_inactive)` smell(s) are disabled for this report: wzxhzdk:9 To enable/disable a smell, set the `active` element in the yaml checks file to "true" or "false".

Configuration {.tabset .tabset-fade}

For the sake of documentation and reproducibility, the current report was rendered in the following environment. Click the line below to expand.

Environment

if( requireNamespace("sessioninfo", quietly = TRUE) ) {
  sessioninfo::session_info()
} else {
  sessionInfo()
}

report_render_duration_in_seconds <- as.integer(difftime(Sys.time(), report_render_start_time, units="secs"))

Report rendered by r Sys.info()["user"] at r strftime(Sys.time(), "%Y-%m-%d, %H:%M %z") in r report_render_duration_in_seconds seconds.

OuhscBbmc/trawler documentation built on Oct. 8, 2024, 11:44 p.m.