## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set(collapse = TRUE, comment = "#>") library(tplyr2) library(knitr) data(tplyr_adsl, package = "tplyr2") ## ----assoc-omnibus------------------------------------------------------------ fisher_p <- function(.data) { suppressWarnings(fisher.test(table(.data$TRT01P, .data$SEX))$p.value) } spec <- tplyr_spec( cols = "TRT01P", layers = tplyr_layers( group_count("SEX", settings = layer_settings( format_strings = list(n_counts = f_str("xx (xx.x%)", "n", "pct")), assoc_test = assoc_test(fn = fisher_p, format = f_str("x.xxx", "p"), label = "Fisher p"))))) b <- tplyr_build(spec, tplyr_adsl) kable(as_display(b)) ## ----assoc-desc--------------------------------------------------------------- spec_age <- tplyr_spec( cols = "TRT01P", layers = tplyr_layers( group_desc("AGE", settings = layer_settings( format_strings = list(Mean = f_str("xx.x", "mean"), SD = f_str("xx.xx", "sd")), assoc_test = assoc_test( fn = function(.data) anova(lm(AGE ~ TRT01P, .data))[["Pr(>F)"]][1], format = f_str("x.xxx", "p"), label = "ANOVA p"))))) kable(as_display(tplyr_build(spec_age, tplyr_adsl))) ## ----assoc-pairwise, eval = FALSE--------------------------------------------- # group_count("AEDECOD", # settings = layer_settings( # distinct_by = "USUBJID", # stat_columns = list("n" = f_str("xx (xx.x%)", "distinct_n", "distinct_pct")), # assoc_test = assoc_test( # fn = function(m) fisher.test(m)$p.value, # m = 2x2 count matrix # reference = "Placebo", # comparisons = c("Low", "High"), # format = f_str("x.xxx", "p"), # label = c("Placebo vs Low", "Placebo vs High")))) # #> rowlabel1 res1 res2 res3 pval1 pval2 # #> 1 HEADACHE 3 (50.0%) 1 (20.0%) 2 (50.0%) 0.524 1.000 # #> 2 NAUSEA 2 (33.3%) 3 (60.0%) 1 (25.0%) 0.524 1.000 ## ----assoc-char, eval = FALSE------------------------------------------------- # ae_pval <- function(m) { # if (sum(m[, 1]) == 0) return(NA_character_) # both arms zero -> blank # p <- fisher.test(m)$p.value # d <- formatC(round(p, 3), format = "f", digits = 3) # if (p > .99) ">.99" else if (p < .15) paste0(d, "*") else paste0(d, " ") # } # group_count("AEDECOD", # settings = layer_settings( # distinct_by = "USUBJID", # stat_columns = list("n" = f_str("xx (xx.x%)", "distinct_n", "distinct_pct")), # assoc_test = assoc_test(fn = ae_pval, # reference = "Placebo", comparisons = c("Low", "High")))) ## ----assoc-multi, eval = FALSE------------------------------------------------ # or_ci <- function(m) { # ft <- fisher.test(m) # c(ft$estimate, ft$conf.int[1], ft$conf.int[2]) # OR, lower, upper # } # group_count("AEDECOD", # settings = layer_settings( # distinct_by = "USUBJID", # stat_columns = list("n" = f_str("xx (xx.x%)", "distinct_n", "distinct_pct")), # assoc_test = assoc_test(fn = or_ci, # reference = "Placebo", comparisons = c("Low", "High"), # format = f_str("xx.xx (xx.xx, xx.xx)", "or", "lo", "hi"), # label = "OR (95% CI)"))) ## ----prop-ci, eval = FALSE---------------------------------------------------- # group_count("AEDECOD", # settings = layer_settings( # distinct_by = "USUBJID", # ci_method = "clopper_pearson", # also: wilson, wald, agresti_coull, jeffreys # format_strings = list( # n_counts = f_str("xx (xx.x%) [xx.x, xx.x]", # "distinct_n", "distinct_pct", # "distinct_ci_lower", "distinct_ci_upper")))) # #> rowlabel1 res1 # #> 1 HEADACHE 12 (30.0%) [16.6, 46.5] ## ----bind-column-------------------------------------------------------------- # 1. descriptive block spec <- tplyr_spec( cols = "TRT01P", layers = tplyr_layers( group_count("SEX", settings = layer_settings( format_strings = list(n_counts = f_str("xx (xx.x%)", "n", "pct")))))) disp <- as_display(tplyr_build(spec, tplyr_adsl)) # 2. compute a statistic per row (here: chi-square of SEX x TRT for each SEX # level vs the rest). Substitute any model here. pval <- vapply(disp$rowlabel1, function(lvl) { tab <- table(tplyr_adsl$TRT01P, tplyr_adsl$SEX == lvl) suppressWarnings(chisq.test(tab)$p.value) }, numeric(1)) # 3. format with the SAME machinery as the table disp$pval <- apply_formats(f_str("x.xxx", "p"), pval) # 4. it is already aligned row-for-row (as_display() preserves build order) kable(disp) ## ----bind-row----------------------------------------------------------------- spec <- tplyr_spec( cols = "TRT01P", layers = tplyr_layers( group_desc("AGE", settings = layer_settings( format_strings = list(n = f_str("xx", "n"), "Mean (SD)" = f_str("xx.x (xx.xx)", "mean", "sd")))))) disp <- as_display(tplyr_build(spec, tplyr_adsl)) # an overall test across arms (substitute lm()/emmeans()/mmrm() as needed) p <- anova(lm(AGE ~ TRT01P, tplyr_adsl))[["Pr(>F)"]][1] # build a matching row: label + one p-value cell in the first result column, # blank in the rest, then bind it on res_cols <- grep("^res", names(disp), value = TRUE) p_row <- disp[1, ] # a row of the right shape p_row$rowlabel1 <- "p-value" p_row[res_cols] <- "" p_row[[res_cols[1]]] <- apply_formats(f_str("x.xxx", "p"), p) out <- rbind(disp, p_row) rownames(out) <- NULL kable(out) ## ----na-arg, eval = FALSE----------------------------------------------------- # apply_formats(f_str("xx.x", "x"), c(2.3, NA, 12.7), na = "") # #> [1] " 2.3" "" "12.7" # # apply_formats(f_str("xx.x", "x"), NA_real_, na = "NE") # or any placeholder # #> [1] "NE" ## ----as-display-labels-------------------------------------------------------- b <- tplyr_build( tplyr_spec(cols = "TRT01P", layers = tplyr_layers(group_count("SEX", settings = layer_settings( format_strings = list(n_counts = f_str("xx (xx.x%)", "n", "pct")))))), tplyr_adsl) kable(as_display(b, labels = TRUE))