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，和session不能用于访问输入/输出是命名空间的外侧，也不能直接访问的反应性表达式和抗值从其他地方应用程序[012]

在您的模块中，您尝试访问用于存储点击（或其他）事件的标准拥有服务器级变量event_data。这些图反应正常，你可以看到如果你添加

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

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

这些限制是有意设计的，它们很重要。目标不是阻止模块与其包含的应用程序交互，而是为了明确这些交互。

这是很好的意思，但在你的情况下，你并没有真正有机会给这个变量指定一个名字，因为plotly处理它封面下的所有东西。幸运的是，有一种方法：

如果一个模块需要访问的输入不是模块的一部分，该含应用应该通过包裹在一个反应​​性表达的输入值（即，反应性（... ））：

callModule(myModule, "myModule1", reactive(input$checkbox1))

这当然去有点违背了全模块化...

因此，这可以固定的方式是将模块之外获取点击事件然后将其作为extr发送输入到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)