Layergroupcollision

DESCRIPTION

@@ -33,4 +33,4 @@ Suggests:
     curl
 URL: https://trafficonese.github.io/leaflet.extras2/, https://github.com/trafficonese/leaflet.extras2
 BugReports: https://github.com/trafficonese/leaflet.extras2/issues
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2

NAMESPACE

@@ -15,6 +15,7 @@ export(addHistory)
 export(addItemContextmenu)
 export(addLabelgun)
 export(addLatLngMoving)
+export(addLayerGroupCollision)
 export(addLeafletsync)
 export(addLeafletsyncDependency)
 export(addMapkeyMarkers)

NEWS.md

@@ -1,5 +1,6 @@
 # leaflet.extras2 (development version)
 
+* Included [LayerGroup.Collision](https://github.com/MazeMap/Leaflet.LayerGroup.Collision) plugin
 * Included [OSM Buildings](https://osmbuildings.org/documentation/leaflet/) plugin
 * New Function `addDivicon` adds `DivIcon` markers to Leaflet maps with support for custom HTML and CSS classes. See the example in `./inst/examples/divicons_html_app.R`
 * Added `addClusterCharts` to enable **pie** and **bar** charts in Marker clusters using `Leaflet.markercluster`, `d3` and `L.DivIcon`, with support for customizable category styling and various aggregation methods like **sum, min, max, mean**, and **median**.

R/divicon.R

@@ -17,13 +17,11 @@ diviconDependency <- function() {
 #' for latitude and longitude coordinates. It allows for the application of custom HTML
 #' content and CSS classes to each marker, providing high flexibility in marker design.
 #'
-#' @param map The Leaflet map object to which the DivIcon markers will be added.
 #' @inheritParams leaflet::addAwesomeMarkers
-#' @param className A single CSS class or a vector of CSS classes to apply to the DivIcon markers.
-#' @param html A single HTML string or a vector of HTML strings to display within the DivIcon markers.
+#' @param className A single CSS class or a vector of CSS classes.
+#' @param html A single HTML string or a vector of HTML strings.
 #' @param divOptions A list of extra options for Leaflet DivIcon.
-#' @param options A list of extra options for the markers.
-#'   See \code{\link[leaflet]{markerOptions}} for more details.
+#'
 #' @family DivIcon Functions
 #' @return The modified Leaflet map object.
 #' @export

R/layergroupcollision.R

@@ -0,0 +1,87 @@
+layergroupCollisionDependency <- function() {
+  list(
+    htmltools::htmlDependency(
+      "lfx-layergroupcollision",
+      version = "1.0.0",
+      src = system.file("htmlwidgets/lfx-layergroupcollision",
+        package = "leaflet.extras2"
+      ),
+      script = c(
+        "rbush.min.js",
+        "Leaflet.LayerGroup.Collision.js",
+        "layergroup-binding.js"
+      ),
+      all_files = TRUE
+    )
+  )
+}
+
+#' Add LayerGroup Collision Plugin to Leaflet Map
+#'
+#' @description Integrates the LayerGroup Collision plugin into a Leaflet map,
+#' which hides overlapping markers and only displays the first added marker in a
+#' collision group. Markers must be static; dynamic changes, dragging, and
+#' deletions are not supported.
+
+#' The function transforms spatial data into GeoJSON format and uses `L.DivIcon`,
+#' allowing you to pass HTML content and CSS classes to style the markers.
+#'
+#' @param group the name of the group. It needs to be single string.
+#' @param margin defines the margin between markers, in pixels
+#' @return A leaflet map object with the LayerGroup Collision plugin added.
+#' @export
+#'
+#' @inheritParams addDivicon
+#' @references \url{https://github.com/MazeMap/Leaflet.LayerGroup.Collision}
+#'
+#' @name LayerroupCollision
+#' @examples
+#' library(leaflet)
+#' library(sf)
+#' library(leaflet.extras2)
+#'
+#' df <- sf::st_as_sf(atlStorms2005)
+#' df <- suppressWarnings(st_cast(df, "POINT"))
+#' df <- df[sample(1:nrow(df), 150, replace = FALSE), ]
+#' df$classes <- sample(x = 1:5, nrow(df), replace = TRUE)
+#'
+#' leaflet() %>%
+#'   addProviderTiles("CartoDB.Positron") %>%
+#'   leaflet::addLayersControl(overlayGroups = c("Labels")) %>%
+#'   addLayerGroupCollision(
+#'     data = df,
+#'     html = ~ paste0(
+#'       '<div style="width: 70px" class="custom-html">',
+#'       '<div class="title">', Name, "</div>",
+#'       '<div class="subtitle">MaxWind: ', MaxWind, "</div>",
+#'       "</div>"
+#'     ),
+#'     className = ~ paste0("my-label my-label-", classes),
+#'     group = "Labels"
+#'   )
+addLayerGroupCollision <- function(
+    map, group = NULL,
+    className = NULL, html = NULL,
+    margin = 5, data = getMapData(map)) {
+  map$dependencies <- c(map$dependencies, layergroupCollisionDependency())
+
+  ## Make Geojson and Assign Class & HTML columns ###########
+  if (!inherits(data, "sf")) {
+    data <- sf::st_as_sf(data)
+  }
+  data$className__ <- evalFormula(className, data)
+  data$html__ <- evalFormula(html, data)
+  geojson <- yyjsonr::write_geojson_str(data)
+  class(geojson) <- c("geojson", "json")
+
+  ## Derive Points and Invoke Method ##################
+  pts <- derivePoints(
+    data, NULL, NULL, TRUE, TRUE,
+    "addLayerGroupCollision"
+  )
+  invokeMethod(
+    map, NULL, "addLayerGroupCollision",
+    geojson, group, margin
+  ) %>%
+    expandLimits(pts$lat, pts$lng)
+}

R/tangram.R

@@ -58,7 +58,7 @@ tangram_deps <- function() {
 addTangram <- function(map, scene = NULL, layerId = NULL, group = NULL,
                        options = NULL) {
   if ((is.null(scene) || !is.character(scene) ||
-       (!gsub(".*\\.", "", scene) %in% c("yaml", "zip")))) {
+    (!gsub(".*\\.", "", scene) %in% c("yaml", "zip")))) {
     stop(
       "The scene must point to a valid .yaml or .zip file.\n",
       "See the documentation for further information."

R/timeslider.R

@@ -3,7 +3,8 @@ timesliderDependencies <- function() {
     htmlDependency(
       "lfx-timeslider", "1.0.0",
       src = system.file("htmlwidgets/lfx-timeslider",
-                        package = "leaflet.extras2"),
+        package = "leaflet.extras2"
+      ),
       stylesheet = "jquery-ui.css",
       script = c(
         "jquery-ui.min.js",
@@ -109,8 +110,10 @@ addTimeslider <- function(map, data, radius = 10,
 
   ## Add Deps and invoke Leaflet
   map$dependencies <- c(map$dependencies, timesliderDependencies())
-  invokeMethod(map, NULL, "addTimeslider", data, options,
-               popupOptions, labelOptions) %>%
+  invokeMethod(
+    map, NULL, "addTimeslider", data, options,
+    popupOptions, labelOptions
+  ) %>%
     expandLimits(bbox[c(2, 4)], bbox[c(1, 3)])
 }
 

R/velocity.R

@@ -3,7 +3,8 @@ velocityDependencies <- function() {
     htmlDependency(
       "lfx-velocity", "1.0.0",
       src = system.file("htmlwidgets/lfx-velocity",
-                        package = "leaflet.extras2"),
+        package = "leaflet.extras2"
+      ),
       script = c(
         "leaflet-velocity.js",
         "leaflet-velocity-bindings.js"

README.md

@@ -41,6 +41,7 @@ If you need a plugin that is not already implemented create an [issue](https://g
 -   [Hexbin-D3](https://github.com/bluehalo/leaflet-d3#hexbins-api)
 -   [History](https://github.com/cscott530/leaflet-history)
 -   [Labelgun](https://github.com/Geovation/labelgun)
+-   [LayerGroup.Collision](https://github.com/MazeMap/Leaflet.LayerGroup.Collision)
 -   [Leaflet.Sync](https://github.com/jieter/Leaflet.Sync)
 -   [Mapkey Icons](https://github.com/mapshakers/leaflet-mapkey-icon)
 -   [Moving Markers](https://github.com/ewoken/Leaflet.MovingMarker)

_pkgdown.yml

@@ -59,6 +59,9 @@ reference:
   - title: Labelgun
     contents:
     - matches("Labelgun")
+  - title: LayerGroup.Collision
+    contents:
+    - matches("LayerGroupCollision")
   - title: Mapkey Icons
     contents:
     - matches("Mapkey")

data-raw/data-raw.R

@@ -1,6 +1,8 @@
 gibs_layerslink <- paste0(
   system.file("htmlwidgets/lfx-gibs",
-              package = "leaflet.extras2"), "/gibs_layers_meta.json")
+    package = "leaflet.extras2"
+  ), "/gibs_layers_meta.json"
+)
 gibs_layers <- jsonify::from_json(json = gibs_layerslink, simplify = TRUE)
 gibs_layers <- data.frame(do.call(rbind, gibs_layers), stringsAsFactors = FALSE)
 gibs_layers$title <- as.character(gibs_layers$title)

inst/examples/layergroupcollision_app.R

@@ -0,0 +1,53 @@
+library(shiny)
+library(leaflet)
+library(sf)
+library(leaflet.extras2)
+options("shiny.autoreload" = TRUE)
+
+df <- sf::st_as_sf(atlStorms2005)
+df <- suppressWarnings(st_cast(df, "POINT"))
+df <- df[sample(1:nrow(df), 150, replace = FALSE),]
+df$classes = sample(x = 1:5, nrow(df), replace = TRUE)
+
+## Ordering is important
+df <- df[order(df$classes, decreasing = FALSE),]
+
+ui <- fluidPage(
+  ## CSS-style ############
+  tags$head(tags$style("
+		.my-label {
+			background: white;
+			border: 1px solid #888;
+			position: relative;
+			display: inline-block;
+			white-space: nowrap;
+		}
+		.my-label-1 { font-size: 28px; background-color: red; top: -26px; }
+		.my-label-2 { font-size: 24px; background-color: orange; top: -25px; }
+		.my-label-3 { font-size: 22px; background-color: yellow; top: -24px; }
+		.my-label-4 { font-size: 16px; background-color: green; top: -23px; }
+		.my-label-5 { font-size: 15px; background-color: lightgreen; top: -22px; }
+  ")),
+  leafletOutput("map", height = 800)
+)
+
+## Server ###########
+server <- function(input, output, session) {
+  output$map <- renderLeaflet({
+    leaflet() %>%
+      addProviderTiles("CartoDB.Positron") %>%
+      leaflet::addLayersControl(overlayGroups = c("Labels")) %>%
+        addLayerGroupCollision(data = df
+                   , html = ~paste0(
+                     '<div class="custom-html">',
+                       '<div class="title">', Name, '</div>',
+                       '<div class="subtitle">MaxWind: ', MaxWind, '</div>',
+                     '</div>'
+                   )
+                   , className = ~paste0("my-label my-label-", classes)
+                   , group = "Labels"
+        )
+
+  })
+}
+shinyApp(ui, server)