Merge pull request #312 from OHDSI/vignette_benchmark

Vignette benchmark

.gitignore

@@ -10,3 +10,4 @@ inst/doc
 docs
 /sql
 /sql_1
+extras/data/*

DESCRIPTION

@@ -55,7 +55,12 @@ Suggests:
  odbc,
  CohortCharacteristics,
  ggplot2,
- DiagrammeR
+ DiagrammeR,
+ visOmopResults,
+ gt,
+ scales,
+ here,
+ ggpubr
 Config/testthat/edition: 3
 Config/testthat/parallel: true
 VignetteBuilder: knitr

data-raw/domainsData.R

@@ -10,5 +10,3 @@ domainsData <- dplyr::tribble(
  "visit", "visit_occurrence", "visit_concept_id", "visit_source_concept_id", "visit_start_date", "visit_end_date",
  "device", "device_exposure", "device_concept_id", "device_source_concept_id", "device_exposure_start_date", "device_exposure_end_date"
 )
-
-usethis::use_data(domainsData, internal = TRUE, overwrite = TRUE)

data-raw/getBenchmarkResults.R

@@ -0,0 +1,54 @@
+library(readr)
+library(omopgenerics)
+library(here)
+library(dplyr)
+library(tidyr)
+
+readData <- function(path) {
+ zipFiles <- list.files(path = path, pattern = ".zip")
+ tempfolder <- tempdir()
+ data <- NULL
+ for (file in zipFiles) {
+ file <- file.path(path, file)
+ fname = unzip(file, list = TRUE)$Name
+ fname <- fname[tools::file_ext(fname) == "csv"]
+ unzip(file, files = fname, exdir = tempfolder, overwrite = TRUE)
+ files <- file.path(tempfolder, fname)
+ data <- c(data, readFiles(files))
+ }
+ return(data)
+}
+
+readFiles <- function(files) {
+ data <- list()
+ for (file in files) {
+ data[[file]] <- readr::read_csv(file, col_types = readr::cols(.default = readr::col_character()))
+ if (all(colnames(data[[file]]) %in% omopgenerics::resultColumns()) & "settings" %in% data[[file]]$variable_name) {
+ data[[file]] <- data[[file]] |> omopgenerics::newSummarisedResult()
+ }
+ }
+ names(data) <- basename(tools::file_path_sans_ext(names(data)))
+ return(data)
+}
+
+mergeData <- function(data, patterns) {
+ x <- list()
+ for (pat in patterns) {
+ dataSubset <- data[grepl(pat, names(data))]
+ srExp <- length(dataSubset)
+ srObs <- sum(lapply(data[grepl(pat, names(data))], class) |> unlist() == "summarised_result")
+ if (srObs > 0) {
+ if (srObs == srExp) {
+ x[[pat]] <- dataSubset %>% omopgenerics::bind()
+ } else {
+ cli::cli_abort("Not all results with pattern {pat} have class summarised result.")
+ }
+ } else {
+ x[[pat]] <- dataSubset %>% dplyr::bind_rows() %>% distinct()
+ }
+ }
+ return(x)
+}
+
+resultPatterns <- c("time", "comparison", "details", "omop", "index_counts", "sql_indexes")
+benchmarkData <- readData(here::here("data-raw", "data")) %>% mergeData(resultPatterns)

data-raw/internalData.R

@@ -0,0 +1,3 @@
+source(here::here("data-raw", "domainsData.R"))
+source(here::here("data-raw", "getBenchmarkResults.R"))
+usethis::use_data(domainsData, benchmarkData, internal = TRUE, overwrite = TRUE)

vignettes/a04_require_intersections.Rmd

@@ -2,7 +2,7 @@
 title: "Requirements on Presence and Absence"
 output: rmarkdown::html_vignette
 vignette: >
- %\VignetteIndexEntry{a01_building_concept_cohorts}
+ %\VignetteIndexEntry{a04_require_intersections}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
 ---