---
title: Vasculitis Data Visualization
author: Agustin Calatroni Wonderful-Wednesdays
date: "`r format(Sys.Date(), format='%a %d %b %Y')`"
output:
flexdashboard::flex_dashboard:
storyboard: true
self_contained: true
source_code: embed
editor_options:
markdown:
wrap: 72
---
```{=html}
```
```{r knitr-defaults, include=FALSE}
# div id = "htmlwidget-517a0f624b2519fadf46"
knitr::opts_chunk$set(warning = FALSE, message = FALSE, comment = NA)
knitr::opts_chunk$set(cache = FALSE)
options(width=170)
```
```{r import-data-raw, include=FALSE}
pacman::p_load(tidyverse, rio)
pacman::p_load(labelled)
vas_01 <- read.csv("https://raw.githubusercontent.com/VIS-SIG/Wonderful-Wednesdays/master/data/2021/2021-05-12/vas_data.csv")
var_label(vas_01) <- c(subject = 'Subject ID',
trt01pn = 'Randomised treatment (0 = Placebo; 1 = Treatment)',
ady = 'Study Day',
sym = 'Vasculitis symptom score',
dose = 'Oral Corticosteroid (OCS) dose',
rem = 'Subject in Remission, i.e. Vasculitis Symptom Score = 0 and OCS Dose <= 7.5 mg/day (Y/N)',
rel = 'Relapse Event (Y)',
acc_rem = 'Accrued Duration of Remission (Days)',
sus_rem = 'Subject Achieved Remission Within First 24 Weeks and Remained in Remission Until EOS? (Y/N))')
# 1 rec per subject
vas_per <- vas_01 %>%
distinct(subject, trt01pn, acc_rem, sus_rem) %>%
mutate(trt01pc = factor(trt01pn,
levels = c(1, 2),
labels = c("P","T")))
export(vas_per, "vas_per.rds")
# 1 rec per day
vas_vis <- vas_01 %>%
left_join(vas_per %>% select(subject, trt01pc)) %>%
select(subject, trt01pc, ady, sym, dose, rem, rel) %>%
mutate(across(c(rem, rel), ~ifelse(.x == 'Y', 1, 0))) %>%
drop_na(sym, dose)
export(vas_vis, "vas_vis.rds")
```
```{r import-data-derive, include=FALSE}
vas_per <- import("vas_per.rds")
vas_vis <- import("vas_vis.rds") %>%
filter(ady <= 420)
vas_per_extra <- vas_vis %>%
group_by(subject) %>%
summarize(n_ady = n(),
cumrem = sum(rem),
cumrel = sum(rel),
dose = median(dose),
sym = median(sym))
```
### **Individual** Longitudinal Visualization
```{r create-trelliscope}
pacman::p_load(trelliscopejs)
vas_per <- vas_per %>%
ungroup() %>%
select(subject, trt01pc) %>%
left_join( vas_per_extra ) %>%
as.data.frame()
vas_per <- set_labels(vas_per,
list(trt01pc = "Randomised treatment (P = Placebo & T = Treatment)",
n_ady = "# of Days in study",
cumrem = "# of Remission Days",
cumrel = "# of Relapse Days",
dose = "Median Oral Corticosteroid (OCS) dose",
sym = "Median Vasculitis symptom score"))
# source('vas-gif.r') # generate the vas-gif prior to include into trelliscope
vas_per %>%
mutate(panel_col = img_panel_local(str_glue('vas-subject-gif/subject_{subject}.gif'))) %>%
trelliscope(name = 'Vasculitis Visualization',
desc = 'Individual Trajectories for multiple outcomes',
panel_col = 'panel_col',
path = './vas-trelliscope',
ncol = 2,
nrow = 1,
state = list(sort = list(sort_spec("n_ady", dir = "desc")),
labels = c('sym', 'dose'))
)
```
------------------------------------------------------------------------
**Individual** Longitudinal Visualization. Patients randomized to active treatment or
placebo with an on-treatment period of 52 weeks and a subsequent 8 weeks off-treatment follow-up period.
**Panels**
**1** Vasculitis symptom score with a square root transformation to reduce right skewness in the score
**2** Oral Corticosteroid (OCS) dose with log(x+1) transformation to reduce right skewness in the dose
**3** Cumulative Remission Events (Remission is defined as Vasculitis Symptom Score = 0 and OCS Dose ≤ 7.5 mg/day)
**4** Cumulative Relapse Events (Relapse is defined as an acute flare-up of symptoms, usually requiring immediate treatment with high dose OCS treatment)
**What is Trelliscope?** Trelliscope is a powerful, scalable,
interactive approach to data visualization. The idea behind trelliscope
is strongly embedded in the small multiples or trellis display, where
data are split into groups and displayed into a grid. This technique is
especially suitable for visualizing large datasets and making
comparisons easier. Trelliscope was developed by [Ryan
Hafen](http://ryanhafen.com/) and further details can be found in
[Ryan's presentation: Modern Approaches to Data Exploration with Trellis
Display](http://slides.com/hafen/trelliscopejs) or in it's documentation
[trelliscopejs](https://hafen.github.io/trelliscopejs/)
Trelliscope makes small multiple displays come alive by providing the ability to interactively
set a specific grid, filter or sorting sort based on summary statistics computed for each group.
**n_ady**:# Days in study **dose** Median OCS dose **sym**Median Vasculitis symptom score **cumrem**: # Remission Days" **cumrel** # Relapse Days
### **Group** Longitudinal (Means & Ratios) Visualization
```{r reshape-calculate, eval=FALSE, include=FALSE}
pacman::p_load(emmeans)
vas_nest <- vas_vis %>%
group_by(subject) %>%
mutate(cumrem = cumsum(rem),
cumrel = cumsum(rel)) %>%
ungroup() %>%
nest_by(ady) %>%
mutate(sym_m = list(glm(sym ~ trt01pc, data = data, family = quasipoisson)),
sym_e = list(emmeans(sym_m, 'trt01pc', type = 'response')),
sym_d = list(bind_rows(summary(sym_e, adjust = 'none', infer = TRUE) %>%
as.data.frame(),
pairs(sym_e, reverse = TRUE) %>%
summary(adjust = 'none', infer = TRUE) %>%
as.data.frame() %>%
rename(trt01pc = contrast,
rate = ratio) ) )) %>%
mutate(dose_m = list(glm(log(dose+1) ~ trt01pc, data = data)),
dose_e = list(emmeans(dose_m, 'trt01pc', type = 'response')),
dose_d = list(bind_rows(summary(dose_e, adjust = 'none', infer = TRUE) %>%
as.data.frame(),
pairs(dose_e, reverse = TRUE) %>%
summary(adjust = 'none', infer = TRUE) %>%
as.data.frame() %>%
rename(trt01pc = contrast,
response = ratio)) %>%
rename(rate = response) ) ) %>%
mutate(cumrem_m = list(glm(cumrem ~ trt01pc, data = data, family = quasipoisson)),
cumrem_e = list(emmeans(cumrem_m, 'trt01pc', type = 'response')),
cumrem_d = list(bind_rows(summary(cumrem_e, adjust = 'none', infer = TRUE) %>%
as.data.frame(),
pairs(cumrem_e, reverse = TRUE) %>%
summary(adjust = 'none', infer = TRUE) %>%
as.data.frame() %>%
rename(trt01pc = contrast,
rate = ratio) ) )) %>%
mutate(cumrel_m = list(glm(cumrel ~ trt01pc, data = data, family = quasipoisson)),
cumrel_e = list(emmeans(cumrel_m, 'trt01pc', type = 'response')),
cumrel_d = list(bind_rows(summary(cumrel_e, adjust = 'none', infer = TRUE) %>%
as.data.frame(),
pairs(cumrel_e, reverse = TRUE) %>%
summary(adjust = 'none', infer = TRUE) %>%
as.data.frame() %>%
rename(trt01pc = contrast,
rate = ratio) ) ))
```
```{r reshape-long & ref-line, eval=FALSE, include=FALSE}
vas_glm <- vas_nest %>%
select(ady, ends_with('_d')) %>%
pivot_longer(cols = -1) %>%
unnest(value) %>%
mutate(name2 = ifelse(trt01pc %in% c('P','T'), 'mean', 'diff') %>%
as.factor() %>%
fct_relevel('mean','diff')) %>%
mutate(name = factor(name) %>%
fct_relevel('sym_d','dose_d','cumrem_d','cumrel_d')) %>%
mutate(time = case_when(ady<168 ~ "a",
ady<365 ~ "b",
TRUE ~ "c")) %>%
mutate(rate = ifelse(name == 'cumrel_d' & ady < 14 & trt01pc %in% c('P','T'), 0.01, rate),
rate = ifelse(name == 'cumrel_d' & ady < 14 & !(trt01pc %in% c('P','T')), 1, rate),
SE = ifelse(name == 'cumrel_d' & ady < 14 & trt01pc %in% c('P','T'), 0, SE),
asymp.LCL = ifelse(name == 'cumrel_d' & ady < 14 & !(trt01pc %in% c('P','T')), 1, asymp.LCL),
asymp.UCL = ifelse(name == 'cumrel_d' & ady < 14 & !(trt01pc %in% c('P','T')), 1, asymp.UCL))
export(vas_glm, 'vas_glm.rds')
```
```{r import-glm}
vas_glm <- import('vas_glm.rds')
ref_df <- crossing(name = c('sym_d','dose_d','cumrem_d','cumrel_d'),
name2 = c('mean','diff'),
time = c('a','b','c'),
ref = 1) %>%
as.data.frame() %>%
mutate(name = as.factor(name) %>% fct_relevel('sym_d','dose_d','cumrem_d','cumrel_d'),
name2 = as.factor(name2) %>% fct_relevel('mean','diff')) %>%
filter(name2 != 'mean')
axs_df <- crossing(name = c('sym_d','dose_d','cumrem_d','cumrel_d'),
name2 = c('mean','diff'),
nesting( ady = c(1, 168, 365, 420),
txt = c('a','b','c','d') )) %>%
as.data.frame() %>%
mutate(name = as.factor(name) %>% fct_relevel('sym_d','dose_d','cumrem_d','cumrel_d'),
name2 = as.factor(name2) %>% fct_relevel('mean','diff')) %>%
filter(name2 == 'mean') %>%
filter(name == 'sym_d')
```
```{r fig-1}
pacman::p_load(ggh4x, ggtext)
vas_l_l <- vas_glm %>%
group_by(name, name2, trt01pc) %>%
slice(n()) %>%
select(ady, name, name2, trt01pc, rate) %>%
mutate(color = case_when(trt01pc == 'T' ~ '#1b9e77',
trt01pc == 'P' ~ '#d95f02',
trt01pc == 'T / P' ~ '#7f7f7f'))
vas_l_l_s <- vas_l_l %>% filter(name == 'sym_d', trt01pc %in% c('T','P'))
vas_l_l_s2 <- vas_l_l %>% filter(name == 'sym_d', trt01pc %in% c('T / P'))
vas_l_l_d <- vas_l_l %>% filter(name == 'dose_d', trt01pc %in% c('T','P'))
vas_l_l_d2 <- vas_l_l %>% filter(name == 'dose_d', trt01pc %in% c('T / P'))
vas_l_l_c <- vas_l_l %>% filter(name == 'cumrem_d', trt01pc %in% c('T','P'))
vas_l_l_c2 <- vas_l_l %>% filter(name == 'cumrem_d', trt01pc %in% c('T / P'))
vas_l_l_cl <- vas_l_l %>% filter(name == 'cumrel_d', trt01pc %in% c('T','P'))
vas_l_l_cl2 <- vas_l_l %>% filter(name == 'cumrel_d', trt01pc %in% c('T / P'))
f1 <- ggplot(data = vas_glm,
aes(x = ady, y =rate, color = trt01pc, fill = trt01pc)) +
geom_hline(data = ref_df,
aes(yintercept = ref),
col = 'gray25') +
geom_vline(xintercept = c(168, 365), col = 'gray65') +
geom_line() +
geom_ribbon(data = . %>% filter(name2 == 'mean'),
aes(ymin=rate-SE, ymax=rate+SE),
alpha=0.5, colour = NA) +
geom_ribbon(data = . %>% filter(name2 == 'diff'),
aes(ymin=asymp.LCL, ymax=asymp.UCL),
alpha=0.5, colour = NA) +
geom_segment(data = axs_df,
x = 1, xend = 365, y = 5.0, yend = 5.0,
arrow = arrow(length = unit(0.08, "native"), type = "closed"),
inherit.aes = FALSE) +
geom_label(data = axs_df,
x = 168, label = "On Treatment",
y = 5.4,
size = 3,
inherit.aes = FALSE) +
geom_segment(data = axs_df,
x = 366, xend = 420, y = 5.0, yend = 5.0,
arrow = arrow(length = unit(0.08, "native"), type = "closed"),
inherit.aes = FALSE) +
geom_label(data = axs_df,
x = 390, label = "Off Treatment",
y = 5.4,
size = 3,
inherit.aes = FALSE) +
coord_cartesian(clip = "off") +
facet_nested_wrap(vars(name, name2),
dir = 'v',
strip.position = "left",
ncol = 1,
scales = 'free_y',
labeller = as_labeller(c(sym_d = "Vasculitis Symptom Score",
dose_d = "Oral Corticosteroid Dose",
cumrem_d = "Remission Event (cumulative)",
cumrel_d = "Relapse Event (cumulative)",
mean = 'Means',
diff = 'Ratio'))
) +
facetted_pos_scales(y =list(
scale_y_continuous(limits = c(0.5, 4.5),
minor_breaks = NULL,
sec.axis = dup_axis(
breaks = vas_l_l_s %>% pull(rate),
labels = str_glue("{vas_l_l_s$trt01pc }"),
name = NULL
)),
scale_y_continuous(limits = c(0.25, 4.5),
trans = "log10",
minor_breaks = NULL,
sec.axis = dup_axis(
breaks = vas_l_l_s2 %>% pull(rate),
labels = str_glue("{vas_l_l_s2$trt01pc }"),
name = NULL
)),
scale_y_continuous(limits = c(3.5, 15.2),
minor_breaks = NULL,
sec.axis = dup_axis(
breaks = vas_l_l_d %>% pull(rate),
labels = str_glue("{vas_l_l_s$trt01pc }"),
name = NULL
)),
scale_y_continuous(limits = c(0.30, 2.0),
trans = "log10",
minor_breaks = NULL,
sec.axis = dup_axis(
breaks = vas_l_l_d2 %>% pull(rate),
labels = str_glue("{vas_l_l_s2$trt01pc }"),
name = NULL
)),
scale_y_continuous(limits = c(0, 205),
minor_breaks = NULL,
sec.axis = dup_axis(
breaks = vas_l_l_c %>% pull(rate),
labels = str_glue("{vas_l_l_s$trt01pc }"),
name = NULL
)),
scale_y_continuous(limits = c(0.2, 11),
trans = "log10",
minor_breaks = NULL,
sec.axis = dup_axis(
breaks = vas_l_l_c2 %>% pull(rate),
labels = str_glue("{vas_l_l_s2$trt01pc }"),
name = NULL
)),
scale_y_continuous(limits = c(0, 3.0),
minor_breaks = NULL,
sec.axis = dup_axis(
breaks = vas_l_l_cl %>% pull(rate),
labels = str_glue("{vas_l_l_s$trt01pc }"),
name = NULL
)),
scale_y_continuous(limits = c(0.10, 5.0),
trans = "log10",
minor_breaks = NULL,
sec.axis = dup_axis(
breaks = vas_l_l_cl2 %>% pull(rate),
labels = str_glue("{vas_l_l_s2$trt01pc }"),
name = NULL
)))
) +
scale_color_manual(values = c('T' = '#1b9e77',
'P' = '#d95f02',
'T / P' = '#7f7f7f'),
guide = FALSE) +
scale_fill_manual(values = c('T' = '#1b9e77',
'P' = '#d95f02',
'T / P' = '#7f7f7f')) +
scale_x_continuous(name = "Study Day",
limits = c(0, 420),
breaks = c(1, 168, 365, 420),
labels = c("1", "168 days\n 24 wks", "365 days\n 52 wks", "420 days\n 60 wks"),
expand = c(0.01, 0.01),
minor_breaks = NULL) +
labs(y = NULL) +
theme_bw(base_size = 10) +
theme(
plot.margin = unit(c(1.5, 0.5, 0.5, 0.5), units="lines"),
legend.position = "none",
strip.placement = "outside",
axis.text.x = element_text(hjust = 1),
axis.text.y.right= element_markdown()
)
```
```{r fig-2}
f2 <- ggplot(data = vas_glm ,
aes(y = rate, fill = trt01pc)) +
geom_hline(data = ref_df,
aes(yintercept = ref),
col = 'gray25') +
geom_boxplot(varwidth = TRUE, alpha = 0.5, outlier.shape = NA) +
facet_nested(rows = vars(name,name2),
cols = vars(time),
scales = 'free_y',
labeller = as_labeller(c(sym_d = "Vasculitis Symptom Score",
dose_d = "Oral Corticosteroid Dose",
cumrem_d = "Remission Event (cumulative)",
cumrel_d = "Relapse Event (cumulative)",
mean = 'Means',
diff = 'Ratio',
a = '0-24 wks',
b = '24-52 wks',
c = '52-60 wks'))
) +
facetted_pos_scales(y =list(
scale_y_continuous(limits = c(0.5, 4.5),
minor_breaks = NULL),
scale_y_continuous(limits = c(0.25, 4.5),
trans = "log10",
minor_breaks = NULL),
scale_y_continuous(limits = c(3.5, 15.2),
minor_breaks = NULL),
scale_y_continuous(limits = c(0.30, 2.0),
trans = "log10",
minor_breaks = NULL),
scale_y_continuous(limits = c(0, 205),
minor_breaks = NULL),
scale_y_continuous(limits = c(0.2, 11),
trans = "log10",
minor_breaks = NULL),
scale_y_continuous(limits = c(0, 3.0),
minor_breaks = NULL),
scale_y_continuous(limits = c(0.10, 5.0),
trans = "log10",
minor_breaks = NULL))
) +
scale_color_manual(values = c('T' = '#1b9e77',
'P' = '#d95f02',
'T / P' = '#7f7f7f'),
guide = FALSE) +
scale_fill_manual(values = c('T' = '#1b9e77',
'P' = '#d95f02',
'T / P' = '#7f7f7f'),
labels = c("P",
"T",
"Ratio")) +
labs(y = NULL,
fill = NULL) +
theme_bw(base_size = 10) +
theme(
legend.position = "none",
strip.placement = "outside",
axis.title.x=element_blank(),
axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank()
)
```
```{r fig-comb, fig.width = 14, fig.height = 8, dpi = 300}
pacman::p_load(patchwork)
f1 + f2 +
plot_layout(widths = c(4, 1.5))
```
------------------------------------------------------------------------
**Vasculitis Symptom Score**
**Means Panel** presents the active treatment and
placebo over the 52 weeks on treatment and 8 weeks off treatment follow-up period.
Darker lines represent the daily means and shaded area are 1+/- Standard Error of the mean.
**Ratio Panel** lines represent the daily ratio of the active treatment to placebo, with their associated 95% confidence intervals represented by the shaded area. Both the daily means (SE) and ratios (95% CI) were obtain from a overdispersed corrected poisson regression.
**Oral Corticosteroid (OCS) dose**
**Means Panel** lines represent the daily geometric means for the active treatment and
placebo with their associated +/- SE.
**Ratio Panel** daily ratio of geometric means with their associated 95% confidence intervals. When the upper CI doesn't
overlap with the 1 horizontal line we conclude there is significant effect. Both the daily geometric means (SE) and
ratios were obtain from a log + 1 OCS transformed linear regression.
**Remission Event & Relapse Event (cumulative)** **Means** daily cumulative events (+/- SE) **Ratio** the daily ratio (95%) of treatment to placebo. These models were also generated using and overdispered poisson regression.
**Boxplots** are the marginal effects of each panel at different times thought the study: **0 to 24 weeks** (early on-treatment period) **24 to 52 weeks** (later on-treatment period) **52 to 60 weeks** (8 weeks of off-treatment follow-up period)
### **Group** Longitudinal (Means & Ratios) Visualization (Animated)
```{r include-gif}
# source('fig-gif.r') # generate the fig-gif prior to include
knitr::include_graphics("vas-fig-gif.gif")
```
------------------------------------------------------------------------
Extends previous static result figure by including animation
### **Group** (Means & Ratios) Descriptive Statistics Table
```{r gtsummary-table}
pacman::p_load(gtsummary)
t_1 <- vas_glm %>%
filter(name == 'sym_d') %>%
select(trt01pc, `Vasculitis symptom score` = rate, time) %>%
mutate(time = factor(time, labels = c('0-24 wks','24-52 wks','52-60 wks'))) %>%
tbl_strata(
strata = time,
.tbl_fun = ~.x %>% tbl_summary(by = 'trt01pc',
type = all_continuous() ~ "continuous2",
statistic = list(all_continuous2() ~ c("{median}",
"{p25}, {p75}",
"{min} - {max}"))
)
)
t_2 <- vas_glm %>%
filter(name == 'dose_d') %>%
select(trt01pc, `Oral Corticosteroid dose` = rate, time) %>%
mutate(time = factor(time, labels = c('0-24 wks','24-52 wks','52-60 wks'))) %>%
tbl_strata(
strata = time,
.tbl_fun = ~.x %>% tbl_summary(by = 'trt01pc',
type = all_continuous() ~ "continuous2",
statistic = list(all_continuous2() ~ c("{median}",
"{p25}, {p75}",
"{min} - {max}"))
)
)
t_3 <- vas_glm %>%
filter(name == 'cumrem_d') %>%
select(trt01pc, `Remission Event (cumulative)` = rate, time) %>%
mutate(time = factor(time, labels = c('0-24 wks','24-52 wks','52-60 wks'))) %>%
tbl_strata(
strata = time,
.tbl_fun = ~.x %>% tbl_summary(by = 'trt01pc',
digits = all_continuous() ~ 1,
type = all_continuous() ~ "continuous2",
statistic = list(all_continuous2() ~ c("{median}",
"{p25}, {p75}",
"{min} - {max}"))
)
)
t_4 <- vas_glm %>%
filter(name == 'cumrel_d') %>%
select(trt01pc, `Relapse Event (cumulative)` = rate, time) %>%
mutate(time = factor(time, labels = c('0-24 wks','24-52 wks','52-60 wks'))) %>%
tbl_strata(
strata = time,
.tbl_fun = ~.x %>% tbl_summary(by = 'trt01pc',
type = all_continuous() ~ "continuous2",
statistic = list(all_continuous2() ~ c("{median}",
"{p25}, {p75}",
"{min} - {max}"))
)
)
tbl_stack(tbls = list(t_1, t_2, t_3, t_4)) %>%
modify_header(update = list(label ~ "**Descriptive Statistics**")) %>%
bold_labels()
```
------------------------------------------------------------------------
Representation of the **boxplot** panels in table format. In particular we show means, IQR (25% & 75% percentile), and
minimum and maximum for each phase of the study, **0 to 24 weeks** (early on-treatment period), **24 to 52 weeks** (later on-treatment period) and **52 to 60 weeks** (8 weeks of off-treatment follow-up period)
