Листовка с несколькими элементами полилиний приводит к огромному HTML

Question

Я строю карту листовки на R, имеющую несколько слоев, которые контролируются addLayersControl. Каждый слой имеет одинаковую пространственную информацию , поэтому изменяются только данные, связанные с каждой полилинией.Идея состоит в том, чтобы иметь базовую карту, где пользователь сам решает, какое поле данных отображать.Мне удалось создать карту, однако я заметил, что размер создаваемого файла html огромен.

В моем реальном контексте создание карты только с одним слоем приводит к файлу размером ~ 20 МБ.Однако, если я добавлю одно поле, оно получит ~ 40 МБ, а три слоя ~ 60 МБ.Поэтому мне кажется, что полученный html загружает один и тот же шейп-файл 3 раза, а не просто использует один шейп-файл и связывает его с каким-либо фреймом данных.

Я согласен с таким поведением листовки или есть способ увеличить размер файла в моем контексте?Возможно, я не запрограммировал свою листовку так: лучше способ ...

Я сделал воспроизводимый пример, чтобы показать проблему.Он использует небольшой шейп-файл, поэтому проблема с размером не является существенной, однако суть одна и та же, которая постоянно удваивает размер файла.Кроме того, пример длинный, извините за это, я не смог найти способ еще больше упростить его.

Подготовка:

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

Его размер явно удваивается.

Итак, подведем итог: есть ли способ получить листовку, чтобы не воспроизводить пространственную информацию при добавлении нескольких полей данных вта же карта?