Interactive dashboards Shiny
useR! 2022: Session 24, Web Frameworks
Agustin Calatroni
Wednesday, 22 June 2022
Abstract
RStudio’s
flexdashboardpackage is a powerful tool to create interactive dashboards in R using R Markdown. A variety of layouts can be quickly generated including multiple pages, storyboards, and commentaries, as well as embedded tabs and drop-down menus. Additionally, with minimal programming effort, the dashboards can be customized via pre-packaged themes or custom CSS. Dashboards can be further extended for user interactivity with tables and visualizations by judicious use of HTML widgets to create a standalone HTML file with no special client or server requirement. In this talk, we will present a workflow utilizing flexdashboard and leveraging the abilities of other individual packages, such astrelliscopejs,plotly,DT,reactable,leaflet,crosstalk, to create highly interactive clinical trial reports for data monitoring and/or statistical analyses results. By avoiding the use of shiny, these reports can be conveniently emailed, deployed on an internal company webpage, or added to GitHub pages for widespread accessibility. Demonstrations of dashboards will include those listed below as well as additional examples that have been developed for current clinical trials monitoring.
Interactivity
Crosstalk & Plotly
pacman::p_load(tidyverse)
pacman::p_load(crosstalk, plotly)
birth_data <- readRDS('dat/birth_data.rds')
birth_data_hi <- SharedData$new(birth_data %>% ungroup())
filter_select(id = "id",
label = "Select a site",
sharedData = birth_data_hi,
group = ~SITENAME,
multiple = FALSE)
gg <- ggplot(birth_data_hi) +
geom_line(aes(DATE_FLOOR, cumsum, group = SITENAME, color = name)) +
facet_wrap(~ origin) +
scale_colour_manual(values = c('#b2df8a','#fb9a99','#fdbf6f'),
guide = "none") +
labs(x = NULL,
y = 'Cumulative Data',
color = NULL) +
theme_bw(base_size = 12)+
theme(panel.grid.minor = element_blank(),
axis.ticks.y.right = element_blank(),
legend.position = "bottom")
ggplotly(gg,
dynamicTicks = TRUE,
width = 800,
height = 400,
tooltip = c("colour","x","y")) %>%
hide_legend() %>%
config(displayModeBar = F)echarts4r
m_data <- birth_data %>%
filter(origin != "Babies") %>%
select(-sum) %>%
pivot_wider(id_cols = c(SITENAME, DATE_FLOOR, origin),
names_from = name,
values_from = cumsum)
c1 <- m_data %>%
group_by(SITENAME) %>%
e_charts(x = DATE_FLOOR, timeline = TRUE,
elementId = "chart1",
height = '500px',
width = '500px') %>%
e_line(serie = `M-Consented`) %>%
e_line(serie = `M-Pre-Screen Eligible`) %>%
e_legend(FALSE) %>%
e_title("Mothers", left = 'center') %>%
e_tooltip(trigger = 'axis') %>%
e_datazoom(type = "slider", show = FALSE) %>%
e_tooltip(trigger = 'axis')
c2 <- birth_data %>%
filter(origin == "Babies") %>%
group_by(SITENAME) %>%
e_charts(x = DATE_FLOOR, timeline = TRUE,
elementId = "chart2",
height = '500px',
width = '500px') %>%
e_line(serie = cumsum,
name = 'B-Consented') %>%
e_legend(FALSE) %>%
e_title("Babies", left = 'center') %>%
e_tooltip(trigger = 'axis') %>%
e_timeline_opts(show = FALSE) %>%
e_datazoom(type = "slider") %>%
e_connect(c("chart1"))
e_arrange(c1, c2,
cols = 2, rows = 1,
width = '1000px',
height = '500px')Jelle Geertsma @rdatasculptor
Please take a look at what we made at @eelloo_nl using #rstats {flexdashboard}, {reactable} and @jdatap’s great {echarts4r}! https://t.co/g9jJtjWj0K #flexdashboard #reactable #echarts4r pic.twitter.com/5PN21wag38
— Jelle Geertsma (@rdatasculptor) August 17, 2021
Goodness, the things @rdatasculptor does with {echarts4r}! I didn’t even know this was possible. https://t.co/Fp3uysc5e5
— John Coene (@jdatap) March 12, 2022
trelliscopejs
pacman::p_load(tidyverse)
pacman::p_load(trelliscopejs)
pacman::p_load(plotly)
birth_data <- readRDS('dat/birth_data.rds')
gg <- birth_data %>%
ungroup() %>%
group_nest(SITENAME) %>%
rowwise() %>%
mutate(babies = max(data %>% filter(name == 'B-Consented') %>% pull(cumsum) ),
mothers = max(data %>% filter(name == 'M-Consented') %>% pull(cumsum) ),
gg = list( ggplot(data) +
geom_line(aes(DATE_FLOOR, cumsum, color = name)) +
facet_wrap(~ origin) +
scale_colour_manual(values = c('#b2df8a','#fb9a99','#fdbf6f'),
guide = "none") +
labs(x = NULL,
y = 'Cumulative Data',
color = NULL) +
theme_bw(base_size = 12)+
theme(panel.grid.minor = element_blank(),
axis.ticks.y.right = element_blank(),
legend.position = "bottom")),
plotly = list( ggplotly(gg,
dynamicTicks = TRUE,
width = 800,
height = 400,
tooltip = c("colour","x","y")) %>%
hide_legend() %>%
config(displayModeBar = F) ))
gg %>%
ungroup() %>%
trelliscope(name = 'Site Enrollement',
desc = 'Visualization w/ trelliscope',
panel_col = 'plotly',
path = './trelliscope',
ncol = 1,
nrow = 1,
height = 900,
width = 600,
state = list(sort = list(sort_spec('SITENAME'))))reactable
pacman::p_load(tidyverse)
pacman::p_load(reactable)
pacman::p_load(plotly)
birth_data <- readRDS('dat/birth_data.rds')
gg <- birth_data %>%
ungroup() %>%
group_nest(SITENAME) %>%
rowwise() %>%
mutate(mothers_pc = max(data %>% filter(name == 'M-Pre-Screen Eligible') %>% pull(cumsum) ),
mothers_c = max(data %>% filter(name == 'M-Consented') %>% pull(cumsum) ),
babies_c = max(data %>% filter(name == 'B-Consented') %>% pull(cumsum) ),
gg = list( ggplot(data) +
geom_line(aes(DATE_FLOOR, cumsum, color = name)) +
facet_wrap(~ origin) +
scale_colour_manual(values = c('#b2df8a','#fb9a99','#fdbf6f'),
guide = "none") +
labs(x = NULL,
y = 'Cumulative Data',
color = NULL) +
theme_bw(base_size = 12)+
theme(panel.grid.minor = element_blank(),
axis.ticks.y.right = element_blank(),
legend.position = "bottom")),
plotly = list( ggplotly(gg,
dynamicTicks = TRUE,
width = 800,
height = 400,
tooltip = c("colour","x","y")) %>%
hide_legend() %>%
config(displayModeBar = F) ))
gg_fig <- gg %>%
select(SITENAME, gg, plotly) %>%
ungroup()
gg %>%
select(SITENAME, mothers_pc, mothers_c , babies_c ) %>%
reactable(.,
bordered = TRUE,
highlight = TRUE,
searchable = FALSE,
pagination = FALSE,
fullWidth = TRUE,
height = 800,
columns = list(
SITENAME = colDef(filterable = TRUE),
mothers_pc = colDef(name = "Mothers"),
mothers_c = colDef(name = "Mothers"),
babies_c = colDef(name = "Babies")
),
columnGroups = list(
colGroup(name = "Pre-Consented", columns = c("mothers_pc")),
colGroup(name = "Consented", columns = c("mothers_c","babies_c"))
),
details = function(index) {
#htmltools::plotTag(gg_fig$gg[[index]])
htmltools::div(style = "padding-left: 80px",
gg_fig$plotly[[index]],
alt="figure",
width = 500, height = 250)
}
) %>%
reactablefmtr::google_font()leaflet
bsselectR
fantastic #rstats bsselectR: Add bootstrap-select dropdown menus to #rmarkdown docs without Shiny @kyle_e_walkerhttps://t.co/x4iW3rNcBx pic.twitter.com/p0BXfPvGy1
— Agustin Calatroni (@acalatr) January 4, 2017
pacman::p_load(tidyverse)
pacman::p_load(scales, ggtext)
pacman::p_load(trelliscopejs)
birth_data <- readRDS('dat/birth_data.rds')
for(i in unique(birth_data$SITENAME)){
dd <- birth_data %>%
filter(SITENAME == i) %>%
mutate(DATE_FLOOR = DATE_FLOOR %>% as.POSIXct())
ax <- dd %>%
group_by(origin, name) %>%
slice(n()) %>%
mutate(color = case_when(name == 'M-Consented' ~ '#fb9a99',
name == 'M-Pre-Screen Eligible' ~ '#fdbf6f',
name == 'B-Consented' ~ '#b2df8a'))
ggplot(data = dd,
aes(x = DATE_FLOOR, y = cumsum, group = name, color = name)) +
geom_line(size = 1) +
facet_wrap(~ origin) +
labs(x = NULL,
y = str_glue('Cumulative Numbers ({i})'),
color = NULL) +
scale_y_continuous(
sec.axis = dup_axis(
breaks = ax$cumsum,
labels = str_glue("<b style='color:{ax$color}'>**{ax$name}** (n={ax$cumsum})</b>"),
name = NULL
)) +
scale_x_datetime(date_breaks = "month",
labels = label_date_short()) +
scale_colour_manual(values = rev(c('#fdbf6f','#fb9a99','#b2df8a')),
guide = 'none') +
theme_bw() +
theme(panel.grid.minor = element_blank(),
axis.text.y.right= element_markdown(),
axis.ticks.y.right = element_blank())
ggsave(str_glue("bsselectR/{i}.png"),
plot = last_plot(),
scale = 4,
width = 750, height = 350, units = 'px')
}
#devtools::install_github("walkerke/bsselectR")
library(bsselectR)
plots_in <- str_glue("bsselectR/{unique(birth_data$SITENAME)}.png")
names(plots_in) <- unique(birth_data$SITENAME)
bsselect(plots_in,
frame_height = "400px", frame_width = "800px",
style = "btn-primary",
box_width = 'fit',
type = "img",
selected = "S-01",
live_search = TRUE,
show_tick = TRUE)Dashboard
flexdashboard
EXAMPLES
Risk factors for in-hospital mortality in laboratory-confirmed COVID-19
Continuous Glucose Monitoring (CGM) Visualization
Vasculitis Data Visualization
Clinical Trial Report
Thank You
github.com/agstn/UseR2022_dashboards
