## ----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))

