Leaflet-groupedlayercontrol 在 R 中使用图层组

Question

我有兴趣在 R 中创建的传单地图中使用leaflet-groupedlayercontrol，并一直关注此gist。我可以成功添加 JS 插件（如下面的这个工作示例），但我的问题是如何引用已经在 R 中创建的标记组？

library(leaflet)
library(htmltools)
library(htmlwidgets)
library(dplyr)

#Download the JS and CSS     
urlf <- 'https://raw.githubusercontent.com/ismyrnow/leaflet-groupedlayercontrol/gh-pages/dist/%s'
download.file(sprintf(urlf,'leaflet.groupedlayercontrol.min.js'), 'C:/Temp/L.Control.groupedlayer.js', mode="wb")
download.file(sprintf(urlf,'leaflet.groupedlayercontrol.min.css'), 'C:/Temp/L.Control.groupedlayer.css', mode="wb")
    
#Add the dependency
    ctrlGrouped <- htmltools::htmlDependency(
      name = 'ctrlGrouped',
      version = "1.0.0",
      src = c(file = normalizePath('C:/Temp')),
      script = "L.Control.groupedlayer.js",
      stylesheet = "L.Control.groupedlayer.css"
    )
    registerPlugin <- function(map, plugin) {
      map$dependencies <- c(map$dependencies, list(plugin))
      map
    }
#create a basic map
map <- leaflet() %>%
        setView(-122.38, 47.56, zoom = 12) 
     
 #add the plugin and then tell it to do stuff within onRender()              
      map <- map %>% registerPlugin(ctrlGrouped) %>% 
 #I can create some points within onRender() but I want to refer to existing R objects if possible.   
        onRender("function(el, x) {
    var basemaps = {
      Grayscale: L.tileLayer('http://{s}.tiles.wmflabs.org/bw-mapnik/{z}/{x}/{y}.png', {
        maxZoom: 18,
        attribution: '&copy; <a href=http://www.openstreetmap.org/copyright>OpenStreetMap</a>'
      })
    };
    basemaps.Grayscale.addTo(this);   // default base layer
    var groups = {
      highschool: new L.LayerGroup(),
      elementary: new L.LayerGroup()
    };
L.marker([47.577541, -122.3843482]).bindPopup('West Seattle HS').addTo(groups.highschool);
    L.marker([47.5661429, -122.3840636]).bindPopup('Seattle Lutheran HS').addTo(groups.highschool);      
    L.marker([47.581081, -122.3871535]).bindPopup('Lafayette ES').addTo(groups.elementary);
    L.marker([47.566556, -122.3964651]).bindPopup('Genesee Hill ES').addTo(groups.elementary);
    // Overlay layers are grouped
    var groupedOverlays = {
      'all schools': {
        'High School locations': groups.highschool,
        'Elementary locations': groups.elementary
      }
    };
        var options = {
      groupCheckboxes: true
        };
        L.control.groupedLayers(null, groupedOverlays, options).addTo(this);
    }") 
      
map

我希望引用现有的 R 对象，使用 addLegend()，控制最初可见的内容等，而不是在 onRender() 中制作所有标记。如果不希望分组图层控制如此糟糕，代码看起来更像这样：

 map <- leaflet() %>%
      addCircles(lng =highschool$Longitude,lat=highschool$Latitude,weight = 1, radius = highschool$units*2 , color = ~pal(a_palette), popup = popup_hs, group="highschool" )%>%
      addCircles(lng =elementary$Longitude,lat=elementary$Latitude,weight = 1, radius = misc$units*2 , color = ~pal(a_palette), popup = popup_el, group="elementary" )%>%
      addLegend("bottomleft", colors = palette_color_RSEI ,group = "highschool",labels = c("Lowest ","","","Highest"),
                title = "Highschool size", opacity = 1) %>%
      addLegend("bottomleft", colors = a_palette ,group = "elementary",labels = c("Lower % of population", "", "","","","Higher % of population"),
                title = "Elementary size", opacity = .5) %>%
      addLayersControl(overlayGroups = c("highschool", "elementary"))%>%
      hideGroup(c(   "highschool"))

任何指导将不胜感激。

Answer 1

它看起来像这样：

map <- leaflet() %>%
    addCircles(...) %>%
    addCircles(...) %>%
    addLegend(...) %>%
    addLegend(...) %>%
    registerPlugin(ctrlGrouped) %>%
    onRender("function(el, x) {
        var groupedOverlays = {
            'all schools': {
                'High School locations': groups.highschool,
                'Elementary locations': groups.elementary
            }
        };
        var options = {
            groupCheckboxes: true
        };
        L.control.groupedLayers(null, groupedOverlays, options).addTo(this);
    }")

Answer 2

看起来您还可以在 javascript for 循环中引用 htmlwidgets::onRender() 内的 R 对象。对我来说，关键是意识到 R 对象在onRender() 中有点符号。例如，R 向量 df$longitude 是一个 JSON 对象，作为 onRender() 中的 data.longitude。

这是我的问题中的一个示例，我将 R 对象中的 4 个标记添加到 onRender() 内的传单地图中，然后使用传单附加组件传单分组图层控件。我的真实世界地图有更多组，所以这可能不是最整洁的方法。

library(leaflet)
library(dplyr)
library(htmlwidgets)


df<-tibble::tibble(lat= c(47.577541, 47.5661429,47.581081,47.566556),
                   lng = c(-122.3843482,-122.3840636,-122.3871535,-122.3964651),
                   name= c("West Seattle HS","Seattle Lutheran HS","Lafayette ES","Genesee Hill ES"),
                   grouping=c("groups.highschool","groups.highschool","groups.elementary","groups.elementary"))

urlf <- 'https://raw.githubusercontent.com/ismyrnow/leaflet-groupedlayercontrol/gh-pages/dist/%s'
download.file(sprintf(urlf,'leaflet.groupedlayercontrol.min.js'), 'C:/Temp/L.Control.groupedlayer.js', mode="wb")
download.file(sprintf(urlf,'leaflet.groupedlayercontrol.min.css'), 'C:/Temp/L.Control.groupedlayer.css', mode="wb")

ctrlGrouped <- htmltools::htmlDependency(
  name = 'ctrlGrouped',
  version = "1.0.0",
  # works in R and Shiny - download js/css files, then use this:
  src = c(file = normalizePath('C:/Temp')),
  script = "L.Control.groupedlayer.js",
  stylesheet = "L.Control.groupedlayer.css"
)
registerPlugin <- function(map, plugin) {
  map$dependencies <- c(map$dependencies, list(plugin))
  map
}

leaflet() %>% addTiles() %>%
  registerPlugin(ctrlGrouped) %>%
  fitBounds(min(df$lng), min(df$lat), max(df$lng), max(df$lat)) %>%
  onRender("
        function(el, x, data) {
         var groups = {
          highschool: new L.LayerGroup(),
          elementary: new L.LayerGroup()
        };
          for (var i = 0; i < data.lng.length; i++) {
            var label = JSON.stringify(data.name[i])
            var mygroup = data.grouping[i]
            var marker =  L.marker([data.lat[i], data.lng[i]]).bindPopup(label).addTo(eval(mygroup));
          }
        var groupedOverlays = {
          'all schools': {
            'High School locations': groups.highschool,
            'Elementary locations': groups.elementary
          }
        };
            var options = {
          groupCheckboxes: true,
          collapsed:false
            };
            L.control.groupedLayers(null, groupedOverlays, options).addTo(this);
        }
      ", data = df)