How to create a pop-up upon selection of points in a plot in a Shiny App

Question

I have the following Shiny Application:

library(ggplot2)
library(Cairo)   # For nicer ggplot2 output when deployed on Linux

mtcars2 <- mtcars[, c("mpg", "cyl", "disp", "hp", "wt", "am", "gear")]


ui <- fluidPage(
  fluidRow(
    column(width = 4,
           plotOutput("plot1", height = 300,
                      # Equivalent to: click = clickOpts(id = "plot_click")
                      click = "plot1_click",
                      brush = brushOpts(
                        id = "plot1_brush"
                      )
           )
    )
  ),
  fluidRow(
    column(width = 6
    ),
    column(width = 6,
           actionButton("show", "Show points"),
           verbatimTextOutput("brush_info")
    )
  )
)

server <- function(input, output) {
  output$plot1 <- renderPlot({
    ggplot(mtcars2, aes(wt, mpg)) + geom_point()
  })

  observeEvent(input$show, {
    showModal(modalDialog(
      title = "Important message",
      "This is an important message!",
      easyClose = TRUE
    ))
  })

  output$click_info <- renderPrint({
    # Because it's a ggplot2, we don't need to supply xvar or yvar; if this
    # were a base graphics plot, we'd need those.
    nearPoints(mtcars2, input$plot1_click, addDist = TRUE)
  })

  output$brush_info <- renderPrint({
    brushedPoints(mtcars2, input$plot1_brush)
  })
}

shinyApp(ui, server)

Right now this table shows me the points I have selected on the graph. This works, however I would like to automatically create a popup with that data as soon you have selected something. So the functionality I have right now with the button "Show points" but then with the input of the brushedPoints(mtcars2, input$plot1_brush)

Any thoughts on how I get this working?

Answer 1

You can create a reactiveVal that contains the 'brushed points'. This requires an observer that updates this reactiveVal whenever the brushed points change. We can then create another observeEvent that listens to changes in our reactiveVal and make it trigger a modalDialog whenever new points are selected. Hope this helps!

By the way, you could also just let the observeEvent listen to input$plot1_brush, but then you would have to run brushedPoints(mtcars2, input$plot1_brush) twice, once for the renderText and once for the modalDialog, so I would suggest the approach with reactiveVal.

library(ggplot2)
library(Cairo)   # For nicer ggplot2 output when deployed on Linux

mtcars2 <- mtcars[, c("mpg", "cyl", "disp", "hp", "wt", "am", "gear")]

ui <- fluidPage(
  fluidRow(
    column(width = 4,
           plotOutput("plot1", height = 300,
                      # Equivalent to: click = clickOpts(id = "plot_click")
                      click = "plot1_click",
                      brush = brushOpts(
                        id = "plot1_brush"
                      )
           )
    )
  ),
  fluidRow(
    column(width = 6
    ),
    column(width = 6,
           verbatimTextOutput("brush_info")
    )
  )
)

server <- function(input, output) {
  output$plot1 <- renderPlot({
    ggplot(mtcars2, aes(wt, mpg)) + geom_point()
  })

  selected_points <- reactiveVal()

  # update the reactiveVal whenever input$plot1_brush changes, i.e. new points are selected.
  observeEvent(input$plot1_brush,{
    selected_points( brushedPoints(mtcars2, input$plot1_brush))
  })

  # show a modal dialog
  observeEvent(selected_points(), ignoreInit=T,ignoreNULL = T, {
    if(nrow(selected_points())>0){
    showModal(modalDialog(
      title = "Important message",
      paste0("You have selected: ",paste0(rownames(selected_points()),collapse=', ')),
      easyClose = TRUE
    ))
    }
  })

  output$brush_info <- renderPrint({
    selected_points()
  })

  output$click_info <- renderPrint({
    nearPoints(mtcars2, input$plot1_click, addDist = TRUE)
  })
}

shinyApp(ui, server)