advanced markers #270

NEWS.md

@@ -3,6 +3,7 @@
 * Uses `async` library loads [issue 256](https://github.com/SymbolixAU/googleway/issues/256)
 * Markers updated to use `AdvancedMarkerElement` [issue 270](https://github.com/SymbolixAU/googleway/issues/270)
   - `colour` argument has changed to be a hex string
+  - `cluster_options` have changed
 
 ## Version 2.7.8
 

R/google_map_layer_marker.R

@@ -35,13 +35,15 @@ googleMarkerClustererDependency <- function() {
 #' Add markers to a google map
 #'
 #' @inheritParams add_circles
-#' @param colour string specifying the column containing the 'colour' to use for
-#' the markers. The colour should be specified as a hex string (e.g. "#FF0000").
-#' @param border_colour string specifying the column containing the 'border colour'
-#' to use for the markers. The colour should be specified as a hex string (e.g. "#FF0000")
-#' @param glyph_colour string specifying the column containing the 'glype colour'
-#' (the center of the marker) to use for the markers.
+#' @param colour string (hex string representation) specifying the column of containing the 'colour' to use for
+#' the markers, or an single hex string to use for all the markers.
+#' @param border_colour string (hex string representation) specifying the column of containing the'border colour'
+#' to use for the markers. The colour should be specified as a hex string (e.g. "#FF0000"),
+#' or an single hex string to use for all the markers.
+#' @param glyph_colour string (hex string representation) specifying the column of containing the 'glyph colour'
+#' (the center of the marker), or an single hex string to use for all the markers.
 #' The colour should be specified as a hex string (e.g. "#FF0000")
+#' @param scale number specifying the scale of the marker.
 #' @param title string specifying the column of \code{data} containing the 'title'
 #' of the markers. The title is displayed when you hover over a marker. If blank,
 #' no title will be displayed for the markers.
@@ -63,13 +65,12 @@ googleMarkerClustererDependency <- function() {
 #' Cluster Options can be supplied as a named list. The available names are
 #'
 #' \itemize{
-#'   \item{gridSize (number) - The grid size of a cluster in pixels}
-#'   \item{maxZoom (number) - The maximum zoom level that a marker can be part of a cluster}
-#'   \item{zoomOnClick (logical) - Whether the default behaviour of clicking on a cluster is to
-#'   zoom into it}
-#'   \item{averageCenter (logical) - Whether the center of each cluster should be the
-#'   average of all markers in the cluster}
-#'   \item{minimumClusterSize (number) - The minimum number of markers required for a cluster}
+#'   \item{minZoom (number - default 0) - The minimum zoom level at which clusters are generated.}
+#'   \item{maxZoom (number - defualt 16) - The maximum zoom level at which clusters are generated.}
+#'   \item{minPoints (number - default 2) - Minimum number of points to form a cluster.}
+#'   \item{radius (number - default 40) - Cluster radius, in pixels.}
+#'   \item{extent (number - default 512) - (Tiles) Tile extent. Radius is calculated relative to this value.}
+#'   \item{nodeSize (number - defualt 64) - Size of the KD-tree leaf node. Affects performance.}
 #' }
 #'
 #' opts <- list(
@@ -88,9 +89,42 @@ googleMarkerClustererDependency <- function() {
 #'  add_markers(
 #'    lat = "stop_lat"
 #'    , lon = "stop_lon"
-#'    , info_window = "stop_name"
+#'    , title = "stop_name"  ## shown when hovering
+#'    , label = "stop_id"    ## shown in center of marker
+#'    , info_window = "stop_name" ## shown when clicking on marker
 #'    )
 #'
+#' ## Colouring markers
+#' google_map(
+#'   key = map_key
+#'   , data = tram_stops
+#'   ) %>%
+#'  add_markers(
+#'    lat = "stop_lat"
+#'    , lon = "stop_lon"
+#'    , title = "stop_name"       ## shown when hovering
+#'    , label = "stop_id"         ## shown in center of marker
+#'    , info_window = "stop_name" ## shown when clicking on marker
+#'    , colour = "#0000FF"        ## Blue
+#'    , glyph_colour = "#00FF00"  ## Green
+#'    , border_colour = "#000000" ## Black
+#'    )
+#'
+#' ## Scale markers
+#' df <- tram_stops
+#' df$scale <- sample(1:5, size = nrow(df), replace = TRUE)
+#' google_map(
+#'   key = map_key
+#'   , data = df
+#'   ) %>%
+#'  add_markers(
+#'    lat = "stop_lat"
+#'    , lon = "stop_lon"
+#'    , colour = "#0000FF"        ## Blue
+#'    , glyph_colour = "#00FF00"  ## Green
+#'    , border_colour = "#000000" ## Black
+#'    , scale = "scale"
+#'    )
 #'
 #' ## using marker icons
 #' iconUrl <- paste0("https://developers.google.com/maps/documentation/",
@@ -118,7 +152,7 @@ googleMarkerClustererDependency <- function() {
 #'    , lon = "stop_lon"
 #'    , info_window = "stop_name"
 #'    , cluster = TRUE
-#'    , cluster_options = list( minimumClusterSize = 5 )
+#'    , cluster_options = list( minPoints = 2, radius = 100)
 #'    )
 #'
 #' }
@@ -129,6 +163,7 @@ add_markers <- function(map,
                         colour = NULL,
                         border_colour = NULL,
                         glyph_colour = NULL,
+                        scale = 1.0,
                         lat = NULL,
                         lon = NULL,
                         polyline = NULL,
@@ -160,6 +195,7 @@ add_markers <- function(map,
   objArgs[["colour"]] <- force( colour )
   objArgs[["border_colour"]] <- force( border_colour )
   objArgs[["glyph_colour"]] <- force( glyph_colour )
+  objArgs[["scale"]] <- force( scale )
   objArgs[["lat"]] <- force( lat )
   objArgs[["lon"]] <- force( lon )
   objArgs[["polyline"]] <- force( polyline )

R/google_map_shape_constructors.R

@@ -164,7 +164,7 @@ requiredHeatmapUpdateColumns <- function() {
 
 ## MARKERS ---------------------------------------------------------------------
 markerColumns <- function() {
-  c('id', 'colour', 'border_colour', 'glyph_colour', 'lat', 'lng', 'title', 'draggable', 'label',
+  c('id', 'colour', 'border_colour', 'glyph_colour', 'scale', 'lat', 'lng', 'title', 'draggable', 'label',
     'info_window', 'mouse_over', 'mouse_over_group', 'url')
 }
 

R/google_place_details.R

@@ -36,7 +36,6 @@
 #'
 #' }
 #' @export
-
 google_place_details <- function(place_id,
                                  language = NULL,
                                  simplify = TRUE,

inst/htmlwidgets/google_map.js

@@ -754,11 +754,11 @@ function clear_object(map_id, objType, layer_id) {
   if (window[map_id + objType + layer_id]) {
     for (i = 0; i < window[map_id + objType + layer_id].length; i++) {
       console.log(window[map_id + objType + layer_id][i]);
-    //https://developers.google.com/maps/documentation/javascript/reference/3/#event
-    google.maps.event.clearInstanceListeners(window[map_id + objType + layer_id][i]);
-    window[map_id + objType + layer_id][i].setMap(null);
-    window[map_id + objType + layer_id][i] = null;
-  }
+      //https://developers.google.com/maps/documentation/javascript/reference/3/#event
+      google.maps.event.clearInstanceListeners(window[map_id + objType + layer_id][i]);
+      window[map_id + objType + layer_id][i].setMap(null);
+      window[map_id + objType + layer_id][i] = null;
+    }
   window[map_id + objType + layer_id] = null;
 
   clear_legend(map_id, layer_id);

inst/htmlwidgets/lib/markers/markers.js

@@ -66,27 +66,23 @@ function promise_to_add_markers(map_id, data_markers, update_map_view, layer_id,
 
 function cluster_markers(map_id, layer_id, cluster_options) {
 
-  /*
-    var opts = cluster_options || {};
-    c
-    console.log( opts );
-    Object.assign( opts,
-      { imagePath: 'https://developers.google.com/maps/documentation/javascript/examples/markerclusterer/m' }
-    );
-  */
+  const minPoints = cluster_options.minimumClusterSize || 2.0;
+  const minZoom = cluster_options.minZoom || 0;
+  const maxZoom = cluster_options.maxZoom || 16;
+  const radius = cluster_options.radius || 40;
+  const extent = cluster_options.extent || 512;
+  const nodeSize = cluster_options.nodeSize || 64;
 
   var markers = window[ map_id + 'googleMarkers' + layer_id ];
 
-  const markerCluster = new markerClusterer.MarkerClusterer({ markers: markers, map: googlewayMap });
+  const markerCluster = new markerClusterer.MarkerClusterer({
+    markers: markers,
+    map: googlewayMap,
+    algorithm: new markerClusterer.SuperClusterAlgorithm({
+      minPoints, minZoom, maxZoom, radius, extent, nodeSize
+    })
+  });
   window[ map_id + 'googleMarkerClusterer' + layer_id ] = markerCluster;
-
-  /*
-    window[map_id + 'googleMarkerClusterer' + layer_id] = new MarkerClusterer(
-      googlewayMap,
-      window[map_id + 'googleMarkers' + layer_id],
-      opts
-    );
-    */
 }
 
 function set_markers(map_id, infoWindow, aMarker, update_map_view, layer_id, use_polyline, timeout) {
@@ -156,22 +152,30 @@ function set_each_marker(latlon, aMarker, infoWindow, update_map_view, map_id, l
     //console.log(aMarker);
     //console.log(googlewayMap);
 
-    var markerInfo
+    var content, markerInfo
+
+    if( aMarker.url !== undefined ) {
+      content = document.createElement("img");
+      content.src = aMarker.url;
+
+    } else {
+      content = new google.maps.marker.PinElement({
+        background: aMarker.colour,
+        borderColor: aMarker.border_colour,
+        glyphColor: aMarker.glyph_colour,
+        glyph: aMarker.label,
+        scale: aMarker.scale
+      }).element;
+    }
+
 
     const marker = new google.maps.marker.AdvancedMarkerElement({
         map: googlewayMap,
         id: aMarker.id,
-        //icon: aMarker.url,
         position: latlon,
         gmpDraggable: aMarker.draggable,
         title: aMarker.title,
-        content: new google.maps.marker.PinElement({
-          background: aMarker.colour,
-          borderColor: aMarker.border_colour,
-          glyphColor: aMarker.glyph_colour,
-          glyph: aMarker.title
-        }).element,
-        //label: aMarker.label,
+        content: content,
         //mouseOver: aMarker.mouse_over,
         //mouseOverGroup: aMarker.mouse_over_group,
         //info_window: aMarker.info_window,
@@ -244,7 +248,6 @@ function set_each_marker(latlon, aMarker, infoWindow, update_map_view, map_id, l
  *          the layer to clear
  */
 function clear_markers(map_id, layer_id) {
-
     // the markers know which map they're on
     // http://stackoverflow.com/questions/7961522/removing-a-marker-in-google-maps-api-v3
     clear_object(map_id, 'googleMarkers', layer_id);

tests/manual_tests.R

@@ -1,13 +1,103 @@
-# ## TODO:
-# ## - marker clusters (add & remove layer)
-# ## -- does this impact any other marker layers?
+## TODO:
+## - marker clusters (add & remove layer)
+## -- does this impact any other marker layers?
+
+## -----------------------
+## Removing Markers
+## -----------------------
+# library(shiny)
+# library(shinydashboard)
+# library(googleway)
+#
+# ui <- dashboardPage(
+#
+#   dashboardHeader(),
+#   dashboardSidebar(),
+#   dashboardBody(
+#     box(width = 12,
+#         google_mapOutput(outputId = "map"),
+#         actionButton(inputId = "marker", label = "clear stops"),
+#     )
+#   )
+# )
+#
+# server <- function(input, output) {
+#   set_key(secret::get_secret("GOOGLE"))
 #
-# ## MARKER CLUSTER
+#   df1 <- tram_stops
+#   df2 <- data.frame(lon = mean(df1$stop_lon), lat = mean(df1$stop_lat))
+#
+#   output$map <- renderGoogle_map({
+#     google_map() %>%
+#       add_markers(
+#         data = df1
+#         , layer_id = "stops"
+#       ) %>%
+#       add_markers(
+#         data = df2
+#         , layer_id = "mean"
+#       )
+#   })
+#
+#   observeEvent(input$marker, {
+#     google_map_update("map") %>%
+#       clear_markers(layer_id = "stops")
+#   })
+#
+# }
+#
+# shinyApp(ui, server)
+
+## -----------------------
+## MARKER CLUSTER
+## -----------------------
 # set_key(secret::get_secret("GOOGLE"))
 # google_map(data = tram_stops) %>%
 #   add_markers(info_window = "stop_name", cluster = TRUE)
 #
-# ## FOCUS LAYER
+#
+# library(shiny)
+# library(shinydashboard)
+# library(googleway)
+#
+# ui <- dashboardPage(
+#
+#   dashboardHeader(),
+#   dashboardSidebar(),
+#   dashboardBody(
+#     box(width = 12,
+#         google_mapOutput(outputId = "map"),
+#         actionButton(inputId = "marker", label = "clear markers"),
+#     )
+#   )
+# )
+#
+# server <- function(input, output) {
+#   set_key(secret::get_secret("GOOGLE"))
+#
+#   df <- tram_stops
+#
+#   output$map <- renderGoogle_map({
+#     google_map() %>%
+#       add_markers(
+#         data = df
+#         , cluster = TRUE
+#       )
+#   })
+#
+#   observeEvent(input$marker, {
+#     google_map_update("map") %>%
+#       clear_markers()
+#   })
+#
+# }
+#
+# shinyApp(ui, server)
+#
+
+## -----------------------
+## FOCUS LAYER
+## -----------------------
 # library(shiny)
 # library(shinydashboard)
 # library(googleway)
@@ -50,8 +140,9 @@
 #
 # shinyApp(ui, server)
 #
-#
-# ## CLEAR MAP BOUNDS
+## -----------------------
+## CLEAR MAP BOUNDS
+## -----------------------
 # ## method
 # ## - add objects, clear objects, clear boudns, add new objects. The boudns
 # ## - should only focus on these new objects, and not include the old ones