diff --git a/NAMESPACE b/NAMESPACE index 13929861..bb646bbd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -51,6 +51,7 @@ export(add_bitmap) export(add_cesium) export(add_column) export(add_dependencies) +export(add_geohash) export(add_geojson) export(add_greatcircle) export(add_grid) @@ -75,6 +76,7 @@ export(clear_animated_arc) export(clear_arc) export(clear_bitmap) export(clear_column) +export(clear_geohash) export(clear_geojson) export(clear_greatcircle) export(clear_grid) diff --git a/NEWS.md b/NEWS.md index c0ca1489..fc954300 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# v0.3.7 + +* `add_s2` and `clear_s2` for adding S2 layers to the map [issue394](https://github.com/SymbolixAU/mapdeck/issues/394) + # v0.3.6 * `add_legend` and `clear_legend()` for adding custom legends to the map [issue 390](https://github.com/SymbolixAU/mapdeck/issues/390) diff --git a/R/map_layer_geohash.R b/R/map_layer_geohash.R new file mode 100644 index 00000000..4e9049c0 --- /dev/null +++ b/R/map_layer_geohash.R @@ -0,0 +1,177 @@ +mapdeckGeohashDependency <- function() { + list( + createHtmlDependency( + name = "geohash", + version = "1.0.0", + src = system.file("htmlwidgets/lib/geohash", package = "mapdeck"), + script = c("geohash.js"), + all_files = FALSE + ) + ) +} + +#' Add geohash +#' +#' The GeohashLayer renders filled and/or stroked polygons based on the Geohash +#' geospatial indexing system. To use, See examples. +#' +#' @inheritParams add_polygon +#' @param geohash column of \code{data} containing the geohash indexes +#' +#' @section transitions: +#' +#' The transitions argument lets you specify the time it will take for the shapes to transition +#' from one state to the next. Only works in an interactive environment (Shiny) +#' and on WebGL-2 supported browsers and hardware. +#' +#' The time is in milliseconds +#' +#' Available transitions for geohash +#' +#' list( +#' elevation = 0 +#' colour = 0 +#' ) +#' +#' @examples +#' \dontrun{ +#' +#' ## You need a valid access token from Mapbox +#' key <- 'abc' +#' set_token( key ) +#' +#' mapdeck( +#' style = mapdeck_style("dark") +#' , location = c(-122.419, 37.774) +#' , zoom = 10 +#' , pitch = 60 +#' ) %>% +#' add_geohash( +#' data = geohash +#' , geohash = "geohash" +#' , fill_colour = "value" +#' , auto_highlight = TRUE +#' , legend = TRUE +#' , elevation = "value" +#' , elevation_scale = 1000 +#' , palette = colourvalues::get_palette("inferno") +#' ) +#' +#' } +#' +#' @details +#' +#' \code{add_geohash} supports a data.frame with a column of geohash indexes +#' +#' +#' @export +add_geohash <- function( + map, + data = get_map_data(map), + geohash = NULL, + stroke_colour = NULL, + stroke_width = NULL, + stroke_opacity = NULL, + fill_colour = NULL, + fill_opacity = NULL, + elevation = NULL, + tooltip = NULL, + auto_highlight = FALSE, + elevation_scale = 1, + highlight_colour = "#AAFFFFFF", + light_settings = list(), + layer_id = NULL, + id = NULL, + palette = "viridis", + na_colour = "#808080FF", + legend = FALSE, + legend_options = NULL, + legend_format = NULL, + update_view = TRUE, + focus_layer = FALSE, + transitions = NULL +) { + + if( nrow( data ) == 0 ) { + return( clear_geohash( map, layer_id ) ) + } + + l <- list() + l[["geohash"]] <- force( geohash ) + l[["stroke_colour"]] <- force( stroke_colour ) + l[["stroke_width"]] <- force( stroke_width ) + l[["stroke_opacity"]] <- resolve_opacity( stroke_opacity ) + l[["fill_colour"]] <- force( fill_colour ) + l[["fill_opacity"]] <- resolve_opacity( fill_opacity ) + l[["elevation"]] <- force( elevation ) + l[["tooltip"]] <- force( tooltip ) + l[["id"]] <- force( id ) + l[["na_colour"]] <- force( na_colour ) + + l <- resolve_palette( l, palette ) + l <- resolve_legend( l, legend ) + l <- resolve_legend_options( l, legend_options ) + + # l <- resolve_data( data, l, c("POINT","MULTIPOINT") ) + l[["data_type"]] <- "df" + l[["data"]] <- data + + bbox <- init_bbox() + update_view <- force( update_view ) + focus_layer <- force( focus_layer ) + + is_extruded <- TRUE + if( !is.null( l[["stroke_width"]] ) | !is.null( l[["stroke_colour"]] ) ) { + is_extruded <- FALSE + if( !is.null( elevation ) ) { + message("stroke provided, ignoring elevation") + } + if( is.null( l[["stroke_width"]] ) ) { + l[["stroke_width"]] <- 1L + } + } + + if ( !is.null(l[["data"]]) ) { + data <- l[["data"]] + l[["data"]] <- NULL + } + + checkHexAlpha(highlight_colour) + layer_id <- layerId(layer_id, "geohash") + + map <- addDependency(map, mapdeckGeohashDependency()) + + tp <- l[["data_type"]] + l[["data_type"]] <- NULL + + geometry_column <- "geohash" + + ## use 'polyline' method because we have strings (cells), not lat/lon coordinates + shape <- rcpp_point_polyline( data, l, geometry_column, "geohash") + + jsfunc <- "add_geohash" + + light_settings <- jsonify::to_json(light_settings, unbox = T) + js_transitions <- resolve_transitions(transitions, "polygon") + + if( inherits( legend, "json" ) ) { + shape[["legend"]] <- legend + legend_format <- "hex" + } else { + shape[["legend"]] <- resolve_legend_format( shape[["legend"]], legend_format ) + legend_format <- "rgb" + } + + invoke_method( + map, jsfunc, map_type( map ), shape[["data"]], layer_id, light_settings, + elevation_scale, auto_highlight, highlight_colour, shape[["legend"]], legend_format, + js_transitions, is_extruded + ) +} + +#' @rdname clear +#' @export +clear_geohash <- function(map, layer_id = NULL, update_view = TRUE, clear_legend = TRUE) { + layer_id <- layerId(layer_id, "geohash") + invoke_method(map, "md_layer_clear", map_type( map ), layer_id, "geohash", update_view, clear_legend ) +} diff --git a/R/mapdeck_map_utilities.R b/R/mapdeck_map_utilities.R index 2caca973..cb3f4245 100644 --- a/R/mapdeck_map_utilities.R +++ b/R/mapdeck_map_utilities.R @@ -131,6 +131,7 @@ layerId <- function( , "cesium" , "i3s" , "geojson" + , "geohash" , "greatcircle" , "grid" , "h3" diff --git a/data-raw/geohash.R b/data-raw/geohash.R new file mode 100644 index 00000000..7021ae5c --- /dev/null +++ b/data-raw/geohash.R @@ -0,0 +1,4 @@ +url <- "https://raw.githubusercontent.com/visgl/deck.gl-data/master/website/sf.geohashes.json" +geohash <- jsonify::from_json(url) + +usethis::use_data(geohash, overwrite = TRUE) diff --git a/data/geohash.rda b/data/geohash.rda new file mode 100644 index 00000000..9885a97c Binary files /dev/null and b/data/geohash.rda differ diff --git a/docs/articles/img/articles/geohash.png b/docs/articles/img/articles/geohash.png new file mode 100644 index 00000000..da8f31a0 Binary files /dev/null and b/docs/articles/img/articles/geohash.png differ diff --git a/inst/htmlwidgets/lib/geohash/geohash.js b/inst/htmlwidgets/lib/geohash/geohash.js new file mode 100644 index 00000000..3efffeaf --- /dev/null +++ b/inst/htmlwidgets/lib/geohash/geohash.js @@ -0,0 +1,41 @@ +function add_geohash( map_id, map_type, geohash_data, layer_id, light_settings, elevation_scale, auto_highlight, highlight_colour, legend, legend_format, js_transition, is_extruded ) { +//bbox, update_view, focus_layer, + + // console.log( legend ); + + const geohashLayer = new deck.GeohashLayer({ + map_id: map_id, + id: 'geohash-'+layer_id, + data: geohash_data, + pickable: true, + stroked: true, + filled: true, + wireframe: false, + extruded: is_extruded, + lineWidthMinPixels: 0, + getGeohash: d => d.geohash, + getLineColor: d => d.stroke_colour, + getFillColor: d => d.fill_colour, + getLineWidth: d => d.stroke_width, + getElevation: d => d.elevation, + elevationScale: elevation_scale, + lightSettings: light_settings, + autoHighlight: auto_highlight, + highlightColor: md_hexToRGBA( highlight_colour ), + onHover: md_update_tooltip, + onClick: info => md_layer_click( map_id, "geohash", info ), + transitions: js_transition || {} + }); + + if( map_type == "google_map") { + md_update_overlay( map_id, 'geohash-'+layer_id, geohashLayer ); + } else { + md_update_layer( map_id, 'geohash-'+layer_id, geohashLayer ); + } + + if (legend !== false) { + md_add_legend(map_id, map_type, layer_id, legend, legend_format); + } + + // md_layer_view( map_id, map_type, layer_id, focus_layer, bbox, update_view ); +} diff --git a/man/add_geohash.Rd b/man/add_geohash.Rd new file mode 100644 index 00000000..b861b7ef --- /dev/null +++ b/man/add_geohash.Rd @@ -0,0 +1,151 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/map_layer_geohash.R +\name{add_geohash} +\alias{add_geohash} +\title{Add geohash} +\usage{ +add_geohash( + map, + data = get_map_data(map), + geohash = NULL, + stroke_colour = NULL, + stroke_width = NULL, + stroke_opacity = NULL, + fill_colour = NULL, + fill_opacity = NULL, + elevation = NULL, + tooltip = NULL, + auto_highlight = FALSE, + elevation_scale = 1, + highlight_colour = "#AAFFFFFF", + light_settings = list(), + layer_id = NULL, + id = NULL, + palette = "viridis", + na_colour = "#808080FF", + legend = FALSE, + legend_options = NULL, + legend_format = NULL, + update_view = TRUE, + focus_layer = FALSE, + transitions = NULL +) +} +\arguments{ +\item{map}{a mapdeck map object} + +\item{data}{data to be used in the layer. All coordinates are expected to be +EPSG:4326 (WGS 84) coordinate system} + +\item{geohash}{column of \code{data} containing the geohash indexes} + +\item{stroke_colour}{variable of \code{data} or hex colour for the stroke. If used, +\code{elevation} is ignored. +If using a hex colour, use either a single value, or a column of hex colours on \code{data}} + +\item{stroke_width}{width of the stroke in meters. If used, \code{elevation} is ignored. Default 1.} + +\item{stroke_opacity}{Either a string specifying the column of \code{data} +containing the opacity of each shape, or a single value in [0,255], or [0, 1), +to be applied to all the shapes. Default 255. If a hex-string is used as the +colour, this argument is ignored and you should include the alpha on the hex string} + +\item{fill_colour}{column of \code{data} or hex colour for the fill colour. +If using a hex colour, use either a single value, or a column of hex colours on \code{data}} + +\item{fill_opacity}{Either a string specifying the column of \code{data} +containing the opacity of each shape, or a single value in [0,255], or [0, 1), +to be applied to all the shapes. Default 255. If a hex-string is used as the +colour, this argument is ignored and you should include the alpha on the hex string} + +\item{elevation}{the height the polygon extrudes from the map. Only available if neither +\code{stroke_colour} or \code{stroke_width} are supplied. Default 0} + +\item{tooltip}{variable of \code{data} containing text or HTML to render as a tooltip} + +\item{auto_highlight}{logical indicating if the shape under the mouse should auto-highlight} + +\item{elevation_scale}{elevation multiplier.} + +\item{highlight_colour}{hex string colour to use for highlighting. Must contain the alpha component.} + +\item{light_settings}{list of light setting parameters. See \link{light_settings}} + +\item{layer_id}{single value specifying an id for the layer. Use this value to +distinguish between shape layers of the same type. Layers with the same id are likely +to conflict and not plot correctly} + +\item{id}{an id value in \code{data} to identify layers when interacting in Shiny apps.} + +\item{palette}{string or matrix. String will be one of \code{colourvalues::colour_palettes()}. +A matrix must have at least 5 rows, and 3 or 4 columns of values between [0, 255], +where the 4th column represents the alpha. You can use a named list to specify a different +palette for different colour options (where available), + e.g. list(fill_colour = "viridis", stroke_colour = "inferno")} + +\item{na_colour}{hex string colour to use for NA values} + +\item{legend}{either a logical indiciating if the legend(s) should be displayed, or +a named list indicating which colour attributes should be included in the legend.} + +\item{legend_options}{A list of options for controlling the legend.} + +\item{legend_format}{A list containing functions to apply to legend values. See section legend} + +\item{update_view}{logical indicating if the map should update the bounds to include this layer} + +\item{focus_layer}{logical indicating if the map should update the bounds to only include this layer} + +\item{transitions}{list specifying the duration of transitions.} +} +\description{ +The GeohashLayer renders filled and/or stroked polygons based on the Geohash +geospatial indexing system. To use, See examples. +} +\details{ +\code{add_geohash} supports a data.frame with a column of geohash indexes +} +\section{transitions}{ + + +The transitions argument lets you specify the time it will take for the shapes to transition +from one state to the next. Only works in an interactive environment (Shiny) +and on WebGL-2 supported browsers and hardware. + +The time is in milliseconds + +Available transitions for geohash + +list( +elevation = 0 +colour = 0 +) +} + +\examples{ +\dontrun{ + +## You need a valid access token from Mapbox +key <- 'abc' +set_token( key ) + +mapdeck( + style = mapdeck_style("dark") + , location = c(-122.419, 37.774) + , zoom = 10 + , pitch = 60 + ) \%>\% + add_geohash( + data = geohash + , geohash = "geohash" + , fill_colour = "value" + , auto_highlight = TRUE + , legend = TRUE + , elevation = "value" + , elevation_scale = 1000 + , palette = colourvalues::get_palette("inferno") + ) + +} + +} diff --git a/man/clear.Rd b/man/clear.Rd index 4a964fb5..fce6394a 100644 --- a/man/clear.Rd +++ b/man/clear.Rd @@ -1,18 +1,20 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/map_layer_animated_arc.R, % R/map_layer_animated_line.R, R/map_layer_arc.R, R/map_layer_bitmap.R, -% R/map_layer_column.R, R/map_layer_geojson.R, R/map_layer_greatcircle.R, -% R/map_layer_grid.R, R/map_layer_h3.R, R/map_layer_heatmap.R, -% R/map_layer_hexagon.R, R/map_layer_line.R, R/map_layer_mesh.R, -% R/map_layer_path.R, R/map_layer_pointcloud.R, R/map_layer_polygon.R, -% R/map_layer_scatterplot.R, R/map_layer_screengrid.R, R/map_layer_terrain.R, -% R/map_layer_text.R, R/map_layer_title.R, R/map_layer_trips.R +% R/map_layer_column.R, R/map_layer_geohash.R, R/map_layer_geojson.R, +% R/map_layer_greatcircle.R, R/map_layer_grid.R, R/map_layer_h3.R, +% R/map_layer_heatmap.R, R/map_layer_hexagon.R, R/map_layer_line.R, +% R/map_layer_mesh.R, R/map_layer_path.R, R/map_layer_pointcloud.R, +% R/map_layer_polygon.R, R/map_layer_scatterplot.R, R/map_layer_screengrid.R, +% R/map_layer_terrain.R, R/map_layer_text.R, R/map_layer_title.R, +% R/map_layer_trips.R \name{clear_animated_arc} \alias{clear_animated_arc} \alias{clear_line} \alias{clear_arc} \alias{clear_bitmap} \alias{clear_column} +\alias{clear_geohash} \alias{clear_geojson} \alias{clear_greatcircle} \alias{clear_grid} @@ -42,6 +44,8 @@ clear_bitmap(map, layer_id = NULL, update_view = TRUE) clear_column(map, layer_id = NULL, update_view = TRUE, clear_legend = TRUE) +clear_geohash(map, layer_id = NULL, update_view = TRUE, clear_legend = TRUE) + clear_geojson(map, layer_id = NULL, update_view = TRUE, clear_legend = TRUE) clear_greatcircle( diff --git a/src/point.cpp b/src/point.cpp index 659e0418..bf84c57d 100644 --- a/src/point.cpp +++ b/src/point.cpp @@ -56,7 +56,8 @@ Rcpp::StringVector get_point_legend_colours( std::string layer_name ) { Rcpp::StringVector point_legend; - if( layer_name == "column" || layer_name == "scatterplot" || layer_name == "h3") { + if( layer_name == "column" || layer_name == "scatterplot" || layer_name == "h3" + || layer_name == "geohash" ) { point_legend = mapdeck::layer_colours::fill_stroke_legend; } else if ( layer_name == "pointcloud" ) { point_legend = mapdeck::layer_colours::fill_legend; @@ -70,7 +71,8 @@ std::unordered_map< std::string, std::string > get_point_colours( std::string la std::unordered_map< std::string, std::string > point_colours; - if( layer_name == "column" || layer_name == "scatterplot" || layer_name == "h3" ) { + if( layer_name == "column" || layer_name == "scatterplot" || layer_name == "h3" + || layer_name == "geohash" ) { point_colours = mapdeck::layer_colours::fill_stroke_colours; } else if ( layer_name == "pointcloud" ) { point_colours = mapdeck::layer_colours::fill_colours; diff --git a/tests/testthat/test-layer_geohash.R b/tests/testthat/test-layer_geohash.R new file mode 100644 index 00000000..89cfcdef --- /dev/null +++ b/tests/testthat/test-layer_geohash.R @@ -0,0 +1,48 @@ +context("geohash") + + +test_that("add_geohash accepts multiple objects", { + + testthat::skip_on_cran() + + library(geohashTools) + + geo <- "[{\"elevation\":0,\"fill_colour\":[68.0,1.0,84.0,255.0],\"stroke_colour\":[68.0,1.0,84.0,255.0],\"geohash\":\"9q8yu\"}]" + poly <- '[{"weight":1.0,"polyline":"_ifpEo`ydL"}]' + + ## sf + set_token("abc") + m <- mapdeck() + sf <- sfheaders::sf_point( capitals[1, ], x = "lon", y = "lat" ) + p <- add_geohash(map = m, data = geohash[1,], geohash = "geohash") + expect_equal( as.character( p$x$calls[[1]]$args[[2]] ), geo ) + + # ## sfencoded + # enc <- googlePolylines::encode( sf ) + # p <- add_geohash( map = m, data = enc ) + # expect_equal( as.character( p$x$calls[[1]]$args[[2]] ), poly ) + # + # ## sfencodedLite + # enc <- googlePolylines::encode( sf, strip = T ) + # p <- add_geohash( map = m, data = enc ) + # expect_equal( as.character( p$x$calls[[1]]$args[[2]] ), poly ) + + ## data.frame with polyline + # df <- as.data.frame( enc ) + # df$geometry <- unlist( df$geometry ) + # + # p <- add_geohash( map = m, data = df, polyline = "geometry" ) + # expect_equal( as.character( p$x$calls[[1]]$args[[2]] ), poly ) + + ## data.frame + # p <- add_geohash( map = m, data = capitals[1, ], lon = "lon", lat = "lat" ) + # expect_equal( as.character( p$x$calls[[1]]$args[[2]] ), geo ) + +}) + +test_that("empty data doesn't crash",{ + m <- mapdeck() + res <- mapdeck::add_geohash(map = m, data = data.frame()) + expect_true( res$x$calls[[1]]$functions == "md_layer_clear" ) +}) + diff --git a/tests/testthat/test-map_layers.R b/tests/testthat/test-map_layers.R index 4fbc795b..bcb56238 100644 --- a/tests/testthat/test-map_layers.R +++ b/tests/testthat/test-map_layers.R @@ -14,6 +14,7 @@ test_that("layerId includes all layers", { , "bitmap" , "column" , "geojson" + , "geohash" , "greatcircle" , "grid" , "h3" diff --git a/vignettes/img/articles/geohash.png b/vignettes/img/articles/geohash.png new file mode 100644 index 00000000..da8f31a0 Binary files /dev/null and b/vignettes/img/articles/geohash.png differ diff --git a/vignettes/layers.Rmd b/vignettes/layers.Rmd index b9f1d1fe..585d9dfd 100644 --- a/vignettes/layers.Rmd +++ b/vignettes/layers.Rmd @@ -320,6 +320,20 @@ add_screengrid( ![Screengrid](./img/articles/screengrid_small.gif) +## Geohash + +```{r} + +mapdeck( token = key, style = mapdeck_style('dark')) %>% + add_geohash(data = mapdeck::geohash + , geohash = "geohash" + , fill_colour = "value" + , elevation = "value" + , elevation_scale = 1000) + +``` + +![Scatter](./img/articles/geohash.png) ## Text