basemaps:basemap Examples

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, ...)) 

             } 

         } 

     } 

 } 

Leave a Comment

This site uses Akismet to reduce spam. Learn how your comment data is processed.