Skip to content

Instantly share code, notes, and snippets.

@jcheng5

jcheng5/README.md

Last active December 15, 2022 16:01
Show Gist options
  • Save jcheng5/c084a59717f18e947a17955007dc5f92 to your computer and use it in GitHub Desktop.
Save jcheng5/c084a59717f18e947a17955007dc5f92 to your computer and use it in GitHub Desktop.
Download ZIP
Using arbitrary Leaflet plugins with Leaflet for R
Raw
README.md

Using arbitrary Leaflet JS plugins with Leaflet for R

The Leaflet JS mapping library has lots of plugins available. The Leaflet package for R provides direct support for some, but far from all, of these plugins, by providing R functions for invoking the plugins.

If you as an R user find yourself wanting to use a Leaflet plugin that isn't directly supported in the R package, you can use the technique shown here to load the plugin yourself and invoke it using JS code.

Raw
leaflet-esri.R
library(leaflet)
library(htmltools)
library(htmlwidgets)
# This tells htmlwidgets about our plugin name, version, and
# where to find the script. (There's also a stylesheet argument
# if the plugin comes with CSS files.)
esriPlugin <- htmlDependency("leaflet.esri", "1.0.3",
src = c(href = "https://cdn.jsdelivr.net/leaflet.esri/1.0.3/"),
script = "esri-leaflet.js"
)
# A function that takes a plugin htmlDependency object and adds
# it to the map. This ensures that however or whenever the map
# gets rendered, the plugin will be loaded into the browser.
registerPlugin <- function(map, plugin) {
map$dependencies <- c(map$dependencies, list(plugin))
map
}
leaflet() %>% setView(-122.23, 37.75, zoom = 10) %>%
# Register ESRI plugin on this map instance
registerPlugin(esriPlugin) %>%
# Add your custom JS logic here. The `this` keyword
# refers to the Leaflet (JS) map object.
onRender("function(el, x) {
L.esri.basemapLayer('Topographic').addTo(this);
}")
Raw
leaflet-heat.R
# This example shows the ability to pass extra R data to onRender.
# At the time of this writing it requires a custom build of htmlwidgets:
# devtools::install_github("ramnathv/htmlwidgets@joe/feature/onrender-data")
#
# Track the progress of this functionality at
# https://github.com/ramnathv/htmlwidgets/pull/202
library(leaflet)
library(htmltools)
library(htmlwidgets)
library(dplyr)
heatPlugin <- htmlDependency("Leaflet.heat", "99.99.99",
src = c(href = "http://leaflet.github.io/Leaflet.heat/dist/"),
script = "leaflet-heat.js"
)
registerPlugin <- function(map, plugin) {
map$dependencies <- c(map$dependencies, list(plugin))
map
}
leaflet() %>% addTiles() %>%
fitBounds(min(quakes$long), min(quakes$lat), max(quakes$long), max(quakes$lat)) %>%
registerPlugin(heatPlugin) %>%
onRender("function(el, x, data) {
data = HTMLWidgets.dataframeToD3(data);
data = data.map(function(val) { return [val.lat, val.long, val.mag*100]; });
L.heatLayer(data, {radius: 25}).addTo(this);
}", data = quakes %>% select(lat, long, mag))
@nash1119
Copy link

@jcheng5 and community

Does anyone know how to successfully pass R objects into the JS logic?

My attempt:

library(leaflet)
library(htmltools)
library(htmlwidgets)
library(fontawesome)
library(jsonlite)

beautifyPlugin <- htmlDependency("Leaflet.BeautifyMarker", "1.0.9",
                                 src = c(href="https://cdn.jsdelivr.net/npm/[email protected]/"),
                                 script = "leaflet-beautify-marker-icon.min.js",
                                 stylesheet = "leaflet-beautify-marker-icon.min.css"
)

fontawesomePlugin <- htmlDependency("Leaflet.BeautifyMarkerFA", "1.0.9",
                                    src = c(href="https://maxcdn.bootstrapcdn.com/font-awesome/4.5.0/css/"),
                                    stylesheet = "font-awesome.min.css"
)

registerPlugin <- function(map, plugin) {
  map$dependencies <- c(map$dependencies, list(plugin))
  map
}

iconName <- list(icon = 'leaf')
toJSON(iconName)
#> {"icon":["leaf"]}
  
leaflet() %>% setView(-122.23, 37.75, zoom = 10)%>%
  addTiles()%>%
  registerPlugin(fontawesomePlugin)%>%
  registerPlugin(beautifyPlugin) %>%
  onRender("function(el, x, iconName) {
          options = {
              icon: data.icon,
              iconShape: 'marker'
           };
           L.marker([37.77, -122.40] ,
           {icon: L.BeautifyIcon.icon(options)
           }).addTo(this).bindPopup('test');
           }")

Created on 2020-10-20 by the reprex package (v0.3.0)

@helgasoft
Copy link

@nash1119 - why not just paste the value inside the JS code string:

library(leaflet)
library(htmltools)
library(htmlwidgets)
beautifyPlugin <- htmlDependency( "Beautify", "1.0.9",
                                 src = c(href="https://cdn.jsdelivr.net/npm/[email protected]/"),
                                 script = "leaflet-beautify-marker-icon.min.js",
                                 stylesheet = "leaflet-beautify-marker-icon.min.css"
)
fontawesomePlugin <- htmlDependency( "fontawesome", "4.5.0",
                                    src = c(href="https://maxcdn.bootstrapcdn.com/font-awesome/4.5.0/css/"),
                                    stylesheet = "font-awesome.min.css"
)
registerPlugin <- function(map, plugin) {
  map$dependencies <- c(map$dependencies, list(plugin))
  map
}
myIcon <- 'leaf'
leaflet() %>% setView(-122.23, 37.75, zoom = 10) %>% addTiles()%>%
 registerPlugin(fontawesomePlugin) %>% 
 registerPlugin(beautifyPlugin) %>%
 onRender(paste0("function(el, x) {
	L.marker([37.77, -122.40] , 
		{icon: L.BeautifyIcon.icon({ icon:'" ,myIcon, "', iconShape: 'marker' }) }).addTo(this).bindPopup('test');
 }"))

@nash1119
Copy link

@helgasoft thank you!

@nash1119
Copy link

nash1119 commented Nov 9, 2020

@rickyars @Bignoozer @chintanp or anyone, did you ever find a solution to why this does not seem to work with leafletProxy()? I am currently having this issue. Thanks!

@viniciuszendron
Copy link

@nash1119 @rickyars @Bignoozer @chintanp please take a look at the question below:

https://stackoverflow.com/questions/52846472/leaflet-plugin-and-leafletproxy-with-polylinedecorator-as-example

It worked for my case as a workaround. You need to anticipate what is coming by creating a function associated to an event listener inside onRender, and call this directly on leaflet, not leafletProxy.

Maybe @jcheng5 could have some idea on why the main approach described in this gist doesn't work well with leafletProxy.

@oggioniale
Copy link

Hello,
some of you have experience about integration of Leaflet.LayerTreePlugin with R Shiny

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

layerTreePlugin <- htmltools::htmlDependency(
  "Leaflet.LayerTreePlugin", "1.0.0",
  src = "./www/js/",
  script = "leaflet-layer-tree-control.js"
)

registerPlugin <- function(map, plugin) {
  map$dependencies <- c(map$dependencies, list(plugin))
  map
}

leaflet() %>% addTiles() %>%
  registerPlugin(layerTreePlugin) %>%
  onRender("function(el, x) {
  function buildContentFromLayer(layer) {
		var content = '<table>';
		var properties = layer.feature.properties;
		for (var i in properties) {
			content += '<tr><td>' + i + '</td><td>' + properties[i] + '</td></tr>';
		}
		content += '</table>';
		return content;
	}
  
	// Icons
	var greenIcon = L.icon({
		iconUrl: 'https://leafletjs.com/examples/custom-icons/leaf-green.png',
		shadowUrl: 'https://leafletjs.com/examples/custom-icons/leaf-shadow.png',

		iconSize: [38, 95],
		shadowSize: [50, 64],
		iconAnchor: [22, 94],
		shadowAnchor: [4, 62],
		popupAnchor: [-3, -76]
	});
	
	var tree = [{code: 'root', name: 'All the Layers', active: true,
			selectedByDefault: false,
			openByDefault: true,
			childLayers: [
				{
					code: 'base',
					name: 'Base layers',
					active: true,
					selectedByDefault: false,
					openByDefault: true,
					childLayers: [
						{
							code: 'osm',
							name: 'OpenStreetMap',
							active: true,
							selectedByDefault: false,
							openByDefault: true,
							childLayers: [],
							selectType: 'MULTIPLE',
							serviceType: 'OSM',
							params: {
								url: 'http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png'
							}
						},
						{
							code: 'google',
							name: 'Google',
							active: true,
							selectedByDefault: true,
							openByDefault: true,
							childLayers: [],
							selectType: 'NONE',
							serviceType: 'GOOGLE',
							params: {}
						},
						{
							code: 'google_terrain',
							name: 'Google Terrain',
							active: true,
							selectedByDefault: false,
							openByDefault: true,
							childLayers: [],
							selectType: 'NONE',
							serviceType: 'GOOGLE_TERRAIN',
							params: {}
						}
					],
					selectType: 'SINGLE',
					serviceType: null,
					params: {}
				},
				{
					code: 'overlays',
					name: 'Overlays',
					active: true,
					selectedByDefault: false,
					openByDefault: true,
					childLayers: [
						{
							code: '50m_coastline',
							name: 'rsg:50m_coastline',
							active: true,
							selectedByDefault: true,
							openByDefault: true,
							selectType: 'MULTIPLE',
							serviceType: 'WFS',
							coordinateSystem: 'EPSG:4326',
							onPopup: function (layer) {
								return buildContentFromLayer(layer);
							},
							params: {
								request: 'getFeature',
								service: 'WFS',
								typeName: 'rsg:50m_coastline',
								style: '{\"stroke\":true,\"fillColor\":\"violet\",\"border\":\"orange\",\"weight\":3,\"opacity\":0.5,\"color\":\"red\",\"dashArray\":\"5\",\"fillOpacity\":0.1}',
								  version: '1.1.0',
								  outputFormat: 'application/json',
								  url: 'https://rsg.pml.ac.uk/geoserver/wfs',
								  maxFeatures: '25'
								},
								childLayers: [
								  {
								    code: 'MPA_SCOTLAND',
								    name: 'rsg:MPA_SCOTLAND',
								    active: true,
								    selectedByDefault: true,
								    openByDefault: true,
								    selectType: 'MULTIPLE',
								    serviceType: 'WFS',
								    coordinateSystem: 'EPSG:4326',
								    onPopup: function (layer) {
								      return buildContentFromLayer(layer);
								    },
								    params: {
								      request: 'getFeature',
								      service: 'WFS',
								      typeName: 'rsg:MPA_SCOTLAND',
								      style: '{\"stroke\":true,\"fillColor\":\"yellow\",\"border\":\"gray\",\"weight\":3,\"opacity\":0.5,\"color\":\"gray\",\"dashArray\":\"5\",\"fillOpacity\":0.1}',
								      version: '1.1.1',
								      outputFormat: 'application/json',
								      url: 'https://rsg.pml.ac.uk/geoserver/wfs',
								      maxFeatures: '25'
								    }
								  },
								  {
								    code: 'MMO_Fish_Shellfish_Cages_A',
								    name: 'rsg:MMO_Fish_Shellfish_Cages_A',
								    active: true,
								    selectedByDefault: false,
								    openByDefault: true,
								    selectType: 'MULTIPLE',
								    serviceType: 'WFS',
								    coordinateSystem: 'EPSG:4326',
								    onPopup: function (layer) {
								      return buildContentFromLayer(layer);
								    },
								    params: {
								      request: 'getFeature',
								      service: 'WFS',
								      typeName: 'rsg:MMO_Fish_Shellfish_Cages_A',
								      version: '1.1.1',
								      outputFormat: 'application/json',
								      url: 'https://rsg.pml.ac.uk/geoserver/wfs',
								      maxFeatures: '25'
								    }
								  }
								  ]
								},
{
  code: 'tiger_roads',
  name: 'tiger:tiger_roads',
  active: true,
  selectedByDefault: false,
  openByDefault: true,
  selectType: 'MULTIPLE',
  serviceType: 'WFS',
  coordinateSystem: 'EPSG:4326',
  onPopup: function (layer) {
    return buildContentFromLayer(layer);
  },
  params: {
    request: 'getFeature',
    service: 'WFS',
    typeName: 'tiger:tiger_roads',
    style: '{\"stroke\":true,\"fillColor\":\"green\",\"border\":\"cyan\",\"weight\":3,\"opacity\":0.5,\"color\":\"red\",\"dashArray\":\"3\",\"fillOpacity\":0.1}',
    version: '1.1.1',
    outputFormat: 'application/json',
    url: 'https://rsg.pml.ac.uk/geoserver/wfs',
    maxFeatures: '25'
  },
  childLayers: [
    {
      code: 'poi',
      name: 'tiger:poi',
      active: true,
      selectedByDefault: true,
      openByDefault: true,
      childLayers: [],
      selectType: 'MULTIPLE',
      serviceType: 'WFS',
      coordinateSystem: 'EPSG:4326',
      onPopup: function (layer) {
        return buildContentFromLayer(layer);
      },
      params: {
        request: 'getFeature',
        service: 'WFS',
        typeName: 'tiger:poi',
        version: '1.1.1',
        outputFormat: 'application/json',
        url: 'https://rsg.pml.ac.uk/geoserver/wfs',
        maxFeatures: '25',
        icon: greenIcon
      },
    }
    ]
}
],
selectType: 'MULTIPLE',
serviceType: null,
params: {}
}
],
selectType: 'NONE',
serviceType: null,
params: {}
}
];

// Base Layers
var layerBuilders = {
  GOOGLE: function (layerSettings) {
    return L.tileLayer('http://{s}.google.com/vt/lyrs=m&x={x}&y={y}&z={z}', {
      maxZoom: 20,
      subdomains: ['mt0', 'mt1', 'mt2', 'mt3']
    });
  },
  GOOGLE_TERRAIN: function (layerSettings) {
    return L.tileLayer('http://{s}.google.com/vt/lyrs=s&x={x}&y={y}&z={z}', {
      maxZoom: 20,
      subdomains: ['mt0', 'mt1', 'mt2', 'mt3']
    });
  }
  
};

// The Tree Control
new L.Control.LayerTreeControl({
  layerTree: tree,
  openByDefault: true,
  layerBuilders: layerBuilders,
  featureBuilders: {
    WFS: {
      zoom: L.Control.LayerTreeControl.WFSZoomFeature
    }
  }
}).addTo(this);

  }")

The map is empty without any Layer Tree

@nicksinus
Copy link

nicksinus commented Jul 16, 2021 •
edited
Loading

I'm trying to use Leaflet.LabelTextCollision, but it doesn't work. What did i miss?

library(tidyverse)
library(leaflet)
library(htmltools)
library(htmlwigets)




label <- data.frame(
lat = c(61.09049, 56.89039, 57.52678, 60.74516, 56.92379, 64.54302, 56.25897, 56.49648, 56.27996, 56.74812, 59.93873, 56.77972, 56.85867, 60.08370, 56.25897),
lon = c(43.17148, 32.65250,  38.31669, 42.04732, 32.74461, 40.53712, 32.08586, 31.64108, 31.66774, 33.51162, 30.31623, 31.25263, 35.92083, 30.27957, 32.08586),
name_label = c("label_1", "label_2", "label_1000", "label_10000", "label_70000", "label_8", "label_999999", "label_777", "label_888888", "label_888", "label_999", "label_7", "label_9", "label_777777777", "label_999999999")
)




col_Plugin <- htmlDependency(
  "Leaflet.LabelTextCollision", "1.4.0",
  src = "./Leaflet.LabelTextCollision-master/dist",
  script = "L.LabelTextCollision.js"
)


registerPlugin <- function(map, plugin) {
  map$dependencies <- c(map$dependencies, list(plugin))
  map
}  


leaflet() %>%
  
  setView(35, 55, zoom = 4) %>%
  
  addProviderTiles(provider =  "OpenStreetMap") %>%
  
  registerPlugin(col_Plugin) %>%

  addLabelOnlyMarkers(lng = label$lon,
                      lat = label$lat,
                      label = lapply(label$name_label, HTML),
                      labelOptions = labelOptions(noHide = T,
                                                  textOnly = F,
                                                  direction = "top")
  ) %>% 
  
  onRender("function(el, x) {

  L.LabelTextCollision().addTo(this);}"

  )

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment