initial trannsferred functions

Author: 16EAGLE

.Rbuildignore

@@ -0,0 +1,2 @@
+^.*\.Rproj$
+^\.Rproj\.user$

.gitignore

@@ -0,0 +1,5 @@
+.Rproj.user
+.Rhistory
+.RData
+.Ruserdata
+basemaps.Rproj

DESCRIPTION

@@ -0,0 +1,22 @@
+Package: basemaps
+Type: Package
+Title: Accessing spatial basemaps in R
+Version: 0.0.1
+Depends:
+  R (>= 3.5.0)
+Date: 2020-05-01
+Authors@R: person("Jakob", "Schwalb-Willmann", email = "movevis@schwalb-willmann.de",
+  role = c("aut", "cre"), comment = c(ORCID = "0000-0003-2665-1509"))
+Description: A lightweight package to access spatial basemaps from open sources such as OpenStreetMap, Carto and Mapbox in R
+License: GPL-3
+Encoding: UTF-8
+Imports:
+  slippymath,
+  curl,
+  raster,
+  sf,
+  pbapply,
+  ggplot2,
+  magick
+BugReports: http://www.github.com/16eagle/basemaps/issues
+RoxygenNote: 7.1.0

LICENSE

@@ -0,0 +1,45 @@
+# Generated by roxygen2: do not edit by hand
+
+export(basemap)
+export(basemap_ggplot)
+export(basemap_mapview)
+export(basemap_plot)
+export(basemap_raster)
+export(basemap_stars)
+export(get_defaults)
+export(get_maptypes)
+export(set_defaults)
+importFrom(curl,curl_download)
+importFrom(ggplot2,aes_string)
+importFrom(ggplot2,geom_raster)
+importFrom(ggplot2,geom_tile)
+importFrom(ggplot2,ggplot)
+importFrom(ggplot2,scale_fill_identity)
+importFrom(magick,image_convert)
+importFrom(magick,image_read)
+importFrom(magick,image_write)
+importFrom(mapview,mapview)
+importFrom(mapview,viewRGB)
+importFrom(pbapply,pbapply)
+importFrom(pbapply,pboptions)
+importFrom(raster,"extent<-")
+importFrom(raster,brick)
+importFrom(raster,crop)
+importFrom(raster,crs)
+importFrom(raster,extend)
+importFrom(raster,extent)
+importFrom(raster,merge)
+importFrom(raster,ncell)
+importFrom(raster,nlayers)
+importFrom(raster,plot)
+importFrom(raster,plotRGB)
+importFrom(raster,projectRaster)
+importFrom(raster,resample)
+importFrom(raster,writeRaster)
+importFrom(sf,st_as_sfc)
+importFrom(sf,st_bbox)
+importFrom(sf,st_crs)
+importFrom(sf,st_transform)
+importFrom(slippymath,bbox_to_tile_grid)
+importFrom(slippymath,compose_tile_grid)
+importFrom(stars,st_as_stars)

NAMESPACE

@@ -0,0 +1,18 @@
+***
+
+## basemaps 0.0.1
+Unreleased development version.
+
+**New functions:**
+
+* 
+
+
+**New features:**
+
+* 
+
+<br>
+
+***
+This document should provide a broad overview on changes that are applied to the basemaps R package. There is no warranty for completeness, since minor changes might not be included. All improvement and feature descriptions are bundled per release version. The document is currently maintained by Jakob Schwalb-Willmann.

NEWS.md

@@ -0,0 +1,83 @@
+#' Get a spatial basemap
+#'
+#' This function (down)loads and caches a basemap from a defined extent \code{ext}, \code{map_service} and \code{map_type} and returns it as a object of a defined \code{class}.
+#'
+#' @param ext extent to be covered by the basemap. Any spatial class.
+#' @param map_service character, 
+#' @param map_type character, 
+#' @param map_token character,
+#' @param map_res numeric,
+#' @param map_dir character, cache directory
+#' @param class character, output class.
+#' @param ... additional arguments.
+#' @param verbose
+#' 
+#' @return
+#' 
+#' @importFrom sf st_bbox 
+#' @importFrom raster nlayers plotRGB plot
+#' @importFrom stars st_as_stars
+#' @importFrom mapview mapview viewRGB
+#' @export
+#' 
+basemap <- function(ext, map_service = NA, map_type = NA, map_res = NA, map_token = NA, map_dir = NA, class = "raster", 
+                    ..., verbose = TRUE){
+  
+  ## checks
+  if(inherits(verbose, "logical")) options(basemaps.verbose = verbose)
+  if(inherits(ext, "sf")) ext <- st_bbox(ext)
+  if(is.na(map_service)) map_service = getOption("basemaps.defaults")$map_service
+  if(is.na(map_type)) map_type = getOption("basemaps.defaults")$map_type
+  if(is.na(map_res)) map_res = getOption("basemaps.defaults")$map_res
+  if(is.na(map_token)) map_token = getOption("basemaps.defaults")$map_token
+  
+  if(!is.na(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 <- NA
+  }
+  if(is.na(map_dir)) map_dir <- getOption("basemaps.defaults")$map_dir
+  class <- tolower(class)
+  
+  ## get map
+  out(paste0("Loading basemap '", map_type, "' from map service '", map_service, "'..."))
+  ext <- st_bbox(ext)
+  map <- .get_map(ext, map_service, map_type, map_token, map_dir, map_res)
+  
+  ## define class
+  if("raster" %in% class) return(map)
+  if("stars" %in% class) return(st_as_stars(map))
+  if("mapview" %in% class) quiet(if(nlayers(map) == 3) return(viewRGB(map, 1, 2, 3)) else return(mapview(map)))
+  if("plot" == class) if(nlayers(map) == 3) plotRGB(map) else plot(map)
+  if("ggplot" %in% class) if(nlayers(map) == 3) gg.bmap(r = map, r_type = "RGB", ...) else gg.bmap(r = map, r_type = "gradient")
+}
+
+#' @inheritParams basemap
+#' @export
+basemap_raster <- function(ext,  map_service = NA, map_type = NA, map_res = NA, map_token = NA, map_dir = NA, ..., verbose = TRUE){
+  basemap(ext, map_service, map_type, map_res, map_token, map_dir, class = "raster", ..., verbose = verbose)
+}
+
+
+#' @inheritParams basemap
+#' @export
+basemap_stars <- function(ext,  map_service = NA, map_type = NA, map_res = NA, map_token = NA, map_dir = NA, ..., verbose = TRUE){
+  basemap(ext, map_service, map_type, map_res, map_token, map_dir, class = "stars", ..., verbose = verbose)
+}
+
+#' @inheritParams basemap
+#' @export
+basemap_mapview <- function(ext,  map_service = NA, map_type = NA, map_res = NA, map_token = NA, map_dir = NA, ..., verbose = TRUE){
+  basemap(ext, map_service, map_type, map_res, map_token, map_dir, class = "mapview", ..., verbose = verbose)
+}
+
+#' @inheritParams basemap
+#' @export
+basemap_plot <- function(ext,  map_service = NA, map_type = NA, map_res = NA, map_token = NA, map_dir = NA, ..., verbose = TRUE){
+  basemap(ext, map_service, map_type, map_res, map_token, map_dir, class = "plot", ..., verbose = verbose)
+}
+
+#' @inheritParams basemap
+#' @export
+basemap_ggplot <- function(ext,  map_service = NA, map_type = NA, map_res = NA, map_token = NA, map_dir = NA, ..., verbose = TRUE){
+  basemap(ext, map_service, map_type, map_res, map_token, map_dir, class = "ggplot", ..., verbose = verbose)
+}

R/basemap.R

@@ -0,0 +1,9 @@
+#' Example extemt
+#'
+#' The example dataset contains the object \code{ext}, an \code{sf} object that can be used to call \code{\link{basemap}} and the associated functions.
+#' 
+#' @format \code{sf} object
+#' @usage data(ext)
+#' @docType data
+#' 
+"ext"

R/data.R

@@ -0,0 +1,26 @@
+#' Set \code{basemaps} defaults
+#'
+#' This function sets the defaults of all map arguments passed to \code{\link{basemap}} and associated functions.
+#' 
+#' @inheritParams basemap
+#' @return None
+#' 
+#' @name defaults
+#' @export
+
+set_defaults <- function(map_service = NULL, map_type = NULL, map_res = NULL, map_token = NULL, map_dir = NULL){
+  
+  defaults <- getOption("basemaps.defaults")
+  if(!is.null(map_service)) defaults$map_service <- map_service
+  if(!is.null(map_type)) defaults$map_type <- map_type
+  if(!is.null(map_res)) defaults$map_res <- map_res
+  if(!is.null(map_token)) defaults$map_token <- map_token
+  if(!is.null(map_dir)) defaults$map_dir <- map_dir
+  options(basemaps.defaults = defaults)
+}
+
+#' @rdname defaults
+#' @export
+get_defaults <- function(){
+  getOption("basemaps.defaults")
+}

R/defaults.R

@@ -0,0 +1,30 @@
+#' Get all supported map types
+#'
+#' This function returns every supported map type that can be used as input to the \code{map_type} argument of \code{\link{frames_spatial}}.
+#'
+#' @param map_service character, optional, either \code{"osm"}, \code{"carto"} or \code{"mapbox"}. Otherwise, a list of map types for both services is returned.
+#' @return A character vector of supported map types
+#' 
+#' @examples 
+#' # for all services
+#' get_maptypes()
+#' 
+#' # for osm only
+#' get_maptypes("osm")
+#' # or
+#' get_maptypes()$osm
+#' 
+#' # for mapbox only
+#' get_maptypes("mapbox")
+#' # or
+#' get_maptypes()$mapbox
+#' 
+#' # same for all other map services
+#' 
+#' @seealso \code{\link{basemap}}
+#' @export
+
+get_maptypes <- function(map_service = NULL){
+  map_types <- lapply(getOption("basemaps.map_api"), names)
+  if(!is.null(map_service)) map_types[[map_service]] else map_types
+}