library(tidycensus) library(leaflet) library(tidyr) library(dplyr) library(purrr) library(sf) library(htmlwidgets) library(svglite) ny_counties <- get_acs( geography = "county", survey = "acs5", variables = c(population = "B01003_001", pop_under_5 = "B01001_003"), year = 2018, geometry = TRUE, state = 36 ) %>% as_tibble() %>% select(-moe) %>% pivot_wider(names_from = variable, values_from = estimate) %>% st_as_sf() %>% mutate(svgimage = map2_chr(population, pop_under_5, function(x, y) { s <- svgstring(standalone = FALSE) barplot(c(x,y)) dev.off() paste('
', sub("line, polyline, polygon, path, rect, circle", ".popgraph line, .popgraph polyline, .popgraph polygon, .popgraph path, .popgraph rect, .popgraph circle", s()), '
' ) })) pal1 <- colorNumeric("viridis", domain = ny_counties$population) pal2 <- colorNumeric("plasma", domain = ny_counties$pop_under_5) nymap <- leaflet(ny_counties) %>% addPolygons( fillColor = ~pal1(population), popup = ~svgimage, fillOpacity = 1, group = "population") %>% addPolygons( fillColor = ~pal2(pop_under_5), popup = ~svgimage, fillOpacity = 1, group = "population under 5") %>% addLayersControl( baseGroups = c("population", "population under 5"), options = layersControlOptions(collapsed = FALSE)) # this will serve as or size benchmark htmlwidgets::saveWidget(nymap, file = "nymap.html") file.size("nymap.html") # to estimate size of the map we can use lobstr::obj_size lobstr::obj_size(as.character(nymap)) # you would expect crosstalk to reduce size by referencing rather than copying # but unfortunately that is not the case library(crosstalk) shared_data <- SharedData$new(ny_counties) nymap_crosstalk <- leaflet(shared_data) %>% addPolygons( fillColor = ~pal1(population), popup = ~svgimage, fillOpacity = 1, group = "population") %>% addPolygons( fillColor = ~pal2(pop_under_5), popup = ~svgimage, fillOpacity = 1, group = "population under 5") %>% addLayersControl( baseGroups = c("population", "population under 5"), options = layersControlOptions(collapsed = FALSE)) lobstr::obj_size(as.character(nymap_crosstalk)) # so I would propose that we reference rather than copy the data # by some manual manipulation (could build some functions eventually) # and use of htmlwidgets::JS() # I think constructing in R/leaflet is still easier so let's start # with a normal leaflet map nymap_smaller <- leaflet(ny_counties) %>% addPolygons( fillColor = ~pal1(population), popup = ~svgimage, fillOpacity = 1, group = "population") %>% addPolygons( fillColor = ~pal2(pop_under_5), popup = ~svgimage, fillOpacity = 1, group = "population under 5") %>% addLayersControl( baseGroups = c("population", "population under 5"), options = layersControlOptions(collapsed = FALSE)) # if we look at the calls we can see the data duplication # calls 1 and 2 are addPolygons str(purrr::map(nymap_smaller$x$calls[1:2],~pluck(.x$args[[1]])), max.level=1) # so let's try to construct a data source in JavaScript with JSON data_json <- jsonlite::toJSON(nymap_smaller$x$calls[[1]]$args[[1]], dataframe="columns", auto_unbox=TRUE) # uncomment the listviewer to see what we are making # but we should have an arrray of arrays of coordinates; 62 elements or nrow(counties) #listviewer::reactjson(data_json) # this is where it gets manual but we could clean up and make generic # we will need a script to add the data as global or we could follow better practices # if necessary scr <- htmltools::tags$script(htmltools::HTML( sprintf("var data = %s", data_json) )) nymap_smaller$x$calls[[1]]$args[[1]] <- htmlwidgets::JS("data") nymap_smaller$x$calls[[2]]$args[[1]] <- htmlwidgets::JS("data") # combine the script and the widget tl <- htmltools::tagList(scr, nymap_smaller) # see if it works htmltools::browsable(tl) # see if file size is smaller sprintf( "nymap size: %s while nymap_smaller size: %s saving %s", lobstr::obj_size(as.character(nymap)), lobstr::obj_size(as.character(nymap_smaller)), lobstr::obj_size(as.character(nymap)) - lobstr::obj_size(as.character(tl)) ) # if in markdown this will save by default standalone and our job is mostly done # however if we want to save standalone html from tags we need to use a function # happy to share options but I think we are in markdown context so possibly not necessary # the file will still be big since dependencies are included in standalone # we can make smaller by using CDN if internet is available substitute_data <- function(map, js_name = NULL) { # make possible bad assumption that first addPolygons will # contain the same data as all other addPolygons dat <- Filter( function(call) { call$method == "addPolygons" }, map$x$calls )[[1]]$args[[1]] data_json <- jsonlite::toJSON( dat, dataframe="columns", auto_unbox=TRUE ) scr <- htmltools::tags$script(htmltools::HTML( sprintf("var %s = %s", js_name, data_json) )) map$x$calls <- Map( function(call) { if(call$method == "addPolygons" && identical(dat, call$args[[1]])) { call$args[[1]] <- htmlwidgets::JS(js_name) call } else { call } }, map$x$calls ) htmltools::tagList( scr, map ) } htmltools::browsable( substitute_data(nymap, "data") )