使用 R 中的图层组进行传单分组图层控制

问题描述

我对在 R 中创建的 Leaflet 地图中使用 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,radius = misc$units*2,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"))

任何指导将不胜感激。

解决方法

看起来像这样：

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

,

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

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

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,options).addTo(this);
        }
      ",data = df)