diff --git a/DESCRIPTION b/DESCRIPTION
index 31a58752..4aa34c4a 100644
--- a/DESCRIPTION
+++ b/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
diff --git a/NAMESPACE b/NAMESPACE
index 88194ff4..697d4400 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -15,6 +15,7 @@ export(addHistory)
export(addItemContextmenu)
export(addLabelgun)
export(addLatLngMoving)
+export(addLayerGroupCollision)
export(addLeafletsync)
export(addLeafletsyncDependency)
export(addMapkeyMarkers)
diff --git a/NEWS.md b/NEWS.md
index 3320c1f8..463fe55e 100644
--- a/NEWS.md
+++ b/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**.
diff --git a/R/divicon.R b/R/divicon.R
index 0f1daa3e..d785ef68 100644
--- a/R/divicon.R
+++ b/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
diff --git a/R/layergroupcollision.R b/R/layergroupcollision.R
new file mode 100644
index 00000000..7ae1e919
--- /dev/null
+++ b/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(
+#' '',
+#' '
', Name, "
",
+#' '
MaxWind: ', MaxWind, "
",
+#' "
',
+ '
', Name, '
',
+ '
MaxWind: ', MaxWind, '
',
+ '
',
+ '
', Name, '
',
+ '
MaxWind: ', MaxWind, '
',
+ '
',
- '
', Name, '
',
- '
MaxWind: ', MaxWind, '
',
- '
",
- "Name: ", Name, "
",
- "MaxWind:", MaxWind, "
",
- "MinPress:", MinPress)
- , options = markerOptions(draggable = TRUE)
+ addDivicon(
+ data = df,
+ html = ~ paste0(
+ '',
+ '
', Name, "
",
+ '
MaxWind: ', MaxWind, "
",
+ "
",
+ "Name: ", Name, "
",
+ "MaxWind:", MaxWind, "
",
+ "MinPress:", MinPress
+ ),
+ options = markerOptions(draggable = TRUE)
)
}
\concept{DivIcon Functions}
diff --git a/man/addEasyprint.Rd b/man/addEasyprint.Rd
index ca80f693..45d60229 100644
--- a/man/addEasyprint.Rd
+++ b/man/addEasyprint.Rd
@@ -19,12 +19,13 @@ Add a control, which allows to print or export a map as .PNG.
}
\examples{
library(leaflet)
-leaflet() \%>\%
+leaflet() \%>\%
addTiles() \%>\%
addEasyprint(options = easyprintOptions(
- title = 'Print map',
- position = 'bottomleft',
- exportOnly = TRUE))
+ title = "Print map",
+ position = "bottomleft",
+ exportOnly = TRUE
+ ))
}
\references{
\url{https://github.com/rowanwins/leaflet-easyPrint}
diff --git a/man/addGIBS.Rd b/man/addGIBS.Rd
index ba72d9ae..2f7a6f04 100644
--- a/man/addGIBS.Rd
+++ b/man/addGIBS.Rd
@@ -47,12 +47,14 @@ library(leaflet.extras2)
layers <- gibs_layers$title[c(35, 128, 185)]
-leaflet() \%>\%
+leaflet() \%>\%
addTiles() \%>\%
setView(9, 50, 4) \%>\%
- addGIBS(layers = layers,
- dates = Sys.Date() - 1,
- group = layers) \%>\%
+ addGIBS(
+ layers = layers,
+ dates = Sys.Date() - 1,
+ group = layers
+ ) \%>\%
addLayersControl(overlayGroups = layers)
}
\references{
diff --git a/man/addHeightgraph.Rd b/man/addHeightgraph.Rd
index 866aeb3b..ec72689f 100644
--- a/man/addHeightgraph.Rd
+++ b/man/addHeightgraph.Rd
@@ -81,7 +81,7 @@ library(leaflet)
library(leaflet.extras2)
library(sf)
-data <- st_cast(st_as_sf(leaflet::atlStorms2005[4,]), "LINESTRING")
+data <- st_cast(st_as_sf(leaflet::atlStorms2005[4, ]), "LINESTRING")
data <- st_transform(data, 4326)
data <- data.frame(st_coordinates(data))
data$elev <- round(runif(nrow(data), 10, 500), 2)
@@ -98,9 +98,11 @@ data$popup <- apply(data, 1, function(x) {
leaflet() \%>\%
addTiles(group = "base") \%>\%
- addHeightgraph(color = "red", columns = c("steepness", "suitability"),
- opacity = 1, data = data, group = "heightgraph",
- options = heightgraphOptions(width = 400))
+ addHeightgraph(
+ color = "red", columns = c("steepness", "suitability"),
+ opacity = 1, data = data, group = "heightgraph",
+ options = heightgraphOptions(width = 400)
+ )
}
\references{
\url{https://github.com/GIScience/Leaflet.Heightgraph}
diff --git a/man/addHexbin.Rd b/man/addHexbin.Rd
index c31cc064..ac7538a3 100644
--- a/man/addHexbin.Rd
+++ b/man/addHexbin.Rd
@@ -63,16 +63,20 @@ library(leaflet)
library(leaflet.extras2)
n <- 1000
-df <- data.frame(lat = rnorm(n, 42.0285, .01),
- lng = rnorm(n, -93.65, .01))
+df <- data.frame(
+ lat = rnorm(n, 42.0285, .01),
+ lng = rnorm(n, -93.65, .01)
+)
-leaflet() \%>\%
+leaflet() \%>\%
addTiles() \%>\%
- addHexbin(lng = df$lng, lat = df$lat,
- options = hexbinOptions(
- colorRange = c("red", "yellow", "blue"),
- radiusRange = c(10, 20)
- ))
+ addHexbin(
+ lng = df$lng, lat = df$lat,
+ options = hexbinOptions(
+ colorRange = c("red", "yellow", "blue"),
+ radiusRange = c(10, 20)
+ )
+ )
}
\references{
\url{https://github.com/bluehalo/leaflet-d3#hexbins-api}
diff --git a/man/addHistory.Rd b/man/addHistory.Rd
index 4853dc2f..e2d23ea0 100644
--- a/man/addHistory.Rd
+++ b/man/addHistory.Rd
@@ -22,7 +22,7 @@ browser. By default, it is a simple pair of buttons -- back and forward.
}
\examples{
library(leaflet)
-leaflet() \%>\%
+leaflet() \%>\%
addTiles() \%>\%
addHistory()
}
diff --git a/man/addLabelgun.Rd b/man/addLabelgun.Rd
index 4fbb9b58..e6b89fca 100644
--- a/man/addLabelgun.Rd
+++ b/man/addLabelgun.Rd
@@ -40,10 +40,12 @@ library(leaflet.extras2)
leaflet() \%>\%
addTiles() \%>\%
- addMarkers(data = breweries91,
- label = ~brewery,
- group = "markers",
- labelOptions = labelOptions(permanent = TRUE)) \%>\%
+ addMarkers(
+ data = breweries91,
+ label = ~brewery,
+ group = "markers",
+ labelOptions = labelOptions(permanent = TRUE)
+ ) \%>\%
addLabelgun("markers", 1)
}
\references{
diff --git a/man/addMapkeyMarkers.Rd b/man/addMapkeyMarkers.Rd
index 513ff7ca..cf097a88 100644
--- a/man/addMapkeyMarkers.Rd
+++ b/man/addMapkeyMarkers.Rd
@@ -78,15 +78,19 @@ Add Mapkey Markers
\examples{
library(leaflet)
-leaflet() \%>\%
+leaflet() \%>\%
addTiles() \%>\%
- addMapkeyMarkers(data = breweries91,
- icon = makeMapkeyIcon(icon = "mapkey",
- iconSize = 30,
- boxShadow = FALSE,
- background = "transparent"),
- group = "mapkey",
- label = ~state, popup = ~village)
+ addMapkeyMarkers(
+ data = breweries91,
+ icon = makeMapkeyIcon(
+ icon = "mapkey",
+ iconSize = 30,
+ boxShadow = FALSE,
+ background = "transparent"
+ ),
+ group = "mapkey",
+ label = ~state, popup = ~village
+ )
}
\references{
\url{https://github.com/mapshakers/leaflet-mapkey-icon}
diff --git a/man/addMovingMarker.Rd b/man/addMovingMarker.Rd
index 37bb5a1b..1facd689 100644
--- a/man/addMovingMarker.Rd
+++ b/man/addMovingMarker.Rd
@@ -82,20 +82,27 @@ library(sf)
library(leaflet)
library(leaflet.extras2)
-crds <- data.frame(structure(c(-67.5, -68.5, -69.6, -70.5, -71.3, -72.2, -72.7,
- -72.9, -73, -72.4, -70.8, 15.8, 16.5, 17.3, 17.8, 18.3, 18.6,
- 19.8, 21.6, 23.5, 25.1, 27.9, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1),
- dim = c(11L, 3L), dimnames = list(NULL, c("X", "Y", "L1"))))
-df <- st_sf(st_sfc(st_linestring(as.matrix(crds), dim="XYZ"), crs = 4326))
-st_geometry(df) <- "geometry"; df <- st_zm(df)
+crds <- data.frame(structure(
+ c(
+ -67.5, -68.5, -69.6, -70.5, -71.3, -72.2, -72.7,
+ -72.9, -73, -72.4, -70.8, 15.8, 16.5, 17.3, 17.8, 18.3, 18.6,
+ 19.8, 21.6, 23.5, 25.1, 27.9, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
+ ),
+ dim = c(11L, 3L), dimnames = list(NULL, c("X", "Y", "L1"))
+))
+df <- st_sf(st_sfc(st_linestring(as.matrix(crds), dim = "XYZ"), crs = 4326))
+st_geometry(df) <- "geometry"
+df <- st_zm(df)
-leaflet() \%>\%
+leaflet() \%>\%
addTiles() \%>\%
addPolylines(data = df) \%>\%
- addMovingMarker(data = df,
- movingOptions = movingMarkerOptions(autostart = TRUE, loop = TRUE),
- label="I am a pirate!",
- popup="Arrr")
+ addMovingMarker(
+ data = df,
+ movingOptions = movingMarkerOptions(autostart = TRUE, loop = TRUE),
+ label = "I am a pirate!",
+ popup = "Arrr"
+ )
}
\references{
\url{https://github.com/ewoken/Leaflet.MovingMarker}
diff --git a/man/addOpenweatherCurrent.Rd b/man/addOpenweatherCurrent.Rd
index 5b841510..5f2ca2d6 100644
--- a/man/addOpenweatherCurrent.Rd
+++ b/man/addOpenweatherCurrent.Rd
@@ -44,12 +44,14 @@ and if used in Shiny, a click on an icon will update a Shiny input at
library(leaflet)
library(leaflet.extras2)
-Sys.setenv("OPENWEATHERMAP" = 'Your_API_Key')
+Sys.setenv("OPENWEATHERMAP" = "Your_API_Key")
-leaflet() \%>\%
- addTiles() \%>\% setView(9, 50, 9) \%>\%
+leaflet() \%>\%
+ addTiles() \%>\%
+ setView(9, 50, 9) \%>\%
addOpenweatherCurrent(options = openweatherCurrentOptions(
- lang = "en", popup = TRUE))
+ lang = "en", popup = TRUE
+ ))
}
}
\references{
diff --git a/man/addOpenweatherTiles.Rd b/man/addOpenweatherTiles.Rd
index 9540810f..7b9d8d65 100644
--- a/man/addOpenweatherTiles.Rd
+++ b/man/addOpenweatherTiles.Rd
@@ -52,10 +52,11 @@ Out of the box a legend image is only available for Pressure,
library(leaflet)
library(leaflet.extras2)
-Sys.setenv("OPENWEATHERMAP" = 'Your_API_Key')
+Sys.setenv("OPENWEATHERMAP" = "Your_API_Key")
-leaflet() \%>\%
- addTiles() \%>\% setView(9, 50, 6) \%>\%
+leaflet() \%>\%
+ addTiles() \%>\%
+ setView(9, 50, 6) \%>\%
addOpenweatherTiles(layers = "wind")
}
}
diff --git a/man/addPlayback.Rd b/man/addPlayback.Rd
index 00c4521d..db8e5f3e 100644
--- a/man/addPlayback.Rd
+++ b/man/addPlayback.Rd
@@ -68,56 +68,71 @@ library(leaflet.extras2)
library(sf)
## Single Elements
-data <- sf::st_as_sf(leaflet::atlStorms2005[1,])
+data <- sf::st_as_sf(leaflet::atlStorms2005[1, ])
data <- st_cast(data, "POINT")
-data$time = as.POSIXct(
- seq.POSIXt(Sys.time() - 1000, Sys.time(), length.out = nrow(data)))
+data$time <- as.POSIXct(
+ seq.POSIXt(Sys.time() - 1000, Sys.time(), length.out = nrow(data))
+)
data$label <- as.character(data$time)
leaflet() \%>\%
addTiles() \%>\%
- addPlayback(data = data, label = ~label,
- popup = ~sprintf("I am a popup for \%s and \%s",
- Name, label),
- popupOptions = popupOptions(offset = c(0, -35)),
- options = playbackOptions(radius = 3,
- tickLen = 36000,
- speed = 50,
- maxInterpolationTime = 1000),
- pathOpts = pathOptions(weight = 5))
+ addPlayback(
+ data = data, label = ~label,
+ popup = ~ sprintf(
+ "I am a popup for \%s and \%s",
+ Name, label
+ ),
+ popupOptions = popupOptions(offset = c(0, -35)),
+ options = playbackOptions(
+ radius = 3,
+ tickLen = 36000,
+ speed = 50,
+ maxInterpolationTime = 1000
+ ),
+ pathOpts = pathOptions(weight = 5)
+ )
## Multiple Elements
-data <- sf::st_as_sf(leaflet::atlStorms2005[1:5,])
+data <- sf::st_as_sf(leaflet::atlStorms2005[1:5, ])
data$Name <- as.character(data$Name)
data <- st_cast(data, "POINT")
data$time <- unlist(lapply(rle(data$Name)$lengths, function(x) {
- seq.POSIXt(as.POSIXct(Sys.Date()-2), as.POSIXct(Sys.Date()), length.out = x)
+ seq.POSIXt(as.POSIXct(Sys.Date() - 2), as.POSIXct(Sys.Date()), length.out = x)
}))
-data$time <- as.POSIXct(data$time, origin="1970-01-01")
+data$time <- as.POSIXct(data$time, origin = "1970-01-01")
data$label <- paste0("Time: ", data$time)
-data$popup = sprintf("Customized Popup
Name: \%s
Time: \%s",
- data$Name, data$time)
+data$popup <- sprintf(
+ "Customized Popup
Name: \%s
Time: \%s",
+ data$Name, data$time
+)
data <- split(data, f = data$Name)
leaflet() \%>\%
addTiles() \%>\%
- addPlayback(data = data,
- popup = ~popup,
- label = ~label,
- popupOptions = popupOptions(offset=c(0,-35)),
- labelOptions = labelOptions(noHide = TRUE),
- options = playbackOptions(radius = 3,
- tickLen = 1000000,
- speed = 5000,
- maxInterpolationTime = 10000,
- transitionpopup = FALSE,
- transitionlabel = FALSE,
- playCommand = "Let's go",
- stopCommand = "Stop it!",
- color = c("red","green","blue",
- "orange","yellow")),
- pathOpts = pathOptions(weight = 5))
+ addPlayback(
+ data = data,
+ popup = ~popup,
+ label = ~label,
+ popupOptions = popupOptions(offset = c(0, -35)),
+ labelOptions = labelOptions(noHide = TRUE),
+ options = playbackOptions(
+ radius = 3,
+ tickLen = 1000000,
+ speed = 5000,
+ maxInterpolationTime = 10000,
+ transitionpopup = FALSE,
+ transitionlabel = FALSE,
+ playCommand = "Let's go",
+ stopCommand = "Stop it!",
+ color = c(
+ "red", "green", "blue",
+ "orange", "yellow"
+ )
+ ),
+ pathOpts = pathOptions(weight = 5)
+ )
}
\references{
\url{https://github.com/hallahan/LeafletPlayback}
diff --git a/man/addReachability.Rd b/man/addReachability.Rd
index 3c4bdda6..b4691613 100644
--- a/man/addReachability.Rd
+++ b/man/addReachability.Rd
@@ -37,7 +37,7 @@ When used in Shiny, 3 events update a certain shiny Input:
library(leaflet)
library(leaflet.extras2)
-Sys.setenv("OPRS" = 'Your_API_Key')
+Sys.setenv("OPRS" = "Your_API_Key")
leaflet() \%>\%
addTiles() \%>\%
diff --git a/man/addSidebar.Rd b/man/addSidebar.Rd
index 9f5043b1..b48a30ac 100644
--- a/man/addSidebar.Rd
+++ b/man/addSidebar.Rd
@@ -30,12 +30,16 @@ The sidebar HTML must be created with \code{\link{sidebar_tabs}} and
library(shiny)
# run example app showing a single sidebar
-runApp(paste0(system.file("examples", package = "leaflet.extras2"),
- "/sidebar_app.R"))
+runApp(paste0(
+ system.file("examples", package = "leaflet.extras2"),
+ "/sidebar_app.R"
+))
# run example app showing two sidebars
-runApp(paste0(system.file("examples", package = "leaflet.extras2"),
- "/multi_sidebar_app.R"))
+runApp(paste0(
+ system.file("examples", package = "leaflet.extras2"),
+ "/multi_sidebar_app.R"
+))
}
}
\references{
diff --git a/man/addSidebyside.Rd b/man/addSidebyside.Rd
index 963db34e..94c910d0 100644
--- a/man/addSidebyside.Rd
+++ b/man/addSidebyside.Rd
@@ -44,19 +44,29 @@ library(leaflet.extras2)
leaflet(quakes) \%>\%
addMapPane("left", zIndex = 0) \%>\%
addMapPane("right", zIndex = 0) \%>\%
- addTiles(group = "base", layerId = "baseid",
- options = pathOptions(pane = "right")) \%>\%
- addProviderTiles(providers$CartoDB.DarkMatter, group="carto", layerId = "cartoid",
- options = pathOptions(pane = "left")) \%>\%
- addCircleMarkers(data = breweries91[1:15,], color = "blue", group = "blue",
- options = pathOptions(pane = "left")) \%>\%
- addCircleMarkers(data = breweries91[15:20,], color = "yellow", group = "yellow") \%>\%
- addCircleMarkers(data = breweries91[15:30,], color = "red", group = "red",
- options = pathOptions(pane = "right")) \%>\%
- addLayersControl(overlayGroups = c("blue","red", "yellow")) \%>\%
- addSidebyside(layerId = "sidecontrols",
- rightId = "baseid",
- leftId = "cartoid")
+ addTiles(
+ group = "base", layerId = "baseid",
+ options = pathOptions(pane = "right")
+ ) \%>\%
+ addProviderTiles(providers$CartoDB.DarkMatter,
+ group = "carto", layerId = "cartoid",
+ options = pathOptions(pane = "left")
+ ) \%>\%
+ addCircleMarkers(
+ data = breweries91[1:15, ], color = "blue", group = "blue",
+ options = pathOptions(pane = "left")
+ ) \%>\%
+ addCircleMarkers(data = breweries91[15:20, ], color = "yellow", group = "yellow") \%>\%
+ addCircleMarkers(
+ data = breweries91[15:30, ], color = "red", group = "red",
+ options = pathOptions(pane = "right")
+ ) \%>\%
+ addLayersControl(overlayGroups = c("blue", "red", "yellow")) \%>\%
+ addSidebyside(
+ layerId = "sidecontrols",
+ rightId = "baseid",
+ leftId = "cartoid"
+ )
}
\references{
\url{https://github.com/digidem/leaflet-side-by-side}
diff --git a/man/addSpinner.Rd b/man/addSpinner.Rd
index 678748d1..261781bd 100644
--- a/man/addSpinner.Rd
+++ b/man/addSpinner.Rd
@@ -31,7 +31,7 @@ leaflet(data = quakes) \%>\%
addTiles() \%>\%
addSpinner() \%>\%
startSpinner(options = list("lines" = 7, "length" = 20)) \%>\%
- addMarkers(~long, ~lat, popup = ~as.character(mag), label = ~as.character(mag)) \%>\%
+ addMarkers(~long, ~lat, popup = ~ as.character(mag), label = ~ as.character(mag)) \%>\%
stopSpinner()
}
\references{
diff --git a/man/addTangram.Rd b/man/addTangram.Rd
index 082e9b77..345c874c 100644
--- a/man/addTangram.Rd
+++ b/man/addTangram.Rd
@@ -56,8 +56,10 @@ server <- function(input, output, session) {
addTangram(scene = scene, group = "tangram") \%>\%
addCircleMarkers(data = breweries91, group = "brews") \%>\%
setView(11, 49.4, 14) \%>\%
- addLayersControl(baseGroups = c("tangram", "base"),
- overlayGroups = c("brews"))
+ addLayersControl(
+ baseGroups = c("tangram", "base"),
+ overlayGroups = c("brews")
+ )
})
}
diff --git a/man/addTimeslider.Rd b/man/addTimeslider.Rd
index 05d4497d..a19dab78 100644
--- a/man/addTimeslider.Rd
+++ b/man/addTimeslider.Rd
@@ -84,18 +84,22 @@ library(leaflet)
library(leaflet.extras2)
library(sf)
-data <- sf::st_as_sf(leaflet::atlStorms2005[1,])
+data <- sf::st_as_sf(leaflet::atlStorms2005[1, ])
data <- st_cast(data, "POINT")
-data$time = as.POSIXct(
- seq.POSIXt(Sys.time() - 1000, Sys.time(), length.out = nrow(data)))
+data$time <- as.POSIXct(
+ seq.POSIXt(Sys.time() - 1000, Sys.time(), length.out = nrow(data))
+)
leaflet() \%>\%
addTiles() \%>\%
- addTimeslider(data = data,
- options = timesliderOptions(
- position = "topright",
- timeAttribute = "time",
- range = TRUE)) \%>\%
+ addTimeslider(
+ data = data,
+ options = timesliderOptions(
+ position = "topright",
+ timeAttribute = "time",
+ range = TRUE
+ )
+ ) \%>\%
setView(-72, 22, 4)
}
\references{
diff --git a/man/addVelocity.Rd b/man/addVelocity.Rd
index 97e776b0..ddc3a62f 100644
--- a/man/addVelocity.Rd
+++ b/man/addVelocity.Rd
@@ -24,8 +24,8 @@ identifier-style names. Any number of layers and even different types of
layers (e.g. markers and polygons) can share the same group name.}
\item{content}{the path or URL to a JSON file representing the velocity data
-or a data.frame which can be transformed to such a JSON file. Please see the
-\href{https://github.com/onaci/leaflet-velocity/tree/master/demo}{demo
+or a data.frame which can be transformed to such a JSON file. Please see
+the \href{https://github.com/onaci/leaflet-velocity/tree/master/demo}{demo
files} for some example data.}
\item{options}{List of further options. See \code{\link{velocityOptions}}}
diff --git a/man/addWMS.Rd b/man/addWMS.Rd
index fc119873..feafadfe 100644
--- a/man/addWMS.Rd
+++ b/man/addWMS.Rd
@@ -55,7 +55,8 @@ A Leaflet plugin for working with Web Map services, providing:
single-tile/untiled/nontiled layers, shared WMS sources, and
\bold{GetFeatureInfo}-powered identify.
-You can also use \bold{CQL-Filters} by appending a string to the \code{'baseUrl'}.
+You can also use \bold{CQL-Filters} by appending a string
+to the \code{'baseUrl'}.
Something like \code{'http://server/wms?cql_filter=attribute=value'}
}
@@ -66,14 +67,17 @@ library(leaflet.extras2)
leaflet() \%>\%
addTiles(group = "base") \%>\%
setView(9, 50, 5) \%>\%
- addWMS(baseUrl = "https://maps.dwd.de/geoserver/dwd/wms",
- layers = "dwd:BRD_1km_winddaten_10m",
- popupOptions = popupOptions(maxWidth = 600),
- checkempty = TRUE,
- options = WMSTileOptions(
- transparent = TRUE,
- format = "image/png",
- info_format = "text/html"))
+ addWMS(
+ baseUrl = "https://maps.dwd.de/geoserver/dwd/wms",
+ layers = "dwd:BRD_1km_winddaten_10m",
+ popupOptions = popupOptions(maxWidth = 600),
+ checkempty = TRUE,
+ options = WMSTileOptions(
+ transparent = TRUE,
+ format = "image/png",
+ info_format = "text/html"
+ )
+ )
}
\references{
\url{https://github.com/heigeo/leaflet.wms}
diff --git a/man/easyprintMap.Rd b/man/easyprintMap.Rd
index 9edd05b9..f0689ba5 100644
--- a/man/easyprintMap.Rd
+++ b/man/easyprintMap.Rd
@@ -26,33 +26,33 @@ Print or export a map programmatically (e.g. in a Shiny environment).
\examples{
## Only run examples in interactive R sessions
if (interactive()) {
-library(shiny)
-library(leaflet)
-library(leaflet.extras2)
+ library(shiny)
+ library(leaflet)
+ library(leaflet.extras2)
-ui <- fluidPage(
- leafletOutput("map"),
- selectInput("scene", "Select Scene", choices = c("CurrentSize", "A4Landscape", "A4Portrait")),
- actionButton("print", "Print Map")
-)
+ ui <- fluidPage(
+ leafletOutput("map"),
+ selectInput("scene", "Select Scene", choices = c("CurrentSize", "A4Landscape", "A4Portrait")),
+ actionButton("print", "Print Map")
+ )
-server <- function(input, output, session) {
- output$map <- renderLeaflet({
- input$print
- leaflet() \%>\%
- addTiles() \%>\%
- setView(10, 50, 9) \%>\%
- addEasyprint(options = easyprintOptions(
- exportOnly = TRUE
- ))
-})
- observeEvent(input$print, {
- leafletProxy("map") \%>\%
- easyprintMap(sizeModes = input$scene)
-})
-}
+ server <- function(input, output, session) {
+ output$map <- renderLeaflet({
+ input$print
+ leaflet() \%>\%
+ addTiles() \%>\%
+ setView(10, 50, 9) \%>\%
+ addEasyprint(options = easyprintOptions(
+ exportOnly = TRUE
+ ))
+ })
+ observeEvent(input$print, {
+ leafletProxy("map") \%>\%
+ easyprintMap(sizeModes = input$scene)
+ })
+ }
-shinyApp(ui, server)
+ shinyApp(ui, server)
}
}
\seealso{
diff --git a/man/historyOptions.Rd b/man/historyOptions.Rd
index 4f10f985..83afcc81 100644
--- a/man/historyOptions.Rd
+++ b/man/historyOptions.Rd
@@ -63,14 +63,15 @@ History Options
}
\examples{
library(leaflet)
-leaflet() \%>\%
+leaflet() \%>\%
addTiles() \%>\%
- addHistory(options = historyOptions(position = "bottomright",
+ addHistory(options = historyOptions(
+ position = "bottomright",
maxMovesToSave = 20,
- backText = "Go back",
+ backText = "Go back",
forwardText = "Go forward",
orientation = "vertical"
- ))
+ ))
}
\references{
\url{https://github.com/cscott530/leaflet-history}
diff --git a/man/makeMapkeyIcon.Rd b/man/makeMapkeyIcon.Rd
index d91941b6..3703af33 100644
--- a/man/makeMapkeyIcon.Rd
+++ b/man/makeMapkeyIcon.Rd
@@ -50,11 +50,13 @@ A list of mapkey-icon data that can be passed to the argument \code{icon}
Make Mapkey Icon
}
\examples{
-makeMapkeyIcon(icon = "traffic_signal",
- color = "#0000ff",
- iconSize = 12,
- boxShadow = FALSE,
- background="transparent")
+makeMapkeyIcon(
+ icon = "traffic_signal",
+ color = "#0000ff",
+ iconSize = 12,
+ boxShadow = FALSE,
+ background = "transparent"
+)
}
\references{
\url{https://github.com/mapshakers/leaflet-mapkey-icon}
diff --git a/man/mapkeyIconList.Rd b/man/mapkeyIconList.Rd
index 90e1ceee..6a1d1d99 100644
--- a/man/mapkeyIconList.Rd
+++ b/man/mapkeyIconList.Rd
@@ -16,7 +16,7 @@ A list of class \code{"leaflet_mapkey_icon_set"}
Make Mapkey-icon set
}
\examples{
-iconSet = mapkeyIconList(
+iconSet <- mapkeyIconList(
red = makeMapkeyIcon(color = "#ff0000"),
blue = makeMapkeyIcon(color = "#0000ff")
)
diff --git a/man/mapkeyIcons.Rd b/man/mapkeyIcons.Rd
index 9edcaacb..18036d25 100644
--- a/man/mapkeyIcons.Rd
+++ b/man/mapkeyIcons.Rd
@@ -55,12 +55,15 @@ these arguments will be ignored.
\examples{
\dontrun{
library(leaflet)
-leaflet() \%>\%
- addMapkeyMarkers(data = breweries91,
- icon = mapkeyIcons(
- color = "red",
- borderRadius = 0,
- iconSize = 25))
+leaflet() \%>\%
+ addMapkeyMarkers(
+ data = breweries91,
+ icon = mapkeyIcons(
+ color = "red",
+ borderRadius = 0,
+ iconSize = 25
+ )
+ )
}
}
\references{
diff --git a/man/setBuildingStyle.Rd b/man/setBuildingStyle.Rd
index 713c498f..4bb1f2b7 100644
--- a/man/setBuildingStyle.Rd
+++ b/man/setBuildingStyle.Rd
@@ -27,7 +27,7 @@ leaflet() \%>\%
addTiles() \%>\%
addBuildings() \%>\%
setBuildingStyle(style) \%>\%
- setView(13.40, 52.51836,15)
+ setView(13.40, 52.51836, 15)
}
\seealso{
Other OSM-Buildings Plugin:
diff --git a/man/sidebar_tabs.Rd b/man/sidebar_tabs.Rd
index c215f4cf..da386611 100644
--- a/man/sidebar_tabs.Rd
+++ b/man/sidebar_tabs.Rd
@@ -26,12 +26,16 @@ Create a Sidebar
library(shiny)
# run example app showing a single sidebar
-runApp(paste0(system.file("examples", package = "leaflet.extras2"),
- "/sidebar_app.R"))
+runApp(paste0(
+ system.file("examples", package = "leaflet.extras2"),
+ "/sidebar_app.R"
+))
# run example app showing two sidebars
-runApp(paste0(system.file("examples", package = "leaflet.extras2"),
- "/multi_sidebar_app.R"))
+runApp(paste0(
+ system.file("examples", package = "leaflet.extras2"),
+ "/multi_sidebar_app.R"
+))
}
}
\references{
diff --git a/man/updateBuildingTime.Rd b/man/updateBuildingTime.Rd
index 7838c312..ec3ccb17 100644
--- a/man/updateBuildingTime.Rd
+++ b/man/updateBuildingTime.Rd
@@ -22,7 +22,7 @@ leaflet() \%>\%
addTiles() \%>\%
addBuildings() \%>\%
updateBuildingTime(as.POSIXct("2024-09-01 19:00:00 CET")) \%>\%
- setView(13.40, 52.51836,15)
+ setView(13.40, 52.51836, 15)
}
\seealso{
Other OSM-Buildings Plugin:
diff --git a/man/velocityOptions.Rd b/man/velocityOptions.Rd
index c6f94957..c03da992 100644
--- a/man/velocityOptions.Rd
+++ b/man/velocityOptions.Rd
@@ -26,7 +26,8 @@ per hour or 'kt' for knots}
\item{colorScale}{A vector of hex colors or an RGB matrix}
\item{...}{Further arguments passed to the Velocity layer and Windy.js.
-For more information, please visit \href{https://github.com/onaci/leaflet-velocity}{leaflet-velocity plugin}}
+For more information, please visit
+\href{https://github.com/onaci/leaflet-velocity}{leaflet-velocity plugin}}
}
\value{
A list of further options for \code{addVelocity}
diff --git a/package-lock.json b/package-lock.json
index bbc4ce3d..630bd259 100644
--- a/package-lock.json
+++ b/package-lock.json
@@ -18,7 +18,8 @@
"leaflet-arrowheads": "^1.4.0",
"leaflet-easyprint": "^2.1.9",
"leaflet-geometryutil": "^0.10.1",
- "leaflet.heightgraph": "^1.4.0"
+ "leaflet.heightgraph": "^1.4.0",
+ "rbush": "^2.0.2"
}
},
"node_modules/commander": {
diff --git a/package.json b/package.json
index fd03ebeb..03b82524 100644
--- a/package.json
+++ b/package.json
@@ -21,6 +21,7 @@
"leaflet-arrowheads": "^1.4.0",
"leaflet-easyprint": "^2.1.9",
"leaflet-geometryutil": "^0.10.1",
- "leaflet.heightgraph": "^1.4.0"
+ "leaflet.heightgraph": "^1.4.0",
+ "rbush": "^2.0.2"
}
}
diff --git a/tests/testthat/test-arrowhead.R b/tests/testthat/test-arrowhead.R
index bd61f538..74935c4d 100644
--- a/tests/testthat/test-arrowhead.R
+++ b/tests/testthat/test-arrowhead.R
@@ -10,7 +10,7 @@ test_that("arrowhead", {
"addArrowhead"
)
expect_true(all(names(m$x$calls[[1]]$args[[10]]) %in%
- c("yawn", "size", "frequency", "proportionalToTotal")))
+ c("yawn", "size", "frequency", "proportionalToTotal")))
m <- leaflet() %>% clearArrowhead("groupname")
m$x$calls[[length(m$x$calls)]]$method == "clearArrowhead"
diff --git a/tests/testthat/test-clustercharts.R b/tests/testthat/test-clustercharts.R
index 7267b764..e272d99d 100644
--- a/tests/testthat/test-clustercharts.R
+++ b/tests/testthat/test-clustercharts.R
@@ -1,19 +1,25 @@
test_that("clustercharts", {
-
## data ##########
data <- sf::st_as_sf(breweries91)
- data$category <- sample(c("Schwer", "Mäßig",
- "Leicht", "kein Schaden"),
- size = nrow(data), replace = TRUE)
+ data$category <- sample(
+ c(
+ "Schwer", "Mäßig",
+ "Leicht", "kein Schaden"
+ ),
+ size = nrow(data), replace = TRUE
+ )
data$label <- paste0(data$brewery, "
", data$address)
data$id <- paste0("ID", seq.int(nrow(data)))
- data$popup <- paste0("", data$brewery,
- "
", data$address, "
")
+ data$popup <- paste0(
+ "", data$brewery,
+ "
", data$address, "
"
+ )
data$tosum <- sample(1:100, nrow(data), replace = TRUE)
data$tosumlabel <- paste("Sum: ", data$tosum)
data$web <- gsub(">(.*?)<", ">", data$tosum, "<", data$web)
data$web <- ifelse(is.na(data$web), "",
- paste0("", data$web, "
"))
+ paste0("", data$web, "
")
+ )
## simple example ##########
m <- leaflet() %>%
@@ -62,8 +68,10 @@ test_that("clustercharts", {
labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden"),
colors = c("lightblue", "orange", "lightyellow", "lightgreen")
),
- popupFields = c("id", "brewery", "address",
- "zipcode", "category", "tosum"),
+ popupFields = c(
+ "id", "brewery", "address",
+ "zipcode", "category", "tosum"
+ ),
popupLabels = c("id", "Brauerei", "Addresse", "PLZ", "Art", "tosum")
)
deps <- findDependencies(m)
@@ -82,8 +90,10 @@ test_that("clustercharts", {
labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden"),
colors = c("lightblue", "orange", "lightyellow", "lightgreen")
),
- popupFields = c("id", "brewery", "address",
- "zipcode", "category", "tosum")
+ popupFields = c(
+ "id", "brewery", "address",
+ "zipcode", "category", "tosum"
+ )
)
deps <- findDependencies(m)
expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
@@ -108,8 +118,10 @@ test_that("clustercharts", {
addClusterCharts(
data = data,
categoryMap =
- data.frame(colors = c("lightblue", "orange",
- "lightyellow", "lightgreen"))
+ data.frame(colors = c(
+ "lightblue", "orange",
+ "lightyellow", "lightgreen"
+ ))
)
)
@@ -141,8 +153,10 @@ test_that("clustercharts", {
data = data,
categoryField = "category",
categoryMap =
- data.frame(colors = c("lightblue", "orange",
- "lightyellow", "lightgreen"))
+ data.frame(colors = c(
+ "lightblue", "orange",
+ "lightyellow", "lightgreen"
+ ))
)
)
deps <- findDependencies(m)
@@ -187,10 +201,14 @@ test_that("clustercharts", {
labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden"),
colors = c("lightblue", "orange", "lightyellow", "lightgreen")
),
- popupFields = c("id", "brewery", "address",
- "zipcode", "category", "tosum", "tosum2"),
- popupLabels = c("id", "Brauerei", "Addresse",
- "PLZ", "Art", "tosum", "tosum2"),
+ popupFields = c(
+ "id", "brewery", "address",
+ "zipcode", "category", "tosum", "tosum2"
+ ),
+ popupLabels = c(
+ "id", "Brauerei", "Addresse",
+ "PLZ", "Art", "tosum", "tosum2"
+ ),
label = "label",
options = clusterchartOptions(size = 50)
)
@@ -226,10 +244,14 @@ test_that("clustercharts", {
labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden"),
colors = c("lightblue", "orange", "lightyellow", "lightgreen")
),
- popupFields = c("id", "brewery", "address",
- "zipcode", "category", "tosum", "tosum2"),
- popupLabels = c("id", "Brauerei", "Addresse",
- "PLZ", "Art", "tosum", "tosum2"),
+ popupFields = c(
+ "id", "brewery", "address",
+ "zipcode", "category", "tosum", "tosum2"
+ ),
+ popupLabels = c(
+ "id", "Brauerei", "Addresse",
+ "PLZ", "Art", "tosum", "tosum2"
+ ),
label = "label",
options = clusterchartOptions(size = c(30, 35))
)
@@ -258,10 +280,14 @@ test_that("clustercharts", {
icons = iconvec
),
options = clusterchartOptions(size = 50),
- popupFields = c("id", "brewery", "address",
- "zipcode", "category", "tosum", "tosum2"),
- popupLabels = c("id", "Brauerei", "Addresse",
- "PLZ", "Art", "tosum", "tosum2"),
+ popupFields = c(
+ "id", "brewery", "address",
+ "zipcode", "category", "tosum", "tosum2"
+ ),
+ popupLabels = c(
+ "id", "Brauerei", "Addresse",
+ "PLZ", "Art", "tosum", "tosum2"
+ ),
label = "label"
)
deps <- findDependencies(m)
@@ -303,10 +329,14 @@ test_that("clustercharts", {
group = "clustermarkers",
layerId = "id",
clusterId = "id",
- popupFields = c("id", "brewery", "address",
- "zipcode", "category", "tosum", "tosum2"),
- popupLabels = c("id", "Brauerei", "Addresse",
- "PLZ", "Art", "tosum", "tosum2"),
+ popupFields = c(
+ "id", "brewery", "address",
+ "zipcode", "category", "tosum", "tosum2"
+ ),
+ popupLabels = c(
+ "id", "Brauerei", "Addresse",
+ "PLZ", "Art", "tosum", "tosum2"
+ ),
label = "label",
markerOptions = markerOptions(
interactive = TRUE,
@@ -318,21 +348,27 @@ test_that("clustercharts", {
riseOnHover = TRUE,
riseOffset = 400
),
- legendOptions = list(position = "bottomright",
- title = "Unfälle im Jahr 2003"),
+ legendOptions = list(
+ position = "bottomright",
+ title = "Unfälle im Jahr 2003"
+ ),
clusterOptions = markerClusterOptions(
showCoverageOnHover = TRUE,
zoomToBoundsOnClick = TRUE,
spiderfyOnMaxZoom = TRUE,
removeOutsideVisibleBounds = TRUE,
- spiderLegPolylineOptions = list(weight = 1.5,
- color = "#222", opacity = 0.5),
+ spiderLegPolylineOptions = list(
+ weight = 1.5,
+ color = "#222", opacity = 0.5
+ ),
freezeAtZoom = TRUE,
clusterPane = "clusterpane",
spiderfyDistanceMultiplier = 2
),
labelOptions = labelOptions(opacity = 0.8, textsize = "14px"),
- popupOptions = popupOptions(maxWidth = 900,
- minWidth = 200, keepInView = TRUE)
+ popupOptions = popupOptions(
+ maxWidth = 900,
+ minWidth = 200, keepInView = TRUE
+ )
)
})
diff --git a/tests/testthat/test-contextmenu.R b/tests/testthat/test-contextmenu.R
index adcb4dc1..7a7ab7f7 100644
--- a/tests/testthat/test-contextmenu.R
+++ b/tests/testthat/test-contextmenu.R
@@ -5,7 +5,8 @@ test_that("contextmenu", {
contextmenuItems =
context_mapmenuItems(
context_menuItem("Zoom Out", "function(e) {this.zoomOut()}",
- disabled = FALSE),
+ disabled = FALSE
+ ),
"-",
context_menuItem("Zoom In", "function(e) {this.zoomIn()}")
)
@@ -44,7 +45,8 @@ test_that("contextmenu", {
"showContextmenu"
)
expect_true(all(
- colnames(m$x$calls[[length(m$x$calls)]]$args[[1]]) %in% c("lng", "lat")))
+ colnames(m$x$calls[[length(m$x$calls)]]$args[[1]]) %in% c("lng", "lat")
+ ))
m <- m %>% showContextmenu(lat = 49.79433, lng = 11.50941)
expect_equal(
@@ -52,7 +54,8 @@ test_that("contextmenu", {
"showContextmenu"
)
expect_true(all(
- colnames(m$x$calls[[length(m$x$calls)]]$args[[1]]) %in% c("lng", "lat")))
+ colnames(m$x$calls[[length(m$x$calls)]]$args[[1]]) %in% c("lng", "lat")
+ ))
m <- m %>% hideContextmenu()
expect_equal(
diff --git a/tests/testthat/test-divicon.R b/tests/testthat/test-divicon.R
index 9078599f..1a567de5 100644
--- a/tests/testthat/test-divicon.R
+++ b/tests/testthat/test-divicon.R
@@ -4,8 +4,10 @@ library(sf)
df <- sf::st_as_sf(atlStorms2005)
df <- suppressWarnings(st_cast(df, "POINT"))
df <- df[sample(1:nrow(df), 50, replace = FALSE), ]
-df$classes <- sample(x = c("myclass1", "myclass2", "myclass3"),
- nrow(df), replace = TRUE)
+df$classes <- sample(
+ x = c("myclass1", "myclass2", "myclass3"),
+ nrow(df), replace = TRUE
+)
df$ID <- paste0("ID_", 1:nrow(df))
df$lon <- st_coordinates(df)[, 1]
df$lat <- st_coordinates(df)[, 2]
@@ -27,16 +29,20 @@ test_that("addDivicon works", {
className = ~ paste("globalclass", classes),
html = ~ paste0("", Name, "
")
)
- expect_true(any(sapply(map$dependencies,
- function(dep) dep$name == "lfx-divicon")))
+ expect_true(any(sapply(
+ map$dependencies,
+ function(dep) dep$name == "lfx-divicon"
+ )))
expect_is(map, "leaflet")
expect_identical(map$x$calls[[2]]$method, "addDivicon")
expect_identical(map$x$calls[[2]]$args[[3]], df$ID)
expect_identical(map$x$calls[[2]]$args[[4]], NULL)
expect_identical(map$x$calls[[2]]$args[[5]], leaflet::markerOptions())
expect_identical(map$x$calls[[2]]$args[[6]], paste("globalclass", df$classes))
- expect_identical(map$x$calls[[2]]$args[[7]],
- paste0("", df$Name, "
"))
+ expect_identical(
+ map$x$calls[[2]]$args[[7]],
+ paste0("", df$Name, "
")
+ )
expect_identical(map$x$calls[[2]]$args[[8]], NULL)
expect_identical(map$x$calls[[2]]$args[[9]], NULL)
expect_identical(map$x$calls[[2]]$args[[10]], NULL)
@@ -45,8 +51,10 @@ test_that("addDivicon works", {
expect_identical(map$x$calls[[2]]$args[[13]], NULL)
# Test 2: Passing a group
- df$groups <- sample(x = c("myclass1", "myclass2", "myclass3"),
- nrow(df), replace = TRUE)
+ df$groups <- sample(
+ x = c("myclass1", "myclass2", "myclass3"),
+ nrow(df), replace = TRUE
+ )
map <- generate_test_map() %>%
addDivicon(
data = df,
@@ -61,8 +69,10 @@ test_that("addDivicon works", {
expect_identical(map$x$calls[[2]]$args[[4]], df$groups)
expect_identical(map$x$calls[[2]]$args[[5]], leaflet::markerOptions())
expect_identical(map$x$calls[[2]]$args[[6]], paste("globalclass", df$classes))
- expect_identical(map$x$calls[[2]]$args[[7]],
- paste0("", df$Name, "
"))
+ expect_identical(
+ map$x$calls[[2]]$args[[7]],
+ paste0("", df$Name, "
")
+ )
expect_identical(map$x$calls[[2]]$args[[8]], NULL)
expect_identical(map$x$calls[[2]]$args[[9]], NULL)
expect_identical(map$x$calls[[2]]$args[[10]], NULL)
@@ -89,8 +99,10 @@ test_that("addDivicon works", {
expect_identical(map$x$calls[[2]]$args[[4]], df$groups)
expect_identical(map$x$calls[[2]]$args[[5]], leaflet::markerOptions())
expect_identical(map$x$calls[[2]]$args[[6]], paste("globalclass", df$classes))
- expect_identical(map$x$calls[[2]]$args[[7]],
- paste0("", df$Name, "
"))
+ expect_identical(
+ map$x$calls[[2]]$args[[7]],
+ paste0("", df$Name, "
")
+ )
expect_identical(map$x$calls[[2]]$args[[8]], paste0(df$ID, ": ", df$Name))
expect_identical(map$x$calls[[2]]$args[[9]], popupOptions(minWidth = 400))
expect_identical(map$x$calls[[2]]$args[[10]], df$groups)
@@ -119,8 +131,10 @@ test_that("addDivicon works", {
expect_identical(map$x$calls[[2]]$args[[4]], df$groups)
expect_identical(map$x$calls[[2]]$args[[5]], leaflet::markerOptions())
expect_identical(map$x$calls[[2]]$args[[6]], paste("globalclass", df$classes))
- expect_identical(map$x$calls[[2]]$args[[7]],
- paste0("", df$Name, "
"))
+ expect_identical(
+ map$x$calls[[2]]$args[[7]],
+ paste0("", df$Name, "
")
+ )
expect_identical(map$x$calls[[2]]$args[[8]], paste0(df$ID, ": ", df$Name))
expect_identical(map$x$calls[[2]]$args[[9]], popupOptions(minWidth = 400))
expect_identical(map$x$calls[[2]]$args[[10]], df$groups)
diff --git a/tests/testthat/test-gibs.R b/tests/testthat/test-gibs.R
index 1e41622f..d5b53c19 100644
--- a/tests/testthat/test-gibs.R
+++ b/tests/testthat/test-gibs.R
@@ -29,7 +29,7 @@ test_that("gibs", {
Sys.Date() - 5
)
- m <- m %>% setTransparent(layers, transparent = FFALSE)
+ m <- m %>% setTransparent(layers, transparent = FALSE)
expect_equal(
m$x$calls[[length(m$x$calls)]]$method,
"setTransparent"
diff --git a/tests/testthat/test-heightgraph.R b/tests/testthat/test-heightgraph.R
index e483d1bf..386022f3 100644
--- a/tests/testthat/test-heightgraph.R
+++ b/tests/testthat/test-heightgraph.R
@@ -34,8 +34,11 @@ data <- structure(
)
),
row.names = 4L, class = c("sf", "data.frame"), sf_column = "geometry",
- agr = structure(c(Name = NA_integer_,
- MaxWind = NA_integer_, MinPress = NA_integer_),
+ agr = structure(
+ c(
+ Name = NA_integer_,
+ MaxWind = NA_integer_, MinPress = NA_integer_
+ ),
levels = c("constant", "aggregate", "identity"), class = "factor"
)
)
diff --git a/tests/testthat/test-layergroupcollision.R b/tests/testthat/test-layergroupcollision.R
new file mode 100644
index 00000000..d6e569b3
--- /dev/null
+++ b/tests/testthat/test-layergroupcollision.R
@@ -0,0 +1,99 @@
+library(testthat)
+library(sf)
+library(leaflet)
+
+# Sample data for testing
+df <- sf::st_as_sf(atlStorms2005)
+df <- suppressWarnings(st_cast(df, "POINT"))
+df <- df[sample(1:nrow(df), 50, replace = FALSE), ]
+df$classes <- sample(
+ x = c("myclass1", "myclass2", "myclass3"),
+ nrow(df), replace = TRUE
+)
+df$ID <- paste0("ID_", 1:nrow(df))
+df$lon <- st_coordinates(df)[, 1]
+df$lat <- st_coordinates(df)[, 2]
+
+# Function to generate map object for reuse in tests
+generate_test_map <- function() {
+ leaflet() %>%
+ addTiles()
+}
+
+# Test 1: Basic functionality of addLayerGroupCollision
+test_that("addLayerGroupCollision works", {
+ map <- generate_test_map() %>%
+ addLayerGroupCollision(
+ data = df,
+ group = "Myclass",
+ className = ~ paste("class", classes),
+ html = ~ paste0("", ID, "
")
+ )
+
+ expect_is(map, "leaflet")
+ expect_true(any(sapply(
+ map$dependencies,
+ function(dep) dep$name == "lfx-layergroupcollision"
+ )))
+ expect_length(map$dependencies[[length(map$dependencies)]]$script, 3)
+ expect_identical(map$x$calls[[2]]$method, "addLayerGroupCollision")
+ expect_is(map$x$calls[[2]]$args[[1]], "geojson")
+ expect_identical(map$x$calls[[2]]$args[[2]], "Myclass")
+ expect_identical(map$x$calls[[2]]$args[[3]], 5) # Default margin
+})
+
+# Test 2: Handling of custom margin
+test_that("addLayerGroupCollision handles custom margin", {
+ map <- generate_test_map() %>%
+ addLayerGroupCollision(
+ data = df,
+ margin = 10
+ )
+
+ expect_is(map, "leaflet")
+ expect_identical(map$x$calls[[2]]$method, "addLayerGroupCollision")
+ expect_identical(map$x$calls[[2]]$args[[3]], 10) # Custom margin
+})
+
+# Test 3: Adding HTML and className with custom values
+test_that("addLayerGroupCollision assigns HTML and className correctly", {
+ map <- generate_test_map() %>%
+ addLayerGroupCollision(
+ data = df,
+ className = ~ paste("myclass", classes),
+ html = ~ paste0("", ID, "
")
+ )
+
+ expect_is(map, "leaflet")
+ expect_identical(map$x$calls[[2]]$method, "addLayerGroupCollision")
+ expect_null(map$x$calls[[2]]$args[[2]])
+ expect_identical(map$x$calls[[2]]$args[[3]], 5)
+})
+
+# Test 4: Verifying map data transformation to GeoJSON
+test_that("addLayerGroupCollision transforms spatial data to GeoJSON", {
+ map <- generate_test_map() %>%
+ addLayerGroupCollision(
+ data = df
+ )
+
+ geojson <- map$x$calls[[2]]$args[[1]]
+ expect_true(inherits(geojson, "geojson"))
+})
+
+# Test 5: Error handling for invalid data
+test_that("addLayerGroupCollision handles invalid data gracefully", {
+ expect_error({
+ map <- generate_test_map() %>%
+ addLayerGroupCollision(
+ data = NULL
+ )
+ })
+
+ expect_error({
+ map <- generate_test_map() %>%
+ addLayerGroupCollision(
+ data = data.frame()
+ )
+ })
+})
diff --git a/tests/testthat/test-leafletsync.R b/tests/testthat/test-leafletsync.R
index cb157eb7..2d21e458 100644
--- a/tests/testthat/test-leafletsync.R
+++ b/tests/testthat/test-leafletsync.R
@@ -5,7 +5,8 @@ test_that("Leaflet Sync works", {
deps <- findDependencies(m)
expect_equal(deps[[length(deps)]]$name, "lfx-leafletsync")
expect_true(all(deps[[length(deps)]]$script %in% c(
- "L.Map.Sync.js", "leafletsync-bindings.js")))
+ "L.Map.Sync.js", "leafletsync-bindings.js"
+ )))
m <- leaflet() %>%
diff --git a/tests/testthat/test-movingmarker.R b/tests/testthat/test-movingmarker.R
index 23286c31..c733b21e 100644
--- a/tests/testthat/test-movingmarker.R
+++ b/tests/testthat/test-movingmarker.R
@@ -1,14 +1,16 @@
library(sf)
## DATA #######################
df <- new("SpatialLinesDataFrame",
- data = structure(list(Name = structure(1L, levels = c(
- "ALPHA",
- "ARLENE", "BRET", "CINDY", "DELTA", "DENNIS", "EMILY", "EPSILON",
- "FRANKLIN", "GAMMA", "GERT", "HARVEY", "IRENE", "JOSE", "KATRINA",
- "LEE", "MARIA", "NATE", "OPHELIA", "PHILIPPE", "RITA", "TEN",
- "TWENTY-TWO", "WILMA"
- ), class = "factor"), MaxWind = 45, MinPress = 998),
- row.names = 1L, class = "data.frame"),
+ data = structure(
+ list(Name = structure(1L, levels = c(
+ "ALPHA",
+ "ARLENE", "BRET", "CINDY", "DELTA", "DENNIS", "EMILY", "EPSILON",
+ "FRANKLIN", "GAMMA", "GERT", "HARVEY", "IRENE", "JOSE", "KATRINA",
+ "LEE", "MARIA", "NATE", "OPHELIA", "PHILIPPE", "RITA", "TEN",
+ "TWENTY-TWO", "WILMA"
+ ), class = "factor"), MaxWind = 45, MinPress = 998),
+ row.names = 1L, class = "data.frame"
+ ),
lines = list(new("Lines", Lines = list(new("Line", coords = structure(c(
-67.5,
-68.5, -69.6, -70.5, -71.3, -72.2, -72.7, -72.9, -73, -72.4,
@@ -22,7 +24,8 @@ df <- new("SpatialLinesDataFrame",
"y"
), c("min", "max"))), proj4string = new(
"CRS",
- projargs = "+proj=longlat +ellps=WGS84 +towgs84=0,0,0,0,0,0,0 +no_defs")
+ projargs = "+proj=longlat +ellps=WGS84 +towgs84=0,0,0,0,0,0,0 +no_defs"
+ )
)
## TESTS #######################
diff --git a/tests/testthat/test-osmbuildings.R b/tests/testthat/test-osmbuildings.R
index 64501aee..eaf3d9c6 100644
--- a/tests/testthat/test-osmbuildings.R
+++ b/tests/testthat/test-osmbuildings.R
@@ -1,4 +1,3 @@
-
create_test_map <- function() {
leaflet() %>% addTiles()
}
@@ -11,14 +10,17 @@ test_that("addBuildings adds dependencies and invokes method correctly", {
map <- addBuildings(map)
# Check if the dependencies are added
- expect_true(any(sapply(map$dependencies,
- function(dep) dep$name) == "lfx-building"))
+ expect_true(any(sapply(
+ map$dependencies,
+ function(dep) dep$name
+ ) == "lfx-building"))
# Check if invokeMethod is called with correct arguments
expect_equal(map$x$calls[[2]]$method, "addBuilding")
expect_equal(
map$x$calls[[2]]$args[[1]],
- "https://{s}.data.osmbuildings.org/0.2/59fcc2e8/tile/{z}/{x}/{y}.json")
+ "https://{s}.data.osmbuildings.org/0.2/59fcc2e8/tile/{z}/{x}/{y}.json"
+ )
})
test_that("addBuildings handles custom eachFn, clickFn, and data", {
@@ -51,8 +53,10 @@ test_that("addBuildings handles custom eachFn, clickFn, and data", {
)
)
- map <- addBuildings(map, eachFn = each_fn,
- clickFn = click_fn, data = geojson_data)
+ map <- addBuildings(map,
+ eachFn = each_fn,
+ clickFn = click_fn, data = geojson_data
+ )
# Check if the JavaScript functions and data are passed correctly
expect_equal(map$x$calls[[2]]$args[[3]], each_fn)
@@ -77,8 +81,10 @@ test_that("updateBuildingTime updates the time correctly", {
# Test suite for setBuildingStyle
test_that("setBuildingStyle applies styles correctly", {
map <- create_test_map()
- style <- list(color = "#0000ff", wallColor = "#0000ff",
- roofColor = "blue", shadows = FALSE)
+ style <- list(
+ color = "#0000ff", wallColor = "#0000ff",
+ roofColor = "blue", shadows = FALSE
+ )
map <- addBuildings(map) %>%
setBuildingStyle(style) %>%
@@ -98,8 +104,10 @@ test_that("setBuildingStyle uses default styles if not provided", {
# map
# Check if invokeMethod is called with the default styles
- default_style <- list(color = "#ffcc00", wallColor = "#ffcc00",
- roofColor = "orange", shadows = TRUE)
+ default_style <- list(
+ color = "#ffcc00", wallColor = "#ffcc00",
+ roofColor = "orange", shadows = TRUE
+ )
expect_equal(map$x$calls[[3]]$"method", "setBuildingStyle")
expect_equal(map$x$calls[[3]]$args[[1]], default_style)
})
diff --git a/tests/testthat/test-playback.R b/tests/testthat/test-playback.R
index f597177d..c21e9d3a 100644
--- a/tests/testthat/test-playback.R
+++ b/tests/testthat/test-playback.R
@@ -134,15 +134,19 @@ test_that("playback", {
structure(c(11.5772056036448, 49.9436206656224), class = c("XY", "POINT", "sfg"))
),
precision = 0,
- bbox = structure(c(xmin = 11.5772056036448,
- ymin = 49.9434124224934,
- xmax = 11.5779536762059,
- ymax = 49.9447628006851),
+ bbox = structure(
+ c(
+ xmin = 11.5772056036448,
+ ymin = 49.9434124224934,
+ xmax = 11.5779536762059,
+ ymax = 49.9447628006851
+ ),
class = "bbox"
),
crs = structure(list(
epsg = 4326L,
- proj4string = "+proj=longlat +datum=WGS84 +no_defs"), class = "crs"),
+ proj4string = "+proj=longlat +datum=WGS84 +no_defs"
+ ), class = "crs"),
n_empty = 0L, class = c("sfc_POINT", "sfc"), ids = 100L
)
),
diff --git a/tests/testthat/test-sidebar.R b/tests/testthat/test-sidebar.R
index 437e7fa2..40d8ba4e 100644
--- a/tests/testthat/test-sidebar.R
+++ b/tests/testthat/test-sidebar.R
@@ -83,12 +83,18 @@ test_that("sidebar-error", {
expect_error(
sidebar_tabs(
list(tags$i(class = "person"), tags$i(class = "person")),
- sidebar_pane(id = "home_id",
- icon = tags$i(class = "person"), tagList()),
- sidebar_pane(id = "profile_id",
- icon = tags$i(class = "person"), tagList()),
- sidebar_pane(id = "messages_id",
- icon = tags$i(class = "person"), tagList())
+ sidebar_pane(
+ id = "home_id",
+ icon = tags$i(class = "person"), tagList()
+ ),
+ sidebar_pane(
+ id = "profile_id",
+ icon = tags$i(class = "person"), tagList()
+ ),
+ sidebar_pane(
+ id = "messages_id",
+ icon = tags$i(class = "person"), tagList()
+ )
)
)
})
diff --git a/tests/testthat/test-sidebyside.R b/tests/testthat/test-sidebyside.R
index 58cd953d..ddeb4cc2 100644
--- a/tests/testthat/test-sidebyside.R
+++ b/tests/testthat/test-sidebyside.R
@@ -14,8 +14,10 @@ test_that("sidebyside", {
data = breweries91[1:15, ], color = "blue", group = "blue",
options = pathOptions(pane = "left")
) %>%
- addCircleMarkers(data = breweries91[15:20, ],
- color = "yellow", group = "yellow") %>%
+ addCircleMarkers(
+ data = breweries91[15:20, ],
+ color = "yellow", group = "yellow"
+ ) %>%
addCircleMarkers(
data = breweries91[15:30, ], color = "red", group = "red",
options = pathOptions(pane = "right")
diff --git a/tests/testthat/test-spin.R b/tests/testthat/test-spin.R
index e92ce77d..fa1f14c5 100644
--- a/tests/testthat/test-spin.R
+++ b/tests/testthat/test-spin.R
@@ -15,6 +15,8 @@ test_that("spin", {
expect_false(m$x$calls[[length(m$x$calls)]]$args[[1]])
m <- m %>% startSpinner(options = list("lines" = 7, "width" = 12))
- expect_equal(m$x$calls[[length(m$x$calls)]]$args[[2]],
- list("lines" = 7, "width" = 12))
+ expect_equal(
+ m$x$calls[[length(m$x$calls)]]$args[[2]],
+ list("lines" = 7, "width" = 12)
+ )
})
diff --git a/tests/testthat/test-tangram.R b/tests/testthat/test-tangram.R
index 24d56606..f5697a3e 100644
--- a/tests/testthat/test-tangram.R
+++ b/tests/testthat/test-tangram.R
@@ -1,6 +1,7 @@
test_that("tangram", {
scene <- system.file("examples/tangram/www/scene.yaml",
- package = "leaflet.extras2")
+ package = "leaflet.extras2"
+ )
m <- leaflet() %>%
addTangram(scene = scene, group = "tangram") %>%
diff --git a/tests/testthat/test-wms.R b/tests/testthat/test-wms.R
index 4055aca4..99d8a911 100644
--- a/tests/testthat/test-wms.R
+++ b/tests/testthat/test-wms.R
@@ -20,5 +20,5 @@ test_that("wms", {
test_that("wms-error", {
expect_error(leaflet() %>%
- addWMS(baseUrl = "https://maps.dwd.de/geoserver/dwd/wms"))
+ addWMS(baseUrl = "https://maps.dwd.de/geoserver/dwd/wms"))
})