r - 带有多个折线元素的传单导致巨大的 HTML

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

它的大小显然翻了一番。

那么，总而言之，有没有办法让传单在向同一张地图添加多个数据字段时不再现空间信息？

标签： rleafletr-leaflet