avoid double refresh of plot in shiny

Question

In a shiny plot I am trying to highlight points matching a clicked point (based on nearPoints() and click).

It sort of works. However, the reactive parts of the shiny app are refreshed twice and the second iteration seems to clear the clicked information.

How can I avoid the second refresh of the app?

Here is the 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)

Dan Gustafsson Dan Gustafsson · Accepted Answer · 2015-07-15T21:06:29

Finally(!) found a workaround for avoiding double refresh on click in Shiny: capture click to a reactiveValue(), using the observeEvent(). Seemingly works on my project, and for your MWE, too. See updated code section below.

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)

avoid double refresh of plot in shiny

1 Answers