Question

我有以下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)

现在，此表显示了我在图表上选择的点数。这有效，但是我想在你选择的东西后自动创建一个包含该数据的弹出窗口。所以我现在使用按钮“显示点”，然后输入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)

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

1 个答案: