omnivoreDependencies <- function() {
list(
html_dep_prod("csv2geojson", "5.1.2"),
html_dep_prod("togeojson", "0.16.2"),
html_dep_prod("topojson", "3.0.2"),
# polyline is not implemented
# wellknown is not implemented
html_dep_prod("lfx-omnivore", "3.0.4", has_binding = TRUE)
)
}
# Source https://github.com/timwis/leaflet-choropleth
# Source New https://github.com/trafficonese/leaflet-choropleth
geoJSONChoroplethDependency <- function() {
list(
# // "leaflet-choropleth": "1.1.4",
html_dep_prod("lfx-choropleth", "1.1.4")
)
}
# Utility Function
invokeJSAddMethod <- function(
jsMethod, # The javascript method to invoke
map, data, layerId = NULL, group = NULL,
markerType = NULL, markerIcons = NULL,
markerIconProperty = NULL, markerOptions = leaflet::markerOptions(),
clusterOptions = NULL, clusterId = NULL,
labelProperty = NULL, labelOptions = leaflet::labelOptions(),
popupProperty = NULL, popupOptions = leaflet::popupOptions(),
stroke = TRUE,
color = "#03F",
weight = 5,
opacity = 0.5,
fill = TRUE,
fillColor = color,
fillOpacity = 0.2,
dashArray = NULL,
smoothFactor = 1.0,
noClip = FALSE,
pathOptions = leaflet::pathOptions(),
highlightOptions = NULL,
...) {
if (!is.null(markerType) && !(markerType %in% c("marker", "circleMarker"))) {
stop("markerType if specified then it needs to be either \"marker\" or \"clusterMarker\"")
}
map$dependencies <- c(map$dependencies, omnivoreDependencies())
if (!is.null(clusterOptions)) {
map$dependencies <- c(
map$dependencies,
leaflet::leafletDependencies$markerCluster()
)
}
pathOptions <- c(pathOptions, list(
stroke = stroke, color = color, weight = weight, opacity = opacity,
fill = fill, fillColor = fillColor, fillOpacity = fillOpacity,
dashArray = dashArray, smoothFactor = smoothFactor, noClip = noClip
))
markerIconFunction <- NULL
if (!is.null(markerIcons)) {
if (inherits(markerIcons, "leaflet_icon_set") ||
inherits(markerIcons, "leaflet_icon")) {
markerIconFunction <- defIconFunction
} else if (inherits(markerIcons, "leaflet_awesome_icon_set") ||
inherits(markerIcons, "leaflet_awesome_icon")) {
if (inherits(markerIcons, "leaflet_awesome_icon_set")) {
libs <- unique(sapply(markerIcons, function(icon) icon$library))
map <- addAwesomeMarkersDependencies(map, libs)
} else {
map <- addAwesomeMarkersDependencies(map, markerIcons$library)
}
markerIconFunction <- awesomeIconFunction
} else {
stop("markerIcons should be created using either leaflet::iconList() or leaflet::awesomeIconList()")
}
}
if (missing(...)) {
invokeMethod(
map, getMapData(map), jsMethod, data, layerId, group,
markerType, markerIcons,
markerIconProperty, markerOptions, markerIconFunction,
clusterOptions, clusterId,
labelProperty, labelOptions, popupProperty, popupOptions,
pathOptions, highlightOptions
)
} else {
invokeMethod(
map, getMapData(map), jsMethod, data, layerId, group,
markerType, markerIcons,
markerIconProperty, markerOptions, markerIconFunction,
clusterOptions, clusterId,
labelProperty, labelOptions, popupProperty, popupOptions,
pathOptions, highlightOptions, ...
)
}
}
#' Adds a GeoJSON/TopoJSON to the leaflet map.
#' @description This is a feature rich alternative to the \code{\link[leaflet]{addGeoJSON}} & \code{\link[leaflet]{addTopoJSON}}
#' with options to map feature properties to labels, popups, colors, markers etc.
#' @param geojson a GeoJSON/TopoJSON URL or file contents in a character vector.
#' @param markerType The type of marker. Either \code{marker} or \code{circleMarker}
#' @param markerIcons Icons for Marker.
#' Can be a single marker using \code{\link[leaflet]{makeIcon}}
#' or a list of markers using \code{\link[leaflet]{iconList}}
#' @param markerIconProperty The property of the feature to use for marker icon.
#' Can be a JS function which accepts a feature and returns an index of \code{markerIcons}.
#' In either case the result must be one of the indexes of markerIcons.
#' @param markerOptions The options for markers
#' @param labelProperty The property to use for the label.
#' You can also pass in a JS function that takes in a feature and returns a text/HTML content.
#' @param popupProperty The property to use for popup content
#' You can also pass in a JS function that takes in a feature and returns a text/HTML content.
#' @param pathOptions Options for shapes
#' @inheritParams leaflet::addPolylines
#' @rdname omnivore
#' @export
#' @examples
#' ## addGeoJSONv2
#' \donttest{
#' geoJson <- readr::read_file(
#' "https://rawgit.com/benbalter/dc-maps/master/maps/historic-landmarks-points.geojson"
#' )
#'
#' leaflet() %>%
#' setView(-77.0369, 38.9072, 12) %>%
#' addProviderTiles(providers$CartoDB.Positron) %>%
#' addWebGLGeoJSONHeatmap(
#' geoJson,
#' size = 30, units = "px"
#' ) %>%
#' addGeoJSONv2(
#' geoJson,
#' markerType = "circleMarker",
#' stroke = FALSE, fillColor = "black", fillOpacity = 0.7,
#' markerOptions = markerOptions(radius = 2)
#' )
#' }
#'
#' ## for more examples see
#' # browseURL(system.file("examples/draw.R", package = "leaflet.extras"))
#' # browseURL(system.file("examples/geojsonv2.R", package = "leaflet.extras"))
#' # browseURL(system.file("examples/search.R", package = "leaflet.extras"))
#' # browseURL(system.file("examples/TopoJSON.R", package = "leaflet.extras"))
#'
addGeoJSONv2 <- function(
map, geojson, layerId = NULL, group = NULL,
markerType = NULL, markerIcons = NULL,
markerIconProperty = NULL, markerOptions = leaflet::markerOptions(),
clusterOptions = NULL, clusterId = NULL,
labelProperty = NULL, labelOptions = leaflet::labelOptions(),
popupProperty = NULL, popupOptions = leaflet::popupOptions(),
stroke = TRUE,
color = "#03F",
weight = 5,
opacity = 0.5,
fill = TRUE,
fillColor = color,
fillOpacity = 0.2,
dashArray = NULL,
smoothFactor = 1.0,
noClip = FALSE,
pathOptions = leaflet::pathOptions(),
highlightOptions = NULL) {
invokeJSAddMethod(
"addGeoJSONv2",
map, geojson, layerId, group,
markerType, markerIcons,
markerIconProperty, markerOptions,
clusterOptions, clusterId,
labelProperty, labelOptions, popupProperty, popupOptions,
stroke,
color,
weight,
opacity,
fill,
fillColor,
fillOpacity,
dashArray,
smoothFactor,
noClip,
pathOptions, highlightOptions
)
}
#' Options to customize a Choropleth Legend
#' @param title An optional title for the legend
#' @param position legend position
#' @param locale The numbers will be formatted using this locale
#' @param numberFormatOptions Options for formatting numbers
#' @export
#' @rdname omnivore
legendOptions <- function(
title = NULL,
position = c("bottomleft", "bottomright", "topleft", "topright"),
locale = "en-US",
numberFormatOptions = list(
style = "decimal",
maximumFractionDigits = 2
)) {
position <- match.arg(position)
leaflet::filterNULL(
list(
title = title,
position = position,
formatOptions = list(
locale = locale,
options = numberFormatOptions
)
)
)
}
#' Adds a GeoJSON/TopoJSON Choropleth.
#' @param valueProperty The property to use for coloring
#' @param scale The scale to use from chroma.js
#' @param steps number of breakes
#' @param mode q for quantile, e for equidistant, k for k-means
#' @param channelMode Default "rgb", can be one of "rgb", "lab", "hsl", "lch"
#' @param padding either a single number or a 2 number vector for clipping color values at ends.
#' @param correctLightness whether to correct lightness
#' @param bezierInterpolate whether to use bezier interpolate for determining colors
#' @param colors overrides scale with manual colors
#' @param legendOptions Options to show a legend.
#' @rdname omnivore
#' @export
#' @examples
#' ## addGeoJSONChoropleth
#' \donttest{
#' geoJson <- readr::read_file(
#' "https://rawgit.com/benbalter/dc-maps/master/maps/ward-2012.geojson"
#' )
#'
#' leaflet() %>%
#' addTiles() %>%
#' setView(-77.0369, 38.9072, 11) %>%
#' addBootstrapDependency() %>%
#' enableMeasurePath() %>%
#' addGeoJSONChoropleth(
#' geoJson,
#' valueProperty = "AREASQMI",
#' scale = c("white", "red"),
#' mode = "q",
#' steps = 4,
#' padding = c(0.2, 0),
#' labelProperty = "NAME",
#' popupProperty = propstoHTMLTable(
#' props = c("NAME", "AREASQMI", "REP_NAME", "WEB_URL", "REP_PHONE", "REP_EMAIL", "REP_OFFICE"),
#' table.attrs = list(class = "table table-striped table-bordered"),
#' drop.na = TRUE
#' ),
#' color = "#ffffff", weight = 1, fillOpacity = 0.7,
#' highlightOptions = highlightOptions(
#' weight = 2, color = "#000000",
#' fillOpacity = 1, opacity = 1,
#' bringToFront = TRUE, sendToBack = TRUE
#' ),
#' pathOptions = pathOptions(
#' showMeasurements = TRUE,
#' measurementOptions = measurePathOptions(imperial = TRUE)
#' )
#' )
#' }
#'
#' ## for more examples see
#' # browseURL(system.file("examples/geojsonv2.R", package = "leaflet.extras"))
#' # browseURL(system.file("examples/measurePath.R", package = "leaflet.extras"))
#' # browseURL(system.file("examples/search.R", package = "leaflet.extras"))
#' # browseURL(system.file("examples/TopoJSON.R", package = "leaflet.extras"))
#'
addGeoJSONChoropleth <- function(
map, geojson, layerId = NULL, group = NULL,
valueProperty,
labelProperty = NULL, labelOptions = leaflet::labelOptions(),
popupProperty = NULL, popupOptions = leaflet::popupOptions(),
scale = c("white", "red"),
steps = 5,
mode = "q",
channelMode = c("rgb", "lab", "hsl", "lch"),
padding = NULL,
correctLightness = FALSE,
bezierInterpolate = FALSE,
colors = NULL,
stroke = TRUE,
color = "#03F",
weight = 1,
opacity = 0.5,
fillOpacity = 0.2,
dashArray = NULL,
smoothFactor = 1.0,
noClip = FALSE,
pathOptions = leaflet::pathOptions(),
highlightOptions = NULL,
legendOptions = NULL) {
map$dependencies <- c(map$dependencies, omnivoreDependencies())
map$dependencies <- c(
map$dependencies,
geoJSONChoroplethDependency()
)
channelMode <- match.arg(channelMode)
pathOptions <- c(pathOptions, list(
valueProperty = valueProperty,
scale = scale,
steps = steps,
mode = mode,
channelMode = channelMode,
padding = padding,
correctLightness = correctLightness,
bezierInterpolate = bezierInterpolate,
colors = colors,
stroke = stroke,
color = color,
weight = weight,
opacity = opacity,
fillOpacity = fillOpacity,
dashArray = dashArray,
smoothFactor = smoothFactor,
noClip = noClip
))
leaflet::invokeMethod(
map, leaflet::getMapData(map), "addGeoJSONChoropleth",
geojson, layerId, group,
labelProperty, labelOptions, popupProperty, popupOptions,
pathOptions, highlightOptions, legendOptions
)
}
#' Adds a KML to the leaflet map.
#' @param kml a KML URL or contents in a character vector.
#' @rdname omnivore
#' @export
#' @examples
#' ## addKML
#' \donttest{
#' kml <- readr::read_file(
#' system.file("examples/data/kml/crimes.kml.zip", package = "leaflet.extras")
#' )
#'
#' leaflet() %>%
#' setView(-77.0369, 38.9072, 12) %>%
#' addProviderTiles(providers$CartoDB.Positron) %>%
#' addWebGLKMLHeatmap(kml, size = 20, units = "px") %>%
#' addKML(
#' kml,
#' markerType = "circleMarker",
#' stroke = FALSE, fillColor = "black", fillOpacity = 1,
#' markerOptions = markerOptions(radius = 1)
#' )
#' }
#'
addKML <- function(
map, kml, layerId = NULL, group = NULL,
markerType = NULL, markerIcons = NULL,
markerIconProperty = NULL, markerOptions = leaflet::markerOptions(),
clusterOptions = NULL, clusterId = NULL,
labelProperty = NULL, labelOptions = leaflet::labelOptions(),
popupProperty = NULL, popupOptions = leaflet::popupOptions(),
stroke = TRUE,
color = "#03F",
weight = 5,
opacity = 0.5,
fill = TRUE,
fillColor = color,
fillOpacity = 0.2,
dashArray = NULL,
smoothFactor = 1.0,
noClip = FALSE,
pathOptions = leaflet::pathOptions(),
highlightOptions = NULL) {
invokeJSAddMethod(
"addKML",
map, kml, layerId, group,
markerType, markerIcons,
markerIconProperty, markerOptions,
clusterOptions, clusterId,
labelProperty, labelOptions, popupProperty, popupOptions,
stroke,
color,
weight,
opacity,
fill,
fillColor,
fillOpacity,
dashArray,
smoothFactor,
noClip,
pathOptions, highlightOptions
)
}
#' Adds a KML Choropleth.
#' @rdname omnivore
#' @export
#' @examples
#' ## addKMLChoropleth
#' \donttest{
#' kml <- readr::read_file(
#' system.file("examples/data/kml/cb_2015_us_state_20m.kml.zip", package = "leaflet.extras")
#' )
#'
#' leaflet() %>%
#' addBootstrapDependency() %>%
#' setView(-98.583333, 39.833333, 4) %>%
#' addProviderTiles(providers$CartoDB.Positron) %>%
#' addKMLChoropleth(
#' kml,
#' valueProperty = JS(
#' "function(feature){
#' var props = feature.properties;
#' var aland = props.ALAND/100000;
#' var awater = props.AWATER/100000;
#' return 100*awater/(awater+aland);
#' }"
#' ),
#' scale = "OrRd", mode = "q", steps = 5,
#' padding = c(0.2, 0),
#' popupProperty = "description",
#' labelProperty = "NAME",
#' color = "#ffffff", weight = 1, fillOpacity = 1,
#' highlightOptions = highlightOptions(
#' fillOpacity = 1, weight = 2, opacity = 1, color = "#000000",
#' bringToFront = TRUE, sendToBack = TRUE
#' ),
#' legendOptions = legendOptions(
#' title = "% of Water Area",
#' numberFormatOptions = list(
#' style = "decimal",
#' maximumFractionDigits = 2
#' )
#' )
#' )
#' }
#'
addKMLChoropleth <- function(
map, kml, layerId = NULL, group = NULL,
valueProperty,
labelProperty = NULL, labelOptions = leaflet::labelOptions(),
popupProperty = NULL, popupOptions = leaflet::popupOptions(),
scale = c("white", "red"),
steps = 5,
mode = "q",
channelMode = c("rgb", "lab", "hsl", "lch"),
padding = NULL,
correctLightness = FALSE,
bezierInterpolate = FALSE,
colors = NULL,
stroke = TRUE,
color = "#03F",
weight = 1,
opacity = 0.5,
fillOpacity = 0.2,
dashArray = NULL,
smoothFactor = 1.0,
noClip = FALSE,
pathOptions = leaflet::pathOptions(),
highlightOptions = NULL,
legendOptions = NULL) {
map$dependencies <- c(map$dependencies, omnivoreDependencies())
map$dependencies <- c(
map$dependencies,
geoJSONChoroplethDependency()
)
channelMode <- match.arg(channelMode)
pathOptions <- c(pathOptions, list(
valueProperty = valueProperty,
scale = scale,
steps = steps,
mode = mode,
channelMode = channelMode,
padding = padding,
correctLightness = correctLightness,
bezierInterpolate = bezierInterpolate,
colors = colors,
stroke = stroke,
color = color,
weight = weight,
opacity = opacity,
fillOpacity = fillOpacity,
dashArray = dashArray,
smoothFactor = smoothFactor,
noClip = noClip
))
leaflet::invokeMethod(
map, leaflet::getMapData(map), "addKMLChoropleth",
kml, layerId, group,
labelProperty, labelOptions, popupProperty, popupOptions,
pathOptions, highlightOptions, legendOptions
)
}
#' Options for parsing CSV
#' @param latfield field name for latitude
#' @param lonfield field name for longitude
#' @param delimiter field separator
#' @rdname omnivore
#' @export
csvParserOptions <- function(
latfield,
lonfield,
delimiter = ",") {
list(
latfield = latfield,
lonfield = lonfield,
delimiter = delimiter
)
}
#' Adds a CSV to the leaflet map.
#' @param csv a CSV URL or contents in a character vector.
#' @param csvParserOptions options for parsing the CSV.
#' Use \code{\link{csvParserOptions}}() to supply csv parser options.
#' @rdname omnivore
#' @export
#' @examples
#' ## addCSV
#' \donttest{
#' csv <- readr::read_file(
#' system.file("examples/data/csv/world_airports.csv.zip", package = "leaflet.extras")
#' )
#'
#' leaflet() %>%
#' setView(0, 0, 2) %>%
#' addProviderTiles(providers$CartoDB.DarkMatterNoLabels) %>%
#' addCSV(
#' csv,
#' csvParserOptions("latitude_deg", "longitude_deg"),
#' markerType = "circleMarker",
#' stroke = FALSE, fillColor = "red", fillOpacity = 1,
#' markerOptions = markerOptions(radius = 0.5)
#' )
#' }
#'
addCSV <- function(
map, csv, csvParserOptions, layerId = NULL, group = NULL,
markerType = NULL, markerIcons = NULL,
markerIconProperty = NULL, markerOptions = leaflet::markerOptions(),
clusterOptions = NULL, clusterId = NULL,
labelProperty = NULL, labelOptions = leaflet::labelOptions(),
popupProperty = NULL, popupOptions = leaflet::popupOptions(),
stroke = TRUE,
color = "#03F",
weight = 5,
opacity = 0.5,
fill = TRUE,
fillColor = color,
fillOpacity = 0.2,
dashArray = NULL,
smoothFactor = 1.0,
noClip = FALSE,
pathOptions = leaflet::pathOptions(),
highlightOptions = NULL) {
invokeJSAddMethod(
"addCSV",
map, csv, layerId, group,
markerType, markerIcons,
markerIconProperty, markerOptions,
clusterOptions, clusterId,
labelProperty, labelOptions, popupProperty, popupOptions,
stroke,
color,
weight,
opacity,
fill,
fillColor,
fillOpacity,
dashArray,
smoothFactor,
noClip,
pathOptions, highlightOptions, csvParserOptions
)
}
#' Adds a GPX to the leaflet map.
#' @param gpx a GPX URL or contents in a character vector.
#' @rdname omnivore
#' @export
#' @examples
#' ## addGPX
#' \donttest{
#' airports <- readr::read_file(
#' system.file("examples/data/gpx/md-airports.gpx.zip", package = "leaflet.extras")
#' )
#'
#' leaflet() %>%
#' addBootstrapDependency() %>%
#' setView(-76.6413, 39.0458, 8) %>%
#' addProviderTiles(
#' providers$CartoDB.Positron,
#' options = providerTileOptions(detectRetina = TRUE)
#' ) %>%
#' addWebGLGPXHeatmap(airports, size = 20000, group = "airports", opacity = 0.9) %>%
#' addGPX(
#' airports,
#' markerType = "circleMarker",
#' stroke = FALSE, fillColor = "black", fillOpacity = 1,
#' markerOptions = markerOptions(radius = 1.5),
#' group = "airports"
#' )
#' }
#'
#' ## for a larger example see
#' # browseURL(system.file("examples/GPX.R", package = "leaflet.extras"))
#'
addGPX <- function(
map, gpx, layerId = NULL, group = NULL,
markerType = NULL, markerIcons = NULL,
markerIconProperty = NULL, markerOptions = leaflet::markerOptions(),
clusterOptions = NULL, clusterId = NULL,
labelProperty = NULL, labelOptions = leaflet::labelOptions(),
popupProperty = NULL, popupOptions = leaflet::popupOptions(),
stroke = TRUE,
color = "#03F",
weight = 5,
opacity = 0.5,
fill = TRUE,
fillColor = color,
fillOpacity = 0.2,
dashArray = NULL,
smoothFactor = 1.0,
noClip = FALSE,
pathOptions = leaflet::pathOptions(),
highlightOptions = NULL) {
invokeJSAddMethod(
"addGPX",
map, gpx, layerId, group,
markerType, markerIcons,
markerIconProperty, markerOptions,
clusterOptions, clusterId,
labelProperty, labelOptions, popupProperty, popupOptions,
stroke,
color,
weight,
opacity,
fill,
fillColor,
fillOpacity,
dashArray,
smoothFactor,
noClip,
pathOptions, highlightOptions
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.