RTF Examples for Efficacy Tables

#' The function assume 1 or 2 column.
#'   If there is only 1 column, only represent mean
#'   If there are 2 column, represent mean (sd) or mean(se)
#' Decimals will understand the number will be formatted as x.x(x.xx)
#' @noRd
fmt_est <- function(data, columns = c("mean", "sd"), decimals = c(1, 2)) {
  .mean <- formatC(data[[columns[[1]]]], digits = decimals[1], format = "f", flag = "0")
  if (length(columns) > 1) {
    .sd <- formatC(data[[columns[[2]]]], digits = decimals[2], format = "f", flag = "0")
    paste0(.mean, " (", .sd, ")")
  } else {
    .mean
  }
}

#' @noRd
fmt_ci <- function(data, columns = c("lower.CL", "upper.CL"), decimals = 2) {
  .lower <- formatC(data[[columns[[1]]]], digits = decimals, format = "f", flag = "0")
  .upper <- formatC(data[[columns[[2]]]], digits = decimals, format = "f", flag = "0")
  paste0("(", .lower, ", ", .upper, ")")
}

#' @noRd
fmt_pval <- function(data, columns = "p.value", decimals = 3) {
  scale <- 10^(-1 * decimals)
  p_scale <- paste0("<", scale)
  if_else(data[[columns[[1]]]] < scale, p_scale,
    formatC(data[[columns[[1]]]], digits = decimals, format = "f", flag = "0")
  )
}

data("r2rtf_HAMD17")
HAMD17 <- r2rtf_HAMD17

ana_week <- 8 # Analysis Week

HAMD17_lmfit <- HAMD17 %>%
  filter(week == ana_week) %>%
  lm(change ~ basval + TRT, data = .)

t11 <- HAMD17 %>%
  filter(week == ana_week) %>%
  group_by(TRT) %>%
  summarise(
    N = n(),
    mean_bl = mean(basval),
    sd_bl = sd(basval),
    mean = mean(change),
    sd = sd(change)
  )

t12 <- emmeans(HAMD17_lmfit, "TRT")
t1 <- merge(t11, t12) %>%
  mutate(emmean_sd = SE * sqrt(df)) %>%
  mutate(
    Trt = c("Study Drug", "Placebo"),
    N1 = N,
    Mean1 = fmt_est(., c("mean_bl", "sd_bl")),
    N2 = N,
    Mean2 = fmt_est(., c("mean", "sd")),
    N3 = N,
    Mean3 = fmt_est(., c("emmean", "emmean_sd")),
    CI = paste(fmt_est(., "emmean"), fmt_ci(., c("lower.CL", "upper.CL")))
  ) %>%
  select(Trt:CI)

knitr::kable(t1)

t2 <- data.frame(pairs(t12))

t2 <- t2 %>%
  mutate(
    lower = estimate - 1.96 * SE,
    upper = estimate + 1.96 * SE
  ) %>%
  mutate(
    comp = "Study Drug vs. Placebo",
    mean = paste(fmt_est(., "estimate"), fmt_ci(., c("lower", "upper"))),
    p = fmt_pval(., "p.value")
  ) %>%
  select(comp:p)

knitr::kable(t2)

t3 <- data.frame(rmse = paste0(
  "Root Mean Squared Error of Change = ",
  formatC(sd(HAMD17_lmfit$residuals), digits = 2, format = "f", flag = "0")
))

knitr::kable(t3)

tbl_1 <- t1 %>%
  rtf_title(
    title = "ANCOVA of Change from Baseline at Week 20",
    subtitle = c(
      "Missing Data Approach",
      "Analysis Population"
    )
  ) %>%
  rtf_colheader(
    colheader = " | Baseline | Week 20 | Change from Baseline",
    col_rel_width = c(3, 4, 4, 9)
  ) %>%
  rtf_colheader(
    colheader = "Treatment | N | Mean (SD) | N | Mean (SD) | N | Mean (SD) | LS Mean (95% CI){^a}",
    col_rel_width = c(3, 1, 3, 1, 3, 1, 3, 5)
  ) %>%
  rtf_body(
    col_rel_width = c(3, 1, 3, 1, 3, 1, 3, 5),
    text_justification = c("l", rep("c", 7)),
    last_row = FALSE
  ) %>%
  rtf_footnote(
    footnote = c(
      "{^a}Based on an ANCOVA model.",
      "ANCOVA = Analysis of Covariance, CI = Confidence Interval, LS = Least Squares, SD = Standard Deviation"
    )
  ) %>%
  rtf_source(
    source = "Source: [study999: adam-adeff]"
  )

tbl_2 <- t2 %>%
  rtf_colheader(
    colheader = "Pairwise Comparison | Difference in LS Mean (95% CI){^a} | p-Value",
    text_justification = c("l", "c", "c"),
    col_rel_width = c(8, 7, 5)
  ) %>%
  rtf_body(
    col_rel_width = c(8, 7, 5),
    text_justification = c("l", "c", "c"),
    last_row = FALSE
  )

tbl_3 <- t3 %>%
  rtf_body(
    as_colheader = FALSE,
    col_rel_width = c(1),
    text_justification = "l"
  )

tbl <- list(tbl_1, tbl_2, tbl_3)

knitr::kable(tbl)

# Output .rtf file
tbl %>%
  rtf_encode() %>%
  write_rtf("rtf/efficacy_example.rtf")