Избегать двойного обновления сюжета в блестящем

В блестящем сюжете я пытаюсь выделить точки, соответствующие точке щелчка (на основе 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)

Ответы

Ответ 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)