plotly.R
plotly.R copied to clipboard
partial_bundle causes a Shiny app to fail when used in a module with only plotly outputs
The app below fails to render any of its outputs when I try to run it; the error message in my web browser's console says Uncaught ReferenceError: Plotly is not defined. I believe this is due to partial_bundle() being used when a plotly object is first rendered in a shiny module with renderPlotly().
When I was creating this example, I noticed that this bug did not appear if either of the following conditions were met:
- The plotly object that is rendered inside the shiny module for the first time didn't use
partial_bundle(), for example, if the initial render of the plot didn't usepartial_bundle()due to conditional logic - The app has a non-plotly output visible, inside or outside the module, when the app is first rendered
library(plotly) # 4.10.0
library(shiny) # 1.7.1
# Create dummy data
dummy_data = data.frame(
x = Sys.Date() + 1:nrow(iris),
y = iris$Sepal.Length,
Species = iris$Species
)
testUI <- function(id, scatter_name, bar_name) {
# Define the namespace for this module
ns = NS(id)
# Return the UI elements for this module
tagList(
plotlyOutput(ns(scatter_name)),
plotlyOutput(ns(bar_name))
)
}
testServer <- function(id, scatter_name, bar_name) {
moduleServer(
id,
function(input, output, session) {
output[[scatter_name]] = renderPlotly({
# req(selected_bars()) # This causes the entire app to fail to load if it is included
if(length(selected_bars()) == 0) {
iris %>%
plot_ly(
type = 'scatter',
mode = 'markers',
x = ~Sepal.Length,
y = ~Sepal.Width
) %>%
# Causes an error
partial_bundle(type = 'cartesian')
} else {
iris %>%
filter(Species %in% selected_bars()) %>%
plot_ly(
type = 'scatter',
mode = 'markers',
x = ~Sepal.Length,
y = ~Sepal.Width,
color = ~Species
) %>%
layout(showlegend = TRUE) %>%
# Does not cause an error
partial_bundle(type = 'cartesian')
}
})
output[[bar_name]] = renderPlotly({
dummy_data %>%
group_by(Species) %>%
summarise(
bar_val = mean(y)
) %>%
arrange(Species) %>% # This is required to mitigate issue #1657
plot_ly(
type = 'bar',
source = bar_name,
x = ~factor(Species, levels = Species[order(-bar_val)]),
y = ~bar_val,
opacity = ifelse(
.$Species %in% selected_bars() | length(selected_bars()) == 0,
1,
.2
),
split = ~Species,
showlegend = FALSE
)
})
# Track what bar(s) the user has selected via click
selected_bars = reactiveVal(value = character(), label = 'selected_bars')
mod_issue_bar_click = reactive({
event_data(event = 'plotly_click', source = bar_name, priority = 'event')$x
})
observeEvent(mod_issue_bar_click(), {
if(! mod_issue_bar_click() %in% selected_bars()) {
selected_bars(
c(
selected_bars(),
mod_issue_bar_click()
)
)
} else {
selected_bars(
selected_bars()[selected_bars() != mod_issue_bar_click()]
)
}
})
}
)
}
shinyApp(
ui = fluidPage(
testUI(
'test',
scatter_name = 'test_line',
bar_name = 'test_bar'
),
hr(), # Visually separates outputs from the module and those not from the module
plotlyOutput('dummy_plot')
# ,
# plotOutput('dummy_plot2')
),
server = function(input, output, session) {
testServer(
'test',
scatter_name = 'test_line',
bar_name = 'test_bar'
)
output$dummy_plot = renderPlotly({
iris %>%
plot_ly(
type = 'scatter',
mode = 'markers',
x = ~Sepal.Length,
y = ~Sepal.Width
)
})
# output$dummy_plot2 = renderPlot({
# plot(
# x = iris$Sepal.Length,
# y = iris$Sepal.Width,
# type = 'b'
# )
# })
}
)