在 Shiny 中链接的 Plotly 热图和散点不在模块中工作

Question

按照以下示例：https://plot.ly/r/shinyapp-linked-click/ 我能够在一个空白的闪亮项目中使它正常工作（相关矩阵链接到散点图）。但是，当我在闪亮的模块中执行相同操作时，基于 event_data 的点击操作似乎不起作用（无论发生什么情况，散点都保持空白，似乎点击没有连接）。

我的可重现示例如下，任何想法或解决方案将不胜感激。

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

你的问题真有意思。我会用 shiny modules page.

中的一些文字段落来回答

首先，您的问题是范围界定问题。更详细：

[...] 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 [...]

在您的模块中，您试图访问 plotly 拥有的服务器级变量 event_data，该变量用于存储点击（或其他）事件。绘图反应正常，如您所见，您是否添加

observe({print(event_data("plotly_click", source = "CORR_MATRIX"))})

在您的服务器功能内部（和模块外部）。但是这种输入没有直接在 correlation_matrix_shinyUI 命名空间中定义，因此仍然无法访问。

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.

这是好意，但在您的情况下，您实际上并没有机会为该变量分配名称，因为 plotly 处理其掩护下的所有内容。幸运的是，有一个方法：

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))

这当然有点违背整个模块化...

因此，解决此问题的方法是在模块外部获取点击事件，然后将其作为额外输入发送至 callModule 函数。代码中的这一部分可能看起来有点多余，但我发现这是唯一可行的方法。

好吧，其余的最好由代码本身来解释。仅对 server 函数和 correlation_matrix_shiny 函数内部进行了更改，其中定义了变量 s。

希望对您有所帮助！最好的问候

代码：

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)

在 Shiny 中链接的 Plotly 热图和散点不在模块中工作

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

module

r

shiny

plotly