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

Question

im trying to create a popup window depending on a click event in Shiny. The window should open up when the user clicks on a row in a DT table. It should contain a plotly graph, that is filtered by the row element in column v1 in df (when a row with v1 == "B" was clicked, all rows with v1 == "B" go in the graph). I can create all objects (see code), but struggle with dependent filtering and opening the popup window based on row click event.

I'm new to Shiny and tried to implement snippets from similar questions, but i couldn't find exactly what i need and bring everything together.

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

We can use modalDialog function from shiny to show the plot in a pop-up and input$tableID_rows_selected to filter the data:

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

App:

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)