From e799f61aa751aa669fba1de5657af54c642b9537 Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Tue, 9 Dec 2014 16:00:29 -0800 Subject: [PATCH 1/9] wip --- R/layers.R | 10 +++++++--- R/normalize.R | 40 +++++++++++++++++++++++++++++++-------- inst/examples/normalize.R | 32 +++++++++++++++++++++++++++++++ 3 files changed, 71 insertions(+), 11 deletions(-) create mode 100644 inst/examples/normalize.R diff --git a/R/layers.R b/R/layers.R index 261a42dd6..99c270c8f 100644 --- a/R/layers.R +++ b/R/layers.R @@ -144,7 +144,7 @@ addCircleMarkers = function( #' @export addCircles = function( - map, lat, lng, radius = 10, layerId = NULL, + map, centers = data, radius = 10, layerId = NULL, stroke = TRUE, color = "#03F", weight = 5, @@ -157,9 +157,13 @@ addCircles = function( lineJoin = NULL, clickable = TRUE, pointerEvents = NULL, - className = "" + className = "", + data = map$x$data ) { - options <- makeOpts(match.call(), c("map", "lat", "lng", "radius", "layerId")) + options <- makeOpts(match.call(), c("map", "centers", "radius", "layerId", "data")) + points <- pointData(centers, data) + lat <- points$lat + lng <- points$lng appendMapData(map, 'circle', lat, lng, radius, layerId, options) %>% expandLimits(lat, lng) } diff --git a/R/normalize.R b/R/normalize.R index 3b571f578..1f1eb5f6b 100644 --- a/R/normalize.R +++ b/R/normalize.R @@ -24,23 +24,47 @@ guessLatLongCols <- function(names, stopOnFailure = TRUE, } # TODO: Add tests -pointData <- function(obj) { +pointData <- function(obj, dataContext) { UseMethod("pointData") } -pointData.default <- function(obj) { +pointData.default <- function(obj, dataContext) { stop("Don't know how to get location data from object of class ", class(obj)) } -pointData.data.frame <- function(obj) { +pointData.data.frame <- function(obj, dataContext) { cols <- guessLatLongCols(names(obj)) return(data.frame( - lng = obj[cols$lng], - lat = obj[cols$lat] + lng = obj[[cols$lng]], + lat = obj[[cols$lat]] )) } -pointData.matrix <- function(obj) { +pointData.formula <- function(obj, dataContext) { + if (length(obj) == 3) { + # binary formula + lng <- eval(obj[[2]], dataContext, environment(obj)) + lat <- eval(obj[[3]], dataContext, environment(obj)) + return(pointData(cbind(lng, lat), dataContext)) + } else if (length(obj) == 2) { + # unary formula + return(pointData(eval(obj[[2]], dataContext, environment(obj)))) + } +} + +pointData.character <- function(obj, dataContext) { + if (length(obj) != 2) { + # TODO: Better error message + stop("Point data character indices should be length 2") + } + + return(structure( + dataContext[, obj], + names = c("lng", "lat") + )) +} + +pointData.matrix <- function(obj, dataContext) { dims <- dim(obj) if (length(dims) != 2) { stop("Point data must be two dimensional") @@ -52,14 +76,14 @@ pointData.matrix <- function(obj) { data.frame(lng = obj[,1], lat = obj[,2]) } -pointData.SpatialPoints <- function(obj) { +pointData.SpatialPoints <- function(obj, dataContext) { structure( as.data.frame(sp::coordinates(obj)), names = c("lng", "lat") ) } -pointData.SpatialPointsDataFrame <- function(obj) { +pointData.SpatialPointsDataFrame <- function(obj, dataContext) { structure( as.data.frame(sp::coordinates(obj)), names = c("lng", "lat") diff --git a/inst/examples/normalize.R b/inst/examples/normalize.R new file mode 100644 index 000000000..6942b3c8d --- /dev/null +++ b/inst/examples/normalize.R @@ -0,0 +1,32 @@ +library(leaflet) +library(sp) + +## Create different forms of point data ========== + +# Individual lng/lat vectors +lng <- runif(20) +lat <- runif(20) +# Simple matrix +mtx <- cbind(lng, lat) +# Spatial +pts <- sp::SpatialPoints(mtx) +ptsdf <- sp::SpatialPointsDataFrame(pts, data.frame(1:20)) +# Data frame with standard col names +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) + +# Make some circles, without formulas +leaflet() %>% addCircles(cbind(lng, lat)) +leaflet() %>% addCircles(pts) +leaflet() %>% addCircles(ptsdf) +leaflet(data) %>% addCircles() +leaflet(data) %>% addCircles(c("Longitude", "Latitude")) +leaflet() %>% addCircles(data = data) +leaflet(dataWeird) %>% addCircles(c("LngCol", "LatCol")) + +# Make some circles, with formulas +leaflet(data) %>% addCircles(Longitude ~ Latitude) +leaflet(dataWeird) %>% addCircles(LngCol ~ LatCol) +leaflet(dataWeird) %>% addCircles(~cbind(LngCol, LatCol)) +leaflet(dataWeird) %>% addCircles(~data.frame(longitude = LngCol, latitude = LatCol)) From 4a8c61f7d8242d6ee605a6f319cf853c96209761 Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Tue, 9 Dec 2014 16:00:34 -0800 Subject: [PATCH 2/9] Revert "wip" This reverts commit 92219f89b5fa2d630e2fbab0b97df8762361b59c. --- R/layers.R | 10 +++------- R/normalize.R | 40 ++++++++------------------------------- inst/examples/normalize.R | 32 ------------------------------- 3 files changed, 11 insertions(+), 71 deletions(-) delete mode 100644 inst/examples/normalize.R diff --git a/R/layers.R b/R/layers.R index 99c270c8f..261a42dd6 100644 --- a/R/layers.R +++ b/R/layers.R @@ -144,7 +144,7 @@ addCircleMarkers = function( #' @export addCircles = function( - map, centers = data, radius = 10, layerId = NULL, + map, lat, lng, radius = 10, layerId = NULL, stroke = TRUE, color = "#03F", weight = 5, @@ -157,13 +157,9 @@ addCircles = function( lineJoin = NULL, clickable = TRUE, pointerEvents = NULL, - className = "", - data = map$x$data + className = "" ) { - options <- makeOpts(match.call(), c("map", "centers", "radius", "layerId", "data")) - points <- pointData(centers, data) - lat <- points$lat - lng <- points$lng + options <- makeOpts(match.call(), c("map", "lat", "lng", "radius", "layerId")) appendMapData(map, 'circle', lat, lng, radius, layerId, options) %>% expandLimits(lat, lng) } diff --git a/R/normalize.R b/R/normalize.R index 1f1eb5f6b..3b571f578 100644 --- a/R/normalize.R +++ b/R/normalize.R @@ -24,47 +24,23 @@ guessLatLongCols <- function(names, stopOnFailure = TRUE, } # TODO: Add tests -pointData <- function(obj, dataContext) { +pointData <- function(obj) { UseMethod("pointData") } -pointData.default <- function(obj, dataContext) { +pointData.default <- function(obj) { stop("Don't know how to get location data from object of class ", class(obj)) } -pointData.data.frame <- function(obj, dataContext) { +pointData.data.frame <- function(obj) { cols <- guessLatLongCols(names(obj)) return(data.frame( - lng = obj[[cols$lng]], - lat = obj[[cols$lat]] + lng = obj[cols$lng], + lat = obj[cols$lat] )) } -pointData.formula <- function(obj, dataContext) { - if (length(obj) == 3) { - # binary formula - lng <- eval(obj[[2]], dataContext, environment(obj)) - lat <- eval(obj[[3]], dataContext, environment(obj)) - return(pointData(cbind(lng, lat), dataContext)) - } else if (length(obj) == 2) { - # unary formula - return(pointData(eval(obj[[2]], dataContext, environment(obj)))) - } -} - -pointData.character <- function(obj, dataContext) { - if (length(obj) != 2) { - # TODO: Better error message - stop("Point data character indices should be length 2") - } - - return(structure( - dataContext[, obj], - names = c("lng", "lat") - )) -} - -pointData.matrix <- function(obj, dataContext) { +pointData.matrix <- function(obj) { dims <- dim(obj) if (length(dims) != 2) { stop("Point data must be two dimensional") @@ -76,14 +52,14 @@ pointData.matrix <- function(obj, dataContext) { data.frame(lng = obj[,1], lat = obj[,2]) } -pointData.SpatialPoints <- function(obj, dataContext) { +pointData.SpatialPoints <- function(obj) { structure( as.data.frame(sp::coordinates(obj)), names = c("lng", "lat") ) } -pointData.SpatialPointsDataFrame <- function(obj, dataContext) { +pointData.SpatialPointsDataFrame <- function(obj) { structure( as.data.frame(sp::coordinates(obj)), names = c("lng", "lat") diff --git a/inst/examples/normalize.R b/inst/examples/normalize.R deleted file mode 100644 index 6942b3c8d..000000000 --- a/inst/examples/normalize.R +++ /dev/null @@ -1,32 +0,0 @@ -library(leaflet) -library(sp) - -## Create different forms of point data ========== - -# Individual lng/lat vectors -lng <- runif(20) -lat <- runif(20) -# Simple matrix -mtx <- cbind(lng, lat) -# Spatial -pts <- sp::SpatialPoints(mtx) -ptsdf <- sp::SpatialPointsDataFrame(pts, data.frame(1:20)) -# Data frame with standard col names -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) - -# Make some circles, without formulas -leaflet() %>% addCircles(cbind(lng, lat)) -leaflet() %>% addCircles(pts) -leaflet() %>% addCircles(ptsdf) -leaflet(data) %>% addCircles() -leaflet(data) %>% addCircles(c("Longitude", "Latitude")) -leaflet() %>% addCircles(data = data) -leaflet(dataWeird) %>% addCircles(c("LngCol", "LatCol")) - -# Make some circles, with formulas -leaflet(data) %>% addCircles(Longitude ~ Latitude) -leaflet(dataWeird) %>% addCircles(LngCol ~ LatCol) -leaflet(dataWeird) %>% addCircles(~cbind(LngCol, LatCol)) -leaflet(dataWeird) %>% addCircles(~data.frame(longitude = LngCol, latitude = LatCol)) From bb74bb856c1a16d3d91789ad7214af34f69d0bbb Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Tue, 9 Dec 2014 17:29:08 -0800 Subject: [PATCH 3/9] Introduce resolveFormula and derivePoints Also export pointsData generics, this is for testing --- R/layers.R | 9 ++------- R/normalize.R | 35 +++++++++++++++++++++++++++++++++-- R/utils.R | 2 +- 3 files changed, 36 insertions(+), 10 deletions(-) diff --git a/R/layers.R b/R/layers.R index 261a42dd6..d5ca3200d 100644 --- a/R/layers.R +++ b/R/layers.R @@ -11,15 +11,10 @@ makeOpts <- function(matchCall, excludes = NULL, envir = parent.frame(2)) { # Evaluate list members that are formulae, using the map data as the environment # (if provided, otherwise the formula environment) -evalFormula <- function(list, map) { - data <- map$x$data +evalFormula <- function(list, data) { evalAll <- function(x) { if (is.list(x)) return(lapply(x, evalAll)) - if (inherits(x, 'formula')) { - if (length(x) != 2L) stop('The formula must be one-sided: ', deparse(x)) - x <- eval(x[[2]], data, environment(x)) - } - x + return(resolveFormula(x, data)) } evalAll(list) } diff --git a/R/normalize.R b/R/normalize.R index 3b571f578..14a27fff0 100644 --- a/R/normalize.R +++ b/R/normalize.R @@ -23,23 +23,52 @@ guessLatLongCols <- function(names, stopOnFailure = TRUE, return(list(lng=NA, lat=NA)) } +resolveFormula <- function(f, data) { + if (!inherits(f, 'formula')) + return(f) + if (length(f) != 2L) + stop("Unexpected two-sided formula: ", deparse(f)) + eval(f[[2]], data, environment(f)) +} + +# Given a data object and lng/lat arguments (which may be NULL [meaning infer +# from data], formula [which should be evaluated with respect to the data], or +# vector data [which should be used as-is]) return a lng/lat data frame. +derivePoints <- function(data, lng, lat) { + if (is.null(lng) || is.null(lat)) { + pts <- pointData(data) + if (is.null(lng)) + lng <- pts$lng + if (is.null(lat)) + lat <- pts$lat + } + + lng <- resolveFormula(lng, data) + lat <- resolveFormula(lat, data) + return(data.frame(lng=lng, lat=lat)) +} + # TODO: Add tests +#' @export pointData <- function(obj) { UseMethod("pointData") } +#' @export pointData.default <- function(obj) { stop("Don't know how to get location data from object of class ", class(obj)) } +#' @export pointData.data.frame <- function(obj) { cols <- guessLatLongCols(names(obj)) return(data.frame( - lng = obj[cols$lng], - lat = obj[cols$lat] + lng = obj[[cols$lng]], + lat = obj[[cols$lat]] )) } +#' @export pointData.matrix <- function(obj) { dims <- dim(obj) if (length(dims) != 2) { @@ -52,6 +81,7 @@ pointData.matrix <- function(obj) { data.frame(lng = obj[,1], lat = obj[,2]) } +#' @export pointData.SpatialPoints <- function(obj) { structure( as.data.frame(sp::coordinates(obj)), @@ -59,6 +89,7 @@ pointData.SpatialPoints <- function(obj) { ) } +#' @export pointData.SpatialPointsDataFrame <- function(obj) { structure( as.data.frame(sp::coordinates(obj)), diff --git a/R/utils.R b/R/utils.R index 94e6ec3ca..1bdf42526 100644 --- a/R/utils.R +++ b/R/utils.R @@ -8,7 +8,7 @@ appendMapData = function(map, component, ...) { x = map$x[[component]] if (is.null(x)) x = list() n = length(x) - x[[n + 1]] = evalFormula(list(...), map) + x[[n + 1]] = evalFormula(list(...), getMapData(map)) map$x[[component]] = x map } From fe0bc40c889ad959c3be9338cafb6c6322712e53 Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Tue, 9 Dec 2014 17:38:12 -0800 Subject: [PATCH 4/9] Layer-specific data overrides; infer lat/lng - Add data parameter to most layer functions - Reverse order of lat/lng to lng/lat in most functions - If lng and/or lat are NULL, infer spatial points from data if possible - Change how data is stored; map$x$data means the data will be serialized and sent to the client, that's bad - Add normalize.R examples, we can delete once this all shakes out --- NAMESPACE | 6 +++ R/layers.R | 80 +++++++++++++++++++++++---------------- R/leaflet.R | 9 ++++- R/utils.R | 4 +- inst/examples/leaflet.R | 28 +++++++------- inst/examples/normalize.R | 29 ++++++++++++++ man/leaflet.Rd | 28 +++++++------- 7 files changed, 120 insertions(+), 64 deletions(-) create mode 100644 inst/examples/normalize.R diff --git a/NAMESPACE b/NAMESPACE index 4028256f2..175a0bbd7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,3 +1,8 @@ +S3method(pointData,SpatialPoints) +S3method(pointData,SpatialPointsDataFrame) +S3method(pointData,data.frame) +S3method(pointData,default) +S3method(pointData,matrix) export("%>%") export(addCircleMarkers) export(addCircles) @@ -12,6 +17,7 @@ export(clearBounds) export(fitBounds) export(leaflet) export(leafletOutput) +export(pointData) export(renderLeaflet) export(setView) export(uspop2000) diff --git a/R/layers.R b/R/layers.R index d5ca3200d..22d1109a8 100644 --- a/R/layers.R +++ b/R/layers.R @@ -71,12 +71,12 @@ addTiles = function( '© OpenStreetMap', 'contributors, CC-BY-SA' ) - appendMapData(map, 'tileLayer', urlTemplate = urlTemplate, options = options) + appendMapData(map, getMapData(map), 'tileLayer', urlTemplate = urlTemplate, options = options) } #' @export addPopups = function( - map, lat, lng, content, layerId = NULL, + map, lng, lat, content, layerId = NULL, maxWidth = 300, minWidth = 50, maxHeight = NULL, @@ -89,16 +89,18 @@ addPopups = function( # autoPanPadding = TODO, zoomAnimation = TRUE, closeOnClick = NULL, - className = "" + className = "", + data = getMapData(map) ) { - options <- makeOpts(match.call(), c("map", "lat", "lng", "content", "layerId")) - appendMapData(map, 'popup', lat, lng, content, layerId, options) %>% - expandLimits(lat, lng) + options <- makeOpts(match.call(), c("map", "lng", "lat", "content", "layerId", "data")) + pts <- derivePoints(data, lng, lat) + appendMapData(map, data, 'popup', pts$lat, pts$lng, content, layerId, options) %>% + expandLimits(pts$lat, pts$lng) } #' @export addMarkers = function( - map, lat, lng, layerId = NULL, + map, lng, lat, layerId = NULL, icon = NULL, clickable = TRUE, draggable = FALSE, @@ -108,16 +110,18 @@ addMarkers = function( zIndexOffset = 0, opacity = 1.0, riseOnHover = FALSE, - riseOffset = 250 + riseOffset = 250, + data = getMapData(map) ) { - options <- makeOpts(match.call(), c("map", "lat", "lng", "layerId")) - appendMapData(map, 'marker', lat, lng, layerId, options) %>% - expandLimits(lat, lng) + options <- makeOpts(match.call(), c("map", "lng", "lat", "layerId", "data")) + pts <- derivePoints(data, lng, lat) + appendMapData(map, data, 'marker', pts$lat, pts$lng, layerId, options) %>% + expandLimits(pts$lat, pts$lng) } #' @export addCircleMarkers = function( - map, lat, lng, radius = 10, layerId = NULL, + map, lng = NULL, lat = NULL, radius = 10, layerId = NULL, stroke = TRUE, color = "#03F", weight = 5, @@ -130,16 +134,18 @@ addCircleMarkers = function( lineJoin = NULL, clickable = TRUE, pointerEvents = NULL, - className = "" + className = "", + data = getMapData(map) ) { - options <- makeOpts(match.call(), c("map", "lat", "lng", "radius", "layerId")) - appendMapData(map, 'circleMarker', lat, lng, radius, layerId, options) %>% - expandLimits(lat, lng) + options <- makeOpts(match.call(), c("map", "lng", "lat", "radius", "layerId", "data")) + pts <- derivePoints(data, lng, lat) + appendMapData(map, data, 'circleMarker', pts$lat, pts$lng, radius, layerId, options) %>% + expandLimits(pts$lat, pts$lng) } #' @export addCircles = function( - map, lat, lng, radius = 10, layerId = NULL, + map, lng = NULL, lat = NULL, radius = 10, layerId = NULL, stroke = TRUE, color = "#03F", weight = 5, @@ -152,17 +158,19 @@ addCircles = function( lineJoin = NULL, clickable = TRUE, pointerEvents = NULL, - className = "" + className = "", + data = getMapData(map) ) { - options <- makeOpts(match.call(), c("map", "lat", "lng", "radius", "layerId")) - appendMapData(map, 'circle', lat, lng, radius, layerId, options) %>% - expandLimits(lat, lng) + options <- makeOpts(match.call(), c("map", "lng", "lat", "radius", "layerId", "data")) + pts <- derivePoints(data, lng, lat) + appendMapData(map, data, 'circle', pts$lat, pts$lng, radius, layerId, options) %>% + expandLimits(pts$lat, pts$lng) } # WARNING: lat and lng are LISTS of latitude and longitude vectors #' @export addPolylines = function( - map, lat, lng, layerId = NULL, + map, lng, lat, layerId = NULL, smoothFactor = 1.0, noClip = FALSE, color = "#03F", @@ -173,16 +181,18 @@ addPolylines = function( lineJoin = NULL, clickable = TRUE, pointerEvents = NULL, - className = "" + className = "", + data = getMapData(map) ) { - options <- makeOpts(match.call(), c("map", "lat", "lng", "layerId")) - appendMapData(map, 'polyline', lat, lng, layerId, options) %>% + options <- makeOpts(match.call(), c("map", "lng", "lat", "layerId", "data")) + # TODO: expandLimits doesn't work here if lat/lng are formulae + appendMapData(map, data, 'polyline', lat, lng, layerId, options) %>% expandLimits(unlist(lat), unlist(lng)) } #' @export addRectangles = function( - map, lat1, lng1, lat2, lng2, layerId = NULL, + map, lng1 = NULL, lat1 = NULL, lng2 = NULL, lat2 = NULL, layerId = NULL, smoothFactor = 1.0, noClip = FALSE, color = "#03F", @@ -196,10 +206,12 @@ addRectangles = function( lineJoin = NULL, clickable = TRUE, pointerEvents = NULL, - className = "" + className = "", + data = getMapData(map) ) { - options <- makeOpts(match.call(), c("map", "lat1", "lng1", "lat2", "lng2", "layerId")) - appendMapData(map, 'rectangle',lat1, lng1, lat2, lng2, layerId, options) %>% + options <- makeOpts(match.call(), c("map", "lat1", "lng1", "lat2", "lng2", "layerId", "data")) + # TODO: expandLimits doesn't work here if lat/lng are formulae + appendMapData(map, data, 'rectangle',lat1, lng1, lat2, lng2, layerId, options) %>% expandLimits(c(lat1, lat2), c(lng1, lng2)) } @@ -220,14 +232,16 @@ addPolygons = function( lineJoin = NULL, clickable = TRUE, pointerEvents = NULL, - className = "" + className = "", + data = getMapData(map) ) { - options <- makeOpts(match.call(), c("map", "lat", "lng", "layerId")) - appendMapData(map, 'polygon', lat, lng, layerId, options) %>% + options <- makeOpts(match.call(), c("map", "lng", "lat", "layerId", "data")) + # TODO: expandLimits doesn't work here if lat/lng are formulae + appendMapData(map, data, 'polygon', lat, lng, layerId, options) %>% expandLimits(unlist(lat), unlist(lng)) } #' @export addGeoJSON = function(map, data, layerId = NULL, options = list()) { - appendMapData(map, 'geoJSON', data, layerId, options) + appendMapData(map, getMapData(map), 'geoJSON', data, layerId, options) } diff --git a/R/leaflet.R b/R/leaflet.R index cd25bc35c..5d8660e05 100644 --- a/R/leaflet.R +++ b/R/leaflet.R @@ -14,7 +14,10 @@ leaflet = function(data = NULL, id = NULL, width = NULL, height = NULL, padding = 0) { htmlwidgets::createWidget( 'leaflet', - list(mapId = id, data = data), + structure( + list(mapId = id), + leafletData = data + ), width = width, height = height, sizingPolicy = htmlwidgets::sizingPolicy( defaultWidth = 'auto', @@ -24,3 +27,7 @@ leaflet = function(data = NULL, id = NULL, width = NULL, height = NULL, padding ) ) } + +getMapData <- function(map) { + attr(map$x, "leafletData", exact = TRUE) +} diff --git a/R/utils.R b/R/utils.R index 1bdf42526..1ae444acb 100644 --- a/R/utils.R +++ b/R/utils.R @@ -4,11 +4,11 @@ filterNULL = function(x) { x[!unlist(lapply(x, is.null))] } -appendMapData = function(map, component, ...) { +appendMapData = function(map, data, component, ...) { x = map$x[[component]] if (is.null(x)) x = list() n = length(x) - x[[n + 1]] = evalFormula(list(...), getMapData(map)) + x[[n + 1]] = evalFormula(list(...), data) map$x[[component]] = x map } diff --git a/inst/examples/leaflet.R b/inst/examples/leaflet.R index 0170ae6ca..0085f9931 100644 --- a/inst/examples/leaflet.R +++ b/inst/examples/leaflet.R @@ -11,35 +11,35 @@ m = m %>% setView(c(42.0285, -93.65), zoom = 17) m # popup -m %>% addPopups(42.0285, -93.65, 'Here is the Department of Statistics, ISU') -rand_lat = function(n = 10) rnorm(n, 42.0285, .01) +m %>% addPopups(-93.65, 42.0285, 'Here is the Department of Statistics, ISU') rand_lng = function(n = 10) rnorm(n, -93.65, .01) +rand_lat = function(n = 10) rnorm(n, 42.0285, .01) m = m %>% clearBounds() # TODO: only one popup can be opened; need to bind all popups in a layer and show all -m %>% addPopups(rand_lat(), rand_lng(), 'Random popups') +m %>% addPopups(rand_lng(), rand_lat(), 'Random popups') # marker -m %>% addMarkers(rand_lat(), rand_lng()) +m %>% addMarkers(rand_lng(), rand_lat()) # circle (units in metres) -m %>% addCircles(rand_lat(50), rand_lng(50), radius = runif(50, 50, 150)) +m %>% addCircles(rand_lng(50), rand_lat(50), radius = runif(50, 50, 150)) # circle marker (units in pixels) -m %>% addCircleMarkers(rand_lat(50), rand_lng(50), color = '#ff0000') -m %>% addCircleMarkers(rand_lat(100), rand_lng(100), radius = runif(100, 5, 15)) +m %>% addCircleMarkers(rand_lng(50), rand_lat(50), color = '#ff0000') +m %>% addCircleMarkers(rand_lng(100), rand_lat(100), radius = runif(100, 5, 15)) # rectangle m %>% addRectangles( - rand_lat(), rand_lng(), rand_lat(), rand_lng(), + rand_lng(), rand_lat(), rand_lng(), rand_lat(), color = 'red', fill = FALSE, dashArray = '5,5', weight = 3 ) # polyline -m %>% addPolylines(rand_lat(50), rand_lng(50)) +m %>% addPolylines(rand_lng(50), rand_lat(50)) # polygon -m %>% addPolygons(rand_lat(), rand_lng(), layerId = 'foo') +m %>% addPolygons(rand_lng(), rand_lat(), layerId = 'foo') # geoJSON seattle_geojson <- list( @@ -118,7 +118,7 @@ df = data.frame( lat = rand_lat(100), lng = rand_lng(100), size = runif(100, 5, 20), color = rgb(runif(100), runif(100), runif(100)), stringsAsFactors = FALSE ) -m = leaflet(df) %>% addTiles() %>% setView(c(42.0285, -93.65), zoom = 17) -m %>% addCircleMarkers(~lat, ~lng, radius = ~size) -m %>% addCircleMarkers(~lat, ~lng, radius = runif(100, 4, 10), color = 'red') -m %>% addCircleMarkers(~lat, ~lng, radius = runif(100, 4, 10), color = ~color) +m = leaflet(df) %>% addTiles() +m %>% addCircleMarkers(~lng, ~lat, radius = ~size) +m %>% addCircleMarkers(~lng, ~lat, radius = runif(100, 4, 10), color = 'red') +m %>% addCircleMarkers(~lng, ~lat, radius = runif(100, 4, 10), color = ~color) diff --git a/inst/examples/normalize.R b/inst/examples/normalize.R new file mode 100644 index 000000000..7b9bee93e --- /dev/null +++ b/inst/examples/normalize.R @@ -0,0 +1,29 @@ +library(leaflet) +library(sp) + +## Create different forms of point data ========== + +# Individual lng/lat vectors +lng <- runif(20) +lat <- runif(20) +# Simple matrix +mtx <- cbind(lng, lat) +# Spatial +pts <- sp::SpatialPoints(mtx) +ptsdf <- sp::SpatialPointsDataFrame(pts, data.frame(1:20)) +# Data frame with standard col names +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) + +# Make some circles, without formulas +leaflet() %>% addCircles(lng, lat) +leaflet() %>% addCircles(data = pts) +leaflet() %>% addCircles(data = ptsdf) +leaflet(data) %>% addCircles() +leaflet() %>% addCircles(data = data) + +# Make some circles, with formulas +leaflet(data) %>% addCircles(~Longitude, ~Latitude) +leaflet(dataWeird) %>% addCircles(~LngCol, ~LatCol) +leaflet() %>% addCircles(~LngCol, ~LatCol, data = dataWeird) diff --git a/man/leaflet.Rd b/man/leaflet.Rd index 9da904404..9a839962d 100644 --- a/man/leaflet.Rd +++ b/man/leaflet.Rd @@ -36,35 +36,35 @@ m = m \%>\% setView(c(42.0285, -93.65), zoom = 17) m # popup -m \%>\% addPopups(42.0285, -93.65, 'Here is the Department of Statistics, ISU') -rand_lat = function(n = 10) rnorm(n, 42.0285, .01) +m \%>\% addPopups(-93.65, 42.0285, 'Here is the Department of Statistics, ISU') rand_lng = function(n = 10) rnorm(n, -93.65, .01) +rand_lat = function(n = 10) rnorm(n, 42.0285, .01) m = m \%>\% clearBounds() # TODO: only one popup can be opened; need to bind all popups in a layer and show all -m \%>\% addPopups(rand_lat(), rand_lng(), 'Random popups') +m \%>\% addPopups(rand_lng(), rand_lat(), 'Random popups') # marker -m \%>\% addMarkers(rand_lat(), rand_lng()) +m \%>\% addMarkers(rand_lng(), rand_lat()) # circle (units in metres) -m \%>\% addCircles(rand_lat(50), rand_lng(50), radius = runif(50, 50, 150)) +m \%>\% addCircles(rand_lng(50), rand_lat(50), radius = runif(50, 50, 150)) # circle marker (units in pixels) -m \%>\% addCircleMarkers(rand_lat(50), rand_lng(50), color = '#ff0000') -m \%>\% addCircleMarkers(rand_lat(100), rand_lng(100), radius = runif(100, 5, 15)) +m \%>\% addCircleMarkers(rand_lng(50), rand_lat(50), color = '#ff0000') +m \%>\% addCircleMarkers(rand_lng(100), rand_lat(100), radius = runif(100, 5, 15)) # rectangle m \%>\% addRectangles( - rand_lat(), rand_lng(), rand_lat(), rand_lng(), + rand_lng(), rand_lat(), rand_lng(), rand_lat(), color = 'red', fill = FALSE, dashArray = '5,5', weight = 3 ) # polyline -m \%>\% addPolylines(rand_lat(50), rand_lng(50)) +m \%>\% addPolylines(rand_lng(50), rand_lat(50)) # polygon -m \%>\% addPolygons(rand_lat(), rand_lng(), layerId = 'foo') +m \%>\% addPolygons(rand_lng(), rand_lat(), layerId = 'foo') # geoJSON seattle_geojson <- list( @@ -143,8 +143,8 @@ df = data.frame( lat = rand_lat(100), lng = rand_lng(100), size = runif(100, 5, 20), color = rgb(runif(100), runif(100), runif(100)), stringsAsFactors = FALSE ) -m = leaflet(df) \%>\% addTiles() \%>\% setView(c(42.0285, -93.65), zoom = 17) -m \%>\% addCircleMarkers(~lat, ~lng, radius = ~size) -m \%>\% addCircleMarkers(~lat, ~lng, radius = runif(100, 4, 10), color = 'red') -m \%>\% addCircleMarkers(~lat, ~lng, radius = runif(100, 4, 10), color = ~color) +m = leaflet(df) \%>\% addTiles() +m \%>\% addCircleMarkers(~lng, ~lat, radius = ~size) +m \%>\% addCircleMarkers(~lng, ~lat, radius = runif(100, 4, 10), color = 'red') +m \%>\% addCircleMarkers(~lng, ~lat, radius = runif(100, 4, 10), color = ~color) } From 126a3ada4d1794057ca66ded51742dee70d5b1dc Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Tue, 9 Dec 2014 17:56:43 -0800 Subject: [PATCH 5/9] Baby steps towards better polygon inputs --- R/layers.R | 13 +++++++++---- inst/examples/normalize.R | 7 +++++++ 2 files changed, 16 insertions(+), 4 deletions(-) diff --git a/R/layers.R b/R/layers.R index 22d1109a8..508e23736 100644 --- a/R/layers.R +++ b/R/layers.R @@ -185,7 +185,8 @@ addPolylines = function( data = getMapData(map) ) { options <- makeOpts(match.call(), c("map", "lng", "lat", "layerId", "data")) - # TODO: expandLimits doesn't work here if lat/lng are formulae + lng <- resolveFormula(lng, data) + lat <- resolveFormula(lat, data) appendMapData(map, data, 'polyline', lat, lng, layerId, options) %>% expandLimits(unlist(lat), unlist(lng)) } @@ -210,7 +211,10 @@ addRectangles = function( data = getMapData(map) ) { options <- makeOpts(match.call(), c("map", "lat1", "lng1", "lat2", "lng2", "layerId", "data")) - # TODO: expandLimits doesn't work here if lat/lng are formulae + lng1 <- resolveFormula(lng1, data) + lat1 <- resolveFormula(lat1, data) + lng2 <- resolveFormula(lng2, data) + lat2 <- resolveFormula(lat2, data) appendMapData(map, data, 'rectangle',lat1, lng1, lat2, lng2, layerId, options) %>% expandLimits(c(lat1, lat2), c(lng1, lng2)) } @@ -218,7 +222,7 @@ addRectangles = function( # WARNING: lat and lng are LISTS of latitude and longitude vectors #' @export addPolygons = function( - map, lat, lng, layerId = NULL, + map, lng, lat, layerId = NULL, smoothFactor = 1.0, noClip = FALSE, color = "#03F", @@ -236,7 +240,8 @@ addPolygons = function( data = getMapData(map) ) { options <- makeOpts(match.call(), c("map", "lng", "lat", "layerId", "data")) - # TODO: expandLimits doesn't work here if lat/lng are formulae + lng <- resolveFormula(lng, data) + lat <- resolveFormula(lat, data) appendMapData(map, data, 'polygon', lat, lng, layerId, options) %>% expandLimits(unlist(lat), unlist(lng)) } diff --git a/inst/examples/normalize.R b/inst/examples/normalize.R index 7b9bee93e..5f2f64af8 100644 --- a/inst/examples/normalize.R +++ b/inst/examples/normalize.R @@ -27,3 +27,10 @@ leaflet() %>% addCircles(data = data) leaflet(data) %>% addCircles(~Longitude, ~Latitude) leaflet(dataWeird) %>% addCircles(~LngCol, ~LatCol) leaflet() %>% addCircles(~LngCol, ~LatCol, data = dataWeird) + + +# Some polygon data +plng <- list(runif(3) + 1, runif(3) + 2, runif(3) + 3) +plat <- list(runif(3), runif(3), runif(3)) +pdata <- data.frame(Latitude=I(plat), Longitude=I(plng)) +leaflet(pdata) %>% addTiles() %>% addPolygons(~Longitude, ~Latitude) From 6b914a7a912bb2bf0eb0239a61d5c6dfa33caa81 Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Tue, 9 Dec 2014 17:58:20 -0800 Subject: [PATCH 6/9] Whoops, rect lat/lng can't be null (yet?) --- R/layers.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/layers.R b/R/layers.R index 508e23736..1af78e1da 100644 --- a/R/layers.R +++ b/R/layers.R @@ -193,7 +193,7 @@ addPolylines = function( #' @export addRectangles = function( - map, lng1 = NULL, lat1 = NULL, lng2 = NULL, lat2 = NULL, layerId = NULL, + map, lng1, lat1, lng2, lat2, layerId = NULL, smoothFactor = 1.0, noClip = FALSE, color = "#03F", From 6500bd05506c5d36b58370fe5436f8d4e84adce4 Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Tue, 9 Dec 2014 23:17:26 -0800 Subject: [PATCH 7/9] Better validation, error messages --- R/layers.R | 20 ++++++++++---------- R/normalize.R | 17 +++++++++++++++-- inst/examples/leaflet.R | 4 ++-- inst/examples/normalize.R | 15 +++++++++++++++ man/leaflet.Rd | 4 ++-- 5 files changed, 44 insertions(+), 16 deletions(-) diff --git a/R/layers.R b/R/layers.R index 1af78e1da..7903b5f1b 100644 --- a/R/layers.R +++ b/R/layers.R @@ -76,7 +76,7 @@ addTiles = function( #' @export addPopups = function( - map, lng, lat, content, layerId = NULL, + map, lng = NULL, lat = NULL, content, layerId = NULL, maxWidth = 300, minWidth = 50, maxHeight = NULL, @@ -93,14 +93,14 @@ addPopups = function( data = getMapData(map) ) { options <- makeOpts(match.call(), c("map", "lng", "lat", "content", "layerId", "data")) - pts <- derivePoints(data, lng, lat) + pts <- derivePoints(data, lng, lat, missing(lng), missing(lat), "addPopups") appendMapData(map, data, 'popup', pts$lat, pts$lng, content, layerId, options) %>% expandLimits(pts$lat, pts$lng) } #' @export addMarkers = function( - map, lng, lat, layerId = NULL, + map, lng = NULL, lat = NULL, layerId = NULL, icon = NULL, clickable = TRUE, draggable = FALSE, @@ -114,7 +114,7 @@ addMarkers = function( data = getMapData(map) ) { options <- makeOpts(match.call(), c("map", "lng", "lat", "layerId", "data")) - pts <- derivePoints(data, lng, lat) + pts <- derivePoints(data, lng, lat, missing(lng), missing(lat), "addMarkers") appendMapData(map, data, 'marker', pts$lat, pts$lng, layerId, options) %>% expandLimits(pts$lat, pts$lng) } @@ -138,7 +138,7 @@ addCircleMarkers = function( data = getMapData(map) ) { options <- makeOpts(match.call(), c("map", "lng", "lat", "radius", "layerId", "data")) - pts <- derivePoints(data, lng, lat) + pts <- derivePoints(data, lng, lat, missing(lng), missing(lat), "addCircleMarkers") appendMapData(map, data, 'circleMarker', pts$lat, pts$lng, radius, layerId, options) %>% expandLimits(pts$lat, pts$lng) } @@ -162,7 +162,7 @@ addCircles = function( data = getMapData(map) ) { options <- makeOpts(match.call(), c("map", "lng", "lat", "radius", "layerId", "data")) - pts <- derivePoints(data, lng, lat) + pts <- derivePoints(data, lng, lat, missing(lng), missing(lat), "addCircles") appendMapData(map, data, 'circle', pts$lat, pts$lng, radius, layerId, options) %>% expandLimits(pts$lat, pts$lng) } @@ -170,7 +170,7 @@ addCircles = function( # WARNING: lat and lng are LISTS of latitude and longitude vectors #' @export addPolylines = function( - map, lng, lat, layerId = NULL, + map, lng = NULL, lat = NULL, layerId = NULL, smoothFactor = 1.0, noClip = FALSE, color = "#03F", @@ -222,7 +222,7 @@ addRectangles = function( # WARNING: lat and lng are LISTS of latitude and longitude vectors #' @export addPolygons = function( - map, lng, lat, layerId = NULL, + map, lng = NULL, lat = NULL, layerId = NULL, smoothFactor = 1.0, noClip = FALSE, color = "#03F", @@ -247,6 +247,6 @@ addPolygons = function( } #' @export -addGeoJSON = function(map, data, layerId = NULL, options = list()) { - appendMapData(map, getMapData(map), 'geoJSON', data, layerId, options) +addGeoJSON = function(map, geojson, layerId = NULL, options = list()) { + appendMapData(map, getMapData(map), 'geoJSON', geojson, layerId, options) } diff --git a/R/normalize.R b/R/normalize.R index 14a27fff0..f81a2e34d 100644 --- a/R/normalize.R +++ b/R/normalize.R @@ -34,8 +34,12 @@ resolveFormula <- function(f, data) { # Given a data object and lng/lat arguments (which may be NULL [meaning infer # from data], formula [which should be evaluated with respect to the data], or # vector data [which should be used as-is]) return a lng/lat data frame. -derivePoints <- function(data, lng, lat) { - if (is.null(lng) || is.null(lat)) { +derivePoints <- function(data, lng, lat, missingLng, missingLat, funcName) { + if (missingLng || missingLat) { + if (is.null(data)) { + stop("Point data not found; please provide ", funcName, + " with data and/or lng/lat arguments") + } pts <- pointData(data) if (is.null(lng)) lng <- pts$lng @@ -45,6 +49,15 @@ derivePoints <- function(data, lng, lat) { 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") + } + return(data.frame(lng=lng, lat=lat)) } diff --git a/inst/examples/leaflet.R b/inst/examples/leaflet.R index 0085f9931..b16262f70 100644 --- a/inst/examples/leaflet.R +++ b/inst/examples/leaflet.R @@ -106,12 +106,12 @@ m %>% setView(c(47.6759920119894, -122.36075812146), zoom = 13) %>% addGeoJSON(s # use the OSM BW layer -leaflet() %>% addTiles('http://{s}.www.toolserver.org/tiles/bw-mapnik/{z}/{x}/{y}.png', list( +leaflet() %>% addTiles('http://{s}.www.toolserver.org/tiles/bw-mapnik/{z}/{x}/{y}.png', attribution = paste( '© OpenStreetMap contributors,', 'CC-BY-SA' ) -)) +) # provide a data frame to leaflet() df = data.frame( diff --git a/inst/examples/normalize.R b/inst/examples/normalize.R index 5f2f64af8..e692862f2 100644 --- a/inst/examples/normalize.R +++ b/inst/examples/normalize.R @@ -28,6 +28,21 @@ leaflet(data) %>% addCircles(~Longitude, ~Latitude) leaflet(dataWeird) %>% addCircles(~LngCol, ~LatCol) leaflet() %>% addCircles(~LngCol, ~LatCol, data = dataWeird) +# Recycling of lng/lat is valid (should it be??) +leaflet() %>% addTiles() %>% addCircles(c(1,2), sort(runif(20) + 10)) +# Plotting of empty data is OK +leaflet(data.frame(Latitude=numeric(0), Longitude=numeric(0))) %>% addCircles() +leaflet() %>% addCircles(numeric(0), numeric(0)) + +# Error cases +leaflet() %>% addCircles() # No data at all +leaflet() %>% addCircles(NULL, NULL) # Explicit NULL +leaflet() %>% addCircles(NULL, 1) # Explicit NULL longitude +leaflet() %>% addCircles(1, NULL) # Explicit NULL latitude +nolat <- NULL +# Indirect NULL. It'd be OK for lat to be missing, but not for it to be present +# and NULL. +leaflet(data) %>% addCircles(1, nolat) # Some polygon data plng <- list(runif(3) + 1, runif(3) + 2, runif(3) + 3) diff --git a/man/leaflet.Rd b/man/leaflet.Rd index 9a839962d..446748603 100644 --- a/man/leaflet.Rd +++ b/man/leaflet.Rd @@ -131,12 +131,12 @@ m \%>\% setView(c(47.6759920119894, -122.36075812146), zoom = 13) \%>\% addGeoJS # use the OSM BW layer -leaflet() \%>\% addTiles('http://{s}.www.toolserver.org/tiles/bw-mapnik/{z}/{x}/{y}.png', list( +leaflet() \%>\% addTiles('http://{s}.www.toolserver.org/tiles/bw-mapnik/{z}/{x}/{y}.png', attribution = paste( '© OpenStreetMap contributors,', 'CC-BY-SA' ) -)) +) # provide a data frame to leaflet() df = data.frame( From c69610ec6e56aafd2b971d58a3d1430ad82b13bf Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Tue, 9 Dec 2014 23:18:52 -0800 Subject: [PATCH 8/9] Remove unnecessary returns I often use unnecessary returns for clarity but these two are pretty egregious :) --- R/normalize.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/normalize.R b/R/normalize.R index f81a2e34d..268ffd493 100644 --- a/R/normalize.R +++ b/R/normalize.R @@ -58,7 +58,7 @@ derivePoints <- function(data, lng, lat, missingLng, missingLat, funcName) { stop(funcName, " requires non-NULL latitude values") } - return(data.frame(lng=lng, lat=lat)) + data.frame(lng=lng, lat=lat) } # TODO: Add tests @@ -75,10 +75,10 @@ pointData.default <- function(obj) { #' @export pointData.data.frame <- function(obj) { cols <- guessLatLongCols(names(obj)) - return(data.frame( + data.frame( lng = obj[[cols$lng]], lat = obj[[cols$lat]] - )) + ) } #' @export From 76fc4da3bb0c34da1edc297557667b886dfc7a87 Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Tue, 9 Dec 2014 23:20:45 -0800 Subject: [PATCH 9/9] Only print first class in error message --- R/normalize.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/normalize.R b/R/normalize.R index 268ffd493..71f18a7b2 100644 --- a/R/normalize.R +++ b/R/normalize.R @@ -69,7 +69,8 @@ pointData <- function(obj) { #' @export pointData.default <- function(obj) { - stop("Don't know how to get location data from object of class ", class(obj)) + stop("Don't know how to get location data from object of class ", + class(obj)[[1]]) } #' @export