diff --git a/R/clusterCharts.R b/R/clusterCharts.R
index 5f954c10..c3de081a 100644
--- a/R/clusterCharts.R
+++ b/R/clusterCharts.R
@@ -136,7 +136,7 @@ addClusterCharts <- function(
clusterchartsDependencies())
## Make Geojson ###########
- if (!inherits(sf::st_as_sf(data), "sf")) {
+ if (!inherits(data, "sf")) {
data <- sf::st_as_sf(data)
}
geojson <- yyjsonr::write_geojson_str(data)
@@ -160,10 +160,10 @@ addClusterCharts <- function(
#' @description Adds options for clusterCharts
#' @param rmax The maximum radius of the clusters.
#' @param size The size of the cluster markers.
-#' @param strokeWidth The stroke width in the chart.
+#' @param strokeWidth The stroke width of the chart.
#' @param width The width of the bar-charts.
#' @param height The height of the bar-charts.
-#' @param innerRadius The inner radius of the pie-charts.
+#' @param innerRadius The inner radius of pie-charts.
#' @param labelBackground Should the label have a background? Default is `FALSE`
#' @param labelFill The label background color. Default is `white`
#' @param labelStroke The label stroke color. Default is `black`
@@ -212,8 +212,7 @@ generate_css <- function(row, icon) {
label <- row["labels"]
color <- row["colors"]
stroke <- row["strokes"]
- if (is.null(color)) color <- stroke
- if (is.null(stroke)) stroke <- color
+ if (is.null(stroke) || is.na(stroke)) stroke <- color
## Replace spaces with dots in the class name #######
label_nospaces <- gsub(" ", ".", label, fixed = TRUE)
@@ -232,11 +231,11 @@ generate_css <- function(row, icon) {
## Make Icon ################
if (is.null(icon)) {
icon <- row['icons']
- if (!is.null(icon)) {
+ if (!is.null(icon) && !is.na(icon)) {
css <- paste0(css,
".icon-", label_nospaces, " {\n",
" background-image: url('", icon, "');\n",
- " background-repeat: no-repeat;\n",
+ " background-repeat: round;\n",
" background-position: 0px 1px;\n",
"}"
)
@@ -264,13 +263,12 @@ generate_css <- function(row, icon) {
css <- paste0(css,
".icon-", label_nospaces, " {\n",
" background-image: url('", iconuse$data, "');\n",
- " background-repeat: no-repeat;\n",
+ " background-repeat: round;\n",
" background-position: 0px 1px;\n",
size,
"}"
)
}
- cat(css)
css
}
@@ -279,26 +277,26 @@ b64EncodePackedIcons <- utils::getFromNamespace("b64EncodePackedIcons", "leaflet
packStrings <- utils::getFromNamespace("packStrings", "leaflet")
-backgroundCSS <- function(label, icon,
- background_repeat = "no-repeat",
- background_position = "0px 1px",
- additional_css = list()) {
- # Start the CSS string
- css <- paste0(".icon-", label, " {\n",
- " background-image: url('", icon, "');\n",
- " background-repeat: ", background_repeat, ";\n",
- " background-position: ", background_position, ";\n")
-
- # Add each additional CSS property
- for (css_property in additional_css) {
- css <- paste0(css, " ", css_property[1], ": ", css_property[2], ";\n")
- }
-
- # Close the CSS block
- css <- paste0(css, "}")
-
- return(css)
-}
+# backgroundCSS <- function(label, icon,
+# background_repeat = "no-repeat",
+# background_position = "0px 1px",
+# additional_css = list()) {
+# # Start the CSS string
+# css <- paste0(".icon-", label, " {\n",
+# " background-image: url('", icon, "');\n",
+# " background-repeat: ", background_repeat, ";\n",
+# " background-position: ", background_position, ";\n")
+#
+# # Add each additional CSS property
+# for (css_property in additional_css) {
+# css <- paste0(css, " ", css_property[1], ": ", css_property[2], ";\n")
+# }
+#
+# # Close the CSS block
+# css <- paste0(css, "}")
+#
+# return(css)
+# }
diff --git a/inst/htmlwidgets/lfx-clustercharts/lfx-clustercharts-bindings.js b/inst/htmlwidgets/lfx-clustercharts/lfx-clustercharts-bindings.js
index b58d67bc..4bcae79a 100644
--- a/inst/htmlwidgets/lfx-clustercharts/lfx-clustercharts-bindings.js
+++ b/inst/htmlwidgets/lfx-clustercharts/lfx-clustercharts-bindings.js
@@ -672,7 +672,7 @@ LeafletWidget.methods.addClusterCharts = function(geojson, layerId, group, type,
legendControl.onAdd = function(map) {
var div = L.DomUtil.create('div', 'clusterlegend');
- div.innerHTML = '' + legendOptions.title + '
';
+ div.innerHTML = legendOptions.title ? '' + legendOptions.title + '
' : '';
var legendItems = d3.select(div)
.selectAll('.legenditem')
diff --git a/man/clusterchartOptions.Rd b/man/clusterchartOptions.Rd
index 6894ba82..446720d5 100644
--- a/man/clusterchartOptions.Rd
+++ b/man/clusterchartOptions.Rd
@@ -31,9 +31,9 @@ clusterchartOptions(
\item{height}{The height of the bar-charts.}
-\item{strokeWidth}{The stroke width in the chart.}
+\item{strokeWidth}{The stroke width of the chart.}
-\item{innerRadius}{The inner radius of the pie-charts.}
+\item{innerRadius}{The inner radius of pie-charts.}
\item{labelBackground}{Should the label have a background? Default is `FALSE`}
diff --git a/tests/testthat/test-clustercharts.R b/tests/testthat/test-clustercharts.R
new file mode 100644
index 00000000..cca1fe31
--- /dev/null
+++ b/tests/testthat/test-clustercharts.R
@@ -0,0 +1,277 @@
+
+test_that("clustercharts", {
+
+ # shipIcon <- leaflet::makeIcon(
+ # iconUrl = "./icons/Icon5.svg"
+ # ,className = "lsaicons"
+ # ,iconWidth = 24, iconHeight = 24, iconAnchorX = 0, iconAnchorY = 0
+ # )
+
+
+ ## data ##########
+ data <- sf::st_as_sf(breweries91)
+ 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$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, "
"))
+
+ ## simple example ##########
+ m <- leaflet() %>% addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = data
+ , categoryField = "category"
+ , categoryMap =
+ data.frame(labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden"),
+ colors = c("lightblue", "orange", "lightyellow", "lightgreen")))
+ deps <- findDependencies(m)
+ expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
+ expect_equal(deps[[length(deps)-1]]$name, "leaflet-markercluster")
+ expect_equal(deps[[length(deps)-2]]$name, "lfx-clustercharts-css")
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addClusterCharts")
+
+ ## simple example (SP-data) ##########
+ m <- leaflet() %>% addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = as(data, "Spatial")
+ , categoryField = "category"
+ , categoryMap =
+ data.frame(labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden"),
+ colors = c("lightblue", "orange", "lightyellow", "lightgreen")))
+ deps <- findDependencies(m)
+ expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
+ expect_equal(deps[[length(deps)-1]]$name, "leaflet-markercluster")
+ expect_equal(deps[[length(deps)-2]]$name, "lfx-clustercharts-css")
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addClusterCharts")
+
+ ## simple example with popupFields / popupLabels ##########
+ m <- leaflet() %>% addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = data
+ , categoryField = "category"
+ , categoryMap =
+ data.frame(labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden"),
+ colors = c("lightblue", "orange", "lightyellow", "lightgreen"))
+ , popupFields = c("id","brewery","address","zipcode", "category","tosum")
+ , popupLabels = c("id","Brauerei","Addresse","PLZ", "Art", "tosum")
+ )
+ deps <- findDependencies(m)
+ expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
+ expect_equal(deps[[length(deps)-1]]$name, "leaflet-markercluster")
+ expect_equal(deps[[length(deps)-2]]$name, "lfx-clustercharts-css")
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addClusterCharts")
+
+ m <- leaflet() %>% addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = data
+ , categoryField = "category"
+ , categoryMap =
+ data.frame(labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden"),
+ colors = c("lightblue", "orange", "lightyellow", "lightgreen"))
+ , popupFields = c("id","brewery","address","zipcode", "category","tosum")
+ )
+ deps <- findDependencies(m)
+ expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
+ expect_equal(deps[[length(deps)-1]]$name, "leaflet-markercluster")
+ expect_equal(deps[[length(deps)-2]]$name, "lfx-clustercharts-css")
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addClusterCharts")
+
+ ## No `categoryMap` - Error ##########
+ m <- expect_error(
+ leaflet() %>%
+ addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = data
+ , categoryField = "category"
+ ))
+
+ ## No `categoryField` - Error ##########
+ m <- expect_error(
+ leaflet() %>%
+ addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = data
+ , categoryMap =
+ data.frame(colors = c("lightblue", "orange", "lightyellow", "lightgreen")
+ )
+ ))
+
+ ## No `colors` in `categoryMap` ##########
+ m <- expect_warning(
+ leaflet() %>%
+ addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = data
+ , categoryField = "category"
+ , categoryMap =
+ data.frame(labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden")
+ # ,colors = c("lightblue", "orange", "lightyellow", "lightgreen")
+ )
+ ))
+ deps <- findDependencies(m)
+ expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
+ expect_equal(deps[[length(deps)-1]]$name, "leaflet-markercluster")
+ expect_equal(deps[[length(deps)-2]]$name, "lfx-clustercharts-css")
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addClusterCharts")
+
+ ## No `labels` in `categoryMap` ##########
+ m <- expect_warning(
+ leaflet() %>%
+ addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = data
+ , categoryField = "category"
+ , categoryMap =
+ data.frame(colors = c("lightblue", "orange", "lightyellow", "lightgreen")
+ )
+ ))
+ deps <- findDependencies(m)
+ expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
+ expect_equal(deps[[length(deps)-1]]$name, "leaflet-markercluster")
+ expect_equal(deps[[length(deps)-2]]$name, "lfx-clustercharts-css")
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addClusterCharts")
+
+ ## Multiple Sizes ##########
+ m <- leaflet() %>%
+ addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = data
+ , categoryField = "category"
+ , categoryMap =
+ data.frame(labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden")
+ ,colors = c("lightblue", "orange", "lightyellow", "lightgreen")
+ )
+ , options = clusterchartOptions(size = c(10,40))
+ )
+ deps <- findDependencies(m)
+ expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
+ expect_equal(deps[[length(deps)-1]]$name, "leaflet-markercluster")
+ expect_equal(deps[[length(deps)-2]]$name, "lfx-clustercharts-css")
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addClusterCharts")
+
+ ## Icons (single) ##########
+ shipIcon <- makeIcon(
+ iconUrl = "https://cdn-icons-png.flaticon.com/512/1355/1355883.png",
+ iconWidth = 40, iconHeight = 50,
+ iconAnchorX = 0, iconAnchorY = 0
+ )
+ m <- leaflet() %>%
+ addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = data
+ , categoryField = "category"
+ , icon = shipIcon
+ , categoryMap =
+ data.frame(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")
+ , label = "label"
+ , options = clusterchartOptions(size = 50)
+ )
+ deps <- findDependencies(m)
+ expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
+ expect_equal(deps[[length(deps)-1]]$name, "leaflet-markercluster")
+ expect_equal(deps[[length(deps)-2]]$name, "lfx-clustercharts-css")
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addClusterCharts")
+
+ ## Icons (multiple) ##########
+ shipIcon <- iconList(
+ "Schwer" = makeIcon("https://leafletjs.com/examples/custom-icons/leaf-red.png",
+ iconWidth = 40, iconHeight = 50),
+ "Mäßig" = makeIcon("https://upload.wikimedia.org/wikipedia/commons/thumb/0/0b/Maki2-ferry-18.svg/480px-Maki2-ferry-18.svg.png",
+ iconWidth = 40),
+ "Leicht" = makeIcon("https://upload.wikimedia.org/wikipedia/commons/thumb/c/c3/Maki2-danger-24.svg/240px-Maki2-danger-24.svg.png",
+ iconWidth = 40),
+ "kein Schaden" = makeIcon("https://leafletjs.com/examples/custom-icons/leaf-green.png",
+ iconWidth = 40, iconHeight = 50)
+ )
+ m <- leaflet() %>%
+ addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = data
+ , categoryField = "category"
+ , icon = shipIcon
+ , categoryMap =
+ data.frame(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")
+ , label = "label"
+ , options = clusterchartOptions(size = c(30,35))
+ )
+ deps <- findDependencies(m)
+ expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
+ expect_equal(deps[[length(deps)-1]]$name, "leaflet-markercluster")
+ expect_equal(deps[[length(deps)-2]]$name, "lfx-clustercharts-css")
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addClusterCharts")
+
+ ## Icons in `categoryMap` ##########
+ iconvec <- c("https://leafletjs.com/examples/custom-icons/leaf-red.png",
+ "https://upload.wikimedia.org/wikipedia/commons/thumb/0/0b/Maki2-ferry-18.svg/480px-Maki2-ferry-18.svg.png",
+ "https://upload.wikimedia.org/wikipedia/commons/thumb/0/0b/Maki2-ferry-18.svg/480px-Maki2-ferry-18.svg.png",
+ "https://leafletjs.com/examples/custom-icons/leaf-green.png")
+ m <- leaflet() %>% addProviderTiles("CartoDB") %>%
+ addClusterCharts(data = as(data, "Spatial")
+ , categoryField = "category"
+ , categoryMap =
+ data.frame(labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden"),
+ colors = c("lightblue", "orange", "lightyellow", "lightgreen"),
+ icons = iconvec)
+ , options = clusterchartOptions(size = 50)
+ , popupFields = c("id","brewery","address","zipcode", "category","tosum","tosum2")
+ , popupLabels = c("id","Brauerei","Addresse","PLZ", "Art", "tosum","tosum2")
+ , label = "label")
+ deps <- findDependencies(m)
+ expect_equal(deps[[length(deps)]]$name, "lfx-clustercharts")
+ expect_equal(deps[[length(deps)-1]]$name, "leaflet-markercluster")
+ expect_equal(deps[[length(deps)-2]]$name, "lfx-clustercharts-css")
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method, "addClusterCharts")
+
+ ## ALL ############
+ m <- leaflet() %>% addMapPane("clusterpane", 420) %>%
+ addClusterCharts(data = data
+ , options = clusterchartOptions(rmax = 50,
+ size = 40,
+ # size = c(100,140),
+ labelBackground = TRUE,
+ labelStroke = "orange",
+ labelColor = "gray",
+ labelOpacity = 0.5,
+ innerRadius = 20,
+ aggregation = "sum",
+ valueField = "tosum",
+ digits = 0,
+ sortTitlebyCount = TRUE)
+ # , type = "bar"
+ # , type = "horizontal"
+ # , type = "custom"
+ , categoryField = "category"
+ , html = "web"
+ , icon = shipIcon
+ , categoryMap =
+ data.frame(labels = c("Schwer", "Mäßig", "Leicht", "kein Schaden"),
+ colors = c("lightblue", "orange", "lightyellow", "lightgreen"))
+ , group = "clustermarkers"
+ , layerId = "id"
+ , clusterId = "id"
+ , popupFields = c("id","brewery","address","zipcode", "category","tosum","tosum2")
+ , popupLabels = c("id","Brauerei","Addresse","PLZ", "Art", "tosum","tosum2")
+ , label = "label"
+ , markerOptions = markerOptions(interactive = TRUE,
+ draggable = TRUE,
+ keyboard = TRUE,
+ title = "Some Marker Title",
+ zIndexOffset = 100,
+ opacity = 1,
+ riseOnHover = TRUE,
+ riseOffset = 400)
+ , 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),
+ freezeAtZoom = TRUE,
+ clusterPane = "clusterpane",
+ spiderfyDistanceMultiplier = 2
+ )
+ , labelOptions = labelOptions(opacity = 0.8, textsize = "14px")
+ , popupOptions = popupOptions(maxWidth = 900, minWidth = 200, keepInView = TRUE)
+ )
+
+})
diff --git a/tests/testthat/test-contextmenu.R b/tests/testthat/test-contextmenu.R
index 97aa18f2..4cf4e97b 100644
--- a/tests/testthat/test-contextmenu.R
+++ b/tests/testthat/test-contextmenu.R
@@ -46,6 +46,14 @@ test_that("contextmenu", {
expect_equal(m$x$calls[[length(m$x$calls)]]$method,
"hideContextmenu")
+ m <- m %>% enableContextmenu()
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method,
+ "enableContextmenu")
+
+ m <- m %>% disableContextmenu()
+ expect_equal(m$x$calls[[length(m$x$calls)]]$method,
+ "disableContextmenu")
+
if (packageVersion("leaflet") < "2.0.4") {
m <- expect_warning(
m %>% addItemContextmenu(
diff --git a/tests/testthat/test-movingmarker.R b/tests/testthat/test-movingmarker.R
index 0bfdccfe..5abe7c7b 100644
--- a/tests/testthat/test-movingmarker.R
+++ b/tests/testthat/test-movingmarker.R
@@ -19,10 +19,10 @@ test_that("movingmarker", {
m <- expect_warning(
leaflet() %>%
- 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"))
expect_is(m, "leaflet")
expect_equal(m$x$calls[[1]]$method, "addMovingMarker")
@@ -82,14 +82,14 @@ test_that("movingmarker", {
dfsf <- expect_warning(st_cast(dfsf, "POINT"))
dfsf <- st_transform(dfsf, 4326)
m <- leaflet() %>%
- addMovingMarker(data = dfsf) %>%
- startMoving()
+ addMovingMarker(data = dfsf) %>%
+ startMoving()
expect_is(m, "leaflet")
expect_equal(m$x$calls[[length(m$x$calls)]]$method, "startMoving")
m <- leaflet() %>%
- addMovingMarker(data = dfsf) %>%
- startMoving()
+ addMovingMarker(data = dfsf) %>%
+ startMoving()
expect_is(m, "leaflet")
expect_equal(m$x$calls[[length(m$x$calls)]]$method, "startMoving")
diff --git a/tests/testthat/test-timeslider.R b/tests/testthat/test-timeslider.R
index 85c70f1f..323b12fd 100644
--- a/tests/testthat/test-timeslider.R
+++ b/tests/testthat/test-timeslider.R
@@ -49,4 +49,28 @@ test_that("timeslider", {
removeTimeslider()
expect_identical(m$x$calls[[length(m$x$calls)]]$method, "removeTimeslider")
+ m <- leaflet() %>%
+ addTimeslider(data = data, fill = FALSE,
+ label = ~Name,
+ options = timesliderOptions(
+ position = "topright",
+ timeAttribute = "time",
+ range = FALSE))
+ expect_is(m, "leaflet")
+ expect_identical(m$x$calls[[1]]$method, "addTimeslider")
+ expect_is(m$x$calls[[1]]$args[[1]], "geojson")
+ expect_true(inherits(m$x$calls[[1]]$args[[1]], "geojson"))
+
+ m <- leaflet() %>%
+ addTimeslider(data = data, fill = FALSE,
+ label = data$Name,
+ options = timesliderOptions(
+ position = "topright",
+ timeAttribute = "time",
+ range = FALSE))
+ expect_is(m, "leaflet")
+ expect_identical(m$x$calls[[1]]$method, "addTimeslider")
+ expect_is(m$x$calls[[1]]$args[[1]], "geojson")
+ expect_true(inherits(m$x$calls[[1]]$args[[1]], "geojson"))
+
})