r - 如何在 Shiny App 的绘图中选择点时创建弹出窗口

Question

我有以下 Shiny 的应用程序:

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)

现在这张表显示了我在图表上选择的点。这行得通，但是我想在您选择某些内容后立即自动创建一个包含该数据的弹出窗口。所以我现在使用按钮“显示点”的功能，然后输入 brushedPoints(mtcars2, input$plot1_brush)

关于我如何让它工作有什么想法吗？

Answer 1

您可以创建一个包含“刷点”的 reactiveVal。这需要观察者在刷点发生变化时更新此 reactiveVal。然后我们可以创建另一个 observeEvent 来监听我们的 reactiveVal 的变化，并让它在选择新点时触发 modalDialog。希望这对您有所帮助!

顺便说一下，您也可以只让 observeEvent 监听 input$plot1_brush，但是您必须运行 brushedPoints(mtcars2, input$ plot1_brush) 两次，一次用于 renderText，一次用于 modalDialog，所以我建议使用 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)