Improve performances of observeEvent in shiny app

Question

I am looking for suggestions in improving performance of my shiny app.

I build a shiny app to have fun and train. The purpose of this application is to add a point on a map when the user clicks on it. These points are also contained in a data table. Thus the points are visible on the map and in the data table. Here is the code:

this_table = data.frame(lat = NA, lng = NA, Distance = NA)

ui <- fluidPage(
      navbarPage("nav", id="nav",

                 tabPanel("Interactive map",
                          tags$head(
                            # Include our custom CSS
                            includeCSS("./www/style.css")
                          ),

                          leafletOutput("map", height=900),
                          # Shiny versions prior to 0.11 should use class = "modal" instead.
                          absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
                                        draggable = TRUE, top = 60, left = "auto", right = 20, bottom = "auto",
                                        width = 450, height = "auto",

                                        h2("Controls"),

                                        DTOutput("data"),
                                            sliderInput("distance", "Dist in meters",min=0, max=50000, step = 1, value=1000)

                          )
                 ),
                 tabPanel("Data"

                          )
      )
    )

    server <- function(input, output, session) {
      # --------- MAP panel
      output$map<- renderLeaflet({
        leaflet(options = leafletOptions(minZoom = 6, dragging = T))%>%
          addProviderTiles(provider = "OpenStreetMap.France")%>%
          setView(lng = 2.43, lat=46.53,zoom = 7) %>%
          setMaxBounds(lng1 = 2.43 + 9,
                       lat1 = 46.53 + 12,
                       lng2 = 2.43 - 7,
                       lat2 = 46.53 - 10)

      })

      ## Observe mouse clicks and add markers
      observeEvent(input$map_click, {
        ## Get the click info like had been doing
        click <- input$map_click
        clat <- click$lat
        clng <- click$lng

        ## Add the maker to the map proxy
        ## not need to re-render the whole thing
        ## the markers a group, "markers", so you can
        ## then do something like hide all the markers with hideGroup('markers')
        leafletProxy('map') %>% # use the proxy to save computation
          addMarkers(lng=clng, lat=clat, group='markers')
      })

      # ------------- Data Absolute panel
      this_table <- reactiveVal(this_table)

      observeEvent(input$map_click, {
        click <- input$map_click
        t = rbind(data.frame(lat = click$lat,
                             lng = click$lng,
                             Distance = input$distance), this_table())
        this_table(t)
      })

      observeEvent(input$delete_btn, {
        t = this_table()
        if (!is.null(input$data_rows_selected)) {
          t <- t[-as.numeric(input$data_rows_selected),]

        }
        this_table(t)
      })


      output$data<-renderDT({
        datatable(this_table(), selection = 'single', options = list(dom = 't'))
      })

    }

    shinyApp(ui, server)

This code works, but when I click for add a point I can see the data table refresh. For my job I build another app but with OpenLayers with a similar function and there was not this refresh.

That's why I was wondering if there was a more efficient way to write my code, which would prevent refresh the data table?

thanks for all help that will be brought to me

EDIT : all code of my app

Answer 1

There are two ideas I would try:

• merge the two observeEvent expressions, or
• not update the data table each time the user clicks.

Merge

You are defining variables such as click twice, along with having two discrete expressions driven by the same event. Try merging into one.

# Data-table
    this_table <- reactiveVal(this_table)

## Observe mouse clicks and add markers 
    observeEvent(input$map_click, {
    ## Get the click info like had been doing
       click <- input$map_click
       clat <- click$lat
       clng <- click$lng

    ## Add the maker to the map proxy and in a group 'markers'
       leafletProxy('map') %>% # use the proxy to save computation
         addMarkers(lng=clng, lat=clat, group='markers')

       t = rbind(data.frame(lat = click$lat,
                         lng = click$lng,
                         Distance = input$distance), this_table())
       this_table(t)
    })

Delay updating table

This may not suit your circumstance but it would help with the lag experienced when clicking. Create an action button and drive the second observeEvent expression from this button.

ui <- fluidPage(
   ...
   your ui code here
   ...
   actionButton("update", "Update table", icon = icon("check"))
   ...
   )

server <- function(input, output, session) {
    ## Observe mouse clicks and add markers 
    observeEvent(input$map_click, {
    ## Get the click info like had been doing
       click <- input$map_click
       clat <- click$lat
       clng <- click$lng

    ## Add the maker to the map proxy and in a group 'markers'
       leafletProxy('map') %>% # use the proxy to save computation
         addMarkers(lng=clng, lat=clat, group='markers')
     })

    # Data-table
    this_table <- reactiveVal(this_table)

    observeEvent(input$update, {
       click <- input$map_click
       t = rbind(data.frame(lat = click$lat,
                         lng = click$lng,
                         Distance = input$distance), this_table())
       this_table(t)
    })
}