## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----setup-------------------------------------------------------------------- library(tidyOhdsiSolutions) # Disable ANSI colour codes so rendered HTML output is clean options(pkg.no_color = TRUE) ## ----basic-messages----------------------------------------------------------- msg_info("Loading configuration from disk") msg_success("All 42 concept sets validated") msg_warn("Column 'mappedSourceCode' is missing — using NA") msg_danger("Connection pool exhausted (non-fatal, retrying)") msg_process("Uploading results to the remote schema") msg_bullet("concept_id 201826 — Type 2 Diabetes Mellitus") msg_todo("Verify descendant flag for hypertension concept set") ## ----layout------------------------------------------------------------------- msg_header("Step 1: Validate Input") msg_info("Checking required columns") msg_success("Validation passed") msg_blank() msg_header("Step 2: Build Cohort") msg_process("Assembling concept set expressions") msg_rule() msg_info("Pipeline complete") ## ----msg-list----------------------------------------------------------------- domains <- c( Condition = "201826, 442793", Drug = "1503297, 40163554", Measurement = "3004501" ) msg_list(domains, header = "Concept set domains") ## ----msg-kv------------------------------------------------------------------- run_info <- list( Package = "tidyOhdsiSolutions", Version = as.character(packageVersion("tidyOhdsiSolutions")), R_version = paste0(R.version$major, ".", R.version$minor), Date = format(Sys.Date()) ) msg_kv(run_info) ## ----iteration-loop----------------------------------------------------------- concept_sets <- list( diabetes = c(201826L, 442793L), hypertension = c(320128L), obesity = c(433736L, 4215968L) ) for (nm in names(concept_sets)) { msg_header(nm) msg_info("Concepts: ", paste(concept_sets[[nm]], collapse = ", ")) msg_success("Processed ", length(concept_sets[[nm]]), " concept(s)") msg_blank() } ## ----iteration-safe----------------------------------------------------------- sources <- list( schema_a = list(valid = TRUE, rows = 1200L), schema_b = list(valid = FALSE, rows = 0L), schema_c = list(valid = TRUE, rows = 850L) ) results <- vector("list", length(sources)) names(results) <- names(sources) for (nm in names(sources)) { results[[nm]] <- msg_try( on_error = "warn", expr = { src <- sources[[nm]] if (!src$valid) stop("Schema '", nm, "' failed validation") msg_success(nm, ": ", src$rows, " rows loaded") src$rows } ) } ## ----verbose-pattern---------------------------------------------------------- process_file <- function(path, verbose = TRUE) { msg_verbose("Opening: ", path, verbose = verbose) # ... processing ... msg_verbose("Done: ", path, verbose = verbose) invisible(path) } # Verbose on (default) process_file("data/concepts.csv") # Verbose off process_file("data/concepts.csv", verbose = FALSE) ## ----timing-simple------------------------------------------------------------ result <- msg_timed( expr = Sys.sleep(0.05), msg = "Sleeping" ) ## ----timing-iteration--------------------------------------------------------- concept_ids <- as.list(c(201826L, 442793L, 320128L, 433736L)) processed <- msg_timed( msg = "Total batch time", expr = lapply(concept_ids, function(id) { msg_info("Processing concept_id ", id) id * 2L # stand-in for real work }) ) ## ----msg-abort---------------------------------------------------------------- validate_schema <- function(x) { if (!is.data.frame(x)) { msg_abort("Expected a data.frame, got: ", class(x)[1]) } invisible(x) } # Catch the error and show its message tryCatch( validate_schema("not a data frame"), error = function(e) msg_danger("Caught: ", conditionMessage(e)) ) ## ----msg-warning-------------------------------------------------------------- withCallingHandlers( { msg_warning("Deprecated argument 'schema' — use 'cdm_schema' instead") msg_info("Continuing with default") }, warning = function(w) { # Muffle so it does not print twice invokeRestart("muffleWarning") } ) ## ----msg-try-modes------------------------------------------------------------ # "warn" — downgrade error to a styled warning msg_try(stop("something went wrong"), on_error = "warn") # "message" — emit as a styled danger message, no stop msg_try(stop("non-critical failure"), on_error = "message") # "ignore" — silently swallow the error msg_try(stop("ignored error"), on_error = "ignore") msg_info("Execution continued after all three") ## ----msg-debug-off------------------------------------------------------------ # Default: pkg.debug = FALSE, so nothing is printed msg_debug("SQL query: SELECT * FROM concept WHERE ...") msg_info("(no debug output above — pkg.debug is FALSE)") ## ----msg-debug-on------------------------------------------------------------- options(pkg.debug = TRUE) msg_debug("SQL query: SELECT * FROM concept WHERE ...") options(pkg.debug = FALSE) # reset ## ----progress-example, eval = FALSE------------------------------------------- # files <- paste0("file_", seq_len(8), ".csv") # pb <- msg_progress(length(files), prefix = "Loading") # # for (f in files) { # Sys.sleep(0.1) # simulated I/O # pb$tick() # } # pb$done("All files loaded") ## ----spinner-example, eval = FALSE-------------------------------------------- # sp <- msg_spinner("Querying vocabulary server") # # for (i in seq_len(30)) { # Sys.sleep(0.05) # sp$spin() # } # sp$done("Query complete") ## ----full-pipeline------------------------------------------------------------ run_pipeline <- function(concept_sets, verbose = TRUE) { msg_header("tidyOhdsiSolutions Pipeline") msg_kv(list( Steps = as.character(length(concept_sets)), Verbose = as.character(verbose) )) msg_blank() results <- vector("list", length(concept_sets)) names(results) <- names(concept_sets) for (nm in names(concept_sets)) { msg_process("Processing: ", nm) results[[nm]] <- msg_try(on_error = "warn", expr = { ids <- concept_sets[[nm]] if (length(ids) == 0L) stop("'", nm, "' has no concept IDs") msg_verbose(" concept IDs: ", paste(ids, collapse = ", "), verbose = verbose) ids }) } msg_blank() msg_rule() succeeded <- sum(!vapply(results, is.null, logical(1L))) msg_success(succeeded, " / ", length(concept_sets), " concept sets processed") invisible(results) } concept_sets <- list( diabetes = c(201826L, 442793L), hypertension = c(320128L), empty_set = integer(0) # will trigger a warning ) out <- run_pipeline(concept_sets, verbose = TRUE)