diff --git a/NEWS.md b/NEWS.md index 61a338f9..7ad32d88 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,7 @@ * Fix for roxygen2 > 7.0.0. #1491 * The opened sidebar tab is returned as Shiny input using the `sidebar_tabs` ID. * allow `...` in `antpathOptions` to be able to set the pane (e.g.: `renderer= JS('L.svg({pane: "my-pane"})')`) +* 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` # leaflet.extras2 1.2.2 diff --git a/R/divicon.R b/R/divicon.R index 2a5477a5..a96e294b 100644 --- a/R/divicon.R +++ b/R/divicon.R @@ -9,41 +9,81 @@ diviconDependency <- function() { ) } -#' Add DivIcon +#' Add DivIcon Markers to a Leaflet Map #' -#' The function expects either line or point data as spatial data or as Simple Feature. -#' Alternatively, coordinates can also be passed as numeric vectors. -#' @param map the map to add moving markers +#' Adds customizable DivIcon markers to a Leaflet map. The function can accept either spatial +#' data (lines or points) in the form of a Simple Feature (sf) object or numeric vectors +#' 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 classes A single or vector of CSS-classes -#' @param htmls A single or vector of HTML objects -#' @param options a list of extra options for markers. See -#' \code{\link[leaflet]{markerOptions}} -#' @family Divicon Functions -#' @references \url{https://github.com/ewoken/Leaflet.MovingMarker} -#' @inherit leaflet::addMarkers return +#' @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 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 #' @examples +#' library(sf) +#' library(leaflet) +#' library(leaflet.extras2) +#' +#' # Sample data +#' 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)) +#' +#' leaflet() %>% +#' addTiles() %>% +#' addDivicon(data = df +#' , html = ~paste0( +#' '
', +#' '
', Name, '
', +#' '
MaxWind: ', MaxWind, '
', +#' '
' +#' ) +#' , label = ~Name +#' , layerId = ~ID +#' , group = "Divicons" +#' , popup = ~paste("ID: ", ID, "
", +#' "Name: ", Name, "
", +#' "MaxWind:", MaxWind, "
", +#' "MinPress:", MinPress) +#' , options = markerOptions(draggable = TRUE) +#' ) addDivicon <- function (map, lng = NULL, lat = NULL, layerId = NULL, group = NULL, - icon = NULL, popup = NULL, popupOptions = NULL, label = NULL, + popup = NULL, popupOptions = NULL, label = NULL, labelOptions = NULL, - classes = NULL, htmls = NULL, + className = NULL, html = NULL, options = markerOptions(), clusterOptions = NULL, - clusterId = NULL, data = getMapData(map)) { + clusterId = NULL, divOptions = list(), data = getMapData(map)) { if (missing(labelOptions)) labelOptions <- labelOptions() - map$dependencies <- c(map$dependencies, diviconDependency()) + if (!is.null(clusterOptions)) + map$dependencies <- c(map$dependencies, leafletDependencies$markerCluster()) + pts <- derivePoints(data, lng, lat, missing(lng), missing(lat), "addDivicon") invokeMethod(map, data, "addDivicon", pts$lat, pts$lng, - icon, layerId, group, options, - classes, htmls, + layerId, group, options, + className, html, popup, popupOptions, label, labelOptions, - clusterId, clusterOptions) %>% + clusterId, clusterOptions, + divOptions, + getCrosstalkOptions(data)) %>% expandLimits(pts$lat, pts$lng) } +getCrosstalkOptions <- utils::getFromNamespace("getCrosstalkOptions", "leaflet") + + + diff --git a/inst/examples/divicons_app.R b/inst/examples/divicons_app.R index 904c4042..79bb8940 100644 --- a/inst/examples/divicons_app.R +++ b/inst/examples/divicons_app.R @@ -4,23 +4,6 @@ library(leaflet) library(leaflet.extras2) # options("shiny.autoreload" = TRUE) -shipIcon <- leaflet::makeIcon( - iconUrl = "./icons/Icon5.svg" - ,className = "lsaicons" - ,iconWidth = 24, iconHeight = 24, iconAnchorX = 0, iconAnchorY = 0 -) -# shipIcon <- iconList( -# "Schwer" = makeIcon("./icons/Icon5.svg", iconWidth = 32, iconHeight = 32), -# "Mäßig" = makeIcon("./icons/Icon8.svg", iconWidth = 32, iconHeight = 32), -# "Leicht" = makeIcon("./icons/Icon25.svg", iconWidth = 32, iconHeight = 32), -# "kein Schaden" = makeIcon("./icons/Icon29.svg", iconWidth = 32, iconHeight = 32) -# ) -# shipIcon <- makeIcon( -# iconUrl = "https://cdn-icons-png.flaticon.com/512/1355/1355883.png", -# iconWidth = 40, iconHeight = 50, -# iconAnchorX = 0, iconAnchorY = 0 -# ) - df <- sf::st_as_sf(atlStorms2005) df <- suppressWarnings(st_cast(df, "POINT")) df <- df[sample(1:nrow(df), 50, replace = F),] @@ -63,18 +46,28 @@ server <- function(input, output, session) { output$map <- renderLeaflet({ leaflet() %>% addTiles() %>% - addDivicon(data = df, - html = ~Name, - class=~paste("globalclass", classes), - label=~Name, - layerId = ~ID, - icon = shipIcon, - popup=~paste("ID: ", ID, "
", + addMarkers(data = df, group="normalmarker", + clusterId = "someclusterid2", + clusterOptions = markerClusterOptions()) %>% + addDivicon(data = df + , html = ~Name + , className = ~paste("globalclass", classes) + , label = ~Name + , layerId = ~ID + , group = "Divicons" + , popup = ~paste("ID: ", ID, "
", "Name: ", Name, "
", "MaxWind:", MaxWind, "
", - "MinPress:", MinPress), - options = markerOptions(draggable = TRUE) - ) + "MinPress:", MinPress) + , options = markerOptions(draggable = TRUE) + , divOptions = list( + popupAnchor = c(10, 0), + iconSize = 10) + # , clusterId = "someclusterid" + # , clusterOptions = markerClusterOptions() + ) %>% + hideGroup("normalmarker") %>% + addLayersControl(overlayGroups = c("Divicons","normalmarker")) }) output$click <- renderPrint({input$map_marker_click}) output$mouseover <- renderPrint({input$map_marker_mouseover}) diff --git a/inst/examples/divicons_html_app.R b/inst/examples/divicons_html_app.R new file mode 100644 index 00000000..1f43d8f1 --- /dev/null +++ b/inst/examples/divicons_html_app.R @@ -0,0 +1,118 @@ +library(sf) +library(shiny) +library(leaflet) +library(leaflet.extras2) + +# Sample data +df <- sf::st_as_sf(atlStorms2005) +df <- suppressWarnings(st_cast(df, "POINT")) +df <- df[sample(1:nrow(df), 50, replace = F),] +df$classes = sample(x = c("myclass1","myclass2","myclass3"), nrow(df), replace = TRUE) +df$ID <- paste0("ID_", 1:nrow(df)) + +## UI ################## +ui <- fluidPage( + ## CSS-style ############ + tags$head(tags$style(" + .globalclass { + width: 80px !important; + height: 80px !important; + margin-top: -40px !important; + margin-left: -40px !important; + font-size: 12px; + text-align: center; + border-radius: 50%; + color: black; + padding: 5px; + box-shadow: 0px 0px 10px rgba(0, 0, 0, 0.5); + background-size: cover; + background-repeat: no-repeat; + background-position: center center; + } + .myclass1 { + background-color: #FF5733; + } + .myclass2 { + background-color: #33FF57; + } + .myclass3 { + background-color: #3357FF; + } + .custom-html { + display: flex; + align-items: center; + justify-content: center; + flex-direction: column; + } + .custom-html img { + border-radius: 50%; + width: 20px; + height: 20px; + margin-bottom: 5px; + } + .custom-html .title { + font-weight: bold; + } + .custom-html .subtitle { + font-size: 10px; + } + ")), + ## CSS-style END ############ + leafletOutput("map", height = 600), + splitLayout(cellWidths = paste0(rep(20,4), "%"), + div(h4("Click Event"), verbatimTextOutput("click")), + div(h4("Mouseover Event"), verbatimTextOutput("mouseover")), + div(h4("Mouseout Event"), verbatimTextOutput("mouseout")), + div(h4("Dragend Event"), verbatimTextOutput("dragend")) + ) +) + +## SERVER ################## +server <- function(input, output, session) { + # Function to get image URL based on class + getImageUrls <- function(classes) { + urls <- c( + "myclass1" = "https://cdn-icons-png.flaticon.com/512/1355/1355883.png", + "myclass2" = "https://cdn-icons-png.flaticon.com/512/1356/1356623.png", + "myclass3" = "https://cdn-icons-png.flaticon.com/512/1357/1357674.png" + ) + return(urls[classes]) + } + + output$map <- renderLeaflet({ + leaflet() %>% + addTiles() %>% + # addMarkers(data = df, group="normalmarker", + # clusterId = "someclusterid2", + # clusterOptions = markerClusterOptions()) %>% + addDivicon(data = df + , html = ~paste0( + '
', + '', + '
', Name, '
', + '
MaxWind: ', MaxWind, '
', + '
' + ) + , className = ~paste("globalclass", classes) + , label = ~Name + , layerId = ~ID + , group = "Divicons" + , popup = ~paste("ID: ", ID, "
", + "Name: ", Name, "
", + "MaxWind:", MaxWind, "
", + "MinPress:", MinPress) + , options = markerOptions(draggable = TRUE) + # , clusterId = "someclusterid" + # , clusterOptions = markerClusterOptions() + ) %>% + addLabelgun("Divicons", 1) %>% + hideGroup("normalmarker") %>% + addLayersControl(overlayGroups = c("Divicons","normalmarker")) + }) + output$click <- renderPrint({input$map_marker_click}) + output$mouseover <- renderPrint({input$map_marker_mouseover}) + output$mouseout <- renderPrint({input$map_marker_mouseout}) + output$dragend <- renderPrint({input$map_marker_dragend}) +} + +shinyApp(ui, server) diff --git a/inst/htmlwidgets/lfx-divicon/lfx-divicon-bindings.js b/inst/htmlwidgets/lfx-divicon/lfx-divicon-bindings.js index 4145ad2b..e1b03b3d 100644 --- a/inst/htmlwidgets/lfx-divicon/lfx-divicon-bindings.js +++ b/inst/htmlwidgets/lfx-divicon/lfx-divicon-bindings.js @@ -1,120 +1,107 @@ /* global LeafletWidget, $, L */ LeafletWidget.methods.addDivicon = function( - lats, lngs, icon, layerId, group, options, - classes, htmls, - popups, popupOptions, labels, labelOptions, - clusterId, clusterOptions, divOptions) { - - var map = this; - console.log("addDivicon") - - // Convert inputs to arrays if they are single strings - classes = toArray(classes, lats.length); - htmls = toArray(htmls, lats.length); - popups = toArray(popups, lats.length); - labels = toArray(labels, lats.length); - layerIds = toArray(layerId, lats.length); - - for (var i = 0; i < lats.length; i++) { - var lat = lats[i]; - var lng = lngs[i]; - var iconClass = classes[i]; - var html = htmls[i]; - var popupContent = popups[i]; - var labelContent = labels[i]; - var layerId = layerIds[i]; - - // Create a new marker with DivIcon - var divIconOptions = Object.assign({}, divOptions, { - className: iconClass, - html: html - }); - var divmarker = new L.Marker([lat, lng], - Object.assign({}, options, { - icon: new L.DivIcon(divIconOptions) - })); - - // Bind popup to the marker if popup content is provided - if (popupContent) { - divmarker.bindPopup(popupContent, popupOptions); - } - - // Assign label (tooltip) to marker if label content is provided - if (labelContent) { - divmarker.bindTooltip(labelContent, labelOptions); + lat, lng, layerId, group, options, + className, html, + popup, popupOptions, label, labelOptions, + clusterId, clusterOptions, divOptions, + crosstalkOptions) { + + (function() { + // Make a Dataframe + let df = new LeafletWidget.DataFrame() + .col("lat", lat) + .col("lng", lng) + .col("layerId", layerId) + .col("group", group) + .col("popup", popup) + .col("popupOptions", popupOptions) + .col("label", label) + .col("labelOptions", labelOptions) + .col("className", className) + .col("html", html) + .cbind(options) + .cbind(crosstalkOptions || {}); + + // Add Cluster + let clusterGroup = this.layerManager.getLayer("cluster", clusterId), + cluster = clusterOptions !== null; + if (cluster && !clusterGroup) { + clusterGroup = L.markerClusterGroup.layerSupport(clusterOptions); + if(clusterOptions.freezeAtZoom) { + let freezeAtZoom = clusterOptions.freezeAtZoom; + delete clusterOptions.freezeAtZoom; + clusterGroup.freezeAtZoom(freezeAtZoom); + } + clusterGroup.clusterLayerStore = new LeafletWidget.ClusterLayerStore(clusterGroup); } - - // Add the marker to the map's layer manager - map.layerManager.addLayer(divmarker, "marker", layerId, group); - - divmarker.on("click", LeafletWidget.methods.mouseHandler(map.id, layerId, group, "marker_click", ""), this); - divmarker.on("mouseover", LeafletWidget.methods.mouseHandler(map.id, layerId, group, "marker_mouseover", ""), this); - divmarker.on("mouseout", LeafletWidget.methods.mouseHandler(map.id, layerId, group, "marker_mouseout", ""), this); - divmarker.on("dragend", LeafletWidget.methods.mouseHandler(map.id, layerId, group, "marker_dragend", ""), this); - - if (clusterId) { - map.layerManager.addLayer(divmarker, "cluster", clusterId, group); - } - - } -}; - - -// Convert single string inputs to arrays -function toArray(input, length) { - if (typeof input === 'string') { - return Array(length).fill(input); - } - return input; -} - - -/* -addDivicon(map, df, group, markerFunc) { - (function() { - for (let i = 0; i < df.nrow(); i++) { - if($.isNumeric(df.get(i, "lat")) && $.isNumeric(df.get(i, "lng"))) { - (function() { - let marker = markerFunc(df, i); - let thisId = df.get(i, "layerId"); - let thisGroup = cluster ? null : df.get(i, "group"); - this.layerManager.addLayer(marker, "marker", thisId, thisGroup, df.get(i, "ctGroup", true), df.get(i, "ctKey", true)); - - let popup = df.get(i, "popup"); - let popupOptions = df.get(i, "popupOptions"); - if (popup !== null) { - if (popupOptions !== null){ - marker.bindPopup(popup, popupOptions); + let extraInfo = cluster ? { clusterId: clusterId } : {}; + + for (let i = 0; i < df.nrow(); i++) { + if($.isNumeric(df.get(i, "lat")) && $.isNumeric(df.get(i, "lng"))) { + (function() { + + let thisId = df.get(i, "layerId"); + let thisGroup = cluster ? null : df.get(i, "group"); + + // Create a new marker with DivIcon + var divIconOptions = Object.assign({}, divOptions, { + className: df.get(i, "className"), + html: df.get(i, "html") + }); + var divmarker = new L.Marker( + [df.get(i, "lat"), df.get(i, "lng")], + Object.assign({}, options, { + icon: new L.DivIcon(divIconOptions) + })); + + if (cluster) { + clusterGroup.clusterLayerStore.add(divmarker, thisId); } else { - marker.bindPopup(popup); + this.layerManager.addLayer(divmarker, "marker", thisId, thisGroup, df.get(i, "ctGroup", true), df.get(i, "ctKey", true)); } - } - let label = df.get(i, "label"); - let labelOptions = df.get(i, "labelOptions"); - if (label !== null) { - if (labelOptions !== null) { - if(labelOptions.permanent) { - marker.bindTooltip(label, labelOptions).openTooltip(); + + // Bind popup to the marker if popup content is provided + let popup = df.get(i, "popup"); + let popupOptions = df.get(i, "popupOptions"); + if (popup !== null) { + if (popupOptions !== null){ + divmarker.bindPopup(popup, popupOptions); } else { - marker.bindTooltip(label, labelOptions); + divmarker.bindPopup(popup); + } + } + + // Assign label (tooltip) to marker if label content is provided + let label = df.get(i, "label"); + let labelOptions = df.get(i, "labelOptions"); + if (label !== null) { + if (labelOptions !== null) { + if(labelOptions.permanent) { + divmarker.bindTooltip(label, labelOptions).openTooltip(); + } else { + divmarker.bindTooltip(label, labelOptions); + } + } else { + divmarker.bindTooltip(label); } - } else { - marker.bindTooltip(label); } - } - //marker.on("click", mouseHandler(this.id, thisId, thisGroup, "marker_click"), this); - //marker.on("mouseover", mouseHandler(this.id, thisId, thisGroup, "marker_mouseover"), this); - //marker.on("mouseout", mouseHandler(this.id, thisId, thisGroup, "marker_mouseout"), this); - //marker.on("dragend", mouseHandler(this.id, thisId, thisGroup, "marker_dragend"), this); - }).call(this); + // Add the marker to the map's layer manager + this.layerManager.addLayer(divmarker, "marker", thisId, thisGroup); + + // Add Listener + divmarker.on("click", LeafletWidget.methods.mouseHandler(this.id, thisId, thisGroup, "marker_click", extraInfo), this); + divmarker.on("mouseover", LeafletWidget.methods.mouseHandler(this.id, thisId, thisGroup, "marker_mouseover", extraInfo), this); + divmarker.on("mouseout", LeafletWidget.methods.mouseHandler(this.id, thisId, thisGroup, "marker_mouseout", extraInfo), this); + divmarker.on("dragend", LeafletWidget.methods.mouseHandler(this.id, thisId, thisGroup, "marker_dragend", extraInfo), this); + + }).call(this); + } + } + if (cluster) { + this.layerManager.addLayer(clusterGroup, "cluster", clusterId, group); } - } + }).call(this); - if (cluster) { - this.layerManager.addLayer(clusterGroup, "cluster", clusterId, group); - } - }).call(map); -} +}; -*/ diff --git a/man/addDivicon.Rd b/man/addDivicon.Rd index 6391be2f..3fe99f4f 100644 --- a/man/addDivicon.Rd +++ b/man/addDivicon.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/divicon.R \name{addDivicon} \alias{addDivicon} -\title{Add DivIcon} +\title{Add DivIcon Markers to a Leaflet Map} \usage{ addDivicon( map, @@ -10,21 +10,21 @@ addDivicon( lat = NULL, layerId = NULL, group = NULL, - icon = NULL, popup = NULL, popupOptions = NULL, label = NULL, labelOptions = NULL, - classes = NULL, - htmls = NULL, + className = NULL, + html = NULL, options = markerOptions(), clusterOptions = NULL, clusterId = NULL, + divOptions = list(), data = getMapData(map) ) } \arguments{ -\item{map}{the map to add moving markers} +\item{map}{The Leaflet map object to which the DivIcon markers will be added.} \item{lng}{a numeric vector of longitudes, or a one-sided formula of the form \code{~x} where \code{x} is a variable in \code{data}; by default (if not @@ -44,8 +44,6 @@ Human-friendly group names are permitted--they need not be short, 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{icon}{the icon(s) for markers;} - \item{popup}{a character vector of the HTML content for the popups (you are recommended to escape the text using \code{\link[htmltools]{htmlEscape}()} for security reasons)} @@ -57,12 +55,12 @@ for security reasons)} \item{labelOptions}{A Vector of \code{\link[leaflet]{labelOptions}} to provide label options for each label. Default \code{NULL}} -\item{classes}{A single or vector of CSS-classes} +\item{className}{A single CSS class or a vector of CSS classes to apply to the DivIcon markers.} -\item{htmls}{A single or vector of HTML objects} +\item{html}{A single HTML string or a vector of HTML strings to display within the DivIcon markers.} -\item{options}{a list of extra options for markers. See -\code{\link[leaflet]{markerOptions}}} +\item{options}{A list of extra options for the markers. +See \code{\link[leaflet]{markerOptions}} for more details.} \item{clusterOptions}{if not \code{NULL}, markers will be clustered using \href{https://github.com/Leaflet/Leaflet.markercluster}{Leaflet.markercluster}; @@ -71,18 +69,50 @@ options} \item{clusterId}{the id for the marker cluster layer} +\item{divOptions}{A list of extra options for Leaflet DivIcon.} + \item{data}{the data object from which the argument values are derived; by default, it is the \code{data} object provided to \code{leaflet()} initially, but can be overridden} } \value{ -the new \code{map} object +The modified Leaflet map object. } \description{ -The function expects either line or point data as spatial data or as Simple Feature. -Alternatively, coordinates can also be passed as numeric vectors. +Adds customizable DivIcon markers to a Leaflet map. The function can accept either spatial +data (lines or points) in the form of a Simple Feature (sf) object or numeric vectors +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. } -\references{ -\url{https://github.com/ewoken/Leaflet.MovingMarker} +\examples{ +library(sf) +library(leaflet) +library(leaflet.extras2) + +# Sample data +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)) + +leaflet() \%>\% + addTiles() \%>\% + addDivicon(data = df + , html = ~paste0( + '
', + '
', Name, '
', + '
MaxWind: ', MaxWind, '
', + '
' + ) + , label = ~Name + , layerId = ~ID + , group = "Divicons" + , popup = ~paste("ID: ", ID, "
", + "Name: ", Name, "
", + "MaxWind:", MaxWind, "
", + "MinPress:", MinPress) + , options = markerOptions(draggable = TRUE) + ) } -\concept{Divicon Functions} +\concept{DivIcon Functions} diff --git a/tests/testthat/test-divicon.R b/tests/testthat/test-divicon.R new file mode 100644 index 00000000..69a81858 --- /dev/null +++ b/tests/testthat/test-divicon.R @@ -0,0 +1,140 @@ +# library(testthat) +# library(leaflet) +library(sf) + +# 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 +test_that("addDivicon works", { + map <- generate_test_map() %>% + addDivicon(data = df, + lng = ~lon, + lat = ~lat, + layerId = ~ID, + className = ~paste("globalclass", classes), + html = ~paste0('
', Name, '
')) + 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[[8]], NULL) + expect_identical(map$x$calls[[2]]$args[[9]], NULL) + expect_identical(map$x$calls[[2]]$args[[10]], NULL) + expect_identical(map$x$calls[[2]]$args[[11]], leaflet::labelOptions()) + expect_identical(map$x$calls[[2]]$args[[12]], NULL) + 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) + map <- generate_test_map() %>% + addDivicon(data = df, + layerId = ~ID, + className = ~paste("globalclass", classes), + group = ~groups, + html = ~paste0('
', Name, '
')) + 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]], 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[[8]], NULL) + expect_identical(map$x$calls[[2]]$args[[9]], NULL) + expect_identical(map$x$calls[[2]]$args[[10]], NULL) + expect_identical(map$x$calls[[2]]$args[[11]], leaflet::labelOptions()) + expect_identical(map$x$calls[[2]]$args[[12]], NULL) + expect_identical(map$x$calls[[2]]$args[[13]], NULL) + + # Test 3: Adding labels and popups + map <- generate_test_map() %>% + addDivicon(data = df, + layerId = ~ID, + className = ~paste("globalclass", classes), + label = ~groups, + labelOptions = labelOptions(textsize = 17), + popup = ~paste0(ID, ": ", Name), + popupOptions = popupOptions(minWidth = 400), + group = ~groups, + html = ~paste0('
', Name, '
')) + 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]], 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[[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) + expect_identical(map$x$calls[[2]]$args[[11]], labelOptions(textsize = 17)) + expect_identical(map$x$calls[[2]]$args[[12]], NULL) + expect_identical(map$x$calls[[2]]$args[[13]], NULL) + + # Test 4: Adding clustering options + map <- generate_test_map() %>% + addDivicon(data = df, + layerId = ~ID, + className = ~paste("globalclass", classes), + label = ~groups, + labelOptions = labelOptions(textsize = 17), + popup = ~paste0(ID, ": ", Name), + popupOptions = popupOptions(minWidth = 400), + group = ~groups, + html = ~paste0('
', Name, '
'), + clusterOptions = markerClusterOptions(), + clusterId = "someclusterid") + 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]], 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[[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) + expect_identical(map$x$calls[[2]]$args[[11]], labelOptions(textsize = 17)) + expect_identical(map$x$calls[[2]]$args[[12]], "someclusterid") + expect_identical(map$x$calls[[2]]$args[[13]], markerClusterOptions()) + + expect_error({ + map <- generate_test_map() %>% + addDivicon(data = NULL, + lng = ~lon, + lat = ~lat, + layerId = ~ID, + className = ~paste("globalclass", classes), + html = ~paste0('
', Name, '
')) + }) + + expect_error({ + map <- generate_test_map() %>% + addDivicon(data = data.frame(), + lng = ~lon, + lat = ~lat, + layerId = ~ID, + className = ~paste("globalclass", classes), + html = ~paste0('
', Name, '
')) + }) + + +}) +