---
title: "Table Gallery"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Table Gallery}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  eval = TRUE,
  comment = "#>"
)
```

<!-- Not creating vignette if gt is not installed. -->
`r if(!requireNamespace("gt")){"The system this vignette was built on did not have the required {gt} package installed. Please visit the package website for the full vignette. http://www.danieldsjoberg.com/gtsummary/articles/gallery.html"}`

```{r exit_early, include = FALSE, eval = !requireNamespace("gt")}
knitr::knit_exit()
```

<!-- Start of vignette -->
Gallery showing various tables possible with the {gtsummary} package.  If you have created an interesting table using {gtsummary}, please submit it to the gallery via a pull request to the [GitHub repository](https://github.com/ddsjoberg/gtsummary).

```{r setup, message = FALSE}
library(gtsummary); library(gt); library(survival)
library(dplyr); library(stringr); library(purrr); library(forcats)
```

---

## Summary Tables

Add a spanning header over the group columns for increased clarity, and modify column headers.
```{r}
trial[c("trt", "age", "grade")] %>%
  tbl_summary(by = trt, missing = "no") %>%
  modify_header(stat_by = md("**{level}** N =  {n} ({style_percent(p)}%)")) %>%
  add_n() %>%
  bold_labels() %>%
  as_gt() %>%
  tab_spanner(columns = starts_with("stat_"), md("**Chemotherapy Treatment**"))
```

---

Modify the function that formats the p-values, change variable labels, updating tumor response header, and add a correction for multiple testing.
```{r}
trial[!is.na(trial$response), c("response", "age", "grade")] %>%
  mutate(response = factor(response, labels = c("No Tumor Response", "Tumor Responded"))) %>%
  tbl_summary(
    by = response, 
    missing = "no",
    label = list(age ~ "Patient Age", grade ~ "Tumor Grade")
  ) %>%
  add_p(pvalue_fun = partial(style_pvalue, digits = 2)) %>%
  add_q()
```

---

Include missing tumor response as column using `fct_explicit_na()`.

```{r}
trial[c("response", "age", "grade")] %>%
  mutate(
    response = factor(response, labels = c("No Tumor Response", "Tumor Responded")) %>% 
      fct_explicit_na(na_level = "Missing Response Status")
  ) %>%
  tbl_summary(
    by = response, 
    label = list(age ~ "Patient Age", grade ~ "Tumor Grade")
  )  
```

---

Include p-values comparing all groups to a single reference group.

```{r}
# table summarizing data with no p-values
t0 <- trial %>%
  select(grade, age, response) %>%
  tbl_summary(by = grade, missing = "no") %>%
  modify_header(stat_by = md("**{level}**"))

# table comparing grade I and II
t1 <- trial %>%
  select(grade, age, response) %>%
  filter(grade %in% c("I", "II")) %>%
  tbl_summary(by = grade, missing = "no") %>%
  add_p() %>%
  modify_header(p.value = md("**I vs. II**"))

# table comparing grade I and II
t2 <- trial %>%
  select(grade, age, response) %>%
  filter(grade %in% c("I", "III")) %>%
  tbl_summary(by = grade, missing = "no") %>%
  add_p()  %>%
  modify_header(p.value = md("**I vs. III**"))

# merging the 3 tables together, and adding additional gt formatting
tbl_merge(list(t0, t1, t2)) %>%
  as_gt(include = -tab_spanner) %>%
  # hiding repeated summary columns
  cols_hide(columns = vars(stat_1_2, stat_2_2, stat_1_3, stat_2_3)) %>%
  # adding spanning headers for summary stats and pvalues
  tab_spanner(label = md("**Tumor Grade**"), columns = starts_with("stat_")) %>%
  tab_spanner(label = md("**p-value**"), columns = starts_with("p.value")) 
```

---

## Regression Tables

Include number of observations and the number of events in a univariate regression table.
```{r}
trial[c("response", "age", "grade")] %>%
  tbl_uvregression(
    method = glm,
    y = response, 
    method.args = list(family = binomial),
    exponentiate = TRUE
  ) %>%
  add_nevent()
```

---

Include two related models side-by-side with descriptive statistics.
```{r}
gt_r1 <- glm(response ~ age + trt, trial, family = binomial) %>%
  tbl_regression(exponentiate = TRUE)
gt_r2 <- coxph(Surv(ttdeath, death) ~ age + trt, trial) %>%
  tbl_regression(exponentiate = TRUE)
gt_t1 <- trial[c("age", "trt")] %>% tbl_summary(missing = "no") %>% add_n()

tbl_merge(
  list(gt_t1, gt_r1, gt_r2),
  tab_spanner = c("**Summary Statistics**", "**Tumor Response**", "**Time to Death**")
)
```

---

Include the number of events at each level of a categorical predictor.
```{r}
gt_model <-
  trial[c("ttdeath", "death", "stage", "grade")] %>%
  tbl_uvregression(
    method = coxph,
    y = Surv(ttdeath, death), 
    exponentiate = TRUE,
    hide_n = TRUE
  )

gt_eventn <-
  trial %>%
  filter(death ==  1) %>%
  select(stage, grade) %>%
  tbl_summary(
    statistic = all_categorical() ~ "{n}",
    label = list(vars(stage) ~ "T Stage", vars(grade) ~ "Grade")
  ) %>%
  modify_header(stat_0 = md("**Event N**"))

tbl_merge(list(gt_eventn, gt_model)) %>%
  bold_labels() %>%
  italicize_levels() %>%
  as_gt(include = -tab_spanner)
```

---

Regression model where the covariate remains the same, and the outcome changes.

```{r}
tbl_reg <-
  trial[c("age", "marker", "trt")] %>%
  tbl_uvregression(
    method = lm,
    x = trt,
    show_single_row = "trt",
    hide_n = TRUE
  ) %>%
  modify_header(
    label = md("**Model Outcome**"),
    estimate = md("**Treatment Coef.**")
  ) 

tbl_reg %>%
  as_gt() %>%
  tab_footnote(
    footnote = "Values larger than 0 indicate larger values in the Drug group.", 
    locations = cells_column_labels(columns = vars(estimate))
  )
```

Add descriptive statistics by treatment group to the table above to produce a table often reported two group comparisons.

```{r}
gt_sum <- 
  trial[c("age", "marker", "trt")] %>%
  mutate(trt = fct_rev(trt)) %>%
  tbl_summary(by = trt, 
              statistic = all_continuous() ~ "{mean} ({sd})",
              missing = "no") %>%
  add_n() %>%
  modify_header(stat_by = md("**{level}**"))


tbl_merge(list(gt_sum, tbl_reg))  %>%
  modify_header(estimate_2 = md("**Difference**")) %>%
  as_gt(include = -tab_spanner)
```

---

Implement a custom tidier to report Wald confidence intervals.
The Wald confidence intervals are calculated by passing the appropriate `confint()` function to `broom::confint_tidy()`.

```{r}
my_tidy <- function(x, exponentiate =  FALSE, conf.level = 0.95, ...) {
  dplyr::bind_cols(
    broom::tidy(x, exponentiate = exponentiate, conf.int = FALSE),
    broom::confint_tidy(x, func = stats::confint.default, conf.level = conf.level)
  )
}

lm(age ~ grade + marker, trial) %>%
  tbl_regression(tidy_fun = my_tidy)
```
