In atorus-research/Tplyr: A Traceability Focused Grammar of Clinical Data Summary

\newpage \tableofcontents \newpage

library(dplyr)
library(testthat)
library(knitr)
library(kableExtra)
library(stringr)
library(purrr)

opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  eval = TRUE,
  echo = FALSE,
  results = "asis",
  message = FALSE,
  tidy = FALSE
)

input_dir <- paste0("../../")
ref_dir <- paste0(input_dir, "references/output")
spec_path <- paste0(input_dir, "/input/specs.csv")
test_cases <- read.csv(paste0(input_dir, "/input/test_cases.csv"), stringsAsFactors = FALSE)

source("../input/helper_test_code.R") # handles environment and access to test_that contents
source("../input/roxy_block_details.R") # scrapes roxygen block for authorship details

Validation Files Information

Specifications

list.files(ref_dir,
    full.names = TRUE, pattern = "specification.Rmd") %>%
  lapply(., scrape_function_specification_block) %>%
  do.call(rbind, .) %>%
  kable(., col.names = c("Specification Name", "Last updated by", "Last updated date"), booktabs = TRUE) %>%
  kable_styling(latex_options = c("repeat_header", "striped"))

Test case

list.files(ref_dir,
    full.names = TRUE, pattern = "test_cases.Rmd") %>%
  lapply(., scrape_function_specification_block) %>%
  do.call(rbind, .) %>%
  kable(., col.names = c("Test Case Name", "Last updated by", "Last updated date"), booktabs = TRUE) %>%
  kable_styling(latex_options = c("repeat_header", "striped"))

Test code

test_code_author <- "~/Tplyr/uat/test_cases.R" %>%
  lapply(., scrape_test_code_block) %>%
  do.call(rbind, .)

cases <- stringr::str_split(test_code_author$title, pattern = "\\.", n = 2,
                simplify = TRUE)[,1] %>%
  gsub(pattern = "T", replacement = "")

pack_rows_count <- sapply(unique(cases), FUN = function(x){
  which(cases == x) %>% min
  })

pack_rows_index <- c(pack_rows_count[-1] - pack_rows_count[-length(pack_rows_count)],
                     length(cases) - pack_rows_count[length(pack_rows_count)] + 1) %>%
  magrittr::set_names(paste0("T", stringr::str_pad(unique(cases), width = 3,
                                                   side = "left", pad = 0)))
#Only pull one of the last updated dates
test_code_author <- test_code_author %>%
  filter(last_updated_date == max(last_updated_date))
test_code_author <- test_code_author[1,]


test_code_author %>%
  kable(., col.names = c("Test Code Name", "Last updated by", "Last updated date"),
        escape = FALSE, booktabs = TRUE) %>%
  kable_styling(latex_options = c("repeat_header", "striped"))

Validation Results

Specifications

scrape_spec_rmd("~/Tplyr/uat/references/output/specification.Rmd")

\newpage

\blandscape

Matrix

# THis looks a little gross
spec_df <- read.csv("~/Tplyr/uat/input/specs.csv")
spec_df <- spec_df[spec_df$RequirementID != "", ]

specs_tested <- test_cases[test_cases$ReqsTested != "", ]
specs_tested_l <- str_split(specs_tested$ReqsTested, ":")

#number of specs(columns)
nspecs <- nrow(spec_df)
#number of tests(rows)
ntests <- nrow(specs_tested)

temp <- lapply(specs_tested_l, function(x) {
  ifelse(spec_df$RequirementID %in% x, "X", "")
})

final <- data.frame(matrix(unlist(temp), ncol = nspecs, nrow = ntests, byrow = TRUE),
                    row.names = specs_tested$TestID)

names(final) <- spec_df$RequirementID

max_cols_to_display <- 24
# max_cols_to_display <- ceiling(ncol(final)/2)
for(i in seq(ceiling(ncol(final)/max_cols_to_display))) {
  start <- 1 + (i-1) *max_cols_to_display
  end <- ifelse(i * max_cols_to_display > ncol(final), ncol(final), i*max_cols_to_display)

  cat(kable(final[,seq(start, end)], "latex", longtable = TRUE, booktabs = TRUE) %>%
      kable_styling(latex_options = c("repeat_header", "striped"), position = "left"))
}


# kable(final, format = "latex", longtable = TRUE, booktabs = TRUE) %>%
#   kable_styling(full_width = "F", font_size = 5, latex_options = c("repeat_header")) %>%
#   landscape()

\elandscape

\newpage

Test Cases

scrape_spec_rmd("~/Tplyr/uat/references/output/test_cases.Rmd")

Test Cases Results

test_res <- eval_test_code("~/Tplyr/uat/test_cases.R")
save(test_res, file = "~/Tplyr/uat/output/test_res.RData")
print_eval_test_results(test_res)

System Information

sessionInfo()

Manual Check Completion History

kable(readRDS("~/Tplyr/uat/references/output/vur_auto.Rds")[, c("ID", "OutputFile", "Response", "Log")],
      format = "latex", row.names = FALSE, longtable = TRUE, booktabs = TRUE,
      col.names = c("Check", "Output File Reviewed", "Response", "Log")) %>%
  kable_styling(latex_options = c("repeat_header", "striped"))