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

## ----format-strings-basic-----------------------------------------------------
geo_fn <- function(.data, .target_var) {
  vals <- .data[[.target_var]]
  pos_vals <- vals[!is.na(vals) & vals > 0]
  data.frame(
    geo_mean = exp(mean(log(pos_vals))),
    geo_sd   = exp(sd(log(pos_vals)))
  )
}

spec <- tplyr_spec(
  cols = "TRTP",
  layers = tplyr_layers(
    group_analyze("AVAL",
      by = "Urate (umol/L)",
      where = AVISIT == "Baseline",
      analyze_fn = geo_fn,
      settings = layer_settings(
        format_strings = list(
          "Geometric Mean" = f_str("xxx.xx", "geo_mean"),
          "Geometric SD"   = f_str("xxx.xx", "geo_sd")
        )
      )
    )
  )
)

result <- tplyr_build(spec, tplyr_adlb)
kable(result[, !grepl("^ord", names(result))])

## ----format-strings-combined--------------------------------------------------
summary_fn <- function(.data, .target_var) {
  vals <- .data[[.target_var]]
  vals <- vals[!is.na(vals)]
  data.frame(
    n      = length(vals),
    mean   = mean(vals),
    sd     = sd(vals),
    median = median(vals)
  )
}

spec <- tplyr_spec(
  cols = "TRTP",
  layers = tplyr_layers(
    group_analyze("AVAL",
      by = "Urate (umol/L)",
      where = AVISIT == "Baseline",
      analyze_fn = summary_fn,
      settings = layer_settings(
        format_strings = list(
          "n"         = f_str("xx", "n"),
          "Mean (SD)" = f_str("xxx.x (xxx.xx)", "mean", "sd"),
          "Median"    = f_str("xxx.xx", "median")
        )
      )
    )
  )
)

result <- tplyr_build(spec, tplyr_adlb)
kable(result[, !grepl("^ord", names(result))])

## ----preformatted-basic-------------------------------------------------------
range_fn <- function(.data, .target_var) {
  vals <- .data[[.target_var]]
  vals <- vals[!is.na(vals)]
  data.frame(
    row_label = c("Range", "Ratio (Max/Min)"),
    formatted = c(
      sprintf("%.1f - %.1f", min(vals), max(vals)),
      sprintf("%.2f", max(vals) / min(vals))
    )
  )
}

spec <- tplyr_spec(
  cols = "TRTP",
  layers = tplyr_layers(
    group_analyze("AVAL",
      by = "Urate (umol/L)",
      where = AVISIT == "Baseline",
      analyze_fn = range_fn
    )
  )
)

result <- tplyr_build(spec, tplyr_adlb)
kable(result[, !grepl("^ord", names(result))])

## ----by-variable--------------------------------------------------------------
mean_fn <- function(.data, .target_var) {
  vals <- .data[[.target_var]]
  vals <- vals[!is.na(vals)]
  data.frame(
    row_label = "Mean (SD)",
    formatted = sprintf("%.1f (%.2f)", mean(vals), sd(vals))
  )
}

spec <- tplyr_spec(
  cols = "TRTP",
  layers = tplyr_layers(
    group_analyze("AVAL",
      by = c("Urate (umol/L)", "AVISIT"),
      where = AVISIT %in% c("Baseline", "Week 4", "Week 8"),
      analyze_fn = mean_fn
    )
  )
)

result <- tplyr_build(spec, tplyr_adlb)
kable(result[, !grepl("^ord", names(result))])

## ----multi-layer--------------------------------------------------------------
geo_fn <- function(.data, .target_var) {
  vals <- .data[[.target_var]]
  pos_vals <- vals[!is.na(vals) & vals > 0]
  data.frame(
    geo_mean = exp(mean(log(pos_vals)))
  )
}

spec <- tplyr_spec(
  cols = "TRT01P",
  layers = tplyr_layers(
    group_count("SEX",
      by = "Gender",
      settings = layer_settings(
        format_strings = list(
          "n (%)" = f_str("xx (xx.x%)", "n", "pct")
        )
      )
    ),
    group_analyze("AGE",
      by = "Age (years)",
      analyze_fn = geo_fn,
      settings = layer_settings(
        format_strings = list(
          "Geometric Mean" = f_str("xx.xx", "geo_mean")
        )
      )
    )
  )
)

result <- tplyr_build(spec, tplyr_adsl)
kable(result[, !grepl("^ord", names(result))])

## ----error-handling-----------------------------------------------------------
safe_geo_fn <- function(.data, .target_var) {
  vals <- .data[[.target_var]]
  pos_vals <- vals[!is.na(vals) & vals > 0]

  if (length(pos_vals) < 2) {
    return(data.frame(geo_mean = NA_real_, geo_sd = NA_real_))
  }

  data.frame(
    geo_mean = exp(mean(log(pos_vals))),
    geo_sd   = exp(sd(log(pos_vals)))
  )
}

spec <- tplyr_spec(
  cols = "TRTP",
  layers = tplyr_layers(
    group_analyze("AVAL",
      by = "Urate (umol/L)",
      where = AVISIT == "Baseline",
      analyze_fn = safe_geo_fn,
      settings = layer_settings(
        format_strings = list(
          "Geometric Mean" = f_str("xxx.xx", "geo_mean"),
          "Geometric SD"   = f_str("xxx.xx", "geo_sd")
        )
      )
    )
  )
)

result <- tplyr_build(spec, tplyr_adlb)
kable(result[, !grepl("^ord", names(result))])

