Question

我正在R上构建具有由addLayersControl控制的多层的传单地图。 每个图层都具有相同的空间信息，因此只有与每个折线相关联的数据才会更改。这个想法是要有一个基本的地图，用户可以在其中确定要显示哪个数据字段。我成功制作了地图，但是我注意到生成的html文件很大。

在我的实际环境中，仅制作一层地图会导致〜20mb的文件。但是，如果我添加一个字段，它会达到〜40mb，而三层〜60mb。因此在我看来，生成的html正在加载相同的shapefile 3次，而不是简单地使用一个shapefile并将其链接到某种数据帧。

我是否拥有这种传单的行为，或者在我的情况下是否有办法进行规模膨胀？我可能没有以更好的方式编写传单...

我举了一个可重复的例子来说明问题。它使用一个很小的shapefile，因此大小问题不是很严重，但是要点是相同的，它使文件大小不断加倍。另外，该示例很冗长，很抱歉，我找不到进一步简化它的方法。

准备工作：

# loading the libraries
library(sf)  
library(leaflet)
library(htmlwidgets)

# preparing the shapefile
nc <- st_read(system.file("gpkg/nc.gpkg", package="sf"), quiet = TRUE) %>% 
  st_transform(st_crs(4326))

# preparing the colors (not really important)
pal.area <- colorNumeric(palette = "inferno", domain = range(nc$AREA))
pal.perim <- colorNumeric(palette = "inferno", domain = range(nc$PERIMETER))
pal.cnty <- colorNumeric(palette = "inferno", domain = range(nc$CNTY_))
pal.sid74 <- colorNumeric(palette = "inferno", domain = range(nc$SID74))

制作传单的这一部分很长，但是它只是4张传单地图，一次是通过一次添加一层来创建的。主要是复制粘贴的工作：

###
one_layer <- leaflet(data = nc) %>%
  addTiles() %>% 
  addPolylines(fillColor = ~pal.area(AREA),
               fill = TRUE,
               opacity = 0.8,
               group = "area") %>% 
  addLegend("bottomright",
            pal = pal.area, values = ~AREA,
    opacity = 1, group = "area"
  )  
###


###
two_layers <- leaflet(data = nc) %>%
  addTiles() %>% 
  addPolylines(fillColor = ~pal.area(AREA),
               fill = TRUE,
               opacity = 0.8,
               group = "area") %>% 
  addLegend("bottomright",
            pal = pal.area, values = ~AREA,
            opacity = 1, group = "area") %>% 
  addPolylines(fillColor = ~pal.perim(PERIMETER),
               fill = TRUE,
               opacity = 0.8,
               group = "perim") %>% 
  addLegend("bottomright",
            pal = pal.perim, values = ~PERIMETER,
            opacity = 1, group = "perim"
  ) %>% 
  addLayersControl(
    overlayGroups = c("area", "perim"), position = "bottomleft",
    options = layersControlOptions(collapsed = FALSE)
  )
###

###
three_layers <- leaflet(data = nc) %>%
  addTiles() %>% 
  addPolylines(fillColor = ~pal.area(AREA),
               fill = TRUE,
               opacity = 0.8,
               group = "area") %>% 
  addLegend("bottomright",
            pal = pal.area, values = ~AREA,
            opacity = 1, group = "area") %>% 
  addPolylines(fillColor = ~pal.perim(PERIMETER),
               fill = TRUE,
               opacity = 0.8,
               group = "perim") %>% 
  addLegend("bottomright",
            pal = pal.perim, values = ~PERIMETER,
            opacity = 1, group = "perim"
  ) %>% 
  addPolylines(fillColor = ~pal.cnty(CNTY_),
               fill = TRUE,
               opacity = 0.8,
               group = "cnty") %>% 
  addLegend("bottomright",
            pal = pal.cnty, values = ~CNTY_,
            opacity = 1, group = "cnty"
  ) %>% 
  addLayersControl(
    overlayGroups = c("area", "perim", "cnty"), position = "bottomleft",
    options = layersControlOptions(collapsed = FALSE)
  ) %>% 
  hideGroup(c("perim","cnty"))
###

###
four_layers <- leaflet(data = nc) %>%
  addTiles() %>% 
  addPolylines(fillColor = ~pal.area(AREA),
               fill = TRUE,
               opacity = 0.8,
               group = "area") %>% 
  addLegend("bottomright",
            pal = pal.area, values = ~AREA,
            opacity = 1, group = "area") %>% 
  addPolylines(fillColor = ~pal.perim(PERIMETER),
               fill = TRUE,
               opacity = 0.8,
               group = "perim") %>% 
  addLegend("bottomright",
            pal = pal.perim, values = ~PERIMETER,
            opacity = 1, group = "perim"
  ) %>% 
  addPolylines(fillColor = ~pal.cnty(CNTY_),
               fill = TRUE,
               opacity = 0.8,
               group = "cnty") %>% 
  addLegend("bottomright",
            pal = pal.cnty, values = ~CNTY_,
            opacity = 1, group = "cnty"
  ) %>% 
  addPolylines(fillColor = ~pal.sid74(SID74),
               fill = TRUE,
               opacity = 0.8,
               group = "sid74") %>% 
  addLegend("bottomright",
            pal = pal.sid74, values = ~SID74,
            opacity = 1, group = "sid74"
  ) %>% 
  addLayersControl(
    overlayGroups = c("area", "perim", "cnty", "sid74"), position = "bottomleft",
    options = layersControlOptions(collapsed = FALSE)
  ) %>% 
  hideGroup(c("perim","cnty", "sid74"))
###

然后，您将获得4个对象（图），我们可以直接在R中比较它们的大小：

object.size(one_layer)
301864 bytes
object.size(two_layers)
531144 bytes
object.size(three_layers)
681872 bytes
object.size(four_layers)
828616 bytes

大小增加是恒定的，并且比仅添加数据而不是添加所有空间信息时的期望值要高得多。作为比较，具有15个场的初始形状的大小为：

object.size(nc)
135360 bytes

如果将地图保存为HTML，则问题更加明显：

saveWidget(one_layer, paste0(getwd(),"/temp_data/temp/one_layer.html"), selfcontained = F)
saveWidget(two_layers, paste0(getwd(),"/temp_data/temp/two_layers.html"), selfcontained = F)
saveWidget(three_layers, paste0(getwd(),"/temp_data/temp/three_layers.html"), selfcontained = F)
saveWidget(four_layers, paste0(getwd(),"/temp_data/temp/four_layers.html"), selfcontained = F)

file.info(list.files("temp_data/temp", pattern = ".html$", full.names = T))$size[c(2,4,3,1)] %>%
  setNames(c("One Layer", "Two Layers", "Three Layers", "Four Layers")) %>%
  barplot(ylab="size in Bytes")

大小显然要加倍。

因此，总而言之，当在同一地图上添加多个数据字段时，是否有一种方法可以使传单不重现空间信息？

包含多个折线元素的传单会产生巨大的HTML

0 个答案: