Polygon support

R/layers.R

@@ -18,6 +18,12 @@ evalFormula = function(list, data) {
   evalAll(list)
 }
 
+# jcheng 12/10/2014: The limits/bbox handling was pretty rushed, unfortunately
+# we have ended up with too many concepts. expandLimits just takes random
+# lat/lng vectors, the sp package's Spatial objects can use `bbox()`, and our
+# polygon lists (returned from polygonData()) use `attr(x, "bbox")` (though at
+# least they are the same shape as the Spatial bounding boxes).
+
 # Notifies the map of new latitude/longitude of items of interest on the map, so
 # that we can expand the limits (i.e. bounding box). We will use this as the
 # initial view if the user doesn't explicitly specify bounds using fitBounds.
@@ -38,6 +44,28 @@ expandLimits = function(map, lat, lng) {
   map
 }
 
+# Same as expandLimits, but takes a polygon (that presumably has a bbox attr)
+# rather than lat/lng.
+expandLimitsBbox = function(map, poly) {
+  bbox = attr(poly, "bbox", exact = TRUE)
+  if (is.null(bbox))
+    stop("Polygon data had no bbox")
+  expandLimits(map, bbox[2,], bbox[1,])
+}
+
+# Represents an initial bbox; if combined with any other bbox value using
+# bboxAdd, the other bbox will be the result.
+bboxNull = cbind(min=c(x=Inf, y=Inf), max=c(x=-Inf, y=-Inf))
+
+# Combine two bboxes; the result will use the mins of the mins and the maxes of
+# the maxes.
+bboxAdd = function(a, b) {
+  cbind(
+    min = pmin(a[,1], b[,1]),
+    max = pmax(a[,2], b[,2])
+  )
+}
+
 #' @export
 addTiles = function(
   map,
@@ -68,7 +96,7 @@ addTiles = function(
       '&copy; <a href="http://openstreetmap.org">OpenStreetMap</a>',
       'contributors, <a href="http://creativecommons.org/licenses/by-sa/2.0/">CC-BY-SA</a>'
     )
-  appendMapData(map, getMapData(map), 'tileLayer', urlTemplate = urlTemplate, options = options)
+  appendMapData(map, getMapData(map), 'tileLayer', urlTemplate, options)
 }
 
 #' @export
@@ -170,6 +198,7 @@ addPolylines = function(
   map, lng = NULL, lat = NULL, layerId = NULL,
   smoothFactor = 1.0,
   noClip = FALSE,
+  stroke = TRUE,
   color = "#03F",
   weight = 5,
   opacity = 0.5,
@@ -182,10 +211,9 @@ addPolylines = function(
   data = getMapData(map)
 ) {
   options = makeOpts(match.call(), c("map", "lng", "lat", "layerId", "data"))
-  lng = resolveFormula(lng, data)
-  lat = resolveFormula(lat, data)
-  appendMapData(map, data, 'polyline', lat, lng, layerId, options) %>%
-    expandLimits(unlist(lat), unlist(lng))
+  pgons = derivePolygons(data, lng, lat, missing(lng), missing(lat), "addPolylines")
+  appendMapData(map, data, 'polyline', pgons, layerId, options) %>%
+    expandLimitsBbox(pgons)
 }
 
 #' @export
@@ -222,6 +250,7 @@ addPolygons = function(
   map, lng = NULL, lat = NULL, layerId = NULL,
   smoothFactor = 1.0,
   noClip = FALSE,
+  stroke = TRUE,
   color = "#03F",
   weight = 5,
   opacity = 0.5,
@@ -237,10 +266,9 @@ addPolygons = function(
   data = getMapData(map)
 ) {
   options = makeOpts(match.call(), c("map", "lng", "lat", "layerId", "data"))
-  lng = resolveFormula(lng, data)
-  lat = resolveFormula(lat, data)
-  appendMapData(map, data, 'polygon', lat, lng, layerId, options) %>%
-    expandLimits(unlist(lat), unlist(lng))
+  pgons = derivePolygons(data, lng, lat, missing(lng), missing(lat), "addPolygons")
+  appendMapData(map, data, 'polygon', pgons, layerId, options) %>%
+    expandLimitsBbox(pgons)
 }
 
 #' @export

R/methods.R

@@ -2,8 +2,8 @@
 #'
 #' A series of methods to manipulate the map.
 #' @param map a map widget object created from \code{\link{leaflet}()}
-#' @param center the coordinate of the map center as a numeric vector of the
-#'   form \code{c(lat, lng)}
+#' @param lng The longitude of the map center
+#' @param lat The latitude of the map center
 #' @param zoom the zoom level
 #' @param options a list of zoom/pan options (see
 #'   \url{http://leafletjs.com/reference.html#map-zoompanoptions})
@@ -12,15 +12,13 @@
 #' @describeIn map-methods Sets the view of the map (center and zoom level)
 #' @export
 #' @examples library(leaflet)
-#' m = leaflet() %>% addTiles() %>% setView(c(42.3489054,-71.0382679), zoom = 18)
+#' m = leaflet() %>% addTiles() %>% setView(-71.0382679, 42.3489054, zoom = 18)
 #' m  # the RStudio 'headquarter'
 #' m %>% fitBounds(40, -72, 43, -70)
 #' m %>% clearBounds()  # world view
-setView = function(map, center = NULL, zoom = NULL, options = list()) {
-  if (!missing(center) && length(center) != 2)
-    stop("'center' must be a numeric vector of the form c(lat, lng)")
-  if (length(options) == 0) options = setNames(list(), character(0))
-  map$x$setView = list(center, zoom, options)
+setView = function(map, lng, lat, zoom, options = list()) {
+  map$x$setView = list(c(lat, lng), zoom, options)
+  map$x$fitBounds = NULL
   map
 }
 
@@ -29,6 +27,7 @@ setView = function(map, center = NULL, zoom = NULL, options = list()) {
 #' @export
 fitBounds = function(map, lat1, lng1, lat2, lng2) {
   map$x$fitBounds = list(lat1, lng1, lat2, lng2)
+  map$x$setView = NULL
   map
 }
 

R/normalize.R

@@ -73,6 +73,39 @@ derivePoints = function(data, lng, lat, missingLng, missingLat, funcName) {
   data.frame(lng=lng, lat=lat)
 }
 
+derivePolygons = function(data, lng, lat, missingLng, missingLat, funcName) {
+  if (missingLng != missingLat) {
+    stop(funcName, " must be called with both lng and lat, or with neither.")
+  }
+  if (missingLng) {
+    if (is.null(data)) {
+      stop("Polygon data not found; please provide ", funcName,
+        " with data and/or lng/lat arguments")
+    }
+    return(polygonData(data))
+  } else {
+    lng = resolveFormula(lng, data)
+    lat = resolveFormula(lat, data)
+
+    if (is.null(lng) && is.null(lat)) {
+      stop(funcName, " requires non-NULL longitude/latitude values")
+    } else if (is.null(lng)) {
+      stop(funcName, " requires non-NULL longitude values")
+    } else if (is.null(lat)) {
+      stop(funcName, " requires non-NULL latitude values")
+    }
+
+    if (!is.numeric(lng) && !is.numeric(lat)) {
+      stop(funcName, " requires numeric longitude/latitude values")
+    } else if (!is.numeric(lng)) {
+      stop(funcName, " requires numeric longitude values")
+    } else if (!is.numeric(lat)) {
+      stop(funcName, " requires numeric latitude values")
+    }
+    return(polygonData(cbind(lng, lat)))
+  }
+}
+
 # TODO: Add tests
 #' @export
 pointData = function(obj) {
@@ -123,29 +156,107 @@ pointData.SpatialPointsDataFrame = function(obj) {
   )
 }
 
-# TODO: Add tests
+# A simple polygon is a list(lng=numeric(), lat=numeric()). A compound polygon
+# is a list of simple polygons. This function returns a list of compound
+# polygons, so list(list(list(lng=..., lat=...))). There is also a bbox
+# attribute attached that gives the bounding box, same as sp::bbox().
 polygonData = function(obj) {
   UseMethod("polygonData")
 }
 
 polygonData.default = function(obj) {
   stop("Don't know how to get path data from object of class ", class(obj)[[1]])
 }
-polygonData.data.frame = function(obj) {
-  stop("Not implemented")
-}
 polygonData.matrix = function(obj) {
-  stop("Not implemented")
+  makePolyList(pointData.matrix(obj))
 }
 polygonData.Polygon = function(obj) {
-  stop("Not implemented")
+  coords = polygon2coords(obj)
+  structure(
+    list(list(coords)),
+    bbox = attr(coords, "bbox", exact = TRUE)
+  )
 }
 polygonData.Polygons = function(obj) {
-  stop("Not implemented")
+  coords = polygons2coords(obj)
+  structure(
+    list(structure(coords, bbox = NULL)),
+    bbox = attr(coords, "bbox", exact = TRUE)
+  )
 }
 polygonData.SpatialPolygons = function(obj) {
-  stop("Not implemented")
+  lapply(obj@polygons, polygons2coords, bbox = FALSE) %>%
+    structure(bbox = obj@bbox)
 }
 polygonData.SpatialPolygonsDataFrame = function(obj) {
-  stop("Not implemented")
+  polygonData(sp::polygons(obj))
+}
+polygonData.map = function(obj) {
+  polygonData(cbind(obj$x, obj$y))
+}
+
+polygonData.Line = function(obj) {
+  coords = line2coords(obj)
+  structure(
+    list(list(coords)),
+    bbox = attr(coords, "bbox", exact = TRUE)
+  )
+}
+polygonData.Lines = function(obj) {
+  coords = lines2coords(obj)
+  structure(
+    list(structure(coords, bbox = NULL)),
+    bbox = attr(coords, "bbox", exact = TRUE)
+  )
+}
+polygonData.SpatialLines = function(obj) {
+  lapply(obj@lines, lines2coords, bbox = FALSE) %>%
+    structure(bbox = obj@bbox)
+}
+polygonData.SpatialLinesDataFrame = function(obj) {
+  polygonData(sp::SpatialLines(obj@lines))
+}
+
+dfbbox = function(df) {
+  suppressWarnings(rbind(
+    lng = range(df$lng, na.rm = TRUE),
+    lat = range(df$lat, na.rm = TRUE)
+  ))
+}
+makePolyList = function(df) {
+  lng = df$lng
+  lat = df$lat
+  i = is.na(lat)
+  chunks = cumsum(i)[!i]
+  unname(split(data.frame(lng=lng[!i], lat=lat[!i]), chunks)) %>%
+    lapply(as.list) %>%
+    lapply(list) %>%
+    structure(bbox = dfbbox(df))
+}
+
+polygon2coords = function(pgon, bbox = TRUE) {
+  df = pointData(sp::coordinates(pgon))
+  structure(
+    as.list(df),
+    bbox = if (bbox) dfbbox(df)
+  )
+}
+line2coords = polygon2coords
+
+plural2coords = function(stuff, bbox) {
+  outbbox = bboxNull
+  lapply(stuff, function(pgon) {
+    coords = polygon2coords(pgon)
+    if (bbox)
+      outbbox <<- bboxAdd(outbbox, attr(coords, "bbox", exact = TRUE))
+    structure(coords, bbox = NULL)
+  }) %>% structure(bbox = if (bbox) outbbox)
+}
+
+polygons2coords = function(pgon, bbox = TRUE) {
+  plural2coords(pgon@Polygons[pgon@plotOrder], bbox)
+}
+
+lines2coords = function(lines, bbox = TRUE) {
+  plural2coords(lines@Lines, bbox)
 }

R/utils.R

@@ -5,10 +5,13 @@ filterNULL = function(x) {
 }
 
 appendMapData = function(map, data, component, ...) {
-  x = map$x[[component]]
+  x = map$x$calls
   if (is.null(x)) x = list()
   n = length(x)
-  x[[n + 1]] = evalFormula(list(...), data)
-  map$x[[component]] = x
+  x[[n + 1]] = list(
+    method = component,
+    args = evalFormula(list(...), data)
+  )
+  map$x$calls = x
   map
 }

inst/examples/leaflet.R

@@ -7,7 +7,7 @@ m  # a map with the default OSM tile layer
 m %>% fitBounds(40, 0, 50, 10)
 
 # move the center to Snedecor Hall
-m = m %>% setView(c(42.0285, -93.65), zoom = 17)
+m = m %>% setView(-93.65, 42.0285, zoom = 17)
 m
 
 # popup
@@ -102,7 +102,7 @@ seattle_geojson <- list(
   ),
   id = "ballard"
 )
-m %>% setView(c(47.6759920119894, -122.36075812146), zoom = 13) %>% addGeoJSON(seattle_geojson)
+m %>% setView(-122.36075812146, 47.6759920119894, zoom = 13) %>% addGeoJSON(seattle_geojson)
 
 
 # use the OSM BW layer

inst/examples/normalize.R

@@ -1,5 +1,6 @@
 library(leaflet)
 library(sp)
+library(maps)
 
 ## Create different forms of point data ==========
 
@@ -15,6 +16,9 @@ ptsdf <- sp::SpatialPointsDataFrame(pts, data.frame(Color = topo.colors(20, NULL
 data <- data.frame(Longitude=lng, Latitude=lat, X=1:20)
 # Data frame with weird col names
 dataWeird <- data.frame(LngCol = lng, LatCol = lat, X=1:20)
+# SpatialDataFrame with weird col names turned to coords
+datacoord <- dataWeird
+coordinates(datacoord) <- ~LngCol+LatCol
 
 # Make some circles, without formulas
 leaflet() %>% addCircles(lng, lat)
@@ -23,6 +27,7 @@ leaflet() %>% addCircles(data = ptsdf)
 leaflet() %>% addCircles(data = ptsdf, radius = 4000, fillColor = ~Color)
 leaflet(data) %>% addCircles()
 leaflet() %>% addCircles(data = data)
+leaflet(datacoord) %>% addCircles()
 
 # Make some circles, with formulas
 leaflet(data) %>% addCircles(~Longitude, ~Latitude)
@@ -46,7 +51,45 @@ nolat <- NULL
 leaflet(data) %>% addCircles(1, nolat)
 
 # Some polygon data
-plng <- list(runif(3) + 1, runif(3) + 2, runif(3) + 3)
-plat <- list(runif(3), runif(3), runif(3))
+rawpolys <- list(
+  lng = list(runif(3) + 1, runif(3) + 2, runif(3) + 3),
+  lat = list(runif(3) + 12, runif(3) + 12, runif(3) + 12)
+)
+plng <- c(rawpolys$lng[[1]], NA, rawpolys$lng[[2]], NA, rawpolys$lng[[3]])
+plat <- c(rawpolys$lat[[1]], NA, rawpolys$lat[[2]], NA, rawpolys$lat[[3]])
 pdata <- data.frame(Latitude=I(plat), Longitude=I(plng))
+pgons <- list(
+  Polygons(list(Polygon(cbind(rawpolys$lng[[1]], rawpolys$lat[[1]]))), ID="A"),
+  Polygons(list(Polygon(cbind(rawpolys$lng[[2]], rawpolys$lat[[2]]))), ID="B"),
+  Polygons(list(Polygon(cbind(rawpolys$lng[[3]], rawpolys$lat[[3]]))), ID="C")
+)
+spgons <- SpatialPolygons(pgons)
+spgonsdf <- SpatialPolygonsDataFrame(spgons, data.frame(Category = as.factor(1:3)), FALSE)
+
+Sr1 = Polygon(cbind(c(2,4,4,1,2),c(2,3,5,4,2)))
+Sr2 = Polygon(cbind(c(5,4,2,5),c(2,3,2,2)))
+Sr3 = Polygon(cbind(c(4,4,5,10,4),c(5,3,2,5,5)))
+Sr4 = Polygon(cbind(c(5,6,6,5,5),c(4,4,3,3,4)), hole = TRUE)
+Srs1 = Polygons(list(Sr1), "s1")
+Srs2 = Polygons(list(Sr2), "s2")
+Srs3 = Polygons(list(Sr4, Sr3), "s3/4")
+SpP = SpatialPolygons(list(Srs1,Srs2,Srs3), 1:3)
+
 leaflet(pdata) %>% addTiles() %>% addPolygons(~Longitude, ~Latitude)
+leaflet(pdata) %>% addTiles() %>% addPolygons(lng=plng, lat=plat)
+leaflet(pdata) %>% addTiles() %>% addPolygons(data = cbind(plng, plat))
+# Single Polygon
+leaflet() %>% addPolygons(data = pgons[[2]]@Polygons[[1]])
+# Single Polygons
+leaflet() %>% addPolygons(data = pgons[[1]])
+# SpatialPolygons
+leaflet() %>% addTiles() %>% addPolygons(data = spgons)
+# SpatialPolygonsDataFrame
+leaflet() %>% addPolygons(data = spgonsdf)
+leaflet() %>% addPolygons(data = SpP)
+leaflet() %>% addPolygons(data = SpP, color = topo.colors(3, NULL), stroke = FALSE) %>%
+  addPolygons(data = spgonsdf, color = 'blue', stroke = FALSE, fillOpacity = 0.5)
+leaflet() %>% addPolylines(data = SpP)
+
+leaflet(data = map("state", fill=TRUE, plot=FALSE)) %>% addTiles() %>%
+  addPolygons(fillColor = topo.colors(10, alpha = NULL), stroke = FALSE)