Here are R programming examples of function basemaps from package basemap
basemap <- function(ext = NULL, map_service = NULL, map_type = NULL,
map_res = NULL, map_token = NULL, map_dir = NULL, class = "stars",
force = FALSE, ..., verbose = TRUE) {
if (inherits(verbose, "logical"))
options(basemaps.verbose = verbose)
if (is.null(ext))
ext <- getOption("basemaps.defaults")$ext
if (is.null(ext))
out("Argument 'ext' is not defined and there is no default defined using set_defaults().",
type = 3)
if (inherits(ext, "sf"))
ext <- st_bbox(ext)
if (is.null(map_service))
map_service <- getOption("basemaps.defaults")$map_service
if (is.null(map_type))
map_type <- getOption("basemaps.defaults")$map_type
if (is.null(map_res))
map_res <- getOption("basemaps.defaults")$map_res
if (is.null(map_token))
map_token <- getOption("basemaps.defaults")$map_token
if (map_service == "mapbox" & is.na(map_token))
out("You need to define 'map_token' to use map_service 'mapbox'. Register at https://www.mapbox.com/ to obtain a token.",
type = 3)
if (map_service == "osm_thunderforest" & is.na(map_token))
out("You need to define 'map_token' to use map_service 'osm_thunderforest'. Register at https://thunderforest.com to obtain a token.",
type = 3)
extras <- list(...)
if (!is.null(extras$browse))
browse <- extras$browse
else browse <- TRUE
if (!is.null(extras$col))
col <- extras$col
else col <- topo.colors(25)
if (!is.null(map_dir))
if (!dir.exists(map_dir)) {
out("Directory defined by argument 'map_dir' does not exist, using a temporary directory instead.",
type = 2)
map_dir <- NULL
}
if (is.null(map_dir))
map_dir <- getOption("basemaps.defaults")$map_dir
class <- tolower(class)
out(paste0("Loading basemap '", map_type, "' from map service '",
map_service, "'..."))
ext <- st_bbox(st_transform(st_as_sfc(st_bbox(ext)), crs = st_crs(3857)))
map_file <- .get_map(ext, map_service, map_type, map_token,
map_dir, map_res, force, class, ...)
if ("geotif" %in% class)
return(map_file)
if (any(c("stars", "plot", "png", "magick") %in% class)) {
map <- read_stars(map_file)
if ("stars" %in% class)
return(map)
if ("plot" == class) {
dim_map <- dim(map)
if (length(dim(map)) == 2)
dim_map["band"] <- 1
if (dim_map[3] == 3) {
plot(map, rgb = 1:3, main = NULL, downsample = 0)
}
else {
plot(map, col = col, breaks = seq(min(map[[1]]),
max(map[[1]]), length.out = length(col) + 1),
main = NULL, downsample = 0)
}
}
if (any("png" == class, "magick" == class)) {
if (!any(grepl("png", rownames(installed.packages())))) {
out("Package 'png' is not installed. Please install 'png' using install.packages('png').")
}
else {
file <- paste0(map_dir, "/", map_service, "_",
map_type, "_", gsub(":", "-", gsub(" ", "_",
Sys.time())), ".png")
map_arr <- map[[1]]
if (!is.na(dim(map_arr)[3])) {
map_arr <- aperm(map_arr, c(2, 1, 3))
map_arr <- sweep(map_arr, MARGIN = 3, STATS = max(map_arr),
FUN = "/")
png::writePNG(map_arr, target = file)
}
else {
map_arr <- sweep(t(map_arr), MARGIN = 1, STATS = max(map_arr),
FUN = "/")
map_arr_col <- col[findInterval(map_arr, seq(0,
1, length.out = length(col)))]
map_arr_rgb <- col2rgb(map_arr_col)
map_arr_rgb <- aperm(array(map_arr_rgb, c(3,
dim(map_arr))), c(2, 3, 1))
map_arr_rgb <- sweep(map_arr_rgb, MARGIN = 3,
STATS = max(map_arr_rgb), FUN = "/")
png::writePNG(map_arr_rgb, target = file)
}
if (grepl("png", class)) {
if (all(isTRUE(interactive()), isTRUE(browse)))
utils::browseURL(file)
return(file)
}
if (grepl("magick", class)) {
return(image_read(file))
}
}
}
}
if (any(c("raster", "mapview", "ggplot", "gglayer") %in%
class)) {
map <- quiet(brick(map_file))
if ("raster" %in% class) {
if (nlayers(map) == 1)
map <- raster(map)
return(map)
}
if ("mapview" %in% class) {
if (!any(grepl("mapview", rownames(installed.packages())))) {
out("Package 'mapview' is not installed. Please install 'mapview' using install.packages('mapview').")
}
else {
quiet(if (nlayers(map) == 3) {
return(mapview::viewRGB(map, 1, 2, 3, layer.name = "Basemap",
maxpixels = ncell(map), quantiles = NULL))
}
else return(mapview::mapview(map)))
}
}
if ("ggplot" %in% class) {
if (!any(grepl("ggplot", rownames(installed.packages())))) {
out("Package 'ggplot2' is not installed. Please install 'ggplot2' using install.packages('ggplot2').")
}
else {
if (nlayers(map) == 3) {
return(gg.bmap(r = map, r_type = "RGB", ...))
}
else {
return(gg.bmap(r = map, r_type = "gradient",
...))
}
}
}
if ("gglayer" %in% class) {
if (!any(grepl("ggplot", rownames(installed.packages())))) {
out("Package 'ggplot2' is not installed. Please install 'ggplot2' using install.packages('ggplot2').")
}
else {
if (nlayers(map) == 3)
return(gg.bmap(r = map, r_type = "RGB", gglayer = T,
...))
else return(gg.bmap(r = map, r_type = "gradient",
gglayer = T, ...))
}
}
}
}