Merge pull request #72 from trafficonese/layergroupcollision

Layergroupcollision

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
+#'
+#' @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 LayerGroupCollision
+#' @examples
+#' library(leaflet)
+#' library(sf)
+#' library(leaflet.extras2)
+#'
+#' df <- sf::st_as_sf(atlStorms2005)
+#' df <- suppressWarnings(st_cast(df, "POINT"))
+#' df$classes <- sample(x = 1:5, nrow(df), replace = TRUE)
+#'
+#' leaflet() %>%
+#'   addProviderTiles("CartoDB.Positron") %>%
+#'   leaflet::addLayersControl(overlayGroups = c("Labels")) %>%
+#'   addPolylines(data = sf::st_as_sf(atlStorms2005), label = ~Name) %>%
+#'   addLayerGroupCollision(
+#'     data = df, margin = 40,
+#'     html = ~ paste0(
+#'       '<div style="width: max-content; background-color: #cbc0c04f" 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)
+}

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")

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)