## -----------------------------------------------------------------------------
#| label: setup
#| include: false
knitr::opts_chunk$set(collapse = TRUE, comment = "#>")
library(ksformat)
library(tidyr)
library(dplyr, warn.conflicts = FALSE)


## -----------------------------------------------------------------------------
#| label: protocol-windows
windows <- fmap_strata(
  stratum = c("ARM_A", "ARM_A", "ARM_A", "ARM_B", "ARM_B"),
  low     = c(0,        7,       28,      0,       14),
  high    = c(7,        28,      Inf,     14,      Inf),
  label   = c("Baseline", "Wk1-3", "Wk4+", "Baseline", "Wk2+"),
  inc_high = c(FALSE, FALSE, TRUE, FALSE, TRUE)
)

fnew(
  windows,
  type = "stratified_range",
  name = "visit_window",
  .other = "Outside window"
)

visit_df <- tibble(
  arm = c("ARM_A", "ARM_A", "ARM_B", "ARM_B", "ARM_C"),
  day = c(3, 35, 5, 40, 10)
) |> mutate(
  window = fputk(arm, day, format = "visit_window"),
)

visit_df


## -----------------------------------------------------------------------------
#| label: composite-keys
fnew(
  fmap(
    paste(
      c("BLOOD CHEMISTRY", "COAGULOGRAM", "COAGULATION PANEL", "COAGULOGRAM"),
      c("BLOOD",           "BLOOD",        "BLOOD",             "BLOOD"),
      c("ALB",             "FIBRINO",      "INR",               "INR"),
      c("g/L",             "g/L",           NA,                  NA),
      sep = "|"
    ),
    c("ALB", "FIBRINO", "INR", "INR")
  ),
  type = "character",
  name = "lb_param",
  ignore_case = TRUE,
  .other = NA
)

lab_df <- tibble(
  LBCAT = c("BLOOD CHEMISTRY", "COAGULOGRAM", "COAGULATION PANEL"),
  LBSPEC = c("BLOOD", "BLOOD", "BLOOD"),
  LBTESTCD = c("ALB", "INR", "INR"),
  LBSTRESU = c("g/L", NA, NA)
) |> mutate(
  PARAMCD = fputk(LBCAT, LBSPEC, LBTESTCD, LBSTRESU, format = "lb_param", na_as_string = TRUE)
)

lab_df


## -----------------------------------------------------------------------------
#| label: reverse-lookup
finput(
  fmap(
    paste(c("PLACEBO", "DRUG A", "DRUG B"), c("PBO", "A50", "B100"), sep = "|"),
    c(1L, 2L, 3L)
  ),
  target_type = "integer",
  name = "trt_code_inv"
)

trt_df <- tibble(
  ARMN = c("PLACEBO", "DRUG A", "DRUG B", "UNKNOWN"),
  TRTCD = c("PBO", "A50", "B100", "X")
) |> mutate(
  TRTSEQ = finputk(ARMN, TRTCD, invalue_name = "trt_code_inv")
)

trt_df


## -----------------------------------------------------------------------------
#| label: numeric-display
fnew("$%,.2f", type = "numeric", name = "currency")
fnew("%.1f%%", type = "numeric", name = "pct")

summary_df <- tibble(
  metric = c("Cost", "Response rate"),
  raw = c(1234.56, 0.153)
) |> mutate(
  display = c(fputn(raw[1], "currency"), fputn(raw[2] * 100, "pct"))
)

summary_df


## -----------------------------------------------------------------------------
stat_fmt <- fnew(
  #"currency"   = "sprintf('$%,.2f', .x1)", # Will not work!
  "currency"   = "formatC(.x1, digits = 2, big.mark = ',', format = 'f', decimal.mark = '.')",
  "pct" = "sprintf('%.1f%%', .x1 * 100)",
  name = "stat",
  type = "character"
)

summary_df <- tibble(
  metric = c("Cost", "Response rate"),
  raw = c(1234.56, 0.153),
  format = c("currency","pct")
) |> mutate(
  display = fput(format, stat_fmt, raw)
)

summary_df


## -----------------------------------------------------------------------------
#| label: operational-periods
fparse(text = '
VALUE study_period (date_range)
  [2024-01-01, 2024-02-01) = "Screening"
  [2024-02-01, 2024-06-01) = "Treatment"
  [2024-06-01, HIGH]       = "Follow-up"
  .missing                 = "No date"
;
')

obs_dates <- as.Date(c("2024-01-15", "2024-03-10", "2024-07-01", NA))
tibble(
  date = obs_dates,
  period = fput(obs_dates, "study_period")
)


## -----------------------------------------------------------------------------
#| label: narrative-fragments
fnew(
  "high" = "sprintf('Above threshold: %s', .x1)",
  "low" = "sprintf('Below threshold: %s', .x1)",
  name = "thr_note"
)

fput(c("high", "low"), "thr_note", c(18.2, 7.4))


## -----------------------------------------------------------------------------
fparse(text = '
VALUE sex (character)
  "M" = "Male"
  "F" = "Female"
  .missing = "Unknown"
  .other = "Other"
;

VALUE age_group (numeric)
  [0, 18)    = "Child"
  [18, 65)   = "Adult"
  [65, HIGH] = "Senior"
;
')


## -----------------------------------------------------------------------------
fparse(text = '
INVALUE sex_inv
  "Male" = "M"
  "Female" = "F"
  .missing = "U"
;
')


## -----------------------------------------------------------------------------
fparse(text = '
VALUE enrldt (date)
  pattern = "DATE9."
  .missing = "Not Enrolled"
;

VALUE visit_time (time)
  pattern = "TIME8."
;

VALUE stamp (datetime)
  pattern = "DATETIME20."
;
')


## -----------------------------------------------------------------------------
fparse(text = '
VALUE currency (numeric, pattern: "$%,.2f")
  .missing = "NO DATA"
;

VALUE pct (numeric, pattern: "%.1f%%")
;
')

tibble(
  raw = c(1234.56, -7890.12, 0, NA),
  currency = fputn(c(1234.56, -7890.12, 0, NA), "currency"),
  pct = fputn(c(0, 12.3, -4.5, NA), "pct")
)


## -----------------------------------------------------------------------------
fparse(text = '
VALUE study_period (date_range)
  [2024-01-01, 2024-02-01) = "Screening"
  [2024-02-01, 2024-06-01) = "Treatment"
  [2024-06-01, HIGH]       = "Follow-up"
;

VALUE shift (datetime_range)
  [2024-01-15 00:00, 2024-01-15 08:00) = "Night"
  [2024-01-15 08:00, 2024-01-15 16:00) = "Day"
  [2024-01-15 16:00, 2024-01-16 00:00) = "Evening"
;
')


## -----------------------------------------------------------------------------
fparse(text = '
VALUE visit_window (stratified_range, range_subtype: numeric)
  "ARM_A"|[0, 7)     = "Baseline"
  "ARM_A"|[7, 28)    = "Wk1-3"
  "ARM_B"|[0, 14)    = "Baseline"
  .other              = "Outside"
;
')


## -----------------------------------------------------------------------------
fnew("$%,.2f", type = "numeric", name = "currency_direct")
fputn(c(1234.56, -7890.12, 0), "currency_direct")


## -----------------------------------------------------------------------------
#| label: cleanup
fclear()