Nothing
pre_process_gt <- function(x, interactive, orig_crs) {
set.bounds <- bg.color <- set.zoom.limits <- legend.position <- colorNA <- NULL
gt <- get("tmapOptions", envir = .TMAP_CACHE)
show.messages <- gt$show.messages
show.warnings <- gt$show.warnings
gts <- x[names(x) == "tm_layout"]
if (length(gts)) {
for (i in 1L:length(gts)) {
g <- gts[[i]]
called <- if (is.null(attr(g, "format_args"))) {
names(g)
} else {
attr(g, "format_args")
}
# specific checks
if (("legend.position" %in% called) && interactive && show.messages) {
message("legend.postion is used for plot mode. Use view.legend.position in tm_view to set the legend position in view mode.")
}
if (all(c("legend.width", "legend.outside") %in% called) && g$legend.outside && show.warnings) {
warning("legend.width controls the width of the legend within a map. Please use legend.outside.size to control the width of the outside legend")
}
if (!is.na(g$style)) {
if (i !=1 && show.messages) message("Note that tm_style(\"", g$style, "\") resets all options set with tm_layout, tm_view, tm_format, or tm_legend. It is therefore recommended to place the tm_style element prior to the other tm_layout/tm_view/tm_format/tm_legend elements.")
gt <- .defaultTmapOptions
if (g$style != "white") {
styleOptions <- get("tmapStyles", envir = .TMAP_CACHE)[[g$style]]
gt[names(styleOptions)] <- styleOptions
}
}
g$style <- NULL
if ("aes.color" %in% names(g)) {
aes <- g$aes.color
if (!all(names(aes) %in% names(gt$aes.color))) stop("Names in aes.color unknown: ", paste(setdiff(names(aes), names(gt$aes.color)), collapse = ", "), call. = FALSE)
g$aes.color <- gt$aes.color
g$aes.color[names(aes)] <- aes
}
if ("aes.palette" %in% names(g)) {
aes <- g$aes.palette
if (!all(names(aes) %in% names(gt$aes.palette))) stop("Names in aes.color unknown: ", paste(setdiff(names(aes), names(gt$aes.palette)), collapse = ", "), call. = FALSE)
g$aes.palette <- gt$aes.palette
g$aes.palette[names(aes)] <- aes
}
if (("legend.format" %in% names(g))) {
lf <- g$legend.format
extraArgs <- setdiff(names(lf), names(gt$legend.format))
if (length(extraArgs) > 1) {
lf_base <- lf[intersect(names(lf), names(gt$legend.format))]
lf_extra <- lf[extraArgs]
} else {
lf_base <- lf
lf_extra <- list()
}
#if (!all(names(lf) %in% names(gt$legend.format))) stop("Names in legend.format unknown: ", paste(setdiff(names(lf), names(gt$legend.format)), collapse = ", "), call. = FALSE)
g$legend.format <- gt$legend.format
g$legend.format[names(lf_base)] <- lf_base
if (length(extraArgs) > 1) {
g$legend.format <- c(g$legend.format, lf_extra)
}
}
if (length(g)) gt[names(g)] <- g
}
}
## preprocess gt
gt <- within(gt, {
pc <- list(sepia.intensity=sepia.intensity, saturation=saturation)
sepia.intensity <- NULL
saturation <- NULL
# put aes colors in right order and name them
if (length(aes.color)==1 && is.null(names(aes.color))) names(aes.color) <- "base"
if (!is.vector(aes.color) || !is.character(aes.color) || length(aes.color) != 8 || !setequal(names(aes.color), c("fill", "borders", "symbols", "dots", "lines", "text", "na", "null"))) {
stop("aes.color should the be a character vector of 8 colors named \"fill\", \"borders\", \"symbols\", \"dots\", \"lines\", \"text\", \"na\", \"null\"", call. = FALSE)
}
aes.colors <- vapply(aes.color, function(ac) if (is.na(ac)) "#000000" else ac, character(1))
# override na
if (interactive) aes.colors["na"] <- if (is.null(colorNA)) "#00000000" else if (is.na(colorNA)) aes.colors["na"] else colorNA
aes.colors.light <- vapply(aes.colors, is_light, logical(1))
aes.color <- NULL
if (is.na(alpha)) alpha <- 1
if (!is.logical(set.bounds)) if (!length(set.bounds)==4 || !is.numeric(set.bounds)) stop("Incorrect set_bounds argument", call.=FALSE)
if (!is.null(bbox)) {
if (is.character(bbox)) {
res <- suppressMessages(geocode_OSM(bbox, as.data.frame = TRUE))
if (is.null(res)) {
message("tmaptools::geocode_OSM didn't found any results for: \"", paste(bbox, collapse = "\" ,\""), "\".")
bbox <- NULL
center <- NULL
} else {
bbox <- sf::st_bbox(c(xmin = min(res$lon_min), ymin = min(res$lat_min), xmax = max(res$lon_max), ymax = max(res$lat_max)), crs = st_crs(4326))
center <- res[, c("query", "lat", "lon")]
res <- NULL
}
} else {
bbox <- bb(bbox)
if (is.na(attr(bbox, "crs"))) {
if (!maybe_longlat(bbox)) stop("bounding box specified with tm_view (or tmap_options) is projected, but the projection is unknown", call. = FALSE)
} else {
bbox <- bb(bbox, projection = .crs_longlat)
}
center <- NULL
}
set.view <- NA
}
if (!is.na(set.view[1])) {
if (!is.numeric(set.view)) stop("set.view is not numeric")
if (!length(set.view) %in% c(1,3)) stop("set.view does not have length 1 or 3")
}
if (!is.na(set.zoom.limits[1])) {
if (!is.numeric(set.zoom.limits)) stop("set.zoom.limits is not numeric")
if (!length(set.zoom.limits)==2) stop("set.zoom.limits does not have length 2")
if (set.zoom.limits[1] >= set.zoom.limits[2]) stop("incorrect set.zoom.limits")
} else {
set.zoom.limits <- c(NA, NA)
}
if (!is.na(set.view[1]) && !is.na(set.zoom.limits[1])) {
if (set.view[length(set.view)] < set.zoom.limits[1]) {
if (show.warnings) warning("default zoom smaller than minimum zoom, now it is set to the minimum zoom")
set.view[length(set.view)] <- set.zoom.limits[1]
}
if (set.view[length(set.view)] > set.zoom.limits[2]) {
if (show.warnings) warning("default zoom larger than maximum zoom, now it is set to the maximum zoom")
set.view[length(set.view)] <- set.zoom.limits[2]
}
}
view.legend.position <- if (is.na(view.legend.position)[1]) {
if (is.null(legend.position)) {
"topright"
} else if (is.character(legend.position) &&
tolower(legend.position[1]) %in% c("left", "right") &&
tolower(legend.position[2]) %in% c("top", "bottom")) {
paste(tolower(legend.position[c(2,1)]), collapse="")
}
} else if (is.character(view.legend.position) &&
view.legend.position[1] %in% c("left", "right") &&
view.legend.position[2] %in% c("top", "bottom")) {
paste(view.legend.position[c(2,1)], collapse="")
} else {
"topright"
}
if (!inherits(projection, "leaflet_crs")) {
if (!is.numeric(projection)) stop("projection in tm_view must be either a leaflet_crs object (recommended) or an EPSG number", call. = FALSE)
if (projection==0) {
projection <- leaflet::leafletCRS(crsClass = "L.CRS.Simple")
if (is.na(set.zoom.limits)[1]) set.zoom.limits[1] <- -1000
} else if (projection %in% c(3857, 4326, 3395)) {
projection <- leaflet::leafletCRS(crsClass = paste("L.CRS.EPSG", projection, sep=""))
} else {
if (show.warnings) warning("Scaling levels may be incorrect for this projection. Please specify a leaflet projection with leafletCRS for more control")
projection <- leaflet::leafletCRS(crsClass = "L.Proj.CRS",
code= paste("EPSG", projection, sep=":"),
proj4def=sf::st_crs(projection)$proj4string,
resolutions = 2^(17:0))
}
# if (projection==0) {
# epsg <- get_epsg_number(orig_crs)
# if (is.na(epsg)) {
# if (interactive) warning("No EPSG code found. Map will be shown in standard Web-Mercator projection.")
# projection <- 3857
# } else {
# projection <- epsg
# }
# }
}
})
gtnull <- names(which(vapply(gt, is.null, logical(1))))
gt[gtnull] <- list(NULL)
gt$design.mode = getOption("tmap.design.mode")
gt
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.