Merge pull request #1 from eroten/positron_no_labels

Add support for Carto Positron without labels, update styling

DESCRIPTION

@@ -1,12 +1,28 @@
-Package: basemapR
 Type: Package
+Package: basemapR
 Title: Base Maps For ggplot2
 Version: 0.1.0
-Author: Chris B
-Maintainer: Chris B <[email protected]>
-Description: Fetches map tiles that can be added to ggplot2 maps.
+Authors@R: 
+    c(person(given = "Chris",
+             family = "B",
+             role = c("cre", "aut"),
+             email = "[email protected]"),
+      person(given = "Liz",
+             family = "Roten",
+             role = "ctb",
+             email = "[email protected]"))
+Description: Fetches map tiles that can be added to ggplot2
+    maps.
 License: MIT
+URL: https://github.com/Chrisjb/basemapR
+BugReports: https://github.com/Chrisjb/basemapR
+Imports: 
+    curl,
+    dplyr,
+    jpeg,
+    png,
+    purrr,
+    sf
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 6.1.1
-Imports: sf, purrr, curl, dplyr, jpeg, png
+RoxygenNote: 7.1.0

R/base_map.R

@@ -21,23 +21,20 @@
 #' # add to ggplot
 #' library(ggplot2)
 #' ggplot() +
-#' base_map(bbox, increase_zoom = 2, basemap = 'google-terrain')+
-#' geom_sf(data = localauth_data, fill =NA )  +
-#' coord_sf(xlim = c(bbox$xmin, bbox$xmax), ylim = c(bbox$ymin, bbox$ymax), crs = 4326)
+#'   base_map(bbox, increase_zoom = 2, basemap = "google-terrain") +
+#'   geom_sf(data = localauth_data, fill = NA) +
+#'   coord_sf(xlim = c(bbox$xmin, bbox$xmax), ylim = c(bbox$ymin, bbox$ymax), crs = 4326)
 #'
 #'
 #' # add straight to ggplot
 #'
 #' ggplot() +
-#' base_map(st_bbox(localauth_data), increase_zoom = 2) +
-#' geom_sf(data = localauth_data, fill = NA)
-#'
+#'   base_map(st_bbox(localauth_data), increase_zoom = 2) +
+#'   geom_sf(data = localauth_data, fill = NA)
 #' @export
 
 
-base_map <- function(bbox, increase_zoom=0, basemap = 'dark', nolabels = F){
-
-
+base_map <- function(bbox, increase_zoom = 0, basemap = "dark", nolabels = F) {
   x_len <- bbox["xmax"] - bbox["xmin"]
   y_len <- bbox["ymax"] - bbox["ymin"]
 
@@ -53,8 +50,10 @@ base_map <- function(bbox, increase_zoom=0, basemap = 'dark', nolabels = F){
 
   xy <- lonlat2xy(bbox[c("xmin", "xmax")], bbox[c("ymin", "ymax")], zoom)
 
-  tiles <- expand.grid(x = seq(xy$x["xmin"], xy$x["xmax"]),
-                       y = seq(xy$y["ymin"], xy$y["ymax"]))
+  tiles <- expand.grid(
+    x = seq(xy$x["xmin"], xy$x["xmax"]),
+    y = seq(xy$y["ymin"], xy$y["ymax"])
+  )
 
 
 
@@ -68,97 +67,92 @@ base_map <- function(bbox, increase_zoom=0, basemap = 'dark', nolabels = F){
   tile_positions <- dplyr::bind_cols(nw_corners, se_corners)
 
 
-  #cartodblayer
-  if(basemap == 'positron'){
-    url <- paste0('https://basemaps.cartocdn.com/light_all/',zoom,'/',tiles$x,'/',tiles$y,'.png') # positron
-  } else if(basemap == 'hydda') {
-    if(nolabels == F) {
-      url <- paste0('https://tile.openstreetmap.se/hydda/full/',zoom,'/',tiles$x,'/',tiles$y,'.png') # hydda
+  # cartodblayer
+  if (basemap == "positron") {
+    if (nolabels == F) {
+      url <- paste0("https://basemaps.cartocdn.com/light_all/", zoom, "/", tiles$x, "/", tiles$y, ".png") # positron
     } else {
-      url <- paste0('https://tile.openstreetmap.se/hydda/base/',zoom,'/',tiles$x,'/',tiles$y,'.png')
+      url <- paste0("https://basemaps.cartocdn.com/light_nolabels/", zoom, "/", tiles$x, "/", tiles$y, ".png")
+    }
+  } else if (basemap == "hydda") {
+    if (nolabels == F) {
+      url <- paste0("https://tile.openstreetmap.se/hydda/full/", zoom, "/", tiles$x, "/", tiles$y, ".png") # hydda
+    } else {
+      url <- paste0("https://tile.openstreetmap.se/hydda/base/", zoom, "/", tiles$x, "/", tiles$y, ".png")
     }
     message('attribution: Tiles courtesy of http://openstreetmap.se/ OpenStreetMap Sweden; Map data &copy; <a href="https://www.openstreetmap.org/copyright">OpenStreetMap</a> contributors')
-
-  } else if(basemap == 'voyager') {
-    if(nolabels == F) {
-      url <- paste0('https://basemaps.cartocdn.com/rastertiles/voyager/',zoom,'/',tiles$x,'/',tiles$y,'.png') # voyager
+  } else if (basemap == "voyager") {
+    if (nolabels == F) {
+      url <- paste0("https://basemaps.cartocdn.com/rastertiles/voyager/", zoom, "/", tiles$x, "/", tiles$y, ".png") # voyager
     } else {
-      url <- paste0('https://basemaps.cartocdn.com/rastertiles/voyager_nolabels/',zoom,'/',tiles$x,'/',tiles$y,'.png')
+      url <- paste0("https://basemaps.cartocdn.com/rastertiles/voyager_nolabels/", zoom, "/", tiles$x, "/", tiles$y, ".png")
     }
     message('attribution: &copy; <a href="https://www.openstreetmap.org/copyright">OpenStreetMap</a> contributors &copy; <a href="https://carto.com/attributions">CARTO</a>')
-
-  } else if(basemap == 'france'){
-    if(nolabels == F) {
-      url <- paste0('https://tile.openstreetmap.fr/osmfr/,zoom','/',tiles$x,'/',tiles$y,'.png') # france
+  } else if (basemap == "france") {
+    if (nolabels == F) {
+      url <- paste0("https://tile.openstreetmap.fr/osmfr/,zoom", "/", tiles$x, "/", tiles$y, ".png") # france
     } else {
-      url <- paste0('https://tile.openstreetmap.fr/osmfr/,zoom','/',tiles$x,'/',tiles$y,'.png') # france
-      message('nolabels not available for basemap: ', basemap, '. returning map with labels.')
+      url <- paste0("https://tile.openstreetmap.fr/osmfr/,zoom", "/", tiles$x, "/", tiles$y, ".png") # france
+      message("nolabels not available for basemap: ", basemap, ". returning map with labels.")
     }
     message('attribution: &copy; Openstreetmap France | &copy; <a href="https://www.openstreetmap.org/copyright">OpenStreetMap</a> contributors')
-
-
-  } else if(basemap == 'dark') {
-    if(nolabels == F) {
-      url <- paste0('https://basemaps.cartocdn.com/dark_all/',zoom,'/',tiles$x,'/',tiles$y,'.png') # dark
+  } else if (basemap == "dark") {
+    if (nolabels == F) {
+      url <- paste0("https://basemaps.cartocdn.com/dark_all/", zoom, "/", tiles$x, "/", tiles$y, ".png") # dark
     } else {
-      url <- paste0('https://basemaps.cartocdn.com/dark_nolabels/',zoom,'/',tiles$x,'/',tiles$y,'.png') # dark
+      url <- paste0("https://basemaps.cartocdn.com/dark_nolabels/", zoom, "/", tiles$x, "/", tiles$y, ".png") # dark
     }
     message('attribution: &copy; <a href="https://www.openstreetmap.org/copyright">OpenStreetMap</a> contributors &copy; <a href="https://carto.com/attributions">CARTO</a>')
-
-  } else if(basemap == 'neighbourhood') {
-    if(nolabels == F) {
-      url <- paste0('https://tile.thunderforest.com/neighbourhood/',zoom,'/',tiles$x,'/',tiles$y,'.png') # neighbourhood
+  } else if (basemap == "neighbourhood") {
+    if (nolabels == F) {
+      url <- paste0("https://tile.thunderforest.com/neighbourhood/", zoom, "/", tiles$x, "/", tiles$y, ".png") # neighbourhood
     } else {
-      url <- paste0('https://tile.thunderforest.com/neighbourhood/',zoom,'/',tiles$x,'/',tiles$y,'.png') # neighbourhood
-      message('nolabels not available for basemap: ', basemap, '. returning map with labels.')
+      url <- paste0("https://tile.thunderforest.com/neighbourhood/", zoom, "/", tiles$x, "/", tiles$y, ".png") # neighbourhood
+      message("nolabels not available for basemap: ", basemap, ". returning map with labels.")
     }
     message('attribution: &copy; <a href="http://www.thunderforest.com/">Thunderforest</a>, &copy; <a href="https://www.openstreetmap.org/copyright">OpenStreetMap</a> contributors')
-
-  } else if(basemap == 'mapnik') {
-    url <- paste0('https://tile.openstreetmap.org/',zoom,'/',tiles$x,'/',tiles$y,'.png') #osm mapnik
+  } else if (basemap == "mapnik") {
+    url <- paste0("https://tile.openstreetmap.org/", zoom, "/", tiles$x, "/", tiles$y, ".png") # osm mapnik
     message('attribution: &copy; <a href="https://www.openstreetmap.org/copyright">OpenStreetMap</a> contributors')
 
-    if(nolabels == T){
-      message('nolabels not available for basemap: ', basemap, '. returning map with labels.')
+    if (nolabels == T) {
+      message("nolabels not available for basemap: ", basemap, ". returning map with labels.")
     }
-  } else if(basemap == 'wikimedia') {
-    url <- paste0('https://maps.wikimedia.org/osm-intl/',zoom,'/',tiles$x,'/',tiles$y,'.png') #wikimedia
-    message('please see attribution details: https://wikimediafoundation.org/wiki/Maps_Terms_of_Use')
+  } else if (basemap == "wikimedia") {
+    url <- paste0("https://maps.wikimedia.org/osm-intl/", zoom, "/", tiles$x, "/", tiles$y, ".png") # wikimedia
+    message("please see attribution details: https://wikimediafoundation.org/wiki/Maps_Terms_of_Use")
 
-    if(nolabels == T){
-      message('nolabels not available for basemap: ', basemap, '. returning map with labels.')
+    if (nolabels == T) {
+      message("nolabels not available for basemap: ", basemap, ". returning map with labels.")
     }
-
-  } else if(basemap == 'esri') {
-    url <- paste0('https://server.arcgisonline.com/ArcGIS/rest/services/World_Topo_Map/MapServer/tile/',zoom,'/',tiles$y,'/',tiles$x,'.png') #esri
-    message('attribution: Tiles &copy; Esri &mdash; Esri, DeLorme, NAVTEQ, TomTom, Intermap, iPC, USGS, FAO, NPS, NRCAN, GeoBase, Kadaster NL, Ordnance Survey, Esri Japan, METI, Esri China (Hong Kong), and the GIS User Community')
-    if(nolabels == T){
-      message('nolabels not available for basemap: ', basemap, '. returning map with labels.')
+  } else if (basemap == "esri") {
+    url <- paste0("https://server.arcgisonline.com/ArcGIS/rest/services/World_Topo_Map/MapServer/tile/", zoom, "/", tiles$y, "/", tiles$x, ".png") # esri
+    message("attribution: Tiles &copy; Esri &mdash; Esri, DeLorme, NAVTEQ, TomTom, Intermap, iPC, USGS, FAO, NPS, NRCAN, GeoBase, Kadaster NL, Ordnance Survey, Esri Japan, METI, Esri China (Hong Kong), and the GIS User Community")
+    if (nolabels == T) {
+      message("nolabels not available for basemap: ", basemap, ". returning map with labels.")
     }
-  } else if(basemap == 'esri-imagery') {
-    url <- paste0('https://server.arcgisonline.com/ArcGIS/rest/services/World_Imagery/MapServer/tile/',zoom,'/',tiles$y,'/',tiles$x,'.png')
-
-    message('attribution: Tiles &copy; Esri &mdash; Source: Esri, i-cubed, USDA, USGS, AEX, GeoEye, Getmapping, Aerogrid, IGN, IGP, UPR-EGP, and the GIS User Community')
-  } else if(basemap == 'google'){
-    url <- paste0('https://mt.google.com/vt/lyrs=m&x=',tiles$x,'&y=',tiles$y,'&z=',zoom,'')
-    message('please see attribution details: https://wikimediafoundation.org/wiki/Maps_Terms_of_Use')
-
-  } else if(basemap == 'google-road'){
-    url <- paste0('https://mt.google.com/vt/lyrs=r&x=',tiles$x,'&y=',tiles$y,'&z=',zoom,'')
-    message('please cite: map data \uA9 2020 Google')
-
-  } else if(basemap == 'google-nobg'){
-    url <- paste0('https://mt.google.com/vt/lyrs=h&x=',tiles$x,'&y=',tiles$y,'&z=',zoom,'')
-    message('please cite: map data \uA9 2020 Google')
-  } else if(basemap == 'google-satellite'){
-    url <- paste0('https://mt.google.com/vt/lyrs=s&x=',tiles$x,'&y=',tiles$y,'&z=',zoom,'')
-    message('please cite: map data \uA9 2020 Google')
-  } else if(basemap == 'google-hybrid'){
-    url <- paste0('https://mt.google.com/vt/lyrs=y&x=',tiles$x,'&y=',tiles$y,'&z=',zoom,'')
-    message('please cite: map data \uA9 2020 Google')
-  } else if(basemap == 'google-terrain'){
-    url <- paste0('https://mt.google.com/vt/lyrs=p&x=',tiles$x,'&y=',tiles$y,'&z=',zoom,'')
-    message('please cite: map data \uA9 2020 Google')
+  } else if (basemap == "esri-imagery") {
+    url <- paste0("https://server.arcgisonline.com/ArcGIS/rest/services/World_Imagery/MapServer/tile/", zoom, "/", tiles$y, "/", tiles$x, ".png")
+
+    message("attribution: Tiles &copy; Esri &mdash; Source: Esri, i-cubed, USDA, USGS, AEX, GeoEye, Getmapping, Aerogrid, IGN, IGP, UPR-EGP, and the GIS User Community")
+  } else if (basemap == "google") {
+    url <- paste0("https://mt.google.com/vt/lyrs=m&x=", tiles$x, "&y=", tiles$y, "&z=", zoom, "")
+    message("please see attribution details: https://wikimediafoundation.org/wiki/Maps_Terms_of_Use")
+  } else if (basemap == "google-road") {
+    url <- paste0("https://mt.google.com/vt/lyrs=r&x=", tiles$x, "&y=", tiles$y, "&z=", zoom, "")
+    message("please cite: map data \uA9 2020 Google")
+  } else if (basemap == "google-nobg") {
+    url <- paste0("https://mt.google.com/vt/lyrs=h&x=", tiles$x, "&y=", tiles$y, "&z=", zoom, "")
+    message("please cite: map data \uA9 2020 Google")
+  } else if (basemap == "google-satellite") {
+    url <- paste0("https://mt.google.com/vt/lyrs=s&x=", tiles$x, "&y=", tiles$y, "&z=", zoom, "")
+    message("please cite: map data \uA9 2020 Google")
+  } else if (basemap == "google-hybrid") {
+    url <- paste0("https://mt.google.com/vt/lyrs=y&x=", tiles$x, "&y=", tiles$y, "&z=", zoom, "")
+    message("please cite: map data \uA9 2020 Google")
+  } else if (basemap == "google-terrain") {
+    url <- paste0("https://mt.google.com/vt/lyrs=p&x=", tiles$x, "&y=", tiles$y, "&z=", zoom, "")
+    message("please cite: map data \uA9 2020 Google")
   }
 
 
@@ -169,5 +163,5 @@ base_map <- function(bbox, increase_zoom=0, basemap = 'dark', nolabels = F){
   args <- tile_positions %>%
     dplyr::mutate(raster = pngs)
 
-  return(purrr::pmap(args,annotation_raster, interpolate = TRUE))
+  return(purrr::pmap(args, annotation_raster, interpolate = TRUE))
 }

R/expand_bbox.R

@@ -13,41 +13,35 @@
 #'
 #' @examples
 #' library(sf)
-#' camden <- dplyr::filter(localauth_data, Name == 'Camden') %>%
+#' camden <- dplyr::filter(localauth_data, Name == "Camden") %>%
 #'   st_transform(4326)
 #' bbox <- expand_bbox(st_bbox(camden), 5000, 5000)
 #'
 #' library(ggplot2)
 #' ggplot() +
 #'   base_map(bbox, increase_zoom = 2) +
 #'   geom_sf(data = camden, fill = NA) +
-#'   coord_sf(xlim = c(bbox['xmin'], bbox['xmax']),
-#'            ylim = c(bbox['ymin'],bbox['ymax']),crs = 4326)
-#'
+#'   coord_sf(
+#'     xlim = c(bbox["xmin"], bbox["xmax"]),
+#'     ylim = c(bbox["ymin"], bbox["ymax"]), crs = 4326
+#'   )
 #' @export
 
 expand_bbox <- function(bbox, X, Y, X2 = X, Y2 = Y,
-                        crs_out = 4326){
+                        crs_out = 4326) {
   bbox <- bbox %>%
     st_as_sfc() %>%
-    sf::st_transform(crs = 4326)%>%
+    sf::st_transform(crs = 4326) %>%
     st_bbox()
 
 
-  bbox['xmin'] <-  bbox['xmin'] - (X / 6370000) * (180 / pi) / cos(bbox['xmin'] * pi/180)
-  bbox['xmax'] <-  bbox['xmax'] + (X2 / 6370000) * (180 / pi) / cos(bbox['xmax'] * pi/180)
-  bbox['ymin'] <-  bbox['ymin'] - (Y / 6370000) * (180 / pi)
-  bbox['ymax'] <- bbox['ymax'] + (Y2 / 6370000) * (180 / pi)
+  bbox["xmin"] <- bbox["xmin"] - (X / 6370000) * (180 / pi) / cos(bbox["xmin"] * pi / 180)
+  bbox["xmax"] <- bbox["xmax"] + (X2 / 6370000) * (180 / pi) / cos(bbox["xmax"] * pi / 180)
+  bbox["ymin"] <- bbox["ymin"] - (Y / 6370000) * (180 / pi)
+  bbox["ymax"] <- bbox["ymax"] + (Y2 / 6370000) * (180 / pi)
 
   bbox %>%
     st_as_sfc() %>%
     sf::st_transform(crs = crs_out) %>%
     st_bbox()
-
-
 }
-
-
-
-
-

R/utils-base_map.R

@@ -24,7 +24,6 @@ xy2lonlat <- function(x, y, zoom) {
 }
 
 get_tile <- function(url) {
-
   tmp <- tempfile()
 
   h <- curl::new_handle()
@@ -33,9 +32,8 @@ get_tile <- function(url) {
   curl::curl_download(url, destfile = tmp)
 
   tryCatch(png::readPNG(tmp),
-           error = function(e){
-             jpeg::readJPEG(tmp)
-           })
-
-
+    error = function(e) {
+      jpeg::readJPEG(tmp)
+    }
+  )
 }

basemapR.Rproj

@@ -18,3 +18,4 @@ StripTrailingWhitespace: Yes
 BuildType: Package
 PackageUseDevtools: Yes
 PackageInstallArgs: --no-multiarch --with-keep.source
+PackageRoxygenize: rd,collate,namespace

readme.Rmd

@@ -5,7 +5,8 @@ output: github_document
 ---
 
 ```{r setup, include=FALSE}
-knitr::opts_chunk$set(echo = TRUE)
+knitr::opts_chunk$set(echo = TRUE,
+                      fig.path = "man/figures/README-")
 ```
 
 ## Installing basemapR