## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----eval=FALSE, echo=TRUE---------------------------------------------------- # ##################################### # # Assign Macro Variables # ##################################### # # # Assign base path # symput("base_path", "c:/packages/macro/tests/testthat/examples") # # # Assign relative paths # symput("log_path", "&base_path/log") # symput("output_path", "&base_path/output") # symput("template_path", "&base_path/templates") # symput("data_path", "&base_path/data") # # # Assign global variables # symput("sponsor_name", "Acme, Inc.") # symput("study_name", "ABC") # symput("prog_name", "t_dm") # # # Select analysis variables # symput("vars", c("AGE", "AGEG", "SEX", "RACE")) # symput("anals", c("cont", "cat", "cat", "cat")) # symput("lbls", c("Age", "Age Group", "Sex", "Race")) # # # Assign or get titles # symput("titles", c("Table 1.0", # "Analysis of Demographic Characteristics", # "Safety Population")) # # # Assign or get footnotes # symput("footnotes", c(paste0("Program: &prog_name..R"), # "NOTE: Denominator based on number of non-missing responses.")) # # # Assign treatment groups and labels # symput("trt_grps", c("ARM A" = "Placebo", # "ARM B" = "Drug 50mg", # "ARM C" = "Drug 100mg", # "ARM D" = "Competitor")) # # # Assign other parameters # symput("env", "dev") # "prod" # symput("out_type", "PDF") # # # Assign preview # symput("preview", ", preview = 1") # # # Preprocess and Run Example3 # macro::msource(paste0(symget("base_path"), "/templates/dm01.R"), # paste0(symget("base_path"), "/code/t_dm.R"), # debug = TRUE, symbolgen = TRUE, clear = FALSE) # ## ----eval=FALSE, echo=TRUE---------------------------------------------------- # ##################################################################### # # Program Name: &prog_name. # # Study: &study_name. # ##################################################################### # # library(sassy) # # # Prepare Log ------------------------------------------------------------- # # # options("logr.autolog" = TRUE, # "logr.on" = TRUE, # "logr.notes" = FALSE, # "procs.print" = FALSE) # # # Assign program name # prog_nm <- "&prog_name." # # # Construct paths # l_path <- file.path("&log_path.", paste0(prog_nm, ".log")) # o_path <- file.path("&output_path.", prog_nm) # # # Open log # lf <- log_open(l_path) # # # Prepare formats --------------------------------------------------------- # # sep("Prepare formats") # # put("Compile format catalog") # fc <- fcat(MEAN = "%.1f", STD = "(%.2f)", # Q1 = "%.1f", Q3 = "%.1f", # MIN = "%d", MAX = "%d", # CNT = "%2d", PCT = "(%5.1f%%)") # # # #%if ("AGEG" %in% &vars.) # # put("Age Groups") # fc$AGEG <- value(condition(x >= 18 & x <= 29, "18 to 29"), # condition(x >=30 & x <= 39, "30 to 39"), # condition(x >=40 & x <=49, "40 to 49"), # condition(x >= 50, ">= 50"), # as.factor = TRUE) # #%end # # #%if ("SEX" %in% &vars.) # # put("Sex decodes") # fc$SEX <- value(condition(x == "M", "Male"), # condition(x == "F", "Female"), # condition(TRUE, "Other"), # as.factor = TRUE) # # #%end # # #%if ("RACE" %in% &vars.) # # put("Race decodes") # fc$RACE <- value(condition(x == "WHITE", "White"), # condition(x == "BLACK OR AFRICAN AMERICAN", "Black or African American"), # condition(x == "ASIAN", "Asian or Pacific Islander"), # condition(x == "UNKNOWN", "Unknown"), # condition(TRUE, "Other"), # as.factor = TRUE) # # #%end # # # # # Load and Prepare Data --------------------------------------------------- # # sep("Prepare Data") # # #%if ("&env." == "prod") # # put("Get data") # libname(dat, "&data_path.", "Rda") # # dm <- dat$dm # # #%else # # put("Create sample data.") # #%include '&template_path./dat01.R' # # #%end # # put("Log starting dataset") # put(dm) # # put("Filter out screen failure") # dm_f <- subset(dm, ARM != 'SCREEN FAILURE') # # # put("Get ARM population counts") # proc_freq(dm_f, tables = ARM, # output = long, # options = v(nopercent, nonobs)) -> arm_pop # # put("Log treatment groups variable") # trt_grps <- `&trt_grps.` # put(trt_grps) # # #%if ("AGEG" %in% &vars.) # # put("Categorize AGE") # dm_f$AGEG <- fapply(dm_f$AGE, fc$AGEG) # #%end # # #% Analysis Macros -------------------------------------------------------- # # #%macro anal_cont(var, lvar, lbl) # #%let blknm <- &lvar._block # # &lbl. Summary Block ------------------------------------------------------- # # sep("Create summary statistics for &lvar..") # # put("Call means procedure to get summary statistics for &lvar.") # proc_means(dm_f, var = `&var.`, # stats = v(n, mean, std, median, q1, q3, min, max), # by = ARM, # options = v(notype, nofreq)) -> `stats_&lvar.` # # put("Combine stats") # datastep(stats_&lvar, # format = fc, # drop = find.names(stats_&lvar, start = 4), # { # VAR <- "&lbl." # `Mean (SD)` <- fapply2(MEAN, STD) # Median <- MEDIAN # `Q1 - Q3` <- fapply2(Q1, Q3, sep = " - ") # `Min - Max` <- fapply2(MIN, MAX, sep = " - ") # # # }) -> comb_&lvar # # put("Transpose ARMs into columns") # proc_transpose(comb_&lvar, # var = names(comb_&lvar), # copy = VAR, id = BY, # name = LABEL) -> `&blknm` # #%mend # # #%macro anal_cat(var, lvar, lbl) # #%let blknm <- &lvar._block # # &lbl. Block --------------------------------------------------------------- # # sep("Create frequency counts for &lbl.") # # put("Get &lvar. frequency counts") # proc_freq(dm_f, # table = `&var.`, # by = ARM, # options = nonobs) -> freq_&lvar # # put("Combine counts and percents and assign age group factor for sorting") # datastep(freq_&lvar, # format = fc, # keep = v(VAR, LABEL, BY, CNTPCT), # { # VAR <- "&lbl." # CNTPCT <- fapply2(CNT, PCT) # #%if ("&var." == "AGEG") # LABEL <- CAT # #%else # LABEL <- fapply(CAT, fc$`&var.`) # #%end # }) -> comb_&lvar # # # put("Sort by &lvar. factor") # proc_sort(comb_&lvar, by = v(BY, LABEL)) -> sort_&lvar # # put("Tranpose &lvar. block") # proc_transpose(sort_&lvar, # var = CNTPCT, # copy = VAR, # id = BY, # by = LABEL, # options = noname) -> `&blknm` # #%mend # # #% Get length of variable vector # #%let varcnt <- %sysfunc(length(&vars.)) # # # Perform Analysis ------------------------------------------------------- # # #% Iterate analysis variables # #%do idx = 1 %to &varcnt. # # #%let var <- %sysfunc(&vars[&idx]) # #%let lvar <- %sysfunc(tolower("&var")) # #%let lbl <- %sysfunc(&lbls[&idx]) # #%let anal <- %sysfunc(&anals[&idx]) # # #%if ("&anal" == "cont") # #%anal_cont(&var, &lvar, &lbl) # #%end # #%if ("&anal." == "cat") # #%anal_cat(&var, &lvar, &lbl) # #%end # #%end # # # Create final data frame ------------------------------------------------- # # #%let blocks <- %sysfunc(paste0(tolower(&vars.), "_block", collapse = ", ")) # # final <- rbind(`&blocks.`) # # # Report ------------------------------------------------------------------ # # #% Include standard report code 01 # #%include '&template_path./rpt01.R' # # # Clean Up ---------------------------------------------------------------- # sep("Clean Up") # # put("Close log") # log_close() # # # # Uncomment to view report # # file.show(res$modified_path) # # # Uncomment to view log # # file.show(lf) # # ## ----eval=FALSE, echo=TRUE---------------------------------------------------- # dm <- read.table(header = TRUE, text = ' # SUBJID ARM SEX RACE AGE # "001" "ARM A" "F" "ASIAN" 19 # "002" "ARM B" "F" "WHITE" 21 # "003" "ARM C" "F" "WHITE" 23 # "004" "ARM D" "F" "BLACK OR AFRICAN AMERICAN" 28 # "005" "ARM A" "M" "WHITE" 37 # "006" "ARM B" "M" "WHITE" 34 # "007" "ARM C" "M" "ASIAN" 36 # "008" "ARM D" "M" "WHITE" 30 # "009" "ARM A" "F" "WHITE" 39 # "010" "ARM B" "F" "WHITE" 31 # "011" "ARM C" "F" "BLACK OR AFRICAN AMERICAN" 33 # "012" "ARM D" "F" "WHITE" 38 # "013" "ARM A" "M" "BLACK OR AFRICAN AMERICAN" 37 # "014" "ARM B" "M" "WHITE" 34 # "015" "ARM C" "M" "WHITE" 36 # "016" "ARM A" "M" "WHITE" 40') # ## ----eval=FALSE, echo=TRUE---------------------------------------------------- # # sep("Create and print report") # # #%if (%symexist(out_type) == FALSE) # #%let out_type <- "RTF" # #%end # # # Get min and max columns # mincol <- names(trt_grps[1]) # maxcol <- names(trt_grps[length(trt_grps)]) # # # Create Table # tbl <- create_table(final, first_row_blank = TRUE) |> # column_defaults(from = mincol, to = maxcol, align = "center", # width = 1.1, standard_eval = TRUE) |> # stub(vars = c("VAR", "LABEL"), "Variable", width = 2.5) |> # define(VAR, blank_after = TRUE, dedupe = TRUE, label = "Variable", # label_row = TRUE) |> # define(LABEL, indent = .25, label = "Demographic Category") |> # titles(`&titles.`, bold = TRUE) |> # footnotes(`&footnotes.`) # # # Add treatment groups # for (trt in names(trt_grps)) { # tbl <- define(tbl, trt, label = trt_grps[trt], n = arm_pop[trt], standard_eval = TRUE) # } # # # Create report # rpt <- create_report(o_path, # output_type = "&out_type.", # font = "Arial") |> # page_header("Sponsor: &sponsor_name.", "Study: &study_name.") |> # set_margins(top = 1, bottom = 1) |> # add_content(tbl) |> # page_footer("Date Produced: {toupper(fapply(Sys.Date(), '%Y%b%d'))}", # right = "Page [pg] of [tpg]") # # put("Write out the report") # res <- write_report(rpt&preview.) # # ## ----eval=FALSE, echo=TRUE---------------------------------------------------- # ##################################################################### # # Program Name: t_dm # # Study: ABC # ##################################################################### # # library(sassy) # # # Prepare Log ------------------------------------------------------------- # # # options("logr.autolog" = TRUE, # "logr.on" = TRUE, # "logr.notes" = FALSE, # "procs.print" = FALSE) # # # Assign program name # prog_nm <- "t_dm" # # # Construct paths # l_path <- file.path("c:/packages/macro/tests/testthat/examples/log", paste0(prog_nm, ".log")) # o_path <- file.path("c:/packages/macro/tests/testthat/examples/output", prog_nm) # # # Open log # lf <- log_open(l_path) # # # Prepare formats --------------------------------------------------------- # # sep("Prepare formats") # # put("Compile format catalog") # fc <- fcat(MEAN = "%.1f", STD = "(%.2f)", # Q1 = "%.1f", Q3 = "%.1f", # MIN = "%d", MAX = "%d", # CNT = "%2d", PCT = "(%5.1f%%)") # # # # put("Age Groups") # fc$AGEG <- value(condition(x >= 18 & x <= 29, "18 to 29"), # condition(x >=30 & x <= 39, "30 to 39"), # condition(x >=40 & x <=49, "40 to 49"), # condition(x >= 50, ">= 50"), # as.factor = TRUE) # # # put("Sex decodes") # fc$SEX <- value(condition(x == "M", "Male"), # condition(x == "F", "Female"), # condition(TRUE, "Other"), # as.factor = TRUE) # # # # put("Race decodes") # fc$RACE <- value(condition(x == "WHITE", "White"), # condition(x == "BLACK OR AFRICAN AMERICAN", "Black or African American"), # condition(x == "ASIAN", "Asian or Pacific Islander"), # condition(x == "UNKNOWN", "Unknown"), # condition(TRUE, "Other"), # as.factor = TRUE) # # # # # # Load and Prepare Data --------------------------------------------------- # # sep("Prepare Data") # # # put("Create sample data.") # dm <- read.table(header = TRUE, text = ' # SUBJID ARM SEX RACE AGE # "001" "ARM A" "F" "ASIAN" 19 # "002" "ARM B" "F" "WHITE" 21 # "003" "ARM C" "F" "WHITE" 23 # "004" "ARM D" "F" "BLACK OR AFRICAN AMERICAN" 28 # "005" "ARM A" "M" "WHITE" 37 # "006" "ARM B" "M" "WHITE" 34 # "007" "ARM C" "M" "ASIAN" 36 # "008" "ARM D" "M" "WHITE" 30 # "009" "ARM A" "F" "WHITE" 39 # "010" "ARM B" "F" "WHITE" 31 # "011" "ARM C" "F" "BLACK OR AFRICAN AMERICAN" 33 # "012" "ARM D" "F" "WHITE" 38 # "013" "ARM A" "M" "BLACK OR AFRICAN AMERICAN" 37 # "014" "ARM B" "M" "WHITE" 34 # "015" "ARM C" "M" "WHITE" 36 # "016" "ARM A" "M" "WHITE" 40') # # # put("Log starting dataset") # put(dm) # # put("Filter out screen failure") # dm_f <- subset(dm, ARM != 'SCREEN FAILURE') # # # put("Get ARM population counts") # proc_freq(dm_f, tables = ARM, # output = long, # options = v(nopercent, nonobs)) -> arm_pop # # put("Log treatment groups variable") # trt_grps <- c('ARM A' = 'Placebo', 'ARM B' = 'Drug 50mg', 'ARM C' = 'Drug 100mg', 'ARM D' = 'Competitor') # put(trt_grps) # # # put("Categorize AGE") # dm_f$AGEG <- fapply(dm_f$AGE, fc$AGEG) # # # # # # Perform Analysis ------------------------------------------------------- # # # # Age Summary Block ------------------------------------------------------- # # sep("Create summary statistics for age.") # # put("Call means procedure to get summary statistics for age") # proc_means(dm_f, var = AGE, # stats = v(n, mean, std, median, q1, q3, min, max), # by = ARM, # options = v(notype, nofreq)) -> `stats_age` # # put("Combine stats") # datastep(stats_age, # format = fc, # drop = find.names(stats_age, start = 4), # { # VAR <- "Age" # `Mean (SD)` <- fapply2(MEAN, STD) # Median <- MEDIAN # `Q1 - Q3` <- fapply2(Q1, Q3, sep = " - ") # `Min - Max` <- fapply2(MIN, MAX, sep = " - ") # # # }) -> comb_age # # put("Transpose ARMs into columns") # proc_transpose(comb_age, # var = names(comb_age), # copy = VAR, id = BY, # name = LABEL) -> age_block # # # # Age Group Block --------------------------------------------------------------- # # sep("Create frequency counts for Age Group") # # put("Get ageg frequency counts") # proc_freq(dm_f, # table = AGEG, # by = ARM, # options = nonobs) -> freq_ageg # # put("Combine counts and percents and assign age group factor for sorting") # datastep(freq_ageg, # format = fc, # keep = v(VAR, LABEL, BY, CNTPCT), # { # VAR <- "Age Group" # CNTPCT <- fapply2(CNT, PCT) # LABEL <- CAT # }) -> comb_ageg # # # put("Sort by ageg factor") # proc_sort(comb_ageg, by = v(BY, LABEL)) -> sort_ageg # # put("Tranpose ageg block") # proc_transpose(sort_ageg, # var = CNTPCT, # copy = VAR, # id = BY, # by = LABEL, # options = noname) -> ageg_block # # # # Sex Block --------------------------------------------------------------- # # sep("Create frequency counts for Sex") # # put("Get sex frequency counts") # proc_freq(dm_f, # table = SEX, # by = ARM, # options = nonobs) -> freq_sex # # put("Combine counts and percents and assign age group factor for sorting") # datastep(freq_sex, # format = fc, # keep = v(VAR, LABEL, BY, CNTPCT), # { # VAR <- "Sex" # CNTPCT <- fapply2(CNT, PCT) # LABEL <- fapply(CAT, fc$SEX) # }) -> comb_sex # # # put("Sort by sex factor") # proc_sort(comb_sex, by = v(BY, LABEL)) -> sort_sex # # put("Tranpose sex block") # proc_transpose(sort_sex, # var = CNTPCT, # copy = VAR, # id = BY, # by = LABEL, # options = noname) -> sex_block # # # # Race Block --------------------------------------------------------------- # # sep("Create frequency counts for Race") # # put("Get race frequency counts") # proc_freq(dm_f, # table = RACE, # by = ARM, # options = nonobs) -> freq_race # # put("Combine counts and percents and assign age group factor for sorting") # datastep(freq_race, # format = fc, # keep = v(VAR, LABEL, BY, CNTPCT), # { # VAR <- "Race" # CNTPCT <- fapply2(CNT, PCT) # LABEL <- fapply(CAT, fc$RACE) # }) -> comb_race # # # put("Sort by race factor") # proc_sort(comb_race, by = v(BY, LABEL)) -> sort_race # # put("Tranpose race block") # proc_transpose(sort_race, # var = CNTPCT, # copy = VAR, # id = BY, # by = LABEL, # options = noname) -> race_block # # # Create final data frame ------------------------------------------------- # # # final <- rbind(age_block, ageg_block, sex_block, race_block) # # # Report ------------------------------------------------------------------ # # # sep("Create and print report") # # # # Get min and max columns # mincol <- names(trt_grps[1]) # maxcol <- names(trt_grps[length(trt_grps)]) # # # Create Table # tbl <- create_table(final, first_row_blank = TRUE) |> # column_defaults(from = mincol, to = maxcol, align = "center", # width = 1.1, standard_eval = TRUE) |> # stub(vars = c("VAR", "LABEL"), "Variable", width = 2.5) |> # define(VAR, blank_after = TRUE, dedupe = TRUE, label = "Variable", # label_row = TRUE) |> # define(LABEL, indent = .25, label = "Demographic Category") |> # titles(c('Table 1.0', 'Analysis of Demographic Characteristics', 'Safety Population'), bold = TRUE) |> # footnotes(c('Program: t_dm.R', 'NOTE: Denominator based on number of non-missing responses.')) # # # Add treatment groups # for (trt in names(trt_grps)) { # tbl <- define(tbl, trt, label = trt_grps[trt], n = arm_pop[trt], standard_eval = TRUE) # } # # # Create report # rpt <- create_report(o_path, # output_type = "PDF", # font = "Arial") |> # page_header("Sponsor: Acme, Inc.", "Study: ABC") |> # set_margins(top = 1, bottom = 1) |> # add_content(tbl) |> # page_footer("Date Produced: {toupper(fapply(Sys.Date(), '%Y%b%d'))}", # right = "Page [pg] of [tpg]") # # put("Write out the report") # res <- write_report(rpt, preview = 1) # # # Clean Up ---------------------------------------------------------------- # sep("Clean Up") # # put("Close log") # log_close() # # # # Uncomment to view report # # file.show(res$modified_path) # # # Uncomment to view log # # file.show(lf) # # #