## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set(collapse = TRUE, comment = "#>") library(lineager) ## ----start-------------------------------------------------------------------- lg_start(study_id = "PROJECT-001", analysis_id = "primary") ## ----tag-basic---------------------------------------------------------------- patients <- data.frame( USUBJID = c("P001", "P002", "P003", "P004", "P005", "P006"), age = c(34L, 19L, 52L, 28L, 61L, 44L), group = c("A", "B", "A", "B", "A", "B"), eligible = c(TRUE, FALSE, TRUE, TRUE, FALSE, TRUE), stringsAsFactors = FALSE ) tagged <- lg_tag(patients, dataset_id = "PATIENTS", label = "Patient registry" ) tagged ## ----tag-multiple------------------------------------------------------------- labs <- data.frame( USUBJID = c("P001", "P001", "P003", "P004", "P006"), test = c("ALT", "AST", "ALT", "ALT", "ALT"), value = c(28.4, 31.2, 45.1, 22.8, 38.6), stringsAsFactors = FALSE ) labs_tagged <- lg_tag(labs, dataset_id = "LABS", label = "Laboratory results") cat("Patients tagged:", nrow(tagged), "rows\n") cat("Labs tagged: ", nrow(labs_tagged), "rows\n") ## ----derive-basic------------------------------------------------------------- derived <- lg_derive(tagged, age_group = ifelse(age >= 40L, ">=40", "<40"), adult = age >= 18L, description = "age_group: >=40 vs <40 from age; adult: age >= 18" ) derived[, c("USUBJID", "age", "age_group", "adult")] ## ----lid-check---------------------------------------------------------------- all(derived[["lineage_id"]] == tagged[["lineage_id"]]) ## ----derive-chain------------------------------------------------------------- derived2 <- lg_derive(derived, label = paste0(USUBJID, " (", group, ")"), description = "Display label combining USUBJID and group" ) derived2[, c("lineage_id", "USUBJID", "group", "label")] ## ----join-left---------------------------------------------------------------- joined <- lg_join(tagged, labs_tagged, by = "USUBJID", type = "left", description = "Merge ALT lab values from LABS onto PATIENTS" ) joined[, c("lineage_id", "USUBJID", "eligible", "test", "value", "lineage_id_y")] ## ----join-types, eval = FALSE------------------------------------------------- # lg_join(x, y, by = "USUBJID", type = "left") # all rows of x # lg_join(x, y, by = "USUBJID", type = "inner") # only matching rows # lg_join(x, y, by = "USUBJID", type = "full") # all rows of both # lg_join(x, y, by = "USUBJID", type = "right") # all rows of y ## ----filter-basic------------------------------------------------------------- eligible_only <- lg_filter(tagged, eligible == TRUE, reason = "Not eligible for analysis (eligible != TRUE)" ) cat("Before:", nrow(tagged), "\n") cat("After: ", nrow(eligible_only), "\n") ## ----filter-enriched---------------------------------------------------------- # reason_code and population enrich the exclusion record step1 <- lg_filter(tagged, eligible == TRUE, reason = "Screening criteria not met (eligible != TRUE)", reason_code = "SCREEN_FAIL", population = "ELIGIBLE_SET" ) step2 <- lg_filter(step1, age >= 18L, reason = "Under minimum age threshold (age < 18)", reason_code = "UNDERAGE", population = "ADULT_SET" ) cat("Enrolled: ", nrow(tagged), "\n") cat("Eligible: ", nrow(step1), "\n") cat("Adult: ", nrow(step2), "\n") ## ----operations--------------------------------------------------------------- ops <- lg_operations() ops[, c("op_id", "op_type", "description", "rows_in", "rows_out")] ## ----history------------------------------------------------------------------ lg_history(step2) ## ----end---------------------------------------------------------------------- lg_end() ## ----complete----------------------------------------------------------------- lg_start(study_id = "DEMO") # Source data raw <- data.frame( id = sprintf("P%03d", 1:8), value = c(12.4, NA, 8.1, 15.2, 9.8, NA, 11.3, 7.4), group = rep(c("treatment", "control"), 4), include = c(TRUE, TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, TRUE), stringsAsFactors = FALSE ) # Tag, derive, filter ds <- lg_tag(raw, dataset_id = "RAW", label = "Raw analysis dataset") ds <- lg_derive(ds, log_value = log(value), value_cat = ifelse(!is.na(value) & value >= 10, "high", "low/missing"), description = "Log-transform value; categorise as high (>=10) vs low/missing" ) ds_clean <- ds |> lg_filter(include == TRUE, reason = "Excluded by study protocol (include != TRUE)" ) |> lg_filter(!is.na(value), reason = "Missing primary endpoint value" ) cat("Rows after cleaning:", nrow(ds_clean), "\n") # Visualise the pipeline lin <- lg_lineage() print(lin) lg_end() ## ----lineage-demo------------------------------------------------------------- lg_start() raw <- lg_tag( data.frame( USUBJID = sprintf("P%02d", 1:6), group = rep(c("A", "B"), 3L), flag = c(TRUE, TRUE, FALSE, TRUE, FALSE, TRUE), stringsAsFactors = FALSE ), dataset_id = "RAW" ) raw <- lg_derive(raw, group_n = ifelse(group == "A", 1L, 2L), description = "Numeric group code" ) lg_filter(raw, flag == TRUE, reason = "Flag not set") lin <- lg_lineage() print(lin) lg_end() ## ----lineage-plot, eval = FALSE----------------------------------------------- # # Render inline (requires DiagrammeR) # lg_plot(lin) # # # Export DOT file for Graphviz / online renderers # lg_plot(lin, output = "outputs/pipeline.dot")