|
| 1 | +############################################################################### |
| 2 | +## The following code originaly comes from the slippymath package. |
| 3 | +## It has been modified and simplified to remove some dependencies (e.g. purrr) |
| 4 | +## by maptiles author. |
| 5 | +## The original code use the MIT License |
| 6 | +############################################################################### |
| 7 | +# MIT License |
| 8 | +# |
| 9 | +# Copyright (c) 2018 Miles McBain |
| 10 | +# |
| 11 | +# Permission is hereby granted, free of charge, to any person obtaining a copy |
| 12 | +# of this software and associated documentation files (the "Software"), |
| 13 | +# to deal in the Software without restriction, including without limitation |
| 14 | +# the rights to use, copy, modify, merge, publish, distribute, sublicense, |
| 15 | +# and/or sell copies of the Software, and to permit persons to whom the Software |
| 16 | +# is furnished to do so, subject to the following conditions: |
| 17 | +# |
| 18 | +# The above copyright notice and this permission notice shall be included in |
| 19 | +# all copies or substantial portions of the Software. |
| 20 | +# |
| 21 | +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR |
| 22 | +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, |
| 23 | +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE |
| 24 | +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER |
| 25 | +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, |
| 26 | +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE |
| 27 | +# SOFTWARE. |
| 28 | + |
| 29 | +bbox_to_tile_grid <- function(bbox, zoom = NULL, max_tiles = NULL) { |
| 30 | + tile_extent <- bbox_tile_extent(bbox, zoom) |
| 31 | + x_tiles <- tile_extent$x_min:tile_extent$x_max |
| 32 | + y_tiles <- tile_extent$y_min:tile_extent$y_max |
| 33 | + tile_grid <- list( |
| 34 | + tiles = expand.grid(x = x_tiles, y = y_tiles), |
| 35 | + zoom = zoom |
| 36 | + ) |
| 37 | + tile_grid |
| 38 | +} |
| 39 | + |
| 40 | +bbox_tile_extent <- function(bbox, zoom) { |
| 41 | + min_tile <- lonlat_to_tilenum( |
| 42 | + lat_deg = bbox["ymin"], lon_deg = bbox["xmin"], zoom |
| 43 | + ) |
| 44 | + max_tile <- lonlat_to_tilenum( |
| 45 | + lat_deg = bbox["ymax"], lon_deg = bbox["xmax"], zoom |
| 46 | + ) |
| 47 | + list( |
| 48 | + x_min = min_tile$x, y_min = max_tile$y, x_max = max_tile$x, |
| 49 | + y_max = min_tile$y |
| 50 | + ) |
| 51 | +} |
| 52 | + |
| 53 | +lonlat_to_tilenum <- function(lon_deg, lat_deg, zoom) { |
| 54 | + lon_rad <- radians(lon_deg) |
| 55 | + lat_rad <- radians(lat_deg) |
| 56 | + x <- lon_rad |
| 57 | + y <- asinh(tan(lat_rad)) |
| 58 | + x <- (1 + (x / pi)) / 2 |
| 59 | + y <- (1 - (y / pi)) / 2 |
| 60 | + n_tiles <- 2^zoom |
| 61 | + xtile <- sm_clamp(floor(x * n_tiles), 0, n_tiles - 1) |
| 62 | + ytile <- sm_clamp(floor(y * n_tiles), 0, n_tiles - 1) |
| 63 | + list(x = xtile, y = ytile) |
| 64 | +} |
| 65 | + |
| 66 | +radians <- function(angle_deg) { |
| 67 | + angle_deg * pi / 180 |
| 68 | +} |
| 69 | + |
| 70 | +degrees <- function(angle_rad) { |
| 71 | + (angle_rad * 180) / pi |
| 72 | +} |
| 73 | + |
| 74 | +sm_clamp <- function(x, mn, mx) { |
| 75 | + x[x < mn] <- mn |
| 76 | + x[x > mx] <- mx |
| 77 | + x |
| 78 | +} |
| 79 | + |
| 80 | +bbox_tile_query <- function(bbox, zoom_levels = 2:18) { |
| 81 | + l <- list() |
| 82 | + for (i in seq_along(zoom_levels)) { |
| 83 | + l[[i]] <- bbox_tile_extent(bbox, zoom = zoom_levels[i]) |
| 84 | + } |
| 85 | + extents_at_zooms <- data.frame( |
| 86 | + matrix( |
| 87 | + data = unlist(lapply(l, unlist)), ncol = 4, byrow = TRUE, |
| 88 | + dimnames = list(seq_along(l), c("x_min", "y_min", "x_max", "y_max")) |
| 89 | + ) |
| 90 | + ) |
| 91 | + extents_at_zooms$y_dim <- abs(extents_at_zooms$y_max - extents_at_zooms$y_min) + 1 |
| 92 | + extents_at_zooms$x_dim <- abs(extents_at_zooms$x_max - extents_at_zooms$x_min) + 1 |
| 93 | + extents_at_zooms$total_tiles <- extents_at_zooms$y_dim * extents_at_zooms$x_dim |
| 94 | + extents_at_zooms$zoom <- zoom_levels |
| 95 | + extents_at_zooms |
| 96 | +} |
| 97 | + |
| 98 | +tile_bbox <- function(x, y, zoom) { |
| 99 | + bottom_left <- lonlat_to_merc(t(as.matrix(unlist(tilenum_to_lonlat(x, y + 1, zoom))))) |
| 100 | + top_right <- lonlat_to_merc(t(as.matrix(unlist(tilenum_to_lonlat(x + 1, y, zoom))))) |
| 101 | + structure( |
| 102 | + c( |
| 103 | + xmin = bottom_left[[1]], ymin = bottom_left[[2]], |
| 104 | + xmax = top_right[[1]], ymax = top_right[[2]] |
| 105 | + ), |
| 106 | + class = "bbox", |
| 107 | + crs = sf::st_crs("EPSG:3857") |
| 108 | + ) |
| 109 | +} |
| 110 | + |
| 111 | +tilenum_to_lonlat <- function(x, y, zoom) { |
| 112 | + n_tiles <- 2^zoom |
| 113 | + lon_rad <- (((x / n_tiles) * 2) - 1) * pi |
| 114 | + merc_lat <- (1 - ((y / n_tiles) * 2)) * pi |
| 115 | + lat_rad <- atan(sinh(merc_lat)) |
| 116 | + list(lon = degrees(lon_rad), lat = degrees(lat_rad)) |
| 117 | +} |
| 118 | + |
| 119 | +lonlat_to_merc <- function(ll) { |
| 120 | + A <- 6378137 |
| 121 | + MAXEXTENT <- 20037508.342789244 |
| 122 | + xy <- cbind(A * radians(ll[, 1]), A * log(tan((pi * 0.25) + (0.5 * radians(ll[, 2]))))) |
| 123 | + xy[, 1] <- sm_clamp(xy[, 1], -MAXEXTENT, MAXEXTENT) |
| 124 | + xy[, 2] <- sm_clamp(xy[, 2], -MAXEXTENT, MAXEXTENT) |
| 125 | + xy |
| 126 | +} |
0 commit comments