hypertidy / ceramic
Showing 1 of 2 files from the diff.
Other files ignored by Codecov
ceramic.Rproj has changed.

@@ -1,170 +1,170 @@
Loading
1 -
provider_from_type <- function(type) {
2 -
  if (grepl("mapbox", type)) return("mapbox")
3 -
  if (grepl("elevation-tiles-prod", type)) return("aws")
4 -
  NULL
5 -
}
6 -
7 -
guess_format <- function(x) {
8 -
  c("png", "jpg")[grepl("satellite", x) + 1L]
9 -
}
10 -
11 -
#' Download Mapbox imagery tiles
12 -
#'
13 -
#' Obtain imagery or elevation tiles by location query. The first argument
14 -
#' `loc` may be a spatial object (sp, raster, sf) or a 2-column matrix with a single
15 -
#' longitude and latitude value. Use `buffer` to define a width and height to pad
16 -
#' around the raw longitude and latitude in metres. If `loc` has an extent, then
17 -
#' `buffer` is ignored.
18 -
#'
19 -
#' `get_tiles()` may be run with no arguments, and will download (and report on) the default
20 -
#' tile source at zoom 0. Arguments `type`, `zoom` (or `max_tiles`), `format` may be used
21 -
#' without setting `loc` or `buffer` and the entire world extent will be used. Please use with caution!
22 -
#' There is no maximum on what will be downloaded, but it can be interrupted at any time.
23 -
#'
24 -
#' Use `debug = TRUE` to avoid download and simply report on what would be done.
25 -
#'
26 -
#' `cc_elevation` does extra work to unpack the DEM tiles from the RGB format.
27 -
#'
28 -
#' Available types are 'elevation-tiles-prod' for AWS elevation tiles, and 'mapbox.satellite',
29 -
#' 'mapbox.outdoors', 'mapbox.terrain-rgb', 'mapbox.streets', 'mapbox.light', 'mapbox.dark'
30 -
#'  or any other string accepted by Mapbox services.
31 -
#'
32 -
#'
33 -
#' @param x a longitude, latitude pair of coordinates, or a spatial object
34 -
#' @param buffer width in metres to extend around the location, ignored if 'x' is a spatial object with extent
35 -
#' @param type character string of provider imagery type (see Details)
36 -
#' @param crop_to_buffer crop to the user extent, used for creation of output objects (otherwise is padded tile extent)
37 -
#' @param format tile format to use, defaults to "jpg" for Mapbox satellite imagery and "png" otherwise
38 -
#' @param ... arguments passed to internal function, specifically `base_url` (see Details)
39 -
#' @param zoom desired zoom for tiles, use with caution - if `NULL` is chosen automatically
40 -
#' @param debug optionally avoid actual download, but print out what would be downloaded in non-debug mode
41 -
#' @param max_tiles maximum number of tiles - if `NULL` is set by zoom constraints
42 -
#' @param base_url tile provider URL expert use only
43 -
#' @param verbose report messages or suppress them
44 -
#' @export
45 -
#' @return A list with files downloaded in character vector, a data frame of the tile indices,
46 -
#' the zoom level used and the extent in [raster::extent] form.
47 -
#' @name get_tiles
48 -
#' @seealso get_tiles_zoom get_tiles_dim get_tiles_buffer
49 -
#' @examples
50 -
#' if (!is.null(get_api_key())) {
51 -
#'    tile_info <- get_tiles(raster::extent(146, 147, -43, -42), type = "mapbox.outdoors", zoom = 5)
52 -
#' }
53 -
get_tiles <- function(x, buffer, type = "mapbox.satellite", crop_to_buffer = TRUE,
54 -
                      format = NULL, ..., zoom = NULL, debug = FALSE, max_tiles = NULL, base_url = NULL,
55 -
                      verbose = TRUE) {
56 -
  if (missing(x) && missing(buffer)) {
57 -
    ## get the whole world at zoom provided, as a neat default
58 -
    x <- cbind(0, 0)
59 -
    buffer <- c(20037508, 20037508)
60 -
    if (is.null(zoom) && is.null(max_tiles)) {
61 -
      zoom <- 0
62 -
    }
63 -
  }
64 -
  if (is.null(format)) {
65 -
    format <- guess_format(type)
66 -
  }
67 -
  if (!is.null(zoom)) max_tiles <- NULL
68 -
  if (!is.null(base_url)) {
69 -
    ## zap the type because input was a custom mapbox style (we assume)
70 -
    type <- ""
71 -
  }
72 -
73 -
  bbox_pair <- spatial_bbox(x, buffer)
74 -
75 -
  my_bbox <- bbox_pair$tile_bbox
76 -
  bb_points <- bbox_pair$user_points
77 -
78 -
79 -
  tile_grid <- slippymath::bbox_to_tile_grid(my_bbox, max_tiles = max_tiles, zoom = zoom)
80 -
  zoom <- tile_grid$zoom
81 -
82 -
  if (is.null(base_url)) {
83 -
    provider <- provider_from_type(type)
84 -
    if (is.null(provider)) stop(sprintf("Provider for '%s' not known", type))
85 -
    query_string <- switch(provider,
86 -
                           mapbox = mapbox_string(type = type, format = format),
87 -
                           aws = aws_string())
88 -
  } else {  ## handle custom
89 -
    query_string <- mk_query_string_custom(baseurl = base_url)
90 -
  }
91 -
92 -
93 -
  files <- unlist(down_loader(tile_grid, query_string, debug = debug, verbose = verbose))
94 -
  bad <- file.info(files)$size < 35
95 -
96 -
  if (!debug && all(bad)) {
97 -
    mess <-paste(files, collapse = "\n")
98 -
    stop(sprintf("no sensible tiles found, check cache?\n%s", mess))
99 -
  }
100 -
  user_ex <- NULL
101 -
  if (crop_to_buffer) user_ex <- raster::extent(as.vector(bb_points))
102 -
  out <- list(files = files[!bad], tiles = tile_grid, extent = user_ex)
103 -
  if (debug) {
104 -
    out <- invisible(out)
105 -
  }
106 -
107 -
  out
108 -
}
109 -
110 -
#' Get tiles with specific constraints
111 -
#'
112 -
#' Get tiles by zoom, by overall dimension, or by buffer on a single point.
113 -
#'
114 -
#'  Each function expects an extent in longitude latitude or a spatial object with extent as the first argument.
115 -
#'
116 -
#' `get_tiles_zoom()` requires a zoom value, defaulting to 0
117 -
#'
118 -
#' `get_tiles_dim()` requires a dim value, default to `c(512, 512)`, a set of 4 tiles
119 -
#'
120 -
#' `get_tiles_buffer()` requires a single location (longitude, latitude) and a buffer in metres
121 -
#' @param x a spatial object with an extent
122 -
#' @param ... passed to `get_tiles()`
123 -
#' @param dim for `get_tiles_dim` the overall maximum dimensions of the image (padded out to tile size of 256x256)
124 -
#' @param zoom desired zoom for tiles, use with caution - cannot be unset in `get_tiles_zoom`
125 -
#' @param buffer width in metres to extend around the location, ignored if 'x' is a spatial object with extent
126 -
#' @param max_tiles maximum number of tiles - if `NULL` is set by zoom constraints
127 -
#' @param format defaults to "png", also available is "jpg"
128 -
#' @name get-tiles-constrained
129 -
#' @aliases get_tiles_zoom get_tiles_dim get_tiles_buffer
130 -
#' @return A list with files downloaded in character vector, a data frame of the tile indices,
131 -
#' the zoom level used and the extent in [raster::extent] form.
132 -
#' @export
133 -
#' @seealso get_tiles
134 -
#' @examples
135 -
#' if (!is.null(get_api_key())) {
136 -
#'  ex <- raster::extent(146, 147, -43, -42)
137 -
#'  tile_infoz <- get_tiles_zoom(ex, type = "mapbox.outdoors", zoom = 1)
138 -
#'
139 -
#'  tile_infod <- get_tiles_dim(ex, type = "mapbox.outdoors", dim = c(256, 256))
140 -
#'
141 -
#'  tile_infob <- get_tiles_buffer(cbind(146.5, -42.5), buffer = 5000, type = "mapbox.outdoors")
142 -
#' }
143 -
get_tiles_zoom <- function(x, zoom = 0, ..., format = "png") {
144 -
  if ("max_tiles" %in% names(list(...))) {
145 -
    stop("max_tiles cannot be set by 'get_tiles_zoom()', use 'get_tiles_dim()'")
146 -
  }
147 -
  get_tiles(x, zoom = zoom, ..., format = format)
148 -
}
149 -
#' @export
150 -
#' @name get-tiles-constrained
151 -
get_tiles_dim <- function(x, dim = c(512, 512), ..., format = "png") {
152 -
  max_tiles <- prod(ceiling(dim / c(256, 256)))
153 -
  if ("zoom" %in% names(list(...))) {
154 -
    stop("zoom cannot be set by 'get_tiles_dim()', use 'get_tiles_zoom()'")
155 -
  }
156 -
  get_tiles(x, max_tiles = max_tiles, ..., format = format)
157 -
}
158 -
#' @export
159 -
#' @name get-tiles-constrained
160 -
get_tiles_buffer <- function(x, buffer = NULL, ..., max_tiles = 9, format = "png") {
161 -
  if (is.null(buffer)) {
162 -
    stop("buffer cannot be NULL in 'get_tiles_buffer()'")
163 -
  }
164 -
  if (!is.numeric(x) || !length(x) == 2L) {
165 -
    stop("get_tiles_buffer() expects a single point location longitude,latitude")
166 -
  }
167 -
  get_tiles(x, buffer = buffer, max_tiles = max_tiles, ..., format = format)
168 -
}
169 -
170 -
1 +
provider_from_type <- function(type) {
2 +
  if (grepl("mapbox", type)) return("mapbox")
3 +
  if (grepl("elevation-tiles-prod", type)) return("aws")
4 +
  NULL
5 +
}
6 +
7 +
guess_format <- function(x) {
8 +
  c("png", "jpg")[grepl("satellite", x) + 1L]
9 +
}
10 +
11 +
#' Download Mapbox imagery tiles
12 +
#'
13 +
#' Obtain imagery or elevation tiles by location query. The first argument
14 +
#' `loc` may be a spatial object (sp, raster, sf) or a 2-column matrix with a single
15 +
#' longitude and latitude value. Use `buffer` to define a width and height to pad
16 +
#' around the raw longitude and latitude in metres. If `loc` has an extent, then
17 +
#' `buffer` is ignored.
18 +
#'
19 +
#' `get_tiles()` may be run with no arguments, and will download (and report on) the default
20 +
#' tile source at zoom 0. Arguments `type`, `zoom` (or `max_tiles`), `format` may be used
21 +
#' without setting `loc` or `buffer` and the entire world extent will be used. Please use with caution!
22 +
#' There is no maximum on what will be downloaded, but it can be interrupted at any time.
23 +
#'
24 +
#' Use `debug = TRUE` to avoid download and simply report on what would be done.
25 +
#'
26 +
#' `cc_elevation` does extra work to unpack the DEM tiles from the RGB format.
27 +
#'
28 +
#' Available types are 'elevation-tiles-prod' for AWS elevation tiles, and 'mapbox.satellite',
29 +
#' 'mapbox.outdoors', 'mapbox.terrain-rgb', 'mapbox.streets', 'mapbox.light', 'mapbox.dark'
30 +
#'  or any other string accepted by Mapbox services.
31 +
#'
32 +
#'
33 +
#' @param x a longitude, latitude pair of coordinates, or a spatial object
34 +
#' @param buffer width in metres to extend around the location, ignored if 'x' is a spatial object with extent
35 +
#' @param type character string of provider imagery type (see Details)
36 +
#' @param crop_to_buffer crop to the user extent, used for creation of output objects (otherwise is padded tile extent)
37 +
#' @param format tile format to use, defaults to "jpg" for Mapbox satellite imagery and "png" otherwise
38 +
#' @param ... arguments passed to internal function, specifically `base_url` (see Details)
39 +
#' @param zoom desired zoom for tiles, use with caution - if `NULL` is chosen automatically
40 +
#' @param debug optionally avoid actual download, but print out what would be downloaded in non-debug mode
41 +
#' @param max_tiles maximum number of tiles - if `NULL` is set by zoom constraints
42 +
#' @param base_url tile provider URL expert use only
43 +
#' @param verbose report messages or suppress them
44 +
#' @export
45 +
#' @return A list with files downloaded in character vector, a data frame of the tile indices,
46 +
#' the zoom level used and the extent in [raster::extent] form.
47 +
#' @name get_tiles
48 +
#' @seealso get_tiles_zoom get_tiles_dim get_tiles_buffer
49 +
#' @examples
50 +
#' if (!is.null(get_api_key())) {
51 +
#'    tile_info <- get_tiles(raster::extent(146, 147, -43, -42), type = "mapbox.outdoors", zoom = 5)
52 +
#' }
53 +
get_tiles <- function(x, buffer, type = "mapbox.satellite", crop_to_buffer = TRUE,
54 +
                      format = NULL, ..., zoom = NULL, debug = FALSE, max_tiles = NULL, base_url = NULL,
55 +
                      verbose = TRUE) {
56 +
  if (missing(x) && missing(buffer)) {
57 +
    ## get the whole world at zoom provided, as a neat default
58 +
    x <- cbind(0, 0)
59 +
    buffer <- c(20037508, 20037508)
60 +
    if (is.null(zoom) && is.null(max_tiles)) {
61 +
      zoom <- 0
62 +
    }
63 +
  }
64 +
  if (is.null(format)) {
65 +
    format <- guess_format(type)
66 +
  }
67 +
  if (!is.null(zoom)) max_tiles <- NULL
68 +
  if (!is.null(base_url)) {
69 +
    ## zap the type because input was a custom mapbox style (we assume)
70 +
    type <- ""
71 +
  }
72 +
73 +
  bbox_pair <- spatial_bbox(x, buffer)
74 +
75 +
  my_bbox <- bbox_pair$tile_bbox
76 +
  bb_points <- bbox_pair$user_points
77 +
78 +
79 +
  tile_grid <- slippymath::bbox_to_tile_grid(my_bbox, max_tiles = max_tiles, zoom = zoom)
80 +
  zoom <- tile_grid$zoom
81 +
82 +
  if (is.null(base_url)) {
83 +
    provider <- provider_from_type(type)
84 +
    if (is.null(provider)) stop(sprintf("Provider for '%s' not known", type))
85 +
    query_string <- switch(provider,
86 +
                           mapbox = mapbox_string(type = type, format = format),
87 +
                           aws = aws_string())
88 +
  } else {  ## handle custom
89 +
    query_string <- mk_query_string_custom(baseurl = base_url)
90 +
  }
91 +
92 +
print(query_string)
93 +
  files <- unlist(down_loader(tile_grid, query_string, debug = debug, verbose = verbose))
94 +
  bad <- file.info(files)$size < 35
95 +
96 +
  if (!debug && all(bad)) {
97 +
    mess <-paste(files, collapse = "\n")
98 +
    stop(sprintf("no sensible tiles found, check cache?\n%s", mess))
99 +
  }
100 +
  user_ex <- NULL
101 +
  if (crop_to_buffer) user_ex <- raster::extent(as.vector(bb_points))
102 +
  out <- list(files = files[!bad], tiles = tile_grid, extent = user_ex)
103 +
  if (debug) {
104 +
    out <- invisible(out)
105 +
  }
106 +
107 +
  out
108 +
}
109 +
110 +
#' Get tiles with specific constraints
111 +
#'
112 +
#' Get tiles by zoom, by overall dimension, or by buffer on a single point.
113 +
#'
114 +
#'  Each function expects an extent in longitude latitude or a spatial object with extent as the first argument.
115 +
#'
116 +
#' `get_tiles_zoom()` requires a zoom value, defaulting to 0
117 +
#'
118 +
#' `get_tiles_dim()` requires a dim value, default to `c(512, 512)`, a set of 4 tiles
119 +
#'
120 +
#' `get_tiles_buffer()` requires a single location (longitude, latitude) and a buffer in metres
121 +
#' @param x a spatial object with an extent
122 +
#' @param ... passed to `get_tiles()`
123 +
#' @param dim for `get_tiles_dim` the overall maximum dimensions of the image (padded out to tile size of 256x256)
124 +
#' @param zoom desired zoom for tiles, use with caution - cannot be unset in `get_tiles_zoom`
125 +
#' @param buffer width in metres to extend around the location, ignored if 'x' is a spatial object with extent
126 +
#' @param max_tiles maximum number of tiles - if `NULL` is set by zoom constraints
127 +
#' @param format defaults to "png", also available is "jpg"
128 +
#' @name get-tiles-constrained
129 +
#' @aliases get_tiles_zoom get_tiles_dim get_tiles_buffer
130 +
#' @return A list with files downloaded in character vector, a data frame of the tile indices,
131 +
#' the zoom level used and the extent in [raster::extent] form.
132 +
#' @export
133 +
#' @seealso get_tiles
134 +
#' @examples
135 +
#' if (!is.null(get_api_key())) {
136 +
#'  ex <- raster::extent(146, 147, -43, -42)
137 +
#'  tile_infoz <- get_tiles_zoom(ex, type = "mapbox.outdoors", zoom = 1)
138 +
#'
139 +
#'  tile_infod <- get_tiles_dim(ex, type = "mapbox.outdoors", dim = c(256, 256))
140 +
#'
141 +
#'  tile_infob <- get_tiles_buffer(cbind(146.5, -42.5), buffer = 5000, type = "mapbox.outdoors")
142 +
#' }
143 +
get_tiles_zoom <- function(x, zoom = 0, ..., format = "png") {
144 +
  if ("max_tiles" %in% names(list(...))) {
145 +
    stop("max_tiles cannot be set by 'get_tiles_zoom()', use 'get_tiles_dim()'")
146 +
  }
147 +
  get_tiles(x, zoom = zoom, ..., format = format)
148 +
}
149 +
#' @export
150 +
#' @name get-tiles-constrained
151 +
get_tiles_dim <- function(x, dim = c(512, 512), ..., format = "png") {
152 +
  max_tiles <- prod(ceiling(dim / c(256, 256)))
153 +
  if ("zoom" %in% names(list(...))) {
154 +
    stop("zoom cannot be set by 'get_tiles_dim()', use 'get_tiles_zoom()'")
155 +
  }
156 +
  get_tiles(x, max_tiles = max_tiles, ..., format = format)
157 +
}
158 +
#' @export
159 +
#' @name get-tiles-constrained
160 +
get_tiles_buffer <- function(x, buffer = NULL, ..., max_tiles = 9, format = "png") {
161 +
  if (is.null(buffer)) {
162 +
    stop("buffer cannot be NULL in 'get_tiles_buffer()'")
163 +
  }
164 +
  if (!is.numeric(x) || !length(x) == 2L) {
165 +
    stop("get_tiles_buffer() expects a single point location longitude,latitude")
166 +
  }
167 +
  get_tiles(x, buffer = buffer, max_tiles = max_tiles, ..., format = format)
168 +
}
169 +
170 +
Files Coverage
R 68.90%
Project Totals (12 files) 68.90%
1
comment: false
2

3
coverage:
4
  status:
5
    project:
6
      default:
7
        target: auto
8
        threshold: 1%
9
    patch:
10
      default:
11
        target: auto
12
        threshold: 1%
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading