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)