googleCircleDependency <- function() {
list(
createHtmlDependency(
name = "circles",
version = "1.0.0",
src = system.file("htmlwidgets/lib/circles", package = "googleway"),
script = c("circles.js"),
all_files = FALSE
)
)
}
#' Add circle
#'
#' Add circles to a google map
#'
#' @param map a googleway map object created from \code{google_map()}
#' @param data data frame containing the data to use in the layer. If Null, the
#' data passed into \code{google_map()} will be used.
#' @param id string specifying the column containing an identifier for a shape
#' @param lat string specifying the column of \code{data} containing the 'latitude'
#' coordinates. If left NULL, a best-guess will be made
#' @param lon string specifying the column of \code{data} containing the 'longitude'
#' coordinates. If left NULL, a best-guess will be made
#' @param polyline string specifying the column of \code{data} containing the encoded polyline.
#' For circles and markers the encoded string will represent a single point.
#' @param radius either a string specifying the column of \code{data} containing the
#' radius of each circle, OR a numeric value specifying the radius of all the circles
#' (radius is expressed in metres)
#' @param draggable string specifying the column of \code{data} defining if
#' the polygon is 'draggable'. The column of data should be logical (either TRUE or FALSE)
#' @param editable string specifying the column of \code{data} defining if the polygon
#' is 'editable' (either TRUE or FALSE)
#' @param stroke_colour either a string specifying the column of \code{data} containing
#' the stroke colour of each shape, or a valid hexadecimal numeric HTML style to
#' be applied to all the shapes
#' @param stroke_opacity either a string specifying the column of \code{data} containing
#' the stroke opacity of each shape, or a value between 0 and 1 that will be
#' applied to all the shapes
#' @param stroke_weight either a string specifying the column of \code{data} containing
#' the stroke weight of each shape, or a number indicating the width of pixels
#' in the line to be applied to all the shapes
#' @param fill_colour either a string specifying the column of \code{data} containing
#' the fill colour of each shape, or a valid hexadecimal numeric HTML style to
#' be applied to all the shapes
#' @param fill_opacity either a string specifying the column of \code{data} containing
#' the fill opacity of each shape, or a value between 0 and 1 that will be applied
#' to all the shapes
#' @param info_window string specifying the column of data to display in an info
#' window when a shape is clicked.
#' @param mouse_over string specifying the column of data to display when the
#' mouse rolls over the shape
#' @param mouse_over_group string specifying the column of data specifying which
#' groups of shapes to highlight on mouseover
#' @param layer_id single value specifying an id for the layer. Use this value to
#' distinguish between shape layers for when using any \code{update_} function, and
#' for separating legends.
#' @param update_map_view logical specifying if the map should re-centre according to
#' the shapes
#' @param z_index single value specifying where the circles appear in the layering
#' of the map objects. Layers with a higher \code{z_index} appear on top of those with
#' a lower \code{z_index}. See details.
#' @param digits integer. Use this parameter to specify how many digits (decimal places)
#' should be used for the latitude / longitude coordinates.
#' @param palette a function, or list of functions, that generates hex colours
#' given a single number as an input. See details.
#' @param legend either a logical indiciating if the legend(s) should be displayed, or
#' a named list indicating which colour attributes should be included in the legend.
#' @param legend_options A list of options for controlling the legend.
#' @param load_interval time in miliseconds to wait between plotting each shape
#' @param focus_layer logical indicating if the map should re-centre according to this layer
#'
#' @section palette:
#'
#' The \code{palette} is used to specify the colours that will map to variables.
#' You can specify a single function to map to all variables, or a named list
#' that specifies a separate function to map to each variable. The elements must
#' be named either \code{fill_colour} or \code{stroke_colour}, and their values
#' are the colour generating functions. The default is \code{viridisLite::viridis}
#'
#' The \code{legend_options} can be used to control the appearance of the legend.
#' This should be a named list, where the names are one of
#' \itemize{
#' \item{position - one of \code{c("TOP_LEFT", "TOP_CENTER", "TOP_RIGHT", "RIGHT_TOP",
#' "RIGHT_CENTER", "RIGHT_BOTTOM", "BOTTOM_RIGHT", "BOTTOM_CENTER", "BOTTOM_LEFT",
#' "LEFT_BOTTOM", "LEFT_CENTER", "LEFT_TOP")}}
#' \item{css - a string of valid \code{css} for controlling the appearance of the legend}
#' \item{title - a string to use for the title of the legend}
#'}
#' if \code{legend_options} are NULL, the default values will apply
#'
#' If you are displaying two legends, one for \code{stroke_colour} and one
#' for \code{fill_colour}, you can specify different options for the different
#' colour attributes. See examples for \link{add_circles}.
#'
#' @details
#'
#' \code{z_index} values define the order in which objects appear on the map.
#' Those with a higher value appear on top of those with a lower value. The default
#' order of objects is (1 being underneath all other objects)
#'
#' \itemize{
#' \item{1. Polygon}
#' \item{2. Rectangle}
#' \item{3. Polyline}
#' \item{4. Circle}
#' }
#'
#' Markers are always the top layer
#'
#' @examples
#' \dontrun{
#'
#' map_key <- 'your_api_key'
#'
#' google_map(key = map_key, data = tram_stops) %>%
#' add_circles(lat = "stop_lat", lon = "stop_lon", fill_colour = "stop_name",
#' stroke_weight = 0.3, stroke_colour = "stop_name", info_window ="stop_id")
#'
#' ## different colour palettes
#' lstPalette <- list(fill_colour = colorRampPalette(c("red","blue")),
#' stroke_colour = viridisLite::plasma)
#'
#' ## set the key via set_key()
#' set_key(key = map_key)
#'
#' google_map(data = tram_stops) %>%
#' add_circles(lat = "stop_lat", lon = "stop_lon", fill_colour = "stop_lat",
#' stroke_weight = 2, stroke_colour = "stop_name", palette = lstPalette, legend = T)
#'
#' ## controlling the legend
#' google_map(data = tram_stops) %>%
#' add_circles(lat = "stop_lat", lon = "stop_lon", fill_colour = "stop_lat",
#' stroke_weight = 2, stroke_colour = "stop_name",
#' legend = c(fill_colour = T, stroke_colour = F),
#' legend_options = list(position = "TOP_RIGHT", css = "max-height: 100px;"))
#'
#'google_map(data = tram_stops) %>%
#' add_circles(lat = "stop_lat", lon = "stop_lon", fill_colour = "stop_lat",
#' stroke_weight = 2, stroke_colour = "stop_name",
#' legend = T,
#' legend_options = list(
#' fill_colour = list(position = "TOP_RIGHT", css = "max-height: 100px;"),
#' stroke_colour = list(position = "LEFT_BOTTOM", title = "Stop Name")
#' ))
#'
#'
#' }
#' @export
add_circles <- function(map,
data = get_map_data(map),
id = NULL,
lat = NULL,
lon = NULL,
polyline = NULL,
radius = NULL,
editable = NULL,
draggable = NULL,
stroke_colour = NULL,
stroke_opacity = NULL,
stroke_weight = NULL,
fill_colour = NULL,
fill_opacity = NULL,
mouse_over = NULL,
mouse_over_group = NULL,
info_window = NULL,
layer_id = NULL,
update_map_view = TRUE,
z_index = NULL,
digits = 4,
palette = NULL,
legend = F,
legend_options = NULL,
load_interval = 0,
focus_layer = FALSE
){
#objArgs <- match.call(expand.dots = F)
objArgs <- list()
objArgs[["id"]] <- force( id )
objArgs[["lat"]] <- force( lat )
objArgs[["lon"]] <- force( lon )
objArgs[["polyline"]] <- force( polyline )
objArgs[["radius"]] <- force( radius )
objArgs[["editable"]] <- force( editable )
objArgs[["draggable"]] <- force( draggable )
objArgs[["stroke_colour"]] <- force( stroke_colour )
objArgs[["stroke_opacity"]] <- force( stroke_opacity )
objArgs[["stroke_weight"]] <- force( stroke_weight )
objArgs[["fill_colour"]] <- force( fill_colour )
objArgs[["fill_opacity"]] <- force( fill_opacity )
objArgs[["mouse_over"]] <- force( mouse_over )
objArgs[["mouse_over_group"]] <- force( mouse_over_group )
objArgs[["info_window"]] <- force( info_window )
objArgs[["layer_id"]] <- force( layer_id )
objArgs[["update_map_view"]] <- force( update_map_view )
objArgs[["z_index"]] <- force( z_index )
objArgs[["digits"]] <- force( digits )
objArgs[["palette"]] <- force( palette )
objArgs[["legend"]] <- force( legend )
objArgs[["legend_options"]] <- force( legend_options )
objArgs[["load_interval"]] <- force( load_interval )
objArgs[["focus_layer"]] <- force( focus_layer )
data <- normaliseSfData(data, "POINT")
polyline <- findEncodedColumn(data, polyline)
if( !is.null(polyline) && !polyline %in% names(objArgs) ) {
objArgs[['polyline']] <- polyline
}
## PARAMETER CHECKS
if(!dataCheck(data, "add_circles")) data <- circleDefaults(1)
layer_id <- layerId(layer_id)
usePolyline <- isUsingPolyline(polyline)
if( !usePolyline ) {
objArgs <- latLonCheck(objArgs, lat, lon, names(data), "add_circles")
}
infoWindowChart <- NULL
if (!is.null(info_window) && isInfoWindowChart(info_window)) {
infoWindowChart <- info_window
objArgs[['info_window']] <- NULL
}
logicalCheck(update_map_view)
logicalCheck(focus_layer)
numericCheck(digits)
numericCheck(z_index)
loadIntervalCheck(load_interval)
palette <- paletteCheck(palette)
objArgs <- zIndexCheck( objArgs, z_index )
## END PARAMETER CHECKS
allCols <- circleColumns()
requiredCols <- requiredCircleColumns()
colourColumns <- shapeAttributes(fill_colour = fill_colour, stroke_colour = stroke_colour)
shape <- createMapObject(data, allCols, objArgs)
pal <- createPalettes(shape, colourColumns)
colour_palettes <- createColourPalettes(data, pal, colourColumns, palette)
colours <- createColours(shape, colour_palettes)
if(length(colours) > 0){
shape <- replaceVariableColours(shape, colours)
}
## LEGEND
legend <- resolveLegend(legend, legend_options, colour_palettes)
requiredDefaults <- setdiff(requiredCols, names(shape))
if(length(requiredDefaults) > 0){
shape <- addDefaults(shape, requiredDefaults, "circle")
}
if( usePolyline ) {
shape <- createPolylineListColumn(shape)
}
shape <- createInfoWindowChart(shape, infoWindowChart, id)
shape <- jsonlite::toJSON(shape, digits = digits)
map <- addDependency(map, googleCircleDependency())
invoke_method(map, 'add_circles', shape, update_map_view, layer_id, usePolyline, legend, load_interval, focus_layer)
}
#' @rdname clear
#' @export
clear_circles <- function(map, layer_id = NULL){
layer_id <- layerId(layer_id)
invoke_method(map, 'clear_circles', layer_id)
}
#' Update circles
#'
#' Updates specific colours and opacities of specified circles Designed to be
#' used in a shiny application.
#'
#' @note Any circles (as specified by the \code{id} argument) that do not exist
#' in the \code{data} passed into \code{add_circles()} will not be added to the map.
#' This function will only update the circles that currently exist on the map when
#' the function is called.
#'
#' @inheritParams add_circles
#' @param id string representing the column of \code{data} containing the id values
#' for the shapes. The id values must be present in the original data supplied to in order
#' for the shape to be udpated.
#'
#' @export
update_circles <- function(map, data, id,
radius = NULL,
draggable = NULL,
stroke_colour = NULL,
stroke_weight = NULL,
stroke_opacity = NULL,
fill_colour = NULL,
fill_opacity = NULL,
info_window = NULL,
layer_id = NULL,
digits = 4,
palette = NULL,
legend = F,
legend_options = NULL
){
# objArgs <- match.call(expand.dots = F)
objArgs <- list()
objArgs[["id"]] <- force( id )
objArgs[["radius"]] <- force( radius )
objArgs[["draggable"]] <- force( draggable )
objArgs[["stroke_colour"]] <- force( stroke_colour )
objArgs[["stroke_weight"]] <- force( stroke_weight )
objArgs[["stroke_opacity"]] <- force( stroke_opacity )
objArgs[["fill_colour"]] <- force( fill_colour )
objArgs[["fill_opacity"]] <- force( fill_opacity )
objArgs[["info_window"]] <- force( info_window )
objArgs[["layer_id"]] <- force( layer_id )
objArgs[["digits"]] <- force( digits )
objArgs[["palette"]] <- force( palette )
objArgs[["legend"]] <- force( legend )
objArgs[["legend_options"]] <- force( legend_options )
# data <- normaliseSfData(data, "POINT")
# polyline <- findEncodedColumn(data, polyline)
#
# if( !is.null(polyline) && !polyline %in% names(objArgs) ) {
# objArgs[['polyline']] <- polyline
# }
layer_id <- layerId(layer_id)
numericCheck(digits)
palette <- paletteCheck(palette)
infoWindowChart <- NULL
if (!is.null(info_window) && isInfoWindowChart(info_window)) {
infoWindowChart <- info_window
objArgs[['info_window']] <- NULL
}
allCols <- circleColumns()
requiredCols <- requiredCircleColumns()
colourColumns <- shapeAttributes(fill_colour, stroke_colour)
shape <- createMapObject(data, allCols, objArgs)
pal <- createPalettes(shape, colourColumns)
colour_palettes <- createColourPalettes(data, pal, colourColumns, palette)
colours <- createColours(shape, colour_palettes)
if(length(colours) > 0){
shape <- replaceVariableColours(shape, colours)
}
## LEGEND
legend <- resolveLegend(legend, legend_options, colour_palettes)
requiredDefaults <- setdiff(requiredCols, names(shape))
if(length(requiredDefaults) > 0){
shape <- addDefaults(shape, requiredDefaults, "circle")
}
shape <- createInfoWindowChart(shape, infoWindowChart, id)
shape <- jsonlite::toJSON(shape, digits = digits)
invoke_method(map, 'update_circles', shape, layer_id, legend)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.