r - 避免在 Shiny 的情况下双重刷新情节

Question

在 Shiny 的图中，我试图突出显示与单击点匹配的点(基于nearPoints() 和单击)。

这确实有效。然而， Shiny 应用程序的 react 部分刷新了两次，第二次迭代似乎清除了点击的信息。

如何避免应用的第二次刷新？

这是 MWE:

library("Cairo")
library("ggplot2")
library("shiny")

ui <- fluidPage(
  fluidRow(
    titlePanel('Phenotype Plots')
  ),

  fluidRow(
    uiOutput("plotui")
  ),

  hr(),

  fluidRow(

    wellPanel(
      h4("Selected"),
      tableOutput("info_clicked")
      ##dataTableOutput("info_clicked") ## overkill here
    )
  )
)


server <- function(input, output, session) {

  selected_line <-  reactive({
    nearPoints(mtcars, input$plot_click,
               maxpoints = 1,
               addDist = TRUE)
  })

  output$plotui <- renderUI({
      plotOutput("plot", height=600,
        click = "plot_click"
      )
    })

  output$plot <- renderPlot({

    p <- ggplot(mtcars) +
      facet_grid(am ~ cyl) +
      theme_bw() +
      geom_point(aes(x=wt, y=mpg))

    sline <- selected_line()
    if (nrow(sline) > 0) {
      p <- p +
        geom_point(aes(x=wt, y=mpg),
                   data=mtcars[mtcars$gear == sline$gear,],
                   colour="darkred",
                   size=1)
    }

    p

  })

  ##output$info_clicked <- renderDataTable({
  output$info_clicked <- renderTable({
    res <- selected_line()
    ## datatable(res)
    res
  })

}

shinyApp(ui, server)

Answer 1

最后(!)找到了避免在 Shiny 中点击时双重刷新的解决方法:使用 observeEvent() 将点击捕获到 reactiveValue()。似乎适用于我的项目，也适用于您的 MWE。请参阅下面更新的代码部分。

library("Cairo")
library("ggplot2")
library("shiny")

ui <- fluidPage(
  fluidRow(
    titlePanel('Phenotype Plots')
  ),

  fluidRow(
    uiOutput("plotui")
  ),

  hr(),

  fluidRow(

    wellPanel(
      h4("Selected"),
      tableOutput("info_clicked")
      ##dataTableOutput("info_clicked") ## overkill here
    )
  )
)


server <- function(input, output, session) {

  ## CHANGE HERE
  ## Set up buffert, to keep the click.  
  click_saved <- reactiveValues(singleclick = NULL)

  ## CHANGE HERE
  ## Save the click, once it occurs.
  observeEvent(eventExpr = input$plot_click, handlerExpr = { click_saved$singleclick <- input$plot_click })


  ## CHANGE HERE  
  selected_line <-  reactive({
    nearPoints(mtcars, click_saved$singleclick, ## changed from "input$plot_click" to saved click.
               maxpoints = 1,
               addDist = TRUE)
  })

  output$plotui <- renderUI({
    plotOutput("plot", height=600,
               click = "plot_click"
    )
  })

  output$plot <- renderPlot({

    p <- ggplot(mtcars) +
      facet_grid(am ~ cyl) +
      theme_bw() +
      geom_point(aes(x=wt, y=mpg))

    sline <- selected_line()
    if (nrow(sline) > 0) {
      p <- p +
        geom_point(aes(x=wt, y=mpg),
                   data=mtcars[mtcars$gear == sline$gear,],
                   colour="darkred",
                   size=1)
    }

    p

  })

  ##output$info_clicked <- renderDataTable({
  output$info_clicked <- renderTable({
    res <- selected_line()
    ## datatable(res)
    res
  })

}

shinyApp(ui, server)