Merge pull request #3 from r-spatial/master

sync fork

DESCRIPTION

@@ -19,7 +19,11 @@ Authors@R:
       person(given = "Kent",
              family = "Johnson",
              role = "ctb",
-             email = "kjohnson@akoyabio.com"))
+             email = "kjohnson@akoyabio.com"),
+      person(given = "Sebastian",
+             family = "Gatscha",
+             role = "ctb",
+             email = "sebastian_gatscha@gmx.at"))
 Maintainer: Tim Appelhans <tim.appelhans@gmail.com>
 Description: Provides bindings to Leaflet.glify which extends leaflet to render large data in the browser using webgl.
 License: MIT + file LICENSE
@@ -32,9 +36,10 @@ Imports:
   jsonify, 
   jsonlite,
   leaflet,
-  sf
+  sf,
+  grDevices
 Suggests:
-    colourvalues, 
-    mapview, 
-    shiny, 
-    testthat
+    colourvalues,
+    mapview,
+    shiny,
+    testthat (>= 2.1.0)

NAMESPACE

@@ -1,14 +1,40 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(makeColorMatrix,Date)
+S3method(makeColorMatrix,POSIXct)
+S3method(makeColorMatrix,POSIXlt)
+S3method(makeColorMatrix,character)
+S3method(makeColorMatrix,data.frame)
+S3method(makeColorMatrix,factor)
+S3method(makeColorMatrix,formula)
+S3method(makeColorMatrix,integer)
+S3method(makeColorMatrix,json)
+S3method(makeColorMatrix,list)
+S3method(makeColorMatrix,matrix)
+S3method(makeColorMatrix,numeric)
+S3method(makePopup,Spatial)
+S3method(makePopup,character)
+S3method(makePopup,data.frame)
+S3method(makePopup,default)
+S3method(makePopup,formula)
+S3method(makePopup,json)
+S3method(makePopup,list)
+S3method(makePopup,logical)
+S3method(makePopup,matrix)
+S3method(makePopup,sf)
+S3method(makePopup,shiny.tag)
 export(addGlPoints)
 export(addGlPolygons)
 export(addGlPolylines)
 export(clearGlLayers)
 export(leafglOutput)
+export(makeColorMatrix)
+export(makePopup)
 export(removeGlPoints)
 export(removeGlPolygons)
 export(removeGlPolylines)
 export(renderLeafgl)
+importFrom(htmltools,htmlDependencies)
 importFrom(htmltools,tagList)
 importFrom(htmltools,tags)
 importFrom(leaflet,leafletOutput)

R/glify-lines.R

@@ -48,26 +48,42 @@ addGlPolylines = function(map,
 
   bounds = as.numeric(sf::st_bbox(data))
 
+  # color
+  args <- list(...)
+  palette = "viridis"
+  if ("palette" %in% names(args)) {
+    palette <- args$palette
+    args$palette = NULL
+  }
+  color <- makeColorMatrix(color, data, palette = palette)
+  if (ncol(color) != 3) stop("only 3 column color matrix supported so far")
+  color = as.data.frame(color, stringsAsFactors = FALSE)
+  colnames(color) = c("r", "g", "b")
+
+  # cols = jsonlite::toJSON(color)
+  cols = jsonify::to_json(color, digits = 3)
+
   # data
   if (is.null(popup)) {
     # geom = sf::st_transform(sf::st_geometry(data), crs = 4326)
     geom = sf::st_geometry(data)
     data = sf::st_sf(id = 1:length(geom), geometry = geom)
   } else if (isTRUE(popup)) {
-    data = data
-  } else {
     data = data[, popup]
+  } else {
+    htmldeps <- htmltools::htmlDependencies(popup)
+    if (length(htmldeps) != 0) {
+      map$dependencies = c(
+        map$dependencies,
+        htmldeps
+      )
+    }
+    popup = makePopup(popup, data)
+    popup = jsonify::to_json(popup)
   }
-
-  data = geojsonsf::sf_geojson(data, ...)
-
-  # color
-  if (ncol(color) != 3) stop("only 3 column color matrix supported so far")
-  color = as.data.frame(color, stringsAsFactors = FALSE)
-  colnames(color) = c("r", "g", "b")
-
-  # cols = jsonlite::toJSON(color)
-  cols = jsonify::to_json(color, digits = 3)
+  if (length(args) == 0) args <- NULL
+  data = do.call(geojsonsf::sf_geojson, c(list(data), args))
+  # data = geojsonsf::sf_geojson(data, ...)
 
   # dependencies
   map$dependencies = c(

R/glify-points.R

@@ -7,15 +7,19 @@
 #'
 #' @param map a leaflet map to add points/polygons to.
 #' @param data sf/sp point/polygon data to add to the map.
-#' @param color a three-column rgb matrix with values between 0 and 1.
+#' @param color Object representing the color. Can be of class integer, character with
+#'   color names, HEX codes or random characters, factor, matrix, data.frame, list, json or formula.
+#'   See the examples or \link{makeColorMatrix} for more information.
 #' @param opacity feature opacity. Numeric between 0 and 1.
 #'   Note: expect funny results if you set this to < 1.
 #' @param weight point size in pixels.
 #' @param group a group name for the feature layer.
+#' @param popup Object representing the popup. Can be of type character with column names,
+#'   formula, logical, data.frame or matrix, Spatial, list or JSON. If the lenght does not
+#'   match the number of rows in the dataset, the popup vector is repeated to match the dimension.
 #' @param layerId the layer id
-#' @param popup logical or the name of the column in data to be used for popups.
 #' @param weight line width/thicknes in pixels for \code{addGlPolylines}.
-#' @param ... ignored.
+#' @param ... Passed to \code{\link{to_json}{jsonify}} for the data coordinates
 #'
 #' @describeIn addGlPoints add points to a leaflet map using Leaflet.glify
 #' @examples
@@ -66,28 +70,44 @@ addGlPoints = function(map,
 
   bounds = as.numeric(sf::st_bbox(data))
 
-  # data
-  # data = sf::st_transform(data, 4326)
-  crds = sf::st_coordinates(data)[, c(2, 1)]
-
   # color
+  args <- list(...)
+  palette = "viridis"
+  if ("palette" %in% names(args)) {
+    palette <- args$palette
+    args$palette = NULL
+  }
+  color <- makeColorMatrix(color, data, palette = palette)
   if (ncol(color) != 3) stop("only 3 column color matrix supported so far")
   color = as.data.frame(color, stringsAsFactors = FALSE)
   colnames(color) = c("r", "g", "b")
 
   # color = jsonlite::toJSON(color)
   color = jsonify::to_json(color)
+
   # popup
   if (!is.null(popup)) {
+    htmldeps <- htmltools::htmlDependencies(popup)
+    if (length(htmldeps) != 0) {
+      map$dependencies = c(
+        map$dependencies,
+        htmldeps
+      )
+    }
+    popup = makePopup(popup, data)
     # popup = jsonlite::toJSON(data[[popup]])
-    popup = jsonify::to_json(data[[popup]])
+    popup = jsonify::to_json(popup)
   } else {
     popup = NULL
   }
 
+  # data
+  # data = sf::st_transform(data, 4326)
+  crds = sf::st_coordinates(data)[, c(2, 1)]
   # convert data to json
   # data = jsonlite::toJSON(crds, digits = 7)
-  data = jsonify::to_json(crds, ...)
+  if (length(args) == 0) args <- NULL
+  data = do.call(jsonify::to_json, c(list(crds), args))
 
   # dependencies
   map$dependencies = c(

R/glify-polygons.R

@@ -46,25 +46,43 @@ addGlPolygons = function(map,
 
   bounds = as.numeric(sf::st_bbox(data))
 
-  # data
-  if (is.null(popup)) {
-    # geom = sf::st_transform(sf::st_geometry(data), crs = 4326)
-    geom = sf::st_geometry(data)
-    data = sf::st_sf(id = 1:length(geom), geometry = geom)
-  } else {
-    data = data[, popup]
-  }
-
-  data = geojsonsf::sf_geojson(data, ...)
-
   # color
+  args <- list(...)
+  palette = "viridis"
+  if ("palette" %in% names(args)) {
+    palette <- args$palette
+    args$palette = NULL
+  }
+  color <- makeColorMatrix(color, data, palette = palette)
   if (ncol(color) != 3) stop("only 3 column color matrix supported so far")
   color = as.data.frame(color, stringsAsFactors = FALSE)
   colnames(color) = c("r", "g", "b")
 
   # cols = jsonlite::toJSON(color)
   cols = jsonify::to_json(color, digits = 3)
 
+  # data
+  if (is.null(popup)) {
+    # geom = sf::st_transform(sf::st_geometry(data), crs = 4326)
+    geom = sf::st_geometry(data)
+    data = sf::st_sf(id = 1:length(geom), geometry = geom)
+  } else if (isTRUE(popup)) {
+    data = data[, popup]
+  } else {
+    htmldeps <- htmltools::htmlDependencies(popup)
+    if (length(htmldeps) != 0) {
+      map$dependencies = c(
+        map$dependencies,
+        htmldeps
+      )
+    }
+    popup = makePopup(popup, data)
+    popup = jsonify::to_json(popup)
+  }
+  if (length(args) == 0) args <- NULL
+  data = do.call(geojsonsf::sf_geojson, c(list(data), args))
+  # data = geojsonsf::sf_geojson(data, ...)
+
   # dependencies
   map$dependencies = c(
     map$dependencies,

R/glify-shiny.R

@@ -2,7 +2,7 @@
 #'
 #' @inheritParams leaflet::leafletOutput
 #' @importFrom leaflet leafletOutput
-#' @importFrom htmltools tagList tags
+#' @importFrom htmltools tagList tags htmlDependencies
 #' @return A UI for rendering leafgl
 #' @export
 #'