Интеграция Shiny и Leaflet действительно медленная - как я могу ускорить ее?

Question

Прямо сейчас я почти уверен, что мое текущее использование блеска и листовки неоптимально.

На высоком уровне мой текущий подход выглядит так:

1. Generateлистовка
2. Создание реактивного информационного кадра при вводе пользователем.
3. Создание реактивного информационного кадра с широтными координатами при выборе пользователем интересующей их области.
4. Объединение пространственного информационного кадра (содержащего почтовый индекс)границы многоугольника) с реактивным кадром данных из шага 2, затем нарисуйте карту с присоединенным кадром данных.При этом сохраняются все данные, необходимые для рисования полигонов, добавления colorBins и fillColor и меток внутри одного и того же конечного кадра данных.

Более подробно, шаги выполняются следующим образом:

1. Создайте карту, подобную этой:

   output$leaflet_map <- renderLeaflet({
   leaflet() %>%
       addTiles()
       })
   

2. Создайте реактивный информационный кадр маркетинговых данных для объединения в sf пространственный информационный кадр, содержащий полигоны почтовых индексов, через sp::merge() (соединение произойдет чуть позже, я к этому вернусь):

   reactive_map_data1 <- reactive({
   df %>%
       filter(BrandAccount_Brand %in% input$selectBrandRecruitment1) %>%
       group_by(POA_CODE, ordertype) %>%
       summarise("Number of Orders type and postcode" = n(), "AOV" = round(mean(TotalDiscount), 2)) %>%
       left_join(seifa, by = "POA_CODE") %>%
       left_join(over25bypostcode, by = "POA_CODE") %>%
       mutate(`Proportion of Population Over 25` = round(n() / `25_and_over` * 100, 4))
       })
   

3. Создайте реактивный информационный кадр, содержащий координаты lat и lon состояния, выбранного с помощьюпользователь, которого нужно ввести в вызов для рендеринга карты:

   reactive_state_recruitment1 <- reactive({
   australian_states %>%
       filter(States == input$selectState_recruitment1)
       })
   

4. Визуализация окончательной карты - profvis определяет, что это влияет на медленную часть:

   observeEvent(
   input$gobutton_recruitment1, {
   
   ## First I load the spatial data with each call to render the 
   ## map - this is almost certainly sub-optimal however I can't 
   ## think of another way to do this as each time the data are 
   ## joined I have no other way of re-setting the gdal.postcodes2 
   ## spatial dataframe to its original state which is why I reload 
   ## it from .rds each time:
   
       gdal.postcodes_recruitment1 <- readRDS("gdal.postcodes2.rds")
   
   ## I then merge the marketing `reactive_map_data1()` dataframe 
   ## created in Step 2 with the freshly loaded `gdal.postcodes2` 
   ## spatial dataframe - `profvis` says this is pretty slow but 
   ## not as slow as the rendering of the map  
   
       gdal.postcodes_recruitment1@data <- sp::merge(gdal.postcodes_recruitment1@data, reactive_map_data1(), by.x = "POA_CODE", all.x = TRUE)
   
   ## Next I generate the domain of `colorBin` with the `Number of 
   ## Orders type and postcode` variable that only exists after the 
   ## merge and is subject to change from user input - it resides 
   ## within the `reactive_map_data1()` dataframe that gets merged 
   ## onto the `gdal.postcodes2()` spatial dataframe.               
   
   pal <- colorBin("YlOrRd", domain = 
   gdal.postcodes_recruitment1$`Number of Orders type and 
   postcode`, bins = bins_counts)
   
   ## Lastly I update the leaflet with `leafletProxy()` to draw the 
   ## map with polygons and fill colour based on the 
   ## `reactive_map_data1()` values            
   
   leafletProxy("leaflet_map_recruitment1", data = gdal.postcodes_recruitment1) %>%
           addPolygons(data = gdal.postcodes_recruitment1, 
                       fillColor = ~pal(gdal.postcodes_recruitment1$`Number of Orders type and postcode`), 
                       weight = 1,
                       opacity = 1,
                       color = "white",
                       dashArray = "2",
                       fillOpacity = .32,
                       highlight = highlightOptions(
                           weight = 3.5,
                           color = "white",
                           dashArray = "4",
                           fillOpacity = 0.35,
                           bringToFront = TRUE),
                       layerId = gdal.postcodes_recruitment1@data$POA_CODE,
                       label = sprintf(
                           "<strong>%s<br/>%s</strong><br/>%s<br/>%s<br/>%s<br/>%s",
                           paste("Postcode: ", gdal.postcodes_recruitment1$POA_CODE, sep = ""),
                           paste("% of Population Over 25: ", gdal.postcodes_recruitment1$`Proportion of Population Over 25`, "%"),
                           paste("Number of Orders: ", gdal.postcodes_recruitment1$`Number of Orders type and postcode`, sep = ""),
                           paste("Ave Order Value: $", gdal.postcodes_recruitment1$`AOV`, sep = ""),
                           paste("Advantage & Disadvantage: ", gdal.postcodes_recruitment1$`Relative Socio-Economic Advantage and Disadvantage Decile`, sep = ""),
                           paste("Education and Occupation: ", gdal.postcodes_recruitment1$`Education and Occupation Decile`, sep = "")
                       ) %>% 
                           lapply(htmltools::HTML),
                       labelOptions = labelOptions(
                           style = list("font-weight" = "normal", padding = "3px 8px"),
                           textsize = "15px",
                           direction = "auto")) %>%
           addLegend("bottomright", pal = pal, values = ~bins_counts,
                     title = "# of Recruits (All Time)",
                     labFormat = labelFormat(suffix = ""),
                     opacity = 1
           ) %>%
           setView(lng = reactive_state_recruitment1()$Lon, lat = reactive_state_recruitment1()$Lat, zoom = reactive_state_recruitment1()$States_Zoom)
   })
   

Вся карта занимает от 7 до 20 секунд, поскольку данные достаточно велики.

Несколько замечаний:

• Полигоны уже упрощены до смерти, в настоящее время они отображают только 10% деталей, которыеПервоначально было предоставлено для определения границ почтового индекса Австралийским бюро статистики.Упростить дальнейшее упрощение многоугольников невозможно.

• sp::merge() - не самая быстрая из join функций, с которыми я сталкивался, но она необходима для объединения пространственного фрейма данных снепространственный фрейм данных (другие объединения, такие как те, которые предлагаются dplyr, не будут выполнять эту задачу - анализ документации sp::merge() показывает, что это как-то связано с типами данных S3 и S4, в любом случае эта часть немедленная часть согласно profvis).

• Согласно profvis фактическая визуализация карты на шаге 4 (рисование полигонов) является медленной частью.В идеале решение для ускорения всего этого процесса должно включать рисование многоугольников на исходной листовке и только обновление fillColor и надписей, примененных к каждому многоугольнику, после ввода actionButton 'Go'.Я не нашел способ сделать это.

Может кто-нибудь придумать способ реструктурировать всю эту процедуру для оптимизации эффективности?

Любой вклад приветствуется.