Question

现在，我几乎可以肯定，我当前对发亮的传单的使用次优。

从总体上讲，我当前的方法如下：

生成传单。
根据用户输入创建反应式数据框。
在用户选择感兴趣区域时，创建一个纬度坐标的反应数据框。
将空间数据框（包含邮政编码多边形边界）与步骤2中的反应式数据框合并，然后绘制具有合并数据框的地图。这样可以保留绘制多边形所需的所有数据，并在同一最终数据框中添加colorBins和fillColor和标签。

更详细地，这些步骤如下执行：

生成这样的地图：

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

产生一个营销数据的反应性数据框，该数据框通过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))
    })

创建一个反应性数据框，其中包含用户选择的状态的lat和lon坐标，以馈入调用以渲染地图：

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

渲染最终地图-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数据类型有关，无论如何，根据{{ 1}}）。
根据profvis，步骤4（绘制多边形）中地图的实际渲染是较慢的部分。理想情况下，加快整个过程的解决方案包括在原始传单上绘制多边形，并仅在输入“ Go” actionButton时更新fillColor和应用于每个多边形的标签。我还没有想办法做到这一点。

谁能想到重新构造整个过程以优化效率的方法？

任何输入都将不胜感激。

Shiny和Leaflet集成的速度真的很慢-如何加快速度？

0 个答案: