Issue394

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)

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)

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 )
+}

R/mapdeck_map_utilities.R

@@ -131,6 +131,7 @@ layerId <- function(
 		, "cesium"
 		, "i3s"
 		, "geojson"
+		, "geohash"
 		, "greatcircle"
 		, "grid"
 		, "h3"

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)

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 );
+}