避免闪亮

Question

在一个闪亮的情节中，我试图突出显示与点击点匹配的点（基于nearPoints（）和点击）。

有点有效。但是，闪亮应用程序的反应部分会刷新两次，第二次迭代似乎会清除点击的信息。

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

这是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中点击双重刷新：使用reactiveValue()捕获点击observeEvent()。看似适用于我的项目，也适用于您的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)