Plotly Heatmap & Scatter Linked in Shiny Not Working in a Module - r

Question

Following the example at: https://plot.ly/r/shinyapp-linked-click/ I was able to in a blank shiny project get this working (correlation matrix linked to a scatter graph). However, when I do the same in a shiny module the event_data based click action doesnt seem to work (the scatter remains blank no mater what happens, seems like the click is not connecting).
My reproducible example is below, any ideas or solutions would be much appreciated.
library(plotly)
#### Define Modules ####
correlation_matrix_shinyUI <- function(id) {
ns <- NS(id)
mainPanel(
plotlyOutput(ns("corr_matrix"), height = '650px'),
plotlyOutput(ns("scatterplot"), height = '550px')
)
}
correlation_matrix_shiny <- function(input, output, session) {
data_df <- reactive({
mtcars
})
corr_data <- reactive({
if (is.null(data_df()))
return()
corr_data <- cor(data_df())
diag(corr_data) <- NA
corr_data <- round(corr_data, 4)
corr_data
})
corr_names <- reactive({
if (is.null(data_df()))
return()
corr_names <- colnames(data_df())
corr_names
})
output$corr_matrix <- renderPlotly({
if (is.null(corr_names()))
return()
if (is.null(corr_data()))
return()
g <- plot_ly(x = corr_names(), y = corr_names(), z = corr_data(),
key = corr_data(), type = "heatmap", source = "CORR_MATRIX", zmax = 1, zmin = -1)
g
})
output$scatterplot <- renderPlotly({
if (is.null(data_df()))
return()
data_use <- data_df()
s <- event_data("plotly_click", source = "CORR_MATRIX")
if (length(s)) {
vars <- c(s[["x"]], s[["y"]])
d <- setNames(data_use[vars], c("x", "y"))
yhat <- fitted(lm(y ~ x, data = d))
plot_ly(d, x = x, y = y, mode = "markers") %>%
plotly::add_trace(x = x, y = yhat, mode = "lines") %>%
plotly::layout(xaxis = list(title = s[["x"]]),
yaxis = list(title = s[["y"]]),
showlegend = FALSE)
} else {
plot_ly()
}
})
}
############ End Module Definition ######
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
),
correlation_matrix_shinyUI(id = "cor_module")
)
)
server <- function(input, output, session) {
callModule(correlation_matrix_shiny, id = "cor_module")
}
shinyApp(ui = ui, server = server)

Answer 1

Your question really is interesting. I will answer with some text passages from the shiny modules page.
Foremost, your problem is a scoping issue. In more detail:
[...] input, output, and session cannot be used to access inputs/outputs that are outside of the namespace, nor can they directly access reactive expressions and reactive values from elsewhere in the application [...]
In your module, you are trying to access the plotly-owned and therefore server-level variable event_data that is used to store click (or other) events. The plots react normal, as you could see if you'd add
observe({print(event_data("plotly_click", source = "CORR_MATRIX"))})
inside your server function (and outside of the module). But this kind of input was not defined directly within the correlation_matrix_shinyUI namespace and so it remains inaccessible.
These restrictions are by design, and they are important. The goal is not to prevent modules from interacting with their containing apps, but rather, to make these interactions explicit.
This is well meant, but in your case, you weren't really given the chance to assign a name to this variable, since plotly handles everything under its cover. Luckily, there is a way:
If a module needs to access an input that isn’t part of the module, the containing app should pass the input value wrapped in a reactive expression (i.e. reactive(...)):
callModule(myModule, "myModule1", reactive(input$checkbox1))
This of course goes a bit contrary to the whole modularization...
So, the way this can be fixed is to fetch the click event outside of the module and then send it as extra input to the callModule function. This part in the code may look a bit redundant, but I found this to be the only way it worked.
Well, the rest can be best explained by the code itself. Changes have only been made to the server function and inside the correlation_matrix_shiny, where the variable s is defined.
I hope this helps!
Best regards
Code:
library(plotly)
#### Define Modules ####
correlation_matrix_shinyUI <- function(id) {
ns <- NS(id)
mainPanel(
plotlyOutput(ns("corr_matrix"), height = '650px'),
plotlyOutput(ns("scatterplot"), height = '550px')
)
}
correlation_matrix_shiny <- function(input, output, session, plotlyEvent) {
data_df <- reactive({
mtcars
})
corr_data <- reactive({
if (is.null(data_df()))
return()
corr_data <- cor(data_df())
diag(corr_data) <- NA
corr_data <- round(corr_data, 4)
corr_data
})
corr_names <- reactive({
if (is.null(data_df()))
return()
corr_names <- colnames(data_df())
corr_names
})
output$corr_matrix <- renderPlotly({
if (is.null(corr_names()))
return()
if (is.null(corr_data()))
return()
g <- plot_ly(x = corr_names(), y = corr_names(), z = corr_data(),
key = corr_data(), type = "heatmap", source = "CORR_MATRIX", zmax = 1, zmin = -1)
g
})
output$scatterplot <- renderPlotly({
if (is.null(data_df()))
return()
data_use <- data_df()
s <- plotlyEvent()
if (length(s)) {
vars <- c(s[["x"]], s[["y"]])
d <- setNames(data_use[vars], c("x", "y"))
yhat <- fitted(lm(y ~ x, data = d))
plot_ly(d, x = x, y = y, mode = "markers") %>%
plotly::add_trace(x = x, y = yhat, mode = "lines") %>%
plotly::layout(xaxis = list(title = s[["x"]]),
yaxis = list(title = s[["y"]]),
showlegend = FALSE)
} else {
plot_ly()
}
})
}
############ End Module Definition ######
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
),
correlation_matrix_shinyUI(id = "cor_module")
)
))
server <- function(input, output, session) {
plotlyEvent <- reactive(event_data("plotly_click", source = "CORR_MATRIX"))
callModule(correlation_matrix_shiny, id = "cor_module", reactive(plotlyEvent()))
}
shinyApp(ui = ui, server = server)