## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
library(tplyr2)
library(knitr)

## ----css, echo = FALSE, results = "asis"--------------------------------------
cat("<style>
table { font-family: Menlo, Consolas, 'DejaVu Sans Mono', monospace; font-size: 85%; }
</style>")

## ----display_helper, echo = FALSE---------------------------------------------
# See vignette("format_strings") -- HTML collapses runs of spaces in a table
# cell, so the result columns get non-breaking spaces to keep the padding visible.
show_table <- function(x, ...) {
  d <- if (any(grepl("^ord_layer", names(x)))) as_display(x) else x
  is_label <- grepl("^rowlabel[0-9]+$|^row_label$", names(d))
  for (j in seq_along(d)) {
    if (!is.character(d[[j]])) next
    d[[j]] <- if (is_label[j]) {
      replace_leading_whitespace(d[[j]])          # keep indentation, allow wrapping
    } else {
      gsub(" ", "\u00a0", d[[j]], fixed = TRUE)   # keep every space in a numeric cell
    }
  }
  kable(d, ...)
}

## ----ae_data------------------------------------------------------------------
set.seed(7)
n_arm <- 300
subj <- data.frame(
  USUBJID = sprintf("S%04d", seq_len(2 * n_arm)),
  TRTA    = rep(c("Placebo", "Drug"), each = n_arm)
)

incidence <- list(
  "HEADACHE"                = c(Placebo = 0.31,   Drug = 0.44),
  "NAUSEA"                  = c(Placebo = 0.12,   Drug = 0.19),
  "INJECTION SITE REACTION" = c(Placebo = 0.995,  Drug = 1.00),
  "ANAPHYLACTIC REACTION"   = c(Placebo = 1/300,  Drug = 2/300)
)

ae <- do.call(rbind, lapply(names(incidence), function(term) {
  do.call(rbind, lapply(c("Placebo", "Drug"), function(arm) {
    pool <- subj$USUBJID[subj$TRTA == arm]
    k <- round(incidence[[term]][[arm]] * length(pool))
    if (k == 0) return(NULL)
    data.frame(USUBJID = pool[seq_len(k)], TRTA = arm, AEDECOD = term)
  }))
}))

ae_spec <- function(...) {
  tplyr_spec(
    cols = "TRTA",
    pop_data = pop_data(cols = c("TRTA" = "TRTA")),
    layers = tplyr_layers(
      group_count("AEDECOD",
        settings = layer_settings(
          distinct_by = "USUBJID", ...,
          format_strings = list(
            n_counts = f_str("xxx (xxx.x%)", "distinct_n", "distinct_pct")
          )
        )
      )
    )
  )
}

## ----pct_plain----------------------------------------------------------------
show_table(tplyr_build(ae_spec(), ae, pop_data = subj))

## ----pct_thresholds-----------------------------------------------------------
show_table(tplyr_build(ae_spec(pct_lt = 1, pct_gt = 99), ae, pop_data = subj))

## ----pct_integer--------------------------------------------------------------
int_spec <- tplyr_spec(
  cols = "TRTA",
  pop_data = pop_data(cols = c("TRTA" = "TRTA")),
  layers = tplyr_layers(
    group_count("AEDECOD",
      settings = layer_settings(
        distinct_by = "USUBJID",
        pct_lt = 1, pct_gt = 99,
        format_strings = list(
          n_counts = f_str("xxx (xxx%)", "distinct_n", "distinct_pct")
        )
      )
    )
  )
)

show_table(tplyr_build(int_spec, ae, pop_data = subj))

## ----zero_counts--------------------------------------------------------------
zero_spec <- function(z) {
  tplyr_spec(
    cols = "TRT01P",
    layers = tplyr_layers(
      group_count("RACE",
        settings = layer_settings(
          zero_count_display = z,
          format_strings = list(n_counts = f_str("xx (xx.x%)", "n", "pct"))
        )
      )
    )
  )
}

show_table(tplyr_build(zero_spec("full"), tplyr_adsl),
           caption = 'zero_count_display = "full" (the default)')

## ----zero_count_only----------------------------------------------------------
show_table(tplyr_build(zero_spec("count_only"), tplyr_adsl),
           caption = 'zero_count_display = "count_only"')

## ----zero_blank---------------------------------------------------------------
show_table(tplyr_build(zero_spec("blank"), tplyr_adsl),
           caption = 'zero_count_display = "blank"')

## ----zero_widths--------------------------------------------------------------
nchar(tplyr_build(zero_spec("full"), tplyr_adsl)$res1)
nchar(tplyr_build(zero_spec("count_only"), tplyr_adsl)$res1)
nchar(tplyr_build(zero_spec("blank"), tplyr_adsl)$res1)

## ----keep_levels--------------------------------------------------------------
spec <- tplyr_spec(
  cols = "TRT01P",
  layers = tplyr_layers(
    group_count("RACE",
      settings = layer_settings(
        keep_levels = c("WHITE", "BLACK OR AFRICAN AMERICAN"),
        format_strings = list(n_counts = f_str("xx (xx.x%)", "n", "pct"))
      )
    )
  )
)

show_table(tplyr_build(spec, tplyr_adsl))

## ----missing_count------------------------------------------------------------
dat <- data.frame(
  TRT  = rep(c("Placebo", "Drug"), each = 20),
  RESP = c(rep("CR", 6), rep("PR", 5), rep("SD", 7), NA, NA,
           rep("CR", 9), rep("PR", 4), rep("SD", 6), NA)
)

spec <- tplyr_spec(
  cols = "TRT",
  layers = tplyr_layers(
    group_count("RESP",
      settings = layer_settings(
        missing_count   = list(label = "Not evaluable"),
        total_row       = TRUE,
        total_row_label = "Total evaluated",
        total_row_count_missings = FALSE,
        format_strings = list(n_counts = f_str("xx (xx.x%)", "n", "pct"))
      )
    )
  )
)

show_table(tplyr_build(spec, dat))

## ----missing_values-----------------------------------------------------------
dat$RESP[c(3, 25)] <- "UNK"

spec <- tplyr_spec(
  cols = "TRT",
  layers = tplyr_layers(
    group_count("RESP",
      settings = layer_settings(
        missing_count = list(label = "Not evaluable", missing_values = "UNK"),
        format_strings = list(n_counts = f_str("xx (xx.x%)", "n", "pct"))
      )
    )
  )
)

show_table(tplyr_build(spec, dat))

## ----stat_columns-------------------------------------------------------------
spec <- tplyr_spec(
  cols = "TRTA",
  pop_data = pop_data(cols = c("TRTA" = "TRT01A")),
  layers = tplyr_layers(
    group_count("AEBODSYS",
      settings = layer_settings(
        distinct_by = "USUBJID",
        stat_columns = list(
          "n (%)" = f_str("xxx (xx.x%)", "distinct_n", "distinct_pct"),
          "E"     = f_str("xxx", "n")
        )
      )
    )
  )
)

result <- tplyr_build(spec, tplyr_adae, pop_data = tplyr_adsl)
show_table(head(as_display(result), 6))

## ----stat_columns_labels------------------------------------------------------
vapply(grep("^res", names(result), value = TRUE),
       function(nm) attr(result[[nm]], "label"), character(1))

## ----stats_as_columns---------------------------------------------------------
spec <- tplyr_spec(
  cols = "TRT01P",
  layers = tplyr_layers(
    group_desc("AGE",
      by = "AGEGR1",
      settings = layer_settings(
        stats_as_columns = TRUE,
        format_strings = list(
          "n"         = f_str("xx", "n"),
          "Mean (SD)" = f_str("xx.x (xx.xx)", "mean", "sd"),
          "Min, Max"  = f_str("xx, xx", "min", "max")
        )
      )
    )
  )
)

result <- tplyr_build(spec, tplyr_adsl)
show_table(result)

## ----stats_as_columns_labels--------------------------------------------------
vapply(grep("^res", names(result), value = TRUE),
       function(nm) attr(result[[nm]], "label"), character(1))

## ----stats_as_columns_no_by---------------------------------------------------
spec <- tplyr_spec(
  cols = "TRT01P",
  layers = tplyr_layers(
    group_desc("AGE",
      settings = layer_settings(
        stats_as_columns = TRUE,
        format_strings = list(
          "n"         = f_str("xx", "n"),
          "Mean (SD)" = f_str("xx.x (xx.xx)", "mean", "sd"),
          "Min, Max"  = f_str("xx, xx", "min", "max")
        )
      )
    )
  )
)

show_table(tplyr_build(spec, tplyr_adsl))

## ----shift_data---------------------------------------------------------------
set.seed(99)
n <- 120
shift_data <- data.frame(
  USUBJID = sprintf("S%03d", seq_len(n)),
  TRTA    = rep(c("Placebo", "Drug"), each = n / 2),
  BNRIND  = factor(sample(c("LOW", "NORMAL", "HIGH"), n, TRUE, c(.15, .7, .15)),
                   levels = c("LOW", "NORMAL", "HIGH")),
  ANRIND  = factor(sample(c("LOW", "NORMAL", "HIGH"), n, TRUE, c(.2, .6, .2)),
                   levels = c("LOW", "NORMAL", "HIGH"))
)

shift_spec <- function(...) {
  tplyr_spec(
    cols = "TRTA",
    layers = tplyr_layers(
      group_shift(c(row = "BNRIND", column = "ANRIND"),
        settings = layer_settings(
          distinct_by = "USUBJID", ...,
          format_strings = list(n_counts = f_str("xx (xx.x%)", "n", "pct"))
        )
      )
    )
  )
}

show_table(tplyr_build(shift_spec(), shift_data),
           caption = 'shift_denom = "total" (the default)')

## ----shift_column-------------------------------------------------------------
result <- tplyr_build(shift_spec(shift_denom = "column"), shift_data)
show_table(result, caption = 'shift_denom = "column"')

## ----shift_labels-------------------------------------------------------------
vapply(grep("^res", names(result), value = TRUE),
       function(nm) attr(result[[nm]], "label"), character(1))

## ----shift_rowwise------------------------------------------------------------
show_table(
  tplyr_build(shift_spec(denoms_by = c("TRTA", "BNRIND")), shift_data),
  caption = 'denoms_by = c("TRTA", "BNRIND") -- row-wise percentages'
)

## ----denom_row----------------------------------------------------------------
show_table(tplyr_build(
  shift_spec(shift_denom = "column", denom_row = TRUE),
  shift_data
))

## ----denom_row_format---------------------------------------------------------
show_table(tplyr_build(
  shift_spec(
    shift_denom     = "column",
    denom_row       = TRUE,
    denom_row_label = "n",
    denom_row_format = f_str("xxx", "n")
  ),
  shift_data
))

## ----nested_build-------------------------------------------------------------
spec <- tplyr_spec(
  cols = "TRTA",
  pop_data = pop_data(cols = c("TRTA" = "TRT01A")),
  layers = tplyr_layers(
    group_count(c("AEBODSYS", "AEDECOD"),
      settings = layer_settings(
        distinct_by = "USUBJID",
        zero_count_display = "count_only",
        format_strings = list(
          n_counts = f_str("xx (xx.x%)", "distinct_n", "distinct_pct")
        )
      )
    )
  )
)

result <- tplyr_build(spec, tplyr_adae, pop_data = tplyr_adsl)
collapsed <- collapse_row_labels(result, "rowlabel1", "rowlabel2",
                                 nest = TRUE, indent = "   ")
show_table(head(collapsed[, c("row_label", "res1", "res2", "res3")], 10))

## ----wrap---------------------------------------------------------------------
collapsed$row_label <- str_indent_wrap(collapsed$row_label, width = 28)
cat(head(collapsed$row_label, 9), sep = "\n")

## ----conditional--------------------------------------------------------------
res <- tplyr_build(zero_spec("full"), tplyr_adsl)

# flag any row where the percentage clears 90%
apply_conditional_format(res$res1, format_group = 2, x > 90,
                         replacement = "(>90%)")

## ----conditional_full---------------------------------------------------------
apply_conditional_format(res$res1, 2, x == 0, "    -     ", full_string = TRUE)

## ----as_display---------------------------------------------------------------
result <- tplyr_build(zero_spec("full"), tplyr_adsl)
kable(as_display(result, labels = TRUE))

## ----whitespace---------------------------------------------------------------
indented <- c("CARDIAC DISORDERS", "   ATRIAL FIBRILLATION")
nchar(indented)
nchar(replace_leading_whitespace(indented))