add Leaflet.heatmap

NAMESPACE

@@ -1,3 +1,5 @@
+# Generated by roxygen2 (4.1.0): do not edit by hand
+
 S3method("[",leaflet_icon_set)
 S3method(pointData,SpatialPoints)
 S3method(pointData,SpatialPointsDataFrame)
@@ -11,6 +13,7 @@ export(addCircleMarkers)
 export(addCircles)
 export(addControl)
 export(addGeoJSON)
+export(addHeatmap)
 export(addLayersControl)
 export(addLegend)
 export(addMarkers)
@@ -28,6 +31,7 @@ export(clearBounds)
 export(clearControls)
 export(clearGeoJSON)
 export(clearGroup)
+export(clearHeatmap)
 export(clearImages)
 export(clearMarkerClusters)
 export(clearMarkers)
@@ -63,6 +67,7 @@ export(projectRasterForLeaflet)
 export(providerTileOptions)
 export(removeControl)
 export(removeGeoJSON)
+export(removeHeatmap)
 export(removeImage)
 export(removeLayersControl)
 export(removeMarker)

R/plugin-heatmap.R

@@ -0,0 +1,84 @@
+leafletHeatmapDependencies <- function() {
+  list(
+    htmltools::htmlDependency(
+      "leaflet-heat",
+      "0.1.3",
+      system.file("htmlwidgets/lib/leaflet-heat", package = "leaflet"),
+      script = "leaflet-heat.js"
+    )
+  )
+}
+
+#' Add a heatmap to the map.
+#'
+#' @param map leaflet map to which you would like to add the heatmap.
+#' @param latlngs matrix of data with latitude in the first column
+#'          and longitude in the second.  An optional third column
+#'          can provide altitude or intensity.
+#' @param minOpacity minimum opacity at which the heat will start.
+#' @param maxZoom zoom level where the points reach maximum intensity
+#'          (as intensity scales with zoom).
+#' @param max maximum point intensity. The default is \code{1.0}.
+#' @param radius radius of each "point" of the heatmap.  The default is
+#'          \code{25}.
+#' @param blur amount of blur to apply.  The default is \code{15}.
+#'          \code{blur=1} means no blur.
+#' @param gradient manual color gradient.  An example is
+#'          \code{gradient = list( '0.4' = 'blue', '0.65' = 'lime', '1'= 'red')}.
+#' @param layerId optional string identifying this layer.  \code{layerId} can
+#'          be helpful in a dynamic/Shiny situation where you might want to
+#'          remove at some point.
+#'
+#' @return modified map
+#'
+#' @example ./inst/examples/heatmap.R
+#'
+#' @export
+
+addHeatmap <- function(
+  map
+  ,latlngs
+  ,minOpacity = 0.05 #- the minimum opacity the heat will start at
+  ,maxZoom = NULL #- zoom level where the points reach maximum intensity (as intensity scales with zoom), equals maxZoom of the map by default
+  ,max = 1.0 #- maximum point intensity, 1.0 by default
+  ,radius = 25 #- radius of each "point" of the heatmap, 25 by default
+  ,blur = 15 #- amount of blur, 15 by default
+  ,gradient = NULL
+  ,layerId = NULL
+) {
+  map$dependencies <- c(map$dependencies, leafletHeatmapDependencies())
+  invokeMethod(
+    map
+    , getMapData(map)
+    , 'addHeatmap'
+    , latlngs
+    , Filter(
+        Negate(is.null)
+        ,list(
+          minOpacity = minOpacity
+          ,maxZoom = maxZoom
+          ,max = max
+          ,radius = radius
+          ,blur = blur
+          ,gradient = gradient
+      ))
+    , layerId
+  )
+}
+
+#' @export
+#' @rdname remove
+removeHeatmap <- function( map, layerId = NULL ){
+  invokeMethod(
+    map
+    , getMapData(map)
+    , 'removeHeatmap'
+    , layerId
+  )
+}
+
+#' @rdname remove
+#' @export
+clearHeatmap = function(map) {
+  invokeMethod(map, NULL, 'clearHeatmap')
+}

inst/examples/heatmap.R

@@ -0,0 +1,90 @@
+library(leaflet)
+
+# match the heatmap demo from Leaflet.heat
+# https://github.com/Leaflet/Leaflet.heat/blob/gh-pages/demo/index.html
+
+# get the data to match exactly
+addressPoints <- readLines(
+  "http://leaflet.github.io/Leaflet.markercluster/example/realworld.10000.js"
+)
+addressPoints <- apply(
+  jsonlite::fromJSON(
+    sprintf("[%s]",
+      paste0(
+        addressPoints[4:(length(addressPoints)-1)]
+        ,collapse=""
+      )
+    )
+  )
+  ,MARGIN = 2
+  ,as.numeric
+)
+
+# create our heatmap
+leaf <- leaflet() %>%
+  setView( 175.475,-37.87, 12 ) %>%
+  addHeatmap(addressPoints)
+
+leaf
+
+# customize our heatmap with options
+library(RColorBrewer)
+pal <- brewer.pal(9,"BuPu")
+
+leaf <- leaflet() %>%
+  setView( 175.475,-37.87, 12 ) %>%
+  addHeatmap(
+    addressPoints
+    ,blur = 50
+    # using example
+    # https://esri.github.io/esri-leaflet/examples/styling-heatmaps.html
+    ,gradient = list(
+      '0.2' = '#ffffb2',
+      '0.4' = '#fd8d3c',
+      '0.6' = '#fd8d3c',
+      '0.8' = '#f03b20',
+      '1' = '#bd0026'
+    )
+  )
+
+leaf
+
+# replicate the example provided by
+#   http://www.d3noob.org/2014/02/generate-heatmap-with-leafletheat-and.html
+
+earthquakes <- readLines(
+  "http://bl.ocks.org/d3noob/raw/8973028/2013-earthquake.js"
+)
+earthquakes <- apply(
+  jsonlite::fromJSON(
+    sprintf("[%s]",
+            paste0(
+              earthquakes[5:(length(earthquakes)-1)]
+              ,collapse=""
+            )
+    )
+  )
+  ,MARGIN = 2
+  ,as.numeric
+)
+
+leaflet() %>%
+  addTiles() %>%
+  setView( 174.146, -41.5546, 10 ) %>%
+  addHeatmap(
+    earthquakes,
+    radius = 20,
+    blur = 15,
+    maxZoom = 17
+  )
+
+#  using data(quakes)
+data(quakes)
+quakes_mat <- matrix(t(quakes[,c(1:2,4)]),ncol=3,byrow=T)
+leaflet() %>%
+  addTiles( ) %>%
+  setView( 178, -20, 5 ) %>%
+  addHeatmap( quakes_mat, blur = 30, max = 0.05, radius = 30 )
+
+# to remove the heatmap
+leaf %>% clearHeatmap()

inst/htmlwidgets/leaflet.js

@@ -935,6 +935,20 @@ var dataframe = (function() {
     this.layerManager.clearLayers("topojson");
   };
 
+  methods.addHeatmap = function( latlngs, options, layerId ) {
+    var heatmapLayer = L.heatLayer(latlngs, options);
+
+    this.layerManager.addLayer(heatmapLayer, "heatmap", layerId);
+  };
+
+  methods.removeHeatmap = function(layerId) {
+    this.layerManager.removeLayer("heatmap", layerId);
+  };
+
+  methods.clearHeatmap = function() {
+    this.layerManager.clearLayers("heatmap");
+  };
+
   methods.addControl = function(html, position, layerId, classes) {
     function onAdd(map) {
       var div = L.DomUtil.create('div', classes);

man/addHeatmap.Rd

@@ -0,0 +1,135 @@
+% Generated by roxygen2 (4.1.0): do not edit by hand
+% Please edit documentation in R/plugin-heatmap.R
+\name{addHeatmap}
+\alias{addHeatmap}
+\title{Add a heatmap to the map.}
+\usage{
+addHeatmap(map, latlngs, minOpacity = 0.05, maxZoom = NULL, max = 1,
+  radius = 25, blur = 15, gradient = NULL, layerId = NULL)
+}
+\arguments{
+\item{map}{leaflet map to which you would like to add the heatmap.}
+
+\item{latlngs}{matrix of data with latitude in the first column
+and longitude in the second.  An optional third column
+can provide altitude or intensity.}
+
+\item{minOpacity}{minimum opacity at which the heat will start.}
+
+\item{maxZoom}{zoom level where the points reach maximum intensity
+(as intensity scales with zoom).}
+
+\item{max}{maximum point intensity. The default is \code{1.0}.}
+
+\item{radius}{radius of each "point" of the heatmap.  The default is
+\code{25}.}
+
+\item{blur}{amount of blur to apply.  The default is \code{15}.
+\code{blur=1} means no blur.}
+
+\item{gradient}{manual color gradient.  An example is
+\code{gradient = list( '0.4' = 'blue', '0.65' = 'lime', '1'= 'red')}.}
+
+\item{layerId}{optional string identifying this layer.  \code{layerId} can
+         be helpful in a dynamic/Shiny situation where you might want to
+         remove at some point.}
+}
+\value{
+modified map
+}
+\description{
+Add a heatmap to the map.
+}
+\examples{
+library(leaflet)
+
+# match the heatmap demo from Leaflet.heat
+# https://github.com/Leaflet/Leaflet.heat/blob/gh-pages/demo/index.html
+
+# get the data to match exactly
+addressPoints <- readLines(
+  "http://leaflet.github.io/Leaflet.markercluster/example/realworld.10000.js"
+)
+addressPoints <- apply(
+  jsonlite::fromJSON(
+    sprintf("[\%s]",
+      paste0(
+        addressPoints[4:(length(addressPoints)-1)]
+        ,collapse=""
+      )
+    )
+  )
+  ,MARGIN = 2
+  ,as.numeric
+)
+
+# create our heatmap
+leaf <- leaflet() \%>\%
+  setView( 175.475,-37.87, 12 ) \%>\%
+  addHeatmap(addressPoints)
+
+leaf
+
+# customize our heatmap with options
+library(RColorBrewer)
+pal <- brewer.pal(9,"BuPu")
+
+leaf <- leaflet() \%>\%
+  setView( 175.475,-37.87, 12 ) \%>\%
+  addHeatmap(
+    addressPoints
+    ,blur = 50
+    # using example
+    # https://esri.github.io/esri-leaflet/examples/styling-heatmaps.html
+    ,gradient = list(
+      '0.2' = '#ffffb2',
+      '0.4' = '#fd8d3c',
+      '0.6' = '#fd8d3c',
+      '0.8' = '#f03b20',
+      '1' = '#bd0026'
+    )
+  )
+
+leaf
+
+# replicate the example provided by
+#   http://www.d3noob.org/2014/02/generate-heatmap-with-leafletheat-and.html
+
+earthquakes <- readLines(
+  "http://bl.ocks.org/d3noob/raw/8973028/2013-earthquake.js"
+)
+earthquakes <- apply(
+  jsonlite::fromJSON(
+    sprintf("[\%s]",
+            paste0(
+              earthquakes[5:(length(earthquakes)-1)]
+              ,collapse=""
+            )
+    )
+  )
+  ,MARGIN = 2
+  ,as.numeric
+)
+
+leaflet() \%>\%
+  addTiles() \%>\%
+  setView( 174.146, -41.5546, 10 ) \%>\%
+  addHeatmap(
+    earthquakes,
+    radius = 20,
+    blur = 15,
+    maxZoom = 17
+  )
+
+#  using data(quakes)
+data(quakes)
+quakes_mat <- matrix(t(quakes[,c(1:2,4)]),ncol=3,byrow=T)
+leaflet() \%>\%
+  addTiles( ) \%>\%
+  setView( 178, -20, 5 ) \%>\%
+  addHeatmap( quakes_mat, blur = 30, max = 0.05, radius = 30 )
+
+# to remove the heatmap
+leaf \%>\% clearHeatmap()
+}
+