如何在 Shiny App 中的绘图中选择点后创建弹出窗口答案

【问题标题】：How to create a pop-up upon selection of points in a plot in a Shiny App如何在 Shiny App 中的绘图中选择点后创建弹出窗口
【发布时间】：2018-01-21 12:26:06
【问题描述】：

我有以下闪亮的应用程序：

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)

对我如何使其工作有任何想法吗？

【问题讨论】：

标签： r ggplot2 shiny modal-dialog

【解决方案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)

【讨论】：