## ----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: 87%; }
</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, ...)
}

## ----lab_data-----------------------------------------------------------------
set.seed(42)
n_subj <- 30
params <- data.frame(
  PARAM  = c("Sodium (mmol/L)", "Alanine Aminotransferase (U/L)", "Creatinine (mg/dL)"),
  mu     = c(140,  28,   0.9),
  sigma  = c(  3,   9,   0.15),
  digits = c(  0,   1,   2)      # the precision each assay reports
)

labs <- do.call(rbind, lapply(seq_len(nrow(params)), function(i) {
  base <- round(rnorm(n_subj, params$mu[i], params$sigma[i]), params$digits[i])
  post <- round(base + rnorm(n_subj, 0, params$sigma[i] / 2), params$digits[i])
  data.frame(
    USUBJID = sprintf("S%03d", seq_len(n_subj)),
    TRTA    = rep(c("Placebo", "Drug"), each = n_subj / 2),
    PARAM   = params$PARAM[i],
    AVAL    = post,
    BASE    = base,
    CHG     = post - base
  )
}))

## ----auto_precision-----------------------------------------------------------
spec <- tplyr_spec(
  cols = "TRTA",
  layers = tplyr_layers(
    group_desc("AVAL",
      by = "PARAM",
      settings = layer_settings(
        precision_by = "PARAM",
        precision_on = "AVAL",
        format_strings = list(
          "n"         = f_str("xx", "n"),
          "Mean (SD)" = f_str("a.a+1 (a.a+2)", "mean", "sd"),
          "Median"    = f_str("a.a+1", "median"),
          "Min, Max"  = f_str("a.a, a.a", "min", "max")
        )
      )
    )
  )
)

show_table(tplyr_build(spec, labs))

## ----precision_on_without-----------------------------------------------------
value_block <- group_desc("AVAL",
  by = c(label("Value at Week 8"), "PARAM"),
  settings = layer_settings(
    precision_by = "PARAM",
    precision_on = "AVAL",
    format_strings = list("Mean (SD)" = f_str("a.a+1 (a.a+2)", "mean", "sd"))
  )
)

spec <- tplyr_spec(
  cols = "TRTA",
  layers = tplyr_layers(
    value_block,
    group_desc("CHG",
      by = c(label("Change from Baseline"), "PARAM"),
      settings = layer_settings(
        precision_by = "PARAM",        # no precision_on: measures CHG
        format_strings = list("Mean (SD)" = f_str("a.a+1 (a.a+2)", "mean", "sd"))
      )
    )
  )
)

show_table(tplyr_build(spec, labs))

## ----precision_on_with--------------------------------------------------------
spec <- tplyr_spec(
  cols = "TRTA",
  layers = tplyr_layers(
    value_block,
    group_desc("CHG",
      by = c(label("Change from Baseline"), "PARAM"),
      settings = layer_settings(
        precision_by = "PARAM",
        precision_on = "AVAL",         # measure AVAL, summarize CHG
        format_strings = list("Mean (SD)" = f_str("a.a+1 (a.a+2)", "mean", "sd"))
      )
    )
  )
)

show_table(tplyr_build(spec, labs))

## ----no_precision_by----------------------------------------------------------
spec <- tplyr_spec(
  cols = "TRTA",
  layers = tplyr_layers(
    group_desc("AVAL",
      by = "PARAM",
      settings = layer_settings(
        precision_on = "AVAL",         # no precision_by
        format_strings = list(
          "Mean (SD)" = f_str("a.a+1 (a.a+2)", "mean", "sd")
        )
      )
    )
  )
)

show_table(tplyr_build(spec, labs))

## ----cap_layer----------------------------------------------------------------
spec <- tplyr_spec(
  cols = "TRTA",
  layers = tplyr_layers(
    group_desc("AVAL",
      by = "PARAM",
      settings = layer_settings(
        precision_by  = "PARAM",
        precision_on  = "AVAL",
        precision_cap = c(int = 3, dec = 1),
        format_strings = list(
          "Mean (SD)" = f_str("a.a+1 (a.a+2)", "mean", "sd"),
          "Min, Max"  = f_str("a.a, a.a", "min", "max")
        )
      )
    )
  )
)

show_table(tplyr_build(spec, labs))

## ----precision_data-----------------------------------------------------------
sap_precision <- data.frame(
  PARAM = c("Sodium (mmol/L)",
            "Alanine Aminotransferase (U/L)",
            "Creatinine (mg/dL)"),
  max_int = c(3L, 3L, 1L),
  max_dec = c(0L, 1L, 2L)
)

spec <- tplyr_spec(
  cols = "TRTA",
  layers = tplyr_layers(
    group_desc("AVAL",
      by = "PARAM",
      settings = layer_settings(
        precision_by   = "PARAM",
        precision_on   = "AVAL",
        precision_data = sap_precision,
        format_strings = list(
          "Mean (SD)" = f_str("a.a+1 (a.a+2)", "mean", "sd")
        )
      )
    )
  )
)

show_table(tplyr_build(spec, labs))

## ----auto_count_layer---------------------------------------------------------
counts <- data.frame(TRT = "A", GROUP = c(rep("Common", 250), rep("Rare", 3)))

spec <- tplyr_spec(
  cols = "TRT",
  layers = tplyr_layers(
    group_count("GROUP",
      settings = layer_settings(
        format_strings = list(n_counts = f_str("a (xx.x%)", "n", "pct"))
      )
    )
  )
)

c(as_display(tplyr_build(spec, counts))$res1)

## ----hug_basic----------------------------------------------------------------
# standard: padding sits between "(" and the number
apply_formats(f_str("xxx (xxx.x%)", "n", "pct"), c(1, 78), c(1.2, 90.7))

# hugged: the same padding moves to just before ")"
apply_formats(f_str("xxx (XXX.x%)", "n", "pct"), c(1, 78), c(1.2, 90.7))

## ----hug_bracket--------------------------------------------------------------
apply_formats(f_str("xxx [XXX.x]", "n", "pct"), c(1, 78), c(1.2, 90.7))

## ----hug_per_group------------------------------------------------------------
apply_formats(f_str("xx (XX.xx%)", "n", "pct"), 12, 4.2)
apply_formats(f_str("xx (xx.XX%)", "n", "pct"), 12, 4.2)
apply_formats(f_str("xx (XX.XX%)", "n", "pct"), 12, 4.2)

## ----hug_rule_lit, warning = TRUE---------------------------------------------
apply_formats(f_str("XXX", "n"), 12)   # nothing precedes the number
apply_formats(f_str("xxx", "n"), 12)   # what you almost certainly wanted

## ----hug_auto-----------------------------------------------------------------
spec <- tplyr_spec(
  cols = "TRTA",
  layers = tplyr_layers(
    group_desc("AVAL",
      by = "PARAM",
      settings = layer_settings(
        precision_by = "PARAM",
        precision_on = "AVAL",
        format_strings = list(
          "Mean (SD)" = f_str("a.a+1 (A.a+2)", "mean", "sd")
        )
      )
    )
  )
)

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

## ----hug_auto_widths----------------------------------------------------------
nchar(result$res1)

## ----together-----------------------------------------------------------------
spec <- tplyr_spec(
  cols = "TRTA",
  layers = tplyr_layers(
    group_desc("AVAL",
      by = "PARAM",
      settings = layer_settings(
        precision_by  = "PARAM",
        precision_on  = "AVAL",
        precision_cap = c(int = 4, dec = 3),
        format_strings = list(
          "n"         = f_str("xx", "n"),
          "Mean (SD)" = f_str("a.a+1 (A.a+2)", "mean", "sd"),
          "Median"    = f_str("a.a+1", "median",
                              empty = c(.overall = "NE")),
          "Q1, Q3"    = f_str("a.a+1, a.a+1", "q1", "q3"),
          "Min, Max"  = f_str("a.a, a.a", "min", "max")
        )
      )
    )
  )
)

show_table(tplyr_build(spec, labs))