R Shiny：如何打开弹出窗口 window 并显示依赖于 DT 数据表的行单击事件的图形

Question

我正在尝试根据 Shiny 中的点击事件创建弹出窗口 window。当用户单击 DT table 中的一行时，window 应该打开。它应该包含一个绘图图，由 df 中 v1 列中的行元素过滤（当单击带有 v1 == "B" 的行时，所有带有 v1 == "B" 的行进入图）。我可以创建所有对象（参见代码），但很难根据行单击事件进行依赖过滤和打开弹出窗口 window。

我是 Shiny 的新手，并尝试实现类似问题的片段，但我找不到我需要的东西并将所有东西放在一起。

library(shiny)
library(DT)
library(plotly)
library(dplyr)

id <- c(1:100)
v1 <- rep(LETTERS[1:10], times = 10)
v2 <- sample.int(100, 100)
v3 <- sample.int(200, 100)
v4 <- sample.int(300, 100)
v5 <- rep(c(2000:2019), times = 5)
df <- data.frame(id, v1, v2, v3, v4, v5)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      menuItem("first", tabName = "first"
      )
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(
        tabName = "first",
        box(width = 12, solidHeader = TRUE,
            DT::dataTableOutput("table"),
            plotlyOutput("plot")
        )
      )
    )
  )
)

server <- function(input, output) {
  
  output$table <- DT::renderDataTable({
    DT::datatable(df,
                  options = list(
                    pageLength = 10, paging = TRUE, searching = TRUE
                  ),
                  rownames = FALSE, selection = "single",
    )
  })
  
  # table_subset <- reactive({
  #     df %>% filter(v1 == "B")
  # })
  
  click_subset <- df %>% filter(v1 == "B")
  
  #Plot in popup window
  output$plot <- renderPlotly({
    plot_ly(click_subset, type = 'bar') %>%
      add_trace(
        x =~v5, y =~v3
      ) 
  })
}

shinyApp(ui, server)

Answer 1

我们可以使用 shiny 中的 modalDialog 函数在弹出窗口中显示绘图， input$tableID_rows_selected 筛选数据：

df_subset <- reactiveVal(NULL)

  observeEvent(input$table_rows_selected, {
    v1_value <- df[input$table_rows_selected, "v1"]
    df_subset(filter(df, v1 == v1_value))
    showModal(modalDialog(plotlyOutput("plot"), size = "m"))
  })

应用程序：

library(shiny)
library(DT)
library(plotly)
library(dplyr)
library(shinyWidgets)
library(shinydashboard)

id <- c(1:100)
v1 <- rep(LETTERS[1:10], times = 10)
v2 <- sample.int(100, 100)
v3 <- sample.int(200, 100)
v4 <- sample.int(300, 100)
v5 <- rep(c(2000:2019), times = 5)
df <- data.frame(id, v1, v2, v3, v4, v5)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      menuItem("first", tabName = "first")
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(
        tabName = "first",
        box(
          width = 12, solidHeader = TRUE,
          DT::dataTableOutput("table"),
          # plotlyOutput("plot")
        )
      )
    )
  )
)

server <- function(input, output) {
  df_subset <- reactiveVal(NULL)

  output$table <- DT::renderDataTable({
    DT::datatable(df,
      options = list(
        pageLength = 10, paging = TRUE, searching = TRUE
      ),
      rownames = FALSE, selection = "single",
    )
  })

  observeEvent(input$table_rows_selected, {
    v1_value <- df[input$table_rows_selected, "v1"]
    df_subset(filter(df, v1 == v1_value))
    showModal(modalDialog(plotlyOutput("plot"), size = "m"))
  })

  click_subset <- df %>% filter(v1 == "B")

  # Plot in popup window
  output$plot <- renderPlotly({
    req(df_subset)
    plot_ly(df_subset(), type = "bar") %>%
      add_trace(
        x = ~v5, y = ~v3
      )
  })
}

shinyApp(ui, server)

R Shiny：如何打开弹出窗口 window 并显示依赖于 DT 数据表的行单击事件的图形

R Shiny: How to open a popup window and show a graph that depends on row click event of DT datatable

datatable

popup

shiny

shinydashboard

dt