在闪亮的应用程序中提高观察事件的性能

Question

我正在寻找有关提高闪亮应用性能的建议。

我构建了一个闪亮的应用程序来获得乐趣和训练。此应用程序的目的是在用户单击地图时在地图上添加一个点。这些点也包含在数据表中。因此，这些点在地图和数据表中可见。代码如下：

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)

此代码有效，但是当我单击添加点时，我可以看到数据表刷新。对于我的工作，我构建了另一个应用程序，但使用具有类似功能的 OpenLayers，并且没有此刷新。

这就是为什么我想知道是否有更有效的方法来编写我的代码，这会阻止刷新数据表？

感谢所有将带给我的帮助

编辑：我的应用的所有代码

Answer 1

我会尝试两个想法：

• 合并两个observeEvent表达式，或者
• 不会在用户每次点击时更新数据表。

合并

您定义了两次变量（例如click），以及由同一事件驱动的两个离散表达式。尝试合并为一个。

# 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)
    })

延迟更新表

这可能不适合您的情况，但有助于解决点击时的延迟问题。创建一个操作按钮并从此按钮驱动第二个 observeEvent 表达式。

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)
    })
}