## ----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-----------------------------------------------------------
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, ...)
}

## ----anatomy------------------------------------------------------------------
f_str("xx.x (xx.xx)", "mean", "sd")

## ----mismatch, error = TRUE---------------------------------------------------
try({
f_str("xx.x (xx.xx)", "mean")
})

## ----literal_trap, error = TRUE-----------------------------------------------
try({
f_str("xx days", "n")
})

## ----literal_trap2------------------------------------------------------------
apply_formats(f_str("xx.x years", "mean", "sd"), 3.2, 1)

## ----literal_fix--------------------------------------------------------------
apply_formats(f_str("xx.x (xx.xx)", "mean", "sd"), 3.2, 1)   # units live in the label

## ----literal_plus-------------------------------------------------------------
apply_formats(f_str("xx+5", "n"), 12)    # "+5" absorbed as an offset
apply_formats(f_str("xx +5", "n"), 12)   # "+5" printed

## ----padding------------------------------------------------------------------
apply_formats(f_str("xxx (xxx.x%)", "n", "pct"),
              c(4, 78, 126), c(4.7, 90.7, 100.0))

## ----overflow-----------------------------------------------------------------
apply_formats(f_str("xxx (xx.x%)", "n", "pct"),
              c(4, 78, 126), c(4.7, 90.7, 100.0))
apply_formats(f_str("x", "n"), c(5, 1234))
apply_formats(f_str("x.x", "v"), c(5.55, 1234.567))

## ----negatives----------------------------------------------------------------
apply_formats(f_str("xx.x", "v"), c(-2.34, 5.6, -0.04))

## ----count_fmt----------------------------------------------------------------
spec <- tplyr_spec(
  cols = "TRT01P",
  layers = tplyr_layers(
    group_count("RACE",
      settings = layer_settings(
        format_strings = list(n_counts = f_str("xxx (xxx.x%)", "n", "pct"))
      )
    )
  )
)

show_table(tplyr_build(spec, tplyr_adsl))

## ----desc_fmt-----------------------------------------------------------------
spec <- tplyr_spec(
  cols = "TRT01P",
  layers = tplyr_layers(
    group_desc("AGE",
      by = "Age (years)",
      settings = layer_settings(
        format_strings = list(
          "n"         = f_str("xx", "n"),
          "Mean (SD)" = f_str("xx.x (xx.xx)", "mean", "sd"),
          "Median"    = f_str("xx.x", "median"),
          "Q1, Q3"    = f_str("xx.x, xx.x", "q1", "q3"),
          "Min, Max"  = f_str("xx, xx", "min", "max"),
          "Missing"   = f_str("xx", "missing")
        )
      )
    )
  )
)

show_table(tplyr_build(spec, tplyr_adsl))

## ----n_over_N-----------------------------------------------------------------
spec <- tplyr_spec(
  cols = "TRT01P",
  layers = tplyr_layers(
    group_count("SEX",
      settings = layer_settings(
        format_strings = list(
          n_counts = f_str("xxx/xxx (xx.x%)", "n", "total", "pct")
        )
      )
    )
  )
)

show_table(tplyr_build(spec, tplyr_adsl))

## ----desc_n_pct---------------------------------------------------------------
spec <- tplyr_spec(
  cols = "TRT01P",
  layers = tplyr_layers(
    group_desc("BMIBL",
      by = "Baseline BMI (kg/m2)",
      settings = layer_settings(
        format_strings = list(
          "Subjects with data, n (%)" = f_str("xx (xx.x%)", "n", "pct"),
          "Records assessed"          = f_str("xx", "n_records"),
          "Mean (SD)"                 = f_str("xx.x (xx.xx)", "mean", "sd"),
          "Missing"                   = f_str("xx", "missing")
        )
      )
    )
  )
)

show_table(tplyr_build(spec, tplyr_adsl))

## ----bad_keyword, warning = TRUE----------------------------------------------
spec <- tplyr_spec(
  cols = "TRT01P",
  layers = tplyr_layers(
    group_desc("AGE",
      settings = layer_settings(
        format_strings = list("Mean" = f_str("xx.x", "average"))
      )
    )
  )
)

show_table(tplyr_build(spec, tplyr_adsl))

## ----rounding_data------------------------------------------------------------
demo <- data.frame(
  TRT = rep(c("Drug", "Placebo"), each = 4),
  VAL = c(1, 2, 3, 4,   3, 4, 5, 6)   # means of exactly 2.5 and 4.5
)

spec <- tplyr_spec(
  cols = "TRT",
  layers = tplyr_layers(
    group_desc("VAL",
      settings = layer_settings(
        format_strings = list("Mean" = f_str("xx", "mean"))
      )
    )
  )
)

## ----rounding_bankers---------------------------------------------------------
show_table(tplyr_build(spec, demo), caption = "Banker's rounding (the default)")

## ----rounding_ibm-------------------------------------------------------------
tplyr2_options(IBMRounding = TRUE)
show_table(tplyr_build(spec, demo), caption = "IBM rounding (half away from zero)")
tplyr2_options(IBMRounding = FALSE)

## ----na_default---------------------------------------------------------------
apply_formats(f_str("xx.x", "v"), c(2.3, NA, 12.7))
apply_formats(f_str("xx.x (xx.xx)", "mean", "sd"), NA, NA)

## ----empty_setup--------------------------------------------------------------
d <- data.frame(
  TRT = c(rep("A", 4), rep("B", 3)),
  VAL = c(1.5, 2.5, 3.5, 4.5, NA, NA, NA)
)

spec <- tplyr_spec(
  cols = "TRT",
  layers = tplyr_layers(
    group_desc("VAL",
      settings = layer_settings(
        format_strings = list(
          "Mean (SD)" = f_str("xx.x (xx.xx)", "mean", "sd", empty = c(.overall = "---")),
          "Median"    = f_str("xx.x", "median", empty = c(.overall = "NE")),
          "SD"        = f_str("xx.xx", "sd", empty = c(.overall = "N/A"))
        )
      )
    )
  )
)

show_table(tplyr_build(spec, d))

## ----empty_partial------------------------------------------------------------
d1 <- data.frame(TRT = c("A", "A", "B"), VAL = c(1.5, 2.5, 7.5))
show_table(tplyr_build(spec, d1))

## ----empty_unnamed------------------------------------------------------------
fmt_overall <- f_str("xx (xxx)", "n", "pct", empty = c(.overall = "NA"))
fmt_fill    <- f_str("xx (xxx)", "n", "pct", empty = "NA")

apply_formats(fmt_overall, NA, NA)   # whole cell replaced
apply_formats(fmt_fill,    NA, NA)   # each field filled
apply_formats(fmt_fill,    NA, 12)   # only the missing field filled

## ----apply_formats_basic------------------------------------------------------
apply_formats(f_str("xxx.x (xxx.xx)", "mean", "sd"),
              c(75.3, 68.1, 80.5),
              c(8.21, 7.55, 9.03))

## ----apply_formats_na---------------------------------------------------------
apply_formats(f_str("xx.x", "v"), c(2.3, NA, 12.7))              # width-preserving blank
apply_formats(f_str("xx.x", "v"), c(2.3, NA, 12.7), na = "")     # nchar 0
apply_formats(f_str("xx.x", "v"), c(2.3, NA, 12.7), na = "NE")   # a sentinel

## ----apply_formats_width------------------------------------------------------
apply_formats(f_str("xx.x", "v"), c(2.3, NA, 12.7), width = 8)
apply_formats(f_str("xx.x", "v"), c(2.3, NA, 12.7), width = 8, pad = "left")

## ----apply_formats_ltgt-------------------------------------------------------
apply_formats(f_str("xx (xx.x%)", "n", "pct"),
              c(1, 40, 253), c(0.4, 47.1, 99.6),
              lt = 1, gt = 99, lt_gt_group = 2)