## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set(collapse = TRUE, comment = "#>") library(lineager) ## ----setup-data--------------------------------------------------------------- lg_start(study_id = "COHORT-001", analysis_id = "main-analysis") # Simulate a patient registry set.seed(42) n <- 20L raw <- data.frame( USUBJID = sprintf("PT-%03d", seq_len(n)), age = sample(15:75, n, replace = TRUE), sex = sample(c("M", "F"), n, replace = TRUE), diagnosis = sample(c("Y", "N", "N"), n, replace = TRUE), consent = sample(c("Y", "Y", "Y", "N"), n, replace = TRUE), prior_drug = sample(c("Y", "N", "N", "N"), n, replace = TRUE), biomarker = round(runif(n, 0.5, 8.5), 2), outcome = ifelse(runif(n) > 0.4, round(rnorm(n, 50, 12), 1), NA_real_), stringsAsFactors = FALSE ) registry <- lg_tag(raw, dataset_id = "REGISTRY", label = "Patient registry — all screened" ) cat("Screened: ", nrow(registry), "patients\n") ## ----filter-required---------------------------------------------------------- # This would error: # lg_filter(registry, age >= 18L) # Error: A `reason` is required. # Correct: adults <- lg_filter(registry, age >= 18L, reason = "Under minimum age threshold (age < 18 years)" ) ## ----filter-reason-code------------------------------------------------------- consented <- lg_filter(adults, consent == "Y", reason = "Did not provide written informed consent", reason_code = "NO_CONSENT" ) diagnosed <- lg_filter(consented, diagnosis == "Y", reason = "Does not meet diagnostic criteria per protocol section 3.1", reason_code = "NO_DIAGNOSIS" ) ## ----filter-population-------------------------------------------------------- no_prior <- lg_filter(diagnosed, prior_drug == "N", reason = "Received prohibited prior medication within wash-out period", reason_code = "PRIOR_MED", population = "ELIGIBLE_SET" ) biomarker_pos <- lg_filter(no_prior, biomarker >= 2.0, reason = "Biomarker below threshold (< 2.0) per protocol section 4.3", reason_code = "LOW_BIOMARKER", population = "BIOMARKER_POS" ) analysis_set <- lg_filter(biomarker_pos, !is.na(outcome), reason = "Missing primary outcome measurement", reason_code = "MISSING_OUTCOME", population = "ANALYSIS_SET" ) cat("Screened: ", nrow(registry), "\n") cat("Adults: ", nrow(adults), "\n") cat("Consented: ", nrow(consented), "\n") cat("Diagnosed: ", nrow(diagnosed), "\n") cat("No prior med: ", nrow(no_prior), "\n") cat("Biomarker+: ", nrow(biomarker_pos), "\n") cat("Analysis set: ", nrow(analysis_set), "\n") ## ----exclusions-all----------------------------------------------------------- excl <- lg_exclusions() cat("Total exclusions:", nrow(excl), "\n") names(excl) ## ----exclusions-population---------------------------------------------------- # Only exclusions related to the final analysis set analysis_excl <- lg_exclusions(population = "ANALYSIS_SET") analysis_excl[, c("usubjid", "reason", "reason_code")] ## ----exclusions-dataset------------------------------------------------------- lg_exclusions(dataset_id = "REGISTRY")[ , c("usubjid", "reason_code", "population") ] ## ----disposition-reason------------------------------------------------------- lg_disposition(by = "reason") ## ----disposition-population--------------------------------------------------- lg_disposition(by = "population") ## ----disposition-dataset------------------------------------------------------ lg_disposition(by = "dataset") ## ----trace-excluded----------------------------------------------------------- # Find a subject who was excluded excluded_id <- lg_exclusions()$usubjid[[1L]] cat("Tracing excluded subject:", excluded_id, "\n") lg_trace(excluded_id) ## ----trace-included----------------------------------------------------------- included_id <- analysis_set$USUBJID[[1L]] cat("Tracing included subject:", included_id, "\n") lg_trace(included_id) ## ----trace-notfound----------------------------------------------------------- result <- lg_trace("PT-999", verbose = FALSE) cat("Datasets found in:", length(result$datasets), "\n") ## ----trace-programmatic------------------------------------------------------- result <- lg_trace(excluded_id, verbose = FALSE) cat("Subject: ", result$usubjid, "\n") cat("Found in: ", paste(result$datasets, collapse = ", "), "\n") cat("Operations: ", nrow(result$operations), "\n") cat("Exclusions: ", nrow(result$exclusions), "\n") if (nrow(result$exclusions) > 0L) { cat("Excluded by: ", result$exclusions$reason[[1L]], "\n") cat("Population: ", result$exclusions$population[[1L]], "\n") } ## ----operations--------------------------------------------------------------- ops <- lg_operations() ops[, c( "op_id", "op_type", "dataset_id", "description", "rows_in", "rows_out" )] ## ----operation-check---------------------------------------------------------- # Verify: total excluded == sum of (rows_in - rows_out) across FILTER ops filter_ops <- ops[ops$op_type == "FILTER", ] total_via_ops <- sum(filter_ops$rows_in - filter_ops$rows_out) total_via_excl <- nrow(lg_exclusions()) cat("Excluded via ops: ", total_via_ops, "\n") cat("Excluded via excl: ", total_via_excl, "\n") cat("Match: ", total_via_ops == total_via_excl, "\n") ## ----lineage------------------------------------------------------------------ lin <- lg_lineage() print(lin) ## ----lineage-plot, eval = FALSE----------------------------------------------- # lg_plot(lin) ## ----cascade------------------------------------------------------------------ lg_start() cohort <- lg_tag( data.frame( id = sprintf("S%02d", 1:10), enrolled = c(rep(TRUE, 8), FALSE, FALSE), treated = c(rep(TRUE, 6), FALSE, FALSE, FALSE, FALSE), complete = c(rep(TRUE, 4), FALSE, FALSE, rep(FALSE, 4)), stringsAsFactors = FALSE ), dataset_id = "COHORT" ) step1 <- lg_filter(cohort, enrolled == TRUE, reason = "Not enrolled in study" ) step2 <- lg_filter(step1, treated == TRUE, reason = "Did not receive study treatment" ) step3 <- lg_filter(step2, complete == TRUE, reason = "Did not complete the study" ) cat("Enrolled: ", nrow(step1), "\n") cat("Treated: ", nrow(step2), "\n") cat("Completed: ", nrow(step3), "\n") lg_disposition(by = "reason") ## ----cascade-end-------------------------------------------------------------- lg_end()