├── .gitignore ├── R ├── sysdata.rda ├── utils-pipe.R ├── georeference.R ├── cache.R └── locale.R ├── tests ├── testthat.R └── testthat │ └── test-get.R ├── docs ├── pkgdown.yml ├── reference │ ├── figures │ │ ├── README-example-1.png │ │ ├── README-tile-plot.png │ │ ├── README-tasmania-1.png │ │ └── README-tile-add-plot.png │ ├── pipe.html │ ├── index.html │ ├── mercator_tile_extent.html │ ├── ceramic_tiles.html │ └── down_loader.html ├── link.svg ├── docsearch.js ├── pkgdown.js ├── authors.html ├── pkgdown.css ├── CODE_OF_CONDUCT.html ├── docsearch.css └── index.html ├── man ├── figures │ ├── README-example-1.png │ ├── README-tasmania-1.png │ ├── README-tile-plot.png │ └── README-tile-add-plot.png ├── pipe.Rd ├── mercator_tile_extent.Rd ├── ceramic_tiles.Rd ├── down_loader.Rd └── cc_location.Rd ├── .Rbuildignore ├── data-raw ├── merc_world.R └── static-readme-figures.R ├── ceramic.Rproj ├── NAMESPACE ├── DESCRIPTION ├── CODE_OF_CONDUCT.md ├── README.Rmd └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | -------------------------------------------------------------------------------- /R/sysdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MilesMcBain/ceramic/master/R/sysdata.rda -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(ceramic) 3 | 4 | test_check("ceramic") 5 | -------------------------------------------------------------------------------- /docs/pkgdown.yml: -------------------------------------------------------------------------------- 1 | pandoc: 2.3.1 2 | pkgdown: 1.1.0 3 | pkgdown_sha: ~ 4 | articles: [] 5 | 6 | -------------------------------------------------------------------------------- /man/figures/README-example-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MilesMcBain/ceramic/master/man/figures/README-example-1.png -------------------------------------------------------------------------------- /man/figures/README-tasmania-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MilesMcBain/ceramic/master/man/figures/README-tasmania-1.png -------------------------------------------------------------------------------- /man/figures/README-tile-plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MilesMcBain/ceramic/master/man/figures/README-tile-plot.png -------------------------------------------------------------------------------- /man/figures/README-tile-add-plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MilesMcBain/ceramic/master/man/figures/README-tile-add-plot.png -------------------------------------------------------------------------------- /tests/testthat/test-get.R: -------------------------------------------------------------------------------- 1 | context("test-get") 2 | 3 | test_that("getting tiles works", { 4 | expect_equal(2 * 2, 4) 5 | }) 6 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^data-raw$ 2 | ^CODE_OF_CONDUCT\.md$ 3 | ^README\.Rmd$ 4 | ^ceramic\.Rproj$ 5 | ^\.Rproj\.user$ 6 | ^docs$ 7 | ^\.Rhistory$ 8 | -------------------------------------------------------------------------------- /docs/reference/figures/README-example-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MilesMcBain/ceramic/master/docs/reference/figures/README-example-1.png -------------------------------------------------------------------------------- /docs/reference/figures/README-tile-plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MilesMcBain/ceramic/master/docs/reference/figures/README-tile-plot.png -------------------------------------------------------------------------------- /docs/reference/figures/README-tasmania-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MilesMcBain/ceramic/master/docs/reference/figures/README-tasmania-1.png -------------------------------------------------------------------------------- /docs/reference/figures/README-tile-add-plot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/MilesMcBain/ceramic/master/docs/reference/figures/README-tile-add-plot.png -------------------------------------------------------------------------------- /R/utils-pipe.R: -------------------------------------------------------------------------------- 1 | #' Pipe operator 2 | #' 3 | #' See \code{magrittr::\link[magrittr]{\%>\%}} for details. 4 | #' 5 | #' @name %>% 6 | #' @rdname pipe 7 | #' @keywords internal 8 | #' @export 9 | #' @importFrom magrittr %>% 10 | #' @usage lhs \%>\% rhs 11 | NULL 12 | -------------------------------------------------------------------------------- /data-raw/merc_world.R: -------------------------------------------------------------------------------- 1 | m <- rworldmap::countriesLow 2 | library(spbabel) 3 | sptable(m) <- sptable(m) %>% dplyr::filter(y_ > -88) 4 | 5 | merc_world <- sp::spTransform(m, "+proj=merc +a=6378137.0 +b=6378137.0") 6 | usethis::use_data(merc_world, internal = TRUE) 7 | 8 | -------------------------------------------------------------------------------- /data-raw/static-readme-figures.R: -------------------------------------------------------------------------------- 1 | png("man/figures/README-tile-plot.png") 2 | ceramic::plot_tiles(ceramic_tiles(zoom = c(7, 9))) 3 | dev.off() 4 | 5 | png("man/figures/README-tile-add-plot.png") 6 | plotRGB(im) 7 | ceramic::plot_tiles(ceramic_tiles(zoom = 7), add = TRUE) 8 | dev.off() 9 | -------------------------------------------------------------------------------- /man/pipe.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-pipe.R 3 | \name{\%>\%} 4 | \alias{\%>\%} 5 | \title{Pipe operator} 6 | \usage{ 7 | lhs \%>\% rhs 8 | } 9 | \description{ 10 | See \code{magrittr::\link[magrittr]{\%>\%}} for details. 11 | } 12 | \keyword{internal} 13 | -------------------------------------------------------------------------------- /ceramic.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /man/mercator_tile_extent.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/georeference.R 3 | \name{mercator_tile_extent} 4 | \alias{mercator_tile_extent} 5 | \title{Tile extent} 6 | \usage{ 7 | mercator_tile_extent(tile_x, tile_y, zoom, tile_size = 256) 8 | } 9 | \arguments{ 10 | \item{tile_x}{x coordinate of tile} 11 | 12 | \item{tile_y}{y coordinate of tile} 13 | 14 | \item{zoom}{zoo level} 15 | 16 | \item{tile_size}{tile dimensions (assumed square atm, 256*256)} 17 | } 18 | \description{ 19 | Calculate tile extent for a given x, y tile at a zoom level. 20 | } 21 | \details{ 22 | Currently only Mapbox spherical Mercator is supported. 23 | } 24 | -------------------------------------------------------------------------------- /man/ceramic_tiles.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cache.R 3 | \name{ceramic_tiles} 4 | \alias{ceramic_tiles} 5 | \title{Tile files} 6 | \usage{ 7 | ceramic_tiles(zoom = NULL, type = "mapbox.satellite", 8 | source = "api.mapbox.com", glob = "*.jpg*", regexp = NULL) 9 | } 10 | \arguments{ 11 | \item{zoom}{zoom level} 12 | 13 | \item{type}{imagery type} 14 | 15 | \item{source}{imagery source} 16 | 17 | \item{glob}{see `fs::dir_ls`} 18 | 19 | \item{regexp}{see `fs::dir_ls`} 20 | } 21 | \description{ 22 | Find existing files in the cache. Various options can be controlled, this is WIP 23 | and due to change pending generalization across providers. 24 | } 25 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export("%>%") 4 | export(cc_casey) 5 | export(cc_davis) 6 | export(cc_heard) 7 | export(cc_kingston) 8 | export(cc_location) 9 | export(cc_macquarie) 10 | export(cc_mawson) 11 | export(ceramic_tiles) 12 | export(down_loader) 13 | export(mercator_tile_extent) 14 | importFrom(curl,curl_download) 15 | importFrom(dplyr,filter) 16 | importFrom(fs,dir_create) 17 | importFrom(fs,dir_exists) 18 | importFrom(glue,glue) 19 | importFrom(graphics,rect) 20 | importFrom(graphics,text) 21 | importFrom(magrittr,"%>%") 22 | importFrom(purrr,pmap) 23 | importFrom(rappdirs,user_cache_dir) 24 | importFrom(rlang,.data) 25 | importFrom(sp,plot) 26 | importFrom(stats,setNames) 27 | importFrom(tibble,tibble) 28 | -------------------------------------------------------------------------------- /man/down_loader.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cache.R 3 | \name{down_loader} 4 | \alias{down_loader} 5 | \title{Downloader for tiles} 6 | \usage{ 7 | down_loader(x, query_string, clobber = FALSE, ..., debug = FALSE) 8 | } 9 | \arguments{ 10 | \item{x}{tiles object} 11 | 12 | \item{query_string}{an api query template (see Details)} 13 | 14 | \item{clobber}{if `TRUE` re download any existing tiles} 15 | } 16 | \value{ 17 | WIP 18 | } 19 | \description{ 20 | Tiles are cached with the native name of the source. 21 | } 22 | \details{ 23 | `query_string` takes the form of a templae, see examples 24 | } 25 | \examples{ 26 | mapbox_query_string <- paste0("https://api.mapbox.com/v4/mapbox.satellite/{zoom}/{x}/{y}.jpg90", 27 | "?access_token=", 28 | Sys.getenv("MAPBOX_API_KEY")) 29 | } 30 | -------------------------------------------------------------------------------- /docs/link.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 5 | 8 | 12 | 13 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: ceramic 2 | Title: Get imagery tiles 3 | Version: 0.0.1 4 | Authors@R: c( 5 | person("Michael", "Sumner", email = "mdsumner@gmail.com", role = c("aut", "cre"), 6 | comment = c(ORCID = "0000-0002-2471-7511")), 7 | person("Miles", "McBain", role = c("ctb"), 8 | comment = c(ORCID = "0000-0003-2865-2548")), 9 | person("Ben", "Raymond", role = c("ctb"), comment = "regex wizardry") 10 | ) 11 | Description: Download imagery tiles to a standard cache. Currently only 'Mapbox' is available. 12 | Depends: R (>= 3.5.0) 13 | License: GPL-3 14 | Encoding: UTF-8 15 | LazyData: true 16 | RoxygenNote: 6.1.0 17 | Imports: 18 | slippymath (>= 0.1.0), 19 | curl, 20 | dplyr, 21 | fs, 22 | glue, 23 | rappdirs, 24 | tibble, 25 | stats, 26 | purrr, 27 | magrittr, 28 | rlang, 29 | sp, 30 | graphics 31 | Remotes: MilesMcBain/slippymath 32 | Suggests: 33 | testthat 34 | URL: https://github.com/hypertidy/ceramic 35 | BugReports: https://github.com/hypertidy/ceramic/issues 36 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Code of Conduct 2 | 3 | As contributors and maintainers of this project, we pledge to respect all people who 4 | contribute through reporting issues, posting feature requests, updating documentation, 5 | submitting pull requests or patches, and other activities. 6 | 7 | We are committed to making participation in this project a harassment-free experience for 8 | everyone, regardless of level of experience, gender, gender identity and expression, 9 | sexual orientation, disability, personal appearance, body size, race, ethnicity, age, or religion. 10 | 11 | Examples of unacceptable behavior by participants include the use of sexual language or 12 | imagery, derogatory comments or personal attacks, trolling, public or private harassment, 13 | insults, or other unprofessional conduct. 14 | 15 | Project maintainers have the right and responsibility to remove, edit, or reject comments, 16 | commits, code, wiki edits, issues, and other contributions that are not aligned to this 17 | Code of Conduct. Project maintainers who do not follow the Code of Conduct may be removed 18 | from the project team. 19 | 20 | Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by 21 | opening an issue or contacting one or more of the project maintainers. 22 | 23 | This Code of Conduct is adapted from the Contributor Covenant 24 | (http://contributor-covenant.org), version 1.0.0, available at 25 | http://contributor-covenant.org/version/1/0/0/ 26 | -------------------------------------------------------------------------------- /man/cc_location.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/locale.R 3 | \name{cc_location} 4 | \alias{cc_location} 5 | \alias{cc_macquarie} 6 | \alias{cc_davis} 7 | \alias{cc_mawson} 8 | \alias{cc_casey} 9 | \alias{cc_heard} 10 | \alias{cc_kingston} 11 | \title{Miscellaneous places} 12 | \usage{ 13 | cc_location(loc = NULL, buffer = 5000, type = "mapbox.outdoors", ..., 14 | debug = FALSE) 15 | 16 | cc_macquarie(loc = c(158.93835, -54.49871), buffer = 5000, 17 | type = "mapbox.outdoors", ..., debug = FALSE) 18 | 19 | cc_davis(loc = c(77 + 58/60 + 3/3600, -(68 + 34/60 + 36/3600)), 20 | buffer = 5000, type = "mapbox.outdoors", ..., debug = FALSE) 21 | 22 | cc_mawson(loc = c(62 + 52/60 + 27/3600, -(67 + 36/60 + 12/3600)), 23 | buffer = 5000, type = "mapbox.outdoors", ..., debug = FALSE) 24 | 25 | cc_casey(loc = cbind(110 + 31/60 + 36/3600, -(66 + 16/60 + 57/3600)), 26 | buffer = 5000, type = "mapbox.outdoors", ..., debug = FALSE) 27 | 28 | cc_heard(loc = c(73 + 30/60 + 30/3600, -(53 + 0 + 0/3600)), 29 | buffer = 5000, type = "mapbox.outdoors", ..., debug = FALSE) 30 | 31 | cc_kingston(loc = c(-147.70837, -42.98682), buffer = 5000, 32 | type = "mapbox.outdoors", ..., debug = FALSE) 33 | } 34 | \arguments{ 35 | \item{buffer}{with in metres to extend around the location} 36 | 37 | \item{...}{dots, ignored currently} 38 | 39 | \item{debug}{optionally print out files that will be used} 40 | } 41 | \value{ 42 | RasterBrick, with RGB 43 | } 44 | \description{ 45 | Visit some nice locales with web tiles. 46 | } 47 | \details{ 48 | * `cc_macquarie` Macquarie Island 49 | } 50 | \examples{ 51 | im <- cc_macquarie() 52 | library(raster) 53 | plotRGB(im) 54 | } 55 | -------------------------------------------------------------------------------- /docs/docsearch.js: -------------------------------------------------------------------------------- 1 | $(function() { 2 | 3 | // register a handler to move the focus to the search bar 4 | // upon pressing shift + "/" (i.e. "?") 5 | $(document).on('keydown', function(e) { 6 | if (e.shiftKey && e.keyCode == 191) { 7 | e.preventDefault(); 8 | $("#search-input").focus(); 9 | } 10 | }); 11 | 12 | $(document).ready(function() { 13 | // do keyword highlighting 14 | /* modified from https://jsfiddle.net/julmot/bL6bb5oo/ */ 15 | var mark = function() { 16 | 17 | var referrer = document.URL ; 18 | var paramKey = "q" ; 19 | 20 | if (referrer.indexOf("?") !== -1) { 21 | var qs = referrer.substr(referrer.indexOf('?') + 1); 22 | var qs_noanchor = qs.split('#')[0]; 23 | var qsa = qs_noanchor.split('&'); 24 | var keyword = ""; 25 | 26 | for (var i = 0; i < qsa.length; i++) { 27 | var currentParam = qsa[i].split('='); 28 | 29 | if (currentParam.length !== 2) { 30 | continue; 31 | } 32 | 33 | if (currentParam[0] == paramKey) { 34 | keyword = decodeURIComponent(currentParam[1].replace(/\+/g, "%20")); 35 | } 36 | } 37 | 38 | if (keyword !== "") { 39 | $(".contents").unmark({ 40 | done: function() { 41 | $(".contents").mark(keyword); 42 | } 43 | }); 44 | } 45 | } 46 | }; 47 | 48 | mark(); 49 | }); 50 | }); 51 | 52 | /* Search term highlighting ------------------------------*/ 53 | 54 | function matchedWords(hit) { 55 | var words = []; 56 | 57 | var hierarchy = hit._highlightResult.hierarchy; 58 | // loop to fetch from lvl0, lvl1, etc. 59 | for (var idx in hierarchy) { 60 | words = words.concat(hierarchy[idx].matchedWords); 61 | } 62 | 63 | var content = hit._highlightResult.content; 64 | if (content) { 65 | words = words.concat(content.matchedWords); 66 | } 67 | 68 | // return unique words 69 | var words_uniq = [...new Set(words)]; 70 | return words_uniq; 71 | } 72 | 73 | function updateHitURL(hit) { 74 | 75 | var words = matchedWords(hit); 76 | var url = ""; 77 | 78 | if (hit.anchor) { 79 | url = hit.url_without_anchor + '?q=' + escape(words.join(" ")) + '#' + hit.anchor; 80 | } else { 81 | url = hit.url + '?q=' + escape(words.join(" ")); 82 | } 83 | 84 | return url; 85 | } 86 | -------------------------------------------------------------------------------- /R/georeference.R: -------------------------------------------------------------------------------- 1 | #' @importFrom tibble tibble 2 | #' @importFrom dplyr filter 3 | spherical_mercator <- function(provider) { 4 | #MAXEXTENT is the bounds between [-180, 180] and [-85.0511, 85.0511] 5 | tibble::tibble(provider = "mapbox", 6 | MAXEXTENT = 20037508.342789244, 7 | A = 6378137.0, B = 6378137.0, 8 | crs = glue::glue("+proj=merc +a={A} +b={A}")) %>% 9 | dplyr::filter(provider == provider) 10 | } 11 | #' Tile extent 12 | #' 13 | #' Calculate tile extent for a given x, y tile at a zoom level. 14 | #' 15 | #' Currently only Mapbox spherical Mercator is supported. 16 | #' 17 | #' @param tile_x x coordinate of tile 18 | #' 19 | #' @param tile_y y coordinate of tile 20 | #' @param zoom zoo level 21 | #' @param tile_size tile dimensions (assumed square atm, 256*256) 22 | #' 23 | #' @importFrom stats setNames 24 | #' @export 25 | mercator_tile_extent <- function(tile_x, tile_y, zoom, tile_size = 256) { 26 | if (any(!c(length(tile_x), length(tile_y), length(zoom), length(tile_size)) == 1)) { 27 | stop("tile_x, tile_y, zoom, tile_size must all be of length 1") 28 | } 29 | params <- spherical_mercator(provider = "mapbox") 30 | params <- params[1, ] ## FIXME: param query should provide a unique set, this is WIP 31 | #st_transform(st_as_sfc(my_bbox), glue("+proj=merc +a={A} +b={A}")) 32 | MAXEXTENT <- params$MAXEXTENT 33 | A <- params$A 34 | ## literal width/height of a square tile at zoom = 0 35 | z0_size <- (MAXEXTENT * 2) 36 | xlim <- -MAXEXTENT + (tile_x + c(0, 1)) * (z0_size/(2^zoom)) 37 | ## upside down Ms. Jane 38 | ylim <- range(MAXEXTENT - (tile_y + c(0, 1) - 0) * (z0_size/(2^zoom))) 39 | stats::setNames(c(xlim, ylim), c("xmin", "xmax", "ymin", "ymax")) 40 | } 41 | 42 | add_extent <- function(x) { 43 | ## assert tibble with tile_x, tile_y, zoom 44 | l <- purrr::map(purrr::transpose(x), ~mercator_tile_extent(.x$tile_x, .x$tile_y, .x$zoom)) 45 | x[c("xmin", "xmax", "ymin", "ymax")] <- tibble::as_tibble(do.call(rbind, l)) 46 | x 47 | } 48 | 49 | #' @importFrom sp plot 50 | #' @importFrom graphics rect text 51 | plot_tiles <- function(x, ..., add = FALSE, label = TRUE, cex = 0.6, add_coast = TRUE, include_zoom = TRUE) { 52 | if (!all(c("xmin", "xmax", "ymin", "ymax") %in% names(x))) stop("need xmin, xmax, ymin, ymax columns") 53 | if (include_zoom && !"zoom" %in% names(x) ) stop("need zoom columns for 'include_zoom = TRUE'") 54 | if (!add) plot(range(c(x$xmin, x$xmax)), range(c(x$ymin, x$ymax)), type = "n", xlab = "x", ylab = "y") 55 | graphics::rect(x$xmin, x$ymin, x$xmax, x$ymax, ...) 56 | if (label) { 57 | if (include_zoom) { 58 | tile_lab <- sprintf("%i [%i,%i]", x$zoom, x$tile_x, x$tile_y) 59 | } else { 60 | tile_lab <- sprintf("[%i,%i]", x$tile_x, x$tile_y) 61 | } 62 | graphics::text((x$xmin + x$xmax) / 2, 63 | (x$ymin + x$ymax) / 2, label = tile_lab, cex = cex) 64 | } 65 | if (add_coast) sp::plot(merc_world, border = "darkgrey", add = TRUE) 66 | } 67 | 68 | tiles_to_polygon <- function(x) { 69 | spex::polygonize(tiles_to_raster(x)) 70 | } 71 | tiles_to_raster <- function(x) { 72 | ex <- raster::extent(min(x$xmin), max(x$xmax), min(x$ymin), max(x$ymax)) 73 | pts <- x[c("tile_x", "tile_y")] %>% dplyr::transmute(x = tile_x - min(tile_x), y = max(tile_y) - tile_y) %>% dplyr::distinct() 74 | r <- raster::setExtent(raster::rasterFromXYZ(pts), ex) 75 | cells <- raster::cellFromRowCol(r, pts$y + 1, pts$x + 1) 76 | r[cells] <- cells 77 | r 78 | } 79 | -------------------------------------------------------------------------------- /docs/pkgdown.js: -------------------------------------------------------------------------------- 1 | /* http://gregfranko.com/blog/jquery-best-practices/ */ 2 | (function($) { 3 | $(function() { 4 | 5 | $("#sidebar") 6 | .stick_in_parent({offset_top: 40}) 7 | .on('sticky_kit:bottom', function(e) { 8 | $(this).parent().css('position', 'static'); 9 | }) 10 | .on('sticky_kit:unbottom', function(e) { 11 | $(this).parent().css('position', 'relative'); 12 | }); 13 | 14 | $('body').scrollspy({ 15 | target: '#sidebar', 16 | offset: 60 17 | }); 18 | 19 | $('[data-toggle="tooltip"]').tooltip(); 20 | 21 | var cur_path = paths(location.pathname); 22 | var links = $("#navbar ul li a"); 23 | var max_length = -1; 24 | var pos = -1; 25 | for (var i = 0; i < links.length; i++) { 26 | if (links[i].getAttribute("href") === "#") 27 | continue; 28 | var path = paths(links[i].pathname); 29 | 30 | var length = prefix_length(cur_path, path); 31 | if (length > max_length) { 32 | max_length = length; 33 | pos = i; 34 | } 35 | } 36 | 37 | // Add class to parent
  • , and enclosing
  • if in dropdown 38 | if (pos >= 0) { 39 | var menu_anchor = $(links[pos]); 40 | menu_anchor.parent().addClass("active"); 41 | menu_anchor.closest("li.dropdown").addClass("active"); 42 | } 43 | }); 44 | 45 | function paths(pathname) { 46 | var pieces = pathname.split("/"); 47 | pieces.shift(); // always starts with / 48 | 49 | var end = pieces[pieces.length - 1]; 50 | if (end === "index.html" || end === "") 51 | pieces.pop(); 52 | return(pieces); 53 | } 54 | 55 | function prefix_length(needle, haystack) { 56 | if (needle.length > haystack.length) 57 | return(0); 58 | 59 | // Special case for length-0 haystack, since for loop won't run 60 | if (haystack.length === 0) { 61 | return(needle.length === 0 ? 1 : 0); 62 | } 63 | 64 | for (var i = 0; i < haystack.length; i++) { 65 | if (needle[i] != haystack[i]) 66 | return(i); 67 | } 68 | 69 | return(haystack.length); 70 | } 71 | 72 | /* Clipboard --------------------------*/ 73 | 74 | function changeTooltipMessage(element, msg) { 75 | var tooltipOriginalTitle=element.getAttribute('data-original-title'); 76 | element.setAttribute('data-original-title', msg); 77 | $(element).tooltip('show'); 78 | element.setAttribute('data-original-title', tooltipOriginalTitle); 79 | } 80 | 81 | if(Clipboard.isSupported()) { 82 | $(document).ready(function() { 83 | var copyButton = ""; 84 | 85 | $(".examples, div.sourceCode").addClass("hasCopyButton"); 86 | 87 | // Insert copy buttons: 88 | $(copyButton).prependTo(".hasCopyButton"); 89 | 90 | // Initialize tooltips: 91 | $('.btn-copy-ex').tooltip({container: 'body'}); 92 | 93 | // Initialize clipboard: 94 | var clipboardBtnCopies = new Clipboard('[data-clipboard-copy]', { 95 | text: function(trigger) { 96 | return trigger.parentNode.textContent; 97 | } 98 | }); 99 | 100 | clipboardBtnCopies.on('success', function(e) { 101 | changeTooltipMessage(e.trigger, 'Copied!'); 102 | e.clearSelection(); 103 | }); 104 | 105 | clipboardBtnCopies.on('error', function() { 106 | changeTooltipMessage(e.trigger,'Press Ctrl+C or Command+C to copy'); 107 | }); 108 | }); 109 | } 110 | })(window.jQuery || window.$) 111 | -------------------------------------------------------------------------------- /R/cache.R: -------------------------------------------------------------------------------- 1 | #' Downloader for tiles 2 | #' 3 | #' Tiles are cached with the native name of the source. 4 | #' 5 | #' `query_string` takes the form of a templae, see examples 6 | #' @param x tiles object 7 | #' @param query_string an api query template (see Details) 8 | #' @param clobber if `TRUE` re download any existing tiles 9 | #' @return WIP 10 | #' @export 11 | #' 12 | #' @examples 13 | #' mapbox_query_string <- paste0("https://api.mapbox.com/v4/mapbox.satellite/{zoom}/{x}/{y}.jpg90", 14 | #' "?access_token=", 15 | #' Sys.getenv("MAPBOX_API_KEY")) 16 | #' @importFrom curl curl_download 17 | #' @importFrom fs dir_exists dir_create 18 | #' @importFrom glue glue 19 | #' @importFrom rappdirs user_cache_dir 20 | #' @importFrom purrr pmap 21 | down_loader <- function(x, query_string, clobber = FALSE, ..., debug = FALSE) { 22 | purrr::pmap(x$tiles, 23 | function(x, y, zoom){ 24 | api_query <- glue::glue(query_string) 25 | outfile <- url_to_cache(api_query) 26 | if (debug) { 27 | print(outfile) 28 | } 29 | 30 | if (!file.exists(outfile) || clobber) { 31 | cachedir <- fs::path_dir(outfile) 32 | 33 | if (!fs::dir_exists(cachedir)) fs::dir_create(cachedir, recursive = TRUE) 34 | ## FIXME: need to error on no API_KEY present 35 | curl::curl_download(url = api_query, 36 | destfile = outfile) 37 | } 38 | outfile 39 | }, 40 | zoom = x$zoom) 41 | } 42 | 43 | #' Tile files 44 | #' 45 | #' Find existing files in the cache. Various options can be controlled, this is WIP 46 | #' and due to change pending generalization across providers. 47 | #' 48 | #' @param zoom zoom level 49 | #' 50 | #' @param type imagery type 51 | #' @param source imagery source 52 | #' @param glob see `fs::dir_ls` 53 | #' @param regexp see `fs::dir_ls` 54 | #' 55 | #' @export 56 | #' @importFrom rlang .data 57 | ceramic_tiles <- function(zoom = NULL, type = "mapbox.satellite", 58 | source = "api.mapbox.com", glob = "*.jpg*", regexp = NULL) { 59 | 60 | ## FIXME: assert that zoom, type, source, all are length 1 61 | bfiles <- 62 | fs::dir_ls(slippy_cache(), recursive = TRUE, type = "file", 63 | glob = glob, regexp = regexp) 64 | strex <- function(x, y) regmatches(x, regexec(y, x)) 65 | toks <- do.call(rbind, strex(bfiles, "([[:digit:]]+)/([[:digit:]]+)/([[:digit:]]+)\\.[^\\.]+$")) 66 | #print(dim(toks)) 67 | files <- tibble::tibble(tile_x = as.integer(toks[,3]), tile_y = as.integer(toks[,4]), 68 | zoom = as.integer(toks[, 2]), 69 | type = tile_type(bfiles), 70 | version = tile_version(bfiles), 71 | source = tile_source(bfiles), fullname = bfiles) 72 | 73 | ## filter type first, then zoom 74 | atype <- type 75 | if (!is.null(type)) files <- dplyr::filter(files, .data$type %in% atype) 76 | if (nrow(files) < 1) stop(sprintf("no tiles at 'type = %s'", atype)) 77 | 78 | if (is.null(zoom)) { 79 | zoom <- min(files$zoom) 80 | message(sprintf("no zoom selected, choosing 'zoom = %i'", zoom)) 81 | } 82 | 83 | azoom <- zoom 84 | 85 | if (!is.null(zoom)) files <- dplyr::filter(files, .data$zoom %in% azoom) 86 | if (nrow(files) < 1) stop(sprintf("no tiles at 'zoom = %i'", azoom)) 87 | #browser() 88 | 89 | add_extent(files ) 90 | } 91 | 92 | tile_source <- function(x) { 93 | basename(dirname(dirname(dirname(dirname(dirname(x)))))) 94 | 95 | } 96 | tile_version <- function(x) { 97 | basename(dirname(dirname(dirname(dirname(x))))) 98 | } 99 | tile_type <- function(x) { 100 | basename(dirname(dirname(dirname(x)))) 101 | } 102 | 103 | tile_x <- function(x) { 104 | as.integer(basename(dirname(x))) 105 | } 106 | tile_y <- function(x) { 107 | #xbase <- basename(x) 108 | stop("not implemented") 109 | } 110 | tile_zoom <- function(x) { 111 | as.integer(basename(dirname(dirname(x)))) 112 | } 113 | 114 | slippy_cache <- function() { 115 | cache <- file.path(rappdirs::user_cache_dir(), ".ceramic") 116 | if (!fs::dir_exists(cache)) fs::dir_create(cache) 117 | cache 118 | } 119 | 120 | url_to_cache <- function(x) { 121 | base_filepath <- file.path(slippy_cache(), gsub("^//", "", gsub("^https\\:", "", gsub("^https\\:", "", x)))) 122 | ## chuck off any ? junk 123 | unlist(lapply(strsplit(base_filepath, "\\?"), "[", 1L)) 124 | } 125 | -------------------------------------------------------------------------------- /docs/authors.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Authors • ceramic 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 44 | 45 | 46 | 47 | 48 | 49 |
    50 |
    51 | 90 | 91 | 92 |
    93 | 94 |
    95 |
    96 |
    97 |

    Authors

    98 |
    99 | 100 |
      101 |
    • 102 |

      Michael Sumner. Author, maintainer. 103 |

      104 |
      • 105 |
    • 106 |

      Miles McBain. Contributor. 107 |

      108 |
      • 109 |
    • 110 |

      Ben Raymond. Contributor. 111 |
      regex wizardry

      112 |
      • 113 |
    114 | 115 |
    116 | 117 |
    118 | 119 | 120 |
    121 |
    122 |

    Developed by Michael Sumner.

    123 |
    124 | 125 |
    126 |

    Site built with pkgdown.

    127 |
    128 | 129 |
    130 |
    131 | 132 | 133 | 134 | 135 | 136 | 137 | -------------------------------------------------------------------------------- /docs/reference/pipe.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Pipe operator — %>% • ceramic 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 47 | 48 | 49 | 50 | 51 | 52 |
    53 |
    54 | 93 | 94 | 95 |
    96 | 97 |
    98 |
    99 |
    100 |

    Pipe operator

    101 | Source: R/utils-pipe.R 102 | 103 |
    104 | 105 |
    106 | 107 |

    See magrittr::%>% for details.

    108 | 109 |
    110 | 111 | 
    lhs %>% rhs
    112 | 113 | 114 |
    115 | 121 |
    122 | 123 |
    124 |
    125 |

    Developed by Michael Sumner.

    126 |
    127 | 128 |
    129 |

    Site built with pkgdown.

    130 |
    131 | 132 |
    133 |
    134 | 135 | 136 | 137 | 138 | 139 | 140 | -------------------------------------------------------------------------------- /R/locale.R: -------------------------------------------------------------------------------- 1 | fast_merge <- function(x) { 2 | ## about 3 times faster than reduce(, merge) 3 | out <- raster::raster(purrr::reduce(purrr::map(x, raster::extent), raster::union), crs = raster::projection(x[[1]])) 4 | raster::res(out) <- raster::res(x[[1]]) 5 | cells <- unlist(purrr::map(x, ~raster::cellsFromExtent(out, .x))) 6 | vals <- do.call(rbind, purrr::map(x, ~raster::values(raster::readAll(.x)))) 7 | raster::setValues(raster::brick(out, out, out), vals[order(cells), ]) 8 | } 9 | 10 | 11 | #' Miscellaneous places 12 | #' 13 | #' Visit some nice locales with web tiles. 14 | #' 15 | #' * `cc_macquarie` Macquarie Island 16 | #' 17 | #' @param buffer with in metres to extend around the location 18 | #' @param ... dots, ignored currently 19 | #' @param debug optionally print out files that will be used 20 | #' 21 | #' @return RasterBrick, with RGB 22 | #' @export 23 | #' @name cc_location 24 | #' @examples 25 | #' im <- cc_macquarie() 26 | #' library(raster) 27 | #' plotRGB(im) 28 | cc_location <- function(loc = NULL, buffer = 5000, 29 | type = "mapbox.outdoors", ..., debug = FALSE) { 30 | get_loc(loc = loc, buffer = buffer, type = type, ..., debug = debug) 31 | } 32 | #' @name cc_location 33 | #' @export 34 | cc_macquarie <- function(loc = c(158.93835,-54.49871), buffer = 5000, 35 | type = "mapbox.outdoors", ..., debug = FALSE) { 36 | cc_location(loc, buffer, type = type, ..., debug = debug) 37 | } 38 | 39 | #' @name cc_location 40 | #' @export 41 | cc_davis <- function(loc = c(77 + 58/60 + 3/3600, 42 | -(68 + 34/60 + 36/3600)), 43 | buffer = 5000, type = "mapbox.outdoors", ..., debug = FALSE) { 44 | # 68°34′36″S 77°58′03″E 45 | cc_location(loc, buffer, type = type, ..., debug = debug) 46 | 47 | } 48 | #' @name cc_location 49 | #' @export 50 | cc_mawson <- function(loc = c(62 + 52/60 + 27/3600, 51 | -(67 + 36/60 + 12/3600)), buffer = 5000, type = "mapbox.outdoors", ..., debug = FALSE) { 52 | # 67°36′12″S 62°52′27″E 53 | 54 | cc_location(loc, buffer, type = type, ..., debug = debug) 55 | 56 | } 57 | 58 | #' @name cc_location 59 | #' @export 60 | cc_casey <- function( loc = cbind(110 + 31/60 + 36/3600, 61 | -(66 + 16/60 + 57/3600)), buffer = 5000, type = "mapbox.outdoors", ..., debug = FALSE) { 62 | #66°16′57″S 110°31′36″E 63 | 64 | cc_location(loc, buffer, type = type, ..., debug = debug) 65 | 66 | } 67 | #' @name cc_location 68 | #' @export 69 | cc_heard <- function(loc = c(73 + 30/60 + 30/3600, 70 | -(53 + 0 + 0/3600)), buffer = 5000, type = "mapbox.outdoors",..., debug = FALSE) { 71 | # 53°S 73°30’E. 72 | 73 | cc_location(loc, buffer, type = type, ..., debug = debug) 74 | 75 | } 76 | #' @name cc_location 77 | #' @export 78 | cc_kingston <- function(loc = c(-147.70837, 79 | -42.98682), buffer = 5000, type = "mapbox.outdoors", ..., debug = FALSE) { 80 | cc_location(loc, buffer, type = type, ..., debug = debug) 81 | 82 | } 83 | get_loc <- function(loc, buffer, type = "mapbox.outdoors", ..., debug = debug, max_tiles = 4L) { 84 | if (length(buffer) == 1) buffer <- rep(buffer, 2) 85 | if (length(loc) > 2) { 86 | warning("'loc' should be a length-2 vector 'c(lon, lat)' or matrix 'cbind(lon, lat)'") 87 | } 88 | if (is.null(dim(loc))) { 89 | loc <- matrix(loc[1:2], ncol = 2L) 90 | } 91 | 92 | ## convert loc to mercator meters 93 | loc <- slippymath::lonlat_to_merc(loc) 94 | 95 | xp <- buffer[1] / 2 96 | yp <- buffer[2] / 2 97 | 98 | ## xmin, ymin 99 | ## xmax, ymax 100 | bb_points <- matrix(c(loc[1,1] - xp, loc[1,2] - yp, loc[1,1] + xp, loc[1,2] + yp), 2, 2, byrow = TRUE) 101 | 102 | if (!slippymath::within_merc_extent(bb_points)){ 103 | warning("The combination of buffer and location extends beyond the tile grid extent. The buffer will be truncated.") 104 | bb_points <- slippymath::merc_truncate(bb_points) 105 | } 106 | 107 | ## convert bb_points back to lonlat 108 | bb_points_lonlat <- slippymath::merc_to_lonlat(bb_points) 109 | 110 | my_bbox <- c(xmin = bb_points_lonlat[1,1], ymin = bb_points_lonlat[1,2], 111 | xmax = bb_points_lonlat[2,1], ymax = bb_points_lonlat[2,2]) 112 | 113 | tile_grid <- slippymath:::bb_to_tg(my_bbox, max_tiles = max_tiles) 114 | zoom <- tile_grid$zoom 115 | 116 | slippymath::bb_tile_query(my_bbox) 117 | 118 | mapbox_query_string <- 119 | paste0(sprintf("https://api.mapbox.com/v4/%s/{zoom}/{x}/{y}.jpg90", type), 120 | "?access_token=", 121 | Sys.getenv("MAPBOX_API_KEY")) 122 | 123 | files <- down_loader(tile_grid, mapbox_query_string, debug = debug) 124 | br <- lapply(files, raster::brick) 125 | 126 | for (i in seq_along(br)) { 127 | br[[i]] <- raster::setExtent(br[[i]], 128 | mercator_tile_extent(tile_grid$tiles$x[i], tile_grid$tiles$y[i], zoom = zoom)) 129 | } 130 | 131 | out <- fast_merge(br) 132 | projection(out) <- "+proj=merc +a=6378137 +b=6378137" 133 | crop(out, extent(bb_points)) 134 | } 135 | -------------------------------------------------------------------------------- /docs/pkgdown.css: -------------------------------------------------------------------------------- 1 | /* Sticky footer */ 2 | 3 | /** 4 | * Basic idea: https://philipwalton.github.io/solved-by-flexbox/demos/sticky-footer/ 5 | * Details: https://github.com/philipwalton/solved-by-flexbox/blob/master/assets/css/components/site.css 6 | * 7 | * .Site -> body > .container 8 | * .Site-content -> body > .container .row 9 | * .footer -> footer 10 | * 11 | * Key idea seems to be to ensure that .container and __all its parents__ 12 | * have height set to 100% 13 | * 14 | */ 15 | 16 | html, body { 17 | height: 100%; 18 | } 19 | 20 | body > .container { 21 | display: flex; 22 | height: 100%; 23 | flex-direction: column; 24 | 25 | padding-top: 60px; 26 | } 27 | 28 | body > .container .row { 29 | flex: 1 0 auto; 30 | } 31 | 32 | footer { 33 | margin-top: 45px; 34 | padding: 35px 0 36px; 35 | border-top: 1px solid #e5e5e5; 36 | color: #666; 37 | display: flex; 38 | flex-shrink: 0; 39 | } 40 | footer p { 41 | margin-bottom: 0; 42 | } 43 | footer div { 44 | flex: 1; 45 | } 46 | footer .pkgdown { 47 | text-align: right; 48 | } 49 | footer p { 50 | margin-bottom: 0; 51 | } 52 | 53 | img.icon { 54 | float: right; 55 | } 56 | 57 | img { 58 | max-width: 100%; 59 | } 60 | 61 | /* Typographic tweaking ---------------------------------*/ 62 | 63 | .contents h1.page-header { 64 | margin-top: calc(-60px + 1em); 65 | } 66 | 67 | /* Section anchors ---------------------------------*/ 68 | 69 | a.anchor { 70 | margin-left: -30px; 71 | display:inline-block; 72 | width: 30px; 73 | height: 30px; 74 | visibility: hidden; 75 | 76 | background-image: url(./link.svg); 77 | background-repeat: no-repeat; 78 | background-size: 20px 20px; 79 | background-position: center center; 80 | } 81 | 82 | .hasAnchor:hover a.anchor { 83 | visibility: visible; 84 | } 85 | 86 | @media (max-width: 767px) { 87 | .hasAnchor:hover a.anchor { 88 | visibility: hidden; 89 | } 90 | } 91 | 92 | 93 | /* Fixes for fixed navbar --------------------------*/ 94 | 95 | .contents h1, .contents h2, .contents h3, .contents h4 { 96 | padding-top: 60px; 97 | margin-top: -40px; 98 | } 99 | 100 | /* Static header placement on mobile devices */ 101 | @media (max-width: 767px) { 102 | .navbar-fixed-top { 103 | position: absolute; 104 | } 105 | .navbar { 106 | padding: 0; 107 | } 108 | } 109 | 110 | 111 | /* Sidebar --------------------------*/ 112 | 113 | #sidebar { 114 | margin-top: 30px; 115 | } 116 | #sidebar h2 { 117 | font-size: 1.5em; 118 | margin-top: 1em; 119 | } 120 | 121 | #sidebar h2:first-child { 122 | margin-top: 0; 123 | } 124 | 125 | #sidebar .list-unstyled li { 126 | margin-bottom: 0.5em; 127 | } 128 | 129 | .orcid { 130 | height: 16px; 131 | vertical-align: middle; 132 | } 133 | 134 | /* Reference index & topics ----------------------------------------------- */ 135 | 136 | .ref-index th {font-weight: normal;} 137 | 138 | .ref-index td {vertical-align: top;} 139 | .ref-index .alias {width: 40%;} 140 | .ref-index .title {width: 60%;} 141 | 142 | .ref-index .alias {width: 40%;} 143 | .ref-index .title {width: 60%;} 144 | 145 | .ref-arguments th {text-align: right; padding-right: 10px;} 146 | .ref-arguments th, .ref-arguments td {vertical-align: top;} 147 | .ref-arguments .name {width: 20%;} 148 | .ref-arguments .desc {width: 80%;} 149 | 150 | /* Nice scrolling for wide elements --------------------------------------- */ 151 | 152 | table { 153 | display: block; 154 | overflow: auto; 155 | } 156 | 157 | /* Syntax highlighting ---------------------------------------------------- */ 158 | 159 | pre { 160 | word-wrap: normal; 161 | word-break: normal; 162 | border: 1px solid #eee; 163 | } 164 | 165 | pre, code { 166 | background-color: #f8f8f8; 167 | color: #333; 168 | } 169 | 170 | pre code { 171 | overflow: auto; 172 | word-wrap: normal; 173 | white-space: pre; 174 | } 175 | 176 | pre .img { 177 | margin: 5px 0; 178 | } 179 | 180 | pre .img img { 181 | background-color: #fff; 182 | display: block; 183 | height: auto; 184 | } 185 | 186 | code a, pre a { 187 | color: #375f84; 188 | } 189 | 190 | a.sourceLine:hover { 191 | text-decoration: none; 192 | } 193 | 194 | .fl {color: #1514b5;} 195 | .fu {color: #000000;} /* function */ 196 | .ch,.st {color: #036a07;} /* string */ 197 | .kw {color: #264D66;} /* keyword */ 198 | .co {color: #888888;} /* comment */ 199 | 200 | .message { color: black; font-weight: bolder;} 201 | .error { color: orange; font-weight: bolder;} 202 | .warning { color: #6A0366; font-weight: bolder;} 203 | 204 | /* Clipboard --------------------------*/ 205 | 206 | .hasCopyButton { 207 | position: relative; 208 | } 209 | 210 | .btn-copy-ex { 211 | position: absolute; 212 | right: 0; 213 | top: 0; 214 | visibility: hidden; 215 | } 216 | 217 | .hasCopyButton:hover button.btn-copy-ex { 218 | visibility: visible; 219 | } 220 | 221 | /* mark.js ----------------------------*/ 222 | 223 | mark { 224 | background-color: rgba(255, 255, 51, 0.5); 225 | border-bottom: 2px solid rgba(255, 153, 51, 0.3); 226 | padding: 1px; 227 | } 228 | 229 | /* vertical spacing after htmlwidgets */ 230 | .html-widget { 231 | margin-bottom: 10px; 232 | } 233 | -------------------------------------------------------------------------------- /docs/reference/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Function reference • ceramic 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 44 | 45 | 46 | 47 | 48 | 49 |
    50 |
    51 | 90 | 91 | 92 |
    93 | 94 |
    95 |
    96 |
    97 |

    Reference

    98 |
    99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 114 | 115 | 116 | 117 | 120 | 121 | 122 | 123 | 126 | 127 | 128 | 129 | 132 | 133 | 134 | 135 |
    111 |

    All functions

    112 |

    113 |
    118 |

    ceramic_tiles()

    119 |

    Tile files

    124 |

    down_loader()

    125 |

    Downloader for tiles

    130 |

    mercator_tile_extent()

    131 |

    Tile extent

    136 |
    137 | 138 | 144 |
    145 | 146 |
    147 |
    148 |

    Developed by Michael Sumner.

    149 |
    150 | 151 |
    152 |

    Site built with pkgdown.

    153 |
    154 | 155 |
    156 |
    157 | 158 | 159 | 160 | 161 | 162 | 163 | -------------------------------------------------------------------------------- /docs/CODE_OF_CONDUCT.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Contributor Code of Conduct • ceramic 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 44 | 45 | 46 | 47 | 48 | 49 |
    50 |
    51 | 90 | 91 | 92 |
    93 | 94 |
    95 |
    96 |
    97 |

    Contributor Code of Conduct

    98 |
    99 | 100 |
    101 | 102 |

    As contributors and maintainers of this project, we pledge to respect all people who contribute through reporting issues, posting feature requests, updating documentation, submitting pull requests or patches, and other activities.

    103 |

    We are committed to making participation in this project a harassment-free experience for everyone, regardless of level of experience, gender, gender identity and expression, sexual orientation, disability, personal appearance, body size, race, ethnicity, age, or religion.

    104 |

    Examples of unacceptable behavior by participants include the use of sexual language or imagery, derogatory comments or personal attacks, trolling, public or private harassment, insults, or other unprofessional conduct.

    105 |

    Project maintainers have the right and responsibility to remove, edit, or reject comments, commits, code, wiki edits, issues, and other contributions that are not aligned to this Code of Conduct. Project maintainers who do not follow the Code of Conduct may be removed from the project team.

    106 |

    Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by opening an issue or contacting one or more of the project maintainers.

    107 |

    This Code of Conduct is adapted from the Contributor Covenant (http://contributor-covenant.org), version 1.0.0, available at http://contributor-covenant.org/version/1/0/0/

    108 |
    109 | 110 |
    111 | 112 |
    113 | 114 | 115 |
    116 |
    117 |

    Developed by Michael Sumner.

    118 |
    119 | 120 |
    121 |

    Site built with pkgdown.

    122 |
    123 | 124 |
    125 |
    126 | 127 | 128 | 129 | 130 | 131 | 132 | -------------------------------------------------------------------------------- /docs/reference/mercator_tile_extent.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Tile extent — mercator_tile_extent • ceramic 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 47 | 48 | 49 | 50 | 51 | 52 |
    53 |
    54 | 93 | 94 | 95 |
    96 | 97 |
    98 |
    99 |
    100 |

    Tile extent

    101 | Source: R/georeference.R 102 | 103 |
    104 | 105 |
    106 | 107 |

    Calculate tile extent for a given x, y tile at a zoom level.

    108 | 109 |
    110 | 111 | 
    mercator_tile_extent(tile_x, tile_y, zoom, tile_size = 256)
    112 | 113 |

    Arguments

    114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 |
    tile_x

    x coordinate of tile

    tile_y

    y coordinate of tile

    zoom

    zoo level

    tile_size

    tile dimensions (assumed square atm, 256*256)

    133 | 134 |

    Details

    135 | 136 |

    Currently only Mapbox spherical Mercator is supported.

    137 | 138 | 139 |
    140 | 149 |
    150 | 151 |
    152 |
    153 |

    Developed by Michael Sumner.

    154 |
    155 | 156 |
    157 |

    Site built with pkgdown.

    158 |
    159 | 160 |
    161 |
    162 | 163 | 164 | 165 | 166 | 167 | 168 | -------------------------------------------------------------------------------- /docs/reference/ceramic_tiles.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Tile files — ceramic_tiles • ceramic 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 48 | 49 | 50 | 51 | 52 | 53 |
    54 |
    55 | 94 | 95 | 96 |
    97 | 98 |
    99 |
    100 |
    101 |

    Tile files

    102 | Source: R/cache.R 103 | 104 |
    105 | 106 |
    107 | 108 |

    Find existing files in the cache. Various options can be controlled, this is WIP 109 | and due to change pending generalization across providers.

    110 | 111 |
    112 | 113 | 
    ceramic_tiles(zoom = NULL, type = "mapbox.satellite",
114 |   source = "api.mapbox.com", glob = "*.jpg*", regexp = NULL)
    115 | 116 |

    Arguments

    117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 |
    zoom

    zoom level

    type

    imagery type

    source

    imagery source

    glob

    see `fs::dir_ls`

    regexp

    see `fs::dir_ls`

    140 | 141 | 142 |
    143 | 150 |
    151 | 152 |
    153 |
    154 |

    Developed by Michael Sumner.

    155 |
    156 | 157 |
    158 |

    Site built with pkgdown.

    159 |
    160 | 161 |
    162 |
    163 | 164 | 165 | 166 | 167 | 168 | 169 | -------------------------------------------------------------------------------- /docs/reference/down_loader.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | Downloader for tiles — down_loader • ceramic 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 47 | 48 | 49 | 50 | 51 | 52 |
    53 |
    54 | 93 | 94 | 95 |
    96 | 97 |
    98 |
    99 |
    100 |

    Downloader for tiles

    101 | Source: R/cache.R 102 | 103 |
    104 | 105 |
    106 | 107 |

    Tiles are cached with the native name of the source.

    108 | 109 |
    110 | 111 | 
    down_loader(x, query_string, clobber = FALSE)
    112 | 113 |

    Arguments

    114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 |
    x

    tiles object

    query_string

    an api query template (see Details)

    clobber

    if `TRUE` re download any existing tiles

    129 | 130 |

    Value

    131 | 132 |

    WIP

    133 | 134 |

    Details

    135 | 136 |

    `query_string` takes the form of a templae, see examples

    137 | 138 | 139 |

    Examples

    140 | 
    mapbox_query_string <- paste0("https://api.mapbox.com/v4/mapbox.satellite/{zoom}/{x}/{y}.jpg90",
141 | "?access_token=",
142 | Sys.getenv("MAPBOX_API_KEY"))
    143 |
    144 | 157 |
    158 | 159 |
    160 |
    161 |

    Developed by Michael Sumner.

    162 |
    163 | 164 |
    165 |

    Site built with pkgdown.

    166 |
    167 | 168 |
    169 |
    170 | 171 | 172 | 173 | 174 | 175 | 176 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | editor_options: 4 | chunk_output_type: console 5 | --- 6 | 7 | 8 | 9 | ```{r setup, include = FALSE} 10 | knitr::opts_chunk$set( 11 | collapse = TRUE, 12 | comment = "#>", 13 | fig.path = "man/figures/README-", 14 | out.width = "100%" 15 | ) 16 | ``` 17 | # ceramic 18 | 19 | The goal of ceramic is to obtain web map tiles for later re-use. Many tools for imagery services treat the imagery as transient, but here we take control over the raw data itself. 20 | 21 | 22 | # Goals 23 | 24 | Very much WIP. 25 | 26 | * control download of raw tiles (we have this!) 27 | * allow lazy read access to tile caches 28 | * generalize across providers 29 | * provide interactive means to build access to imagery 30 | 31 | 32 | ## Installation 33 | 34 | You can install the dev version of ceramic from Github. 35 | 36 | ```R 37 | devtools::install_github("hypertidy/ceramic") 38 | ``` 39 | 40 | 41 | ## Example 42 | 43 | This complete example gets tiled imagery that we can use as real data. 44 | 45 | The code here 46 | 47 | * generates a bounding box in longitud-latitude 48 | * uses [slippymath](https://github.com/MilesMcBain/slippymath/) to find sensible tiles for the region 49 | * downloads them to a local cache 50 | * georeferences them and merges the tiles into a sensible raster object 51 | 52 | 53 | 54 | ```{r example} 55 | ## a point in longlat, and a buffer with in metres 56 | pt <- cbind(136, -34) 57 | im <- cc_location(pt, buffer = c(1e6, 5e5), type = "mapbox.satellite", debug = T) 58 | plotRGB(im) 59 | 60 | ## get the matching tiles (zoom is magic here, it's all wrapped - needs thought) 61 | 62 | tiles <- ceramic_tiles(zoom = 6, type = "mapbox.satellite") 63 | library(sf) 64 | plot(st_geometry(tiles_to_polygon(tiles)), add = TRUE) 65 | middle <- function(x, y) { 66 | x + (y - x)/2 67 | } 68 | text(middle(tiles$xmin, tiles$xmax), middle(tiles$ymin, tiles$ymax), lab = sprintf("[%i,%i]", tiles$tile_x, tiles$tile_y), 69 | col = "firebrick") 70 | ``` 71 | 72 | 73 | 74 | There is a helper function to find existing tiles. 75 | 76 | ```{r files} 77 | 78 | ceramic_tiles(zoom = 7, type = "mapbox.satellite") 79 | ``` 80 | 81 | and every row has the extent values useable directly by raster: 82 | 83 | ```{r extent} 84 | ceramic_tiles(zoom = 7, type = "mapbox.satellite") %>% 85 | dplyr::slice(1:5) %>% 86 | purrr::transpose() %>% 87 | purrr::map(~raster::extent(unlist(.x[c("xmin", "xmax", "ymin", "ymax")]))) 88 | ``` 89 | 90 | 91 | Another example 92 | 93 | ```{r tasmania} 94 | my_bbox <- 95 | st_bbox(c(xmin = 144, 96 | xmax = 147.99, 97 | ymin = -44.12, 98 | ymax = -40), 99 | crs = st_crs("+proj=longlat +ellps=WGS84")) 100 | tile_grid <- slippymath:::bb_to_tg(my_bbox, max_tiles = 36) 101 | files <- unlist(down_loader(tile_grid, mapbox_query_string)) 102 | br <- lapply(files, raster::brick) 103 | 104 | for (i in seq_along(br)) { 105 | br[[i]] <- setExtent(br[[i]], 106 | mercator_tile_extent(tile_grid$tiles$x[i], tile_grid$tiles$y[i], zoom = tile_grid$zoom)) 107 | } 108 | 109 | im <- purrr::reduce(br, raster::merge) 110 | projection(im) <- "+proj=merc +a=6378137 +b=6378137" 111 | plotRGB(im) 112 | plot(st_transform(ozmaps::abs_lga$geometry, projection(im)), add = TRUE, lwd = 2, border = "white") 113 | ``` 114 | 115 | An internal function sets up a plot of tiles at particular zoom levels. 116 | 117 | ```R 118 | ceramic::plot_tiles(ceramic_tiles(zoom = c(7, 9))) 119 | ``` 120 | 121 | ![tile plot](man/figures/README-tile-plot.png) 122 | 123 | And we can add the tiles to an existing plot. 124 | 125 | ```R 126 | plotRGB(im) 127 | ceramic::plot_tiles(ceramic_tiles(zoom = 7), add = TRUE) 128 | ``` 129 | 130 | ![tile add plot](man/figures/README-tile-add-plot.png) 131 | 132 | 133 | ## Address helper 134 | 135 | ```{r get-address} 136 | ## DEPENDS ON Sys.getenv("OPENCAGE_KEY") 137 | get_address <- function(address) { 138 | x <- opencage::opencage_forward(address, no_annotations = T, no_dedupe = T) 139 | 140 | cbind(x$results$geometry.lng[1], x$results$geometry.lat[1]) 141 | } 142 | ``` 143 | 144 | rgb helper 145 | 146 | ```{r rgb} 147 | values_to_hex <- function(x) { 148 | rgb(x[,1], x[,2], x[, 3], max = 255) 149 | } 150 | raster_to_hex <- function(x) { 151 | values_to_hex(raster::values(x)) 152 | } 153 | quadmesh_to_tex <- function(x, im) { 154 | xy_to_tex(t(x$vb[1:2, ]), im) 155 | } 156 | xy_to_tex <- function(xy, im) { 157 | xyFromCell(setExtent(im, extent(0, 1, 0, 1)), 158 | cellFromXY(im, xy)) ## must be the same projection 159 | } 160 | ``` 161 | # Textures 162 | 163 | WIP 164 | 165 | ```{r texture1,eval=FALSE} 166 | im <- cc_location(get_address("Uluru"), type = "mapbox.satellite", debug = T) 167 | library(raster) 168 | #im <- crop(im, extent(im, 256, 512, 256, 512)) 169 | qm <- quadmesh::quadmesh(im, z = NULL) 170 | 171 | col <- raster_to_hex(im) 172 | qm$material$col <- rep(col, each = 4) 173 | library(rgl) 174 | rgl.clear() 175 | shade3d(qm) 176 | #rglwidget() 177 | ``` 178 | 179 | ```{r rgb-texture,eval=FALSE} 180 | tfile <- tempfile(fileext = "png") 181 | slippymath::raster_to_png(im, tfile) 182 | texqm <- quadmesh::quadmesh(im, z = NULL) 183 | texcoords <- quadmesh_to_tex(texqm, im) 184 | rgl.clear() 185 | shade3d(texqm, texcoords = texcoords[qm$ib, ], texture = tfile) 186 | #rglwidget() 187 | ``` 188 | 189 | Now with elevation. 190 | 191 | ```{r elevatr,eval=FALSE} 192 | elev <- elevatr::get_elev_raster(data.frame(x = mean(c(xmin(im), xmax(im))), 193 | y = mean(c(ymin(im), ymax(im)))), 194 | src = "aws", prj = "+proj=merc +a=6378137 +b=6378137", z = 13) 195 | texqm$vb[3, ] <- raster::extract(elev, t(texqm$vb[1:2, ]), method = "bilinear") 196 | rgl.clear() 197 | ## don't forget to set to non-black for textures 198 | ## and to index the texture coordinates 199 | shade3d(texqm, texcoords = texcoords[qm$ib, ], texture = tfile, col = "white") 200 | #rglwidget() 201 | 202 | ``` 203 | 204 | ## Elevation 205 | 206 | Finally, this is the kind of useability we need. 207 | 208 | Get DEM, get image, make a scene. 209 | 210 | ```{r elevation} 211 | cc_elevation <- function(loc,...) { 212 | dat <- cc_location(loc, 5000, type = "mapbox.terrain-rgb") 213 | height <- -10000 + ((dat[[1]] * 256 * 256 + dat[[2]] * 256 + dat[[3]]) * 0.1) 214 | projection(height) <- "+proj=merc +a=6378137 +b=6378137" 215 | height 216 | } 217 | loc <- cbind(147.3565, -43.19052) 218 | dem <- cc_elevation(loc) 219 | library(quadmesh) # @textures branch 220 | 221 | qm <- quadmesh(dem, texture = cc_location(loc, type = "mapbox.satellite")) 222 | library(rgl) 223 | shade3d(qm); rglwidget() 224 | 225 | ``` 226 | 227 | Please note that the 'ceramic' project is released with a [Contributor Code of Conduct](CODE_OF_CONDUCT.md). By contributing to this project, you agree to abide by its terms. 228 | 229 | 230 | 231 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # ceramic 5 | 6 | The goal of ceramic is to obtain web map tiles for later re-use. Many 7 | tools for imagery services treat the imagery as transient, but here we 8 | take control over the raw data itself. 9 | 10 | # Goals 11 | 12 | Very much WIP. 13 | 14 | - control download of raw tiles (we have this\!) 15 | - allow lazy read access to tile caches 16 | - generalize across providers 17 | - provide interactive means to build access to imagery 18 | 19 | ## Installation 20 | 21 | You can install the dev version of ceramic from Github. 22 | 23 | ``` r 24 | devtools::install_github("hypertidy/ceramic") 25 | ``` 26 | 27 | ## Example 28 | 29 | This complete example gets tiled imagery that we can use as real data. 30 | 31 | The code here 32 | 33 | - generates a bounding box in longitud-latitude 34 | - uses [slippymath](https://github.com/MilesMcBain/slippymath/) to 35 | find sensible tiles for the region 36 | - downloads them to a local cache 37 | - georeferences them and merges the tiles into a sensible raster 38 | object 39 | 40 | 41 | 42 | ``` r 43 | library(sf) ## st_bbox, st_crs 44 | #> Linking to GEOS 3.6.2, GDAL 2.3.2, PROJ 4.9.3 45 | #> Linking to GEOS 3.6.1, GDAL 2.2.3, PROJ 4.9.3 46 | library(slippymath) 47 | my_bbox <- 48 | st_bbox(c(xmin = 130, 49 | xmax = 146, 50 | ymin = -36, 51 | ymax = -28), 52 | crs = st_crs("+proj=longlat +ellps=WGS84")) 53 | library(purrr) ## is_null clashes with testthat::is_null 54 | tile_grid <- slippymath:::bb_to_tg(my_bbox, max_tiles = 36) 55 | zoom <- tile_grid$zoom 56 | 57 | mapbox_query_string <- 58 | paste0("https://api.mapbox.com/v4/mapbox.satellite/{zoom}/{x}/{y}.jpg90", 59 | "?access_token=", 60 | Sys.getenv("MAPBOX_API_KEY")) 61 | 62 | library(ceramic) 63 | files <- unlist(down_loader(tile_grid, mapbox_query_string)) 64 | tibble::tibble(filename = gsub(normalizePath(rappdirs::user_cache_dir(), winslash = "/"), 65 | "", 66 | normalizePath(files, winslash = "/"))) 67 | #> # A tibble: 24 x 1 68 | #> filename 69 | #> 70 | #> 1 /.ceramic/api.mapbox.com/v4/mapbox.satellite/7/110/74.jpg90 71 | #> 2 /.ceramic/api.mapbox.com/v4/mapbox.satellite/7/111/74.jpg90 72 | #> 3 /.ceramic/api.mapbox.com/v4/mapbox.satellite/7/112/74.jpg90 73 | #> 4 /.ceramic/api.mapbox.com/v4/mapbox.satellite/7/113/74.jpg90 74 | #> 5 /.ceramic/api.mapbox.com/v4/mapbox.satellite/7/114/74.jpg90 75 | #> 6 /.ceramic/api.mapbox.com/v4/mapbox.satellite/7/115/74.jpg90 76 | #> 7 /.ceramic/api.mapbox.com/v4/mapbox.satellite/7/110/75.jpg90 77 | #> 8 /.ceramic/api.mapbox.com/v4/mapbox.satellite/7/111/75.jpg90 78 | #> 9 /.ceramic/api.mapbox.com/v4/mapbox.satellite/7/112/75.jpg90 79 | #> 10 /.ceramic/api.mapbox.com/v4/mapbox.satellite/7/113/75.jpg90 80 | #> # ... with 14 more rows 81 | 82 | library(raster) 83 | #> Loading required package: sp 84 | br <- lapply(files, raster::brick) 85 | 86 | for (i in seq_along(br)) { 87 | br[[i]] <- setExtent(br[[i]], 88 | mercator_tile_extent(tile_grid$tiles$x[i], tile_grid$tiles$y[i], zoom = zoom)) 89 | } 90 | 91 | im <- purrr::reduce(br, raster::merge) 92 | plotRGB(im) 93 | # devtools::install_github("mdsumner/ozmaps") 94 | dat <- sf::st_transform(ozmaps::ozmap_states, "+proj=merc +a=6378137 +b=6378137") 95 | plot(dat$geometry, add = TRUE, lwd = 5, border = "dodgerblue") 96 | ``` 97 | 98 | 99 | 100 | There is a helper function to find existing tiles. 101 | 102 | ``` r 103 | 104 | ceramic_tiles(zoom = 7, type = "mapbox.satellite") 105 | #> [1] 83 4 106 | #> # A tibble: 24 x 11 107 | #> tile_x tile_y zoom type version source 108 | #> 109 | #> 1 110 74 7 mapb… v4 api.m… 110 | #> 2 110 75 7 mapb… v4 api.m… 111 | #> 3 110 76 7 mapb… v4 api.m… 112 | #> 4 110 77 7 mapb… v4 api.m… 113 | #> 5 111 74 7 mapb… v4 api.m… 114 | #> 6 111 75 7 mapb… v4 api.m… 115 | #> 7 111 76 7 mapb… v4 api.m… 116 | #> 8 111 77 7 mapb… v4 api.m… 117 | #> 9 112 74 7 mapb… v4 api.m… 118 | #> 10 112 75 7 mapb… v4 api.m… 119 | #> # ... with 14 more rows, and 5 more variables: fullname , 120 | #> # xmin , xmax , ymin , ymax 121 | ``` 122 | 123 | and every row has the extent values useable directly by raster: 124 | 125 | ``` r 126 | ceramic_tiles(zoom = 7, type = "mapbox.satellite") %>% 127 | dplyr::slice(1:5) %>% 128 | purrr::transpose() %>% 129 | purrr::map(~raster::extent(unlist(.x[c("xmin", "xmax", "ymin", "ymax")]))) 130 | #> [1] 83 4 131 | #> [[1]] 132 | #> class : Extent 133 | #> xmin : 14401959 134 | #> xmax : 14715045 135 | #> ymin : -3443947 136 | #> ymax : -3130861 137 | #> 138 | #> [[2]] 139 | #> class : Extent 140 | #> xmin : 14401959 141 | #> xmax : 14715045 142 | #> ymin : -3757033 143 | #> ymax : -3443947 144 | #> 145 | #> [[3]] 146 | #> class : Extent 147 | #> xmin : 14401959 148 | #> xmax : 14715045 149 | #> ymin : -4070119 150 | #> ymax : -3757033 151 | #> 152 | #> [[4]] 153 | #> class : Extent 154 | #> xmin : 14401959 155 | #> xmax : 14715045 156 | #> ymin : -4383205 157 | #> ymax : -4070119 158 | #> 159 | #> [[5]] 160 | #> class : Extent 161 | #> xmin : 14715045 162 | #> xmax : 15028131 163 | #> ymin : -3443947 164 | #> ymax : -3130861 165 | ``` 166 | 167 | Another example 168 | 169 | ``` r 170 | my_bbox <- 171 | st_bbox(c(xmin = 144, 172 | xmax = 147.99, 173 | ymin = -44.12, 174 | ymax = -40), 175 | crs = st_crs("+proj=longlat +ellps=WGS84")) 176 | tile_grid <- slippymath:::bb_to_tg(my_bbox, max_tiles = 36) 177 | files <- unlist(down_loader(tile_grid, mapbox_query_string)) 178 | br <- lapply(files, raster::brick) 179 | 180 | for (i in seq_along(br)) { 181 | br[[i]] <- setExtent(br[[i]], 182 | mercator_tile_extent(tile_grid$tiles$x[i], tile_grid$tiles$y[i], zoom = tile_grid$zoom)) 183 | } 184 | 185 | im <- purrr::reduce(br, raster::merge) 186 | projection(im) <- "+proj=merc +a=6378137 +b=6378137" 187 | plotRGB(im) 188 | plot(st_transform(ozmaps::abs_lga$geometry, projection(im)), add = TRUE, lwd = 2, border = "white") 189 | ``` 190 | 191 | 192 | 193 | An internal function sets up a plot of tiles at particular zoom levels. 194 | 195 | ``` r 196 | ceramic::plot_tiles(ceramic_tiles(zoom = c(7, 9))) 197 | ``` 198 | 199 | ![tile plot](man/figures/README-tile-plot.png) 200 | 201 | And we can add the tiles to an existing plot. 202 | 203 | ``` r 204 | plotRGB(im) 205 | ceramic::plot_tiles(ceramic_tiles(zoom = 7), add = TRUE) 206 | ``` 207 | 208 | ![tile add plot](man/figures/README-tile-add-plot.png) 209 | 210 | Please note that the ‘ceramic’ project is released with a [Contributor 211 | Code of Conduct](CODE_OF_CONDUCT.md). By contributing to this project, 212 | you agree to abide by its terms. 213 | -------------------------------------------------------------------------------- /docs/docsearch.css: -------------------------------------------------------------------------------- 1 | /* Docsearch -------------------------------------------------------------- */ 2 | /* 3 | Source: https://github.com/algolia/docsearch/ 4 | License: MIT 5 | */ 6 | 7 | .algolia-autocomplete { 8 | display: block; 9 | -webkit-box-flex: 1; 10 | -ms-flex: 1; 11 | flex: 1 12 | } 13 | 14 | .algolia-autocomplete .ds-dropdown-menu { 15 | width: 100%; 16 | min-width: none; 17 | max-width: none; 18 | padding: .75rem 0; 19 | background-color: #fff; 20 | background-clip: padding-box; 21 | border: 1px solid rgba(0, 0, 0, .1); 22 | box-shadow: 0 .5rem 1rem rgba(0, 0, 0, .175); 23 | } 24 | 25 | @media (min-width:768px) { 26 | .algolia-autocomplete .ds-dropdown-menu { 27 | width: 175% 28 | } 29 | } 30 | 31 | .algolia-autocomplete .ds-dropdown-menu::before { 32 | display: none 33 | } 34 | 35 | .algolia-autocomplete .ds-dropdown-menu [class^=ds-dataset-] { 36 | padding: 0; 37 | background-color: rgb(255,255,255); 38 | border: 0; 39 | max-height: 80vh; 40 | } 41 | 42 | .algolia-autocomplete .ds-dropdown-menu .ds-suggestions { 43 | margin-top: 0 44 | } 45 | 46 | .algolia-autocomplete .algolia-docsearch-suggestion { 47 | padding: 0; 48 | overflow: visible 49 | } 50 | 51 | .algolia-autocomplete .algolia-docsearch-suggestion--category-header { 52 | padding: .125rem 1rem; 53 | margin-top: 0; 54 | font-size: 1.3em; 55 | font-weight: 500; 56 | color: #00008B; 57 | border-bottom: 0 58 | } 59 | 60 | .algolia-autocomplete .algolia-docsearch-suggestion--wrapper { 61 | float: none; 62 | padding-top: 0 63 | } 64 | 65 | .algolia-autocomplete .algolia-docsearch-suggestion--subcategory-column { 66 | float: none; 67 | width: auto; 68 | padding: 0; 69 | text-align: left 70 | } 71 | 72 | .algolia-autocomplete .algolia-docsearch-suggestion--content { 73 | float: none; 74 | width: auto; 75 | padding: 0 76 | } 77 | 78 | .algolia-autocomplete .algolia-docsearch-suggestion--content::before { 79 | display: none 80 | } 81 | 82 | .algolia-autocomplete .ds-suggestion:not(:first-child) .algolia-docsearch-suggestion--category-header { 83 | padding-top: .75rem; 84 | margin-top: .75rem; 85 | border-top: 1px solid rgba(0, 0, 0, .1) 86 | } 87 | 88 | .algolia-autocomplete .ds-suggestion .algolia-docsearch-suggestion--subcategory-column { 89 | display: block; 90 | padding: .1rem 1rem; 91 | margin-bottom: 0.1; 92 | font-size: 1.0em; 93 | font-weight: 400 94 | /* display: none */ 95 | } 96 | 97 | .algolia-autocomplete .algolia-docsearch-suggestion--title { 98 | display: block; 99 | padding: .25rem 1rem; 100 | margin-bottom: 0; 101 | font-size: 0.9em; 102 | font-weight: 400 103 | } 104 | 105 | .algolia-autocomplete .algolia-docsearch-suggestion--text { 106 | padding: 0 1rem .5rem; 107 | margin-top: -.25rem; 108 | font-size: 0.8em; 109 | font-weight: 400; 110 | line-height: 1.25 111 | } 112 | 113 | .algolia-autocomplete .algolia-docsearch-footer { 114 | width: 110px; 115 | height: 20px; 116 | z-index: 3; 117 | margin-top: 10.66667px; 118 | float: right; 119 | font-size: 0; 120 | line-height: 0; 121 | } 122 | 123 | .algolia-autocomplete .algolia-docsearch-footer--logo { 124 | background-image: url("data:image/svg+xml;utf8,"); 125 | background-repeat: no-repeat; 126 | background-position: 50%; 127 | background-size: 100%; 128 | overflow: hidden; 129 | text-indent: -9000px; 130 | width: 100%; 131 | height: 100%; 132 | display: block; 133 | transform: translate(-8px); 134 | } 135 | 136 | .algolia-autocomplete .algolia-docsearch-suggestion--highlight { 137 | color: #FF8C00; 138 | background: rgba(232, 189, 54, 0.1) 139 | } 140 | 141 | 142 | .algolia-autocomplete .algolia-docsearch-suggestion--text .algolia-docsearch-suggestion--highlight { 143 | box-shadow: inset 0 -2px 0 0 rgba(105, 105, 105, .5) 144 | } 145 | 146 | .algolia-autocomplete .ds-suggestion.ds-cursor .algolia-docsearch-suggestion--content { 147 | background-color: rgba(192, 192, 192, .15) 148 | } 149 | -------------------------------------------------------------------------------- /docs/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | Get imagery tiles • ceramic 9 | 10 | 11 | 12 | 13 | 14 | 15 | 19 | 20 | 21 |
    22 |
    61 | 62 | 63 | 64 |
    65 |
    66 | 67 | 68 | 69 | 70 | 71 |
    72 |

    73 | ceramic

    74 |

    The goal of ceramic is to obtain web map tiles for later re-use. Many tools for imagery services treat the imagery as transient, but here we take control over the raw data itself.

    75 |
    76 |
    77 |

    78 | Goals

    79 |

    Very much WIP.

    80 |
      81 |
    • control download of raw tiles (we have this!)
      • 82 |
    • allow lazy read access to tile caches
      • 83 |
    • generalize across providers
      • 84 |
    • provide interactive means to build access to imagery
      • 85 |
    86 |
    87 |

    88 | Installation

    89 |

    You can install the dev version of ceramic from Github.

    90 | 
    devtools::install_github("hypertidy/ceramic")
    91 |
    92 |
    93 |

    94 | Example

    95 |

    This complete example gets tiled imagery that we can use as real data.

    96 |

    The code here

    97 |
      98 |
    • generates a bounding box in longitud-latitude
      • 99 |
    • uses slippymath to find sensible tiles for the region
      • 100 |
    • downloads them to a local cache
      • 101 |
    • georeferences them and merges the tiles into a sensible raster object
      • 102 |
    103 | 
    library(sf)     ## st_bbox, st_crs
104 | #> Linking to GEOS 3.6.2, GDAL 2.3.2, PROJ 4.9.3
105 | #> Linking to GEOS 3.6.1, GDAL 2.2.3, PROJ 4.9.3
106 | library(slippymath)
107 | my_bbox <-
108 |   st_bbox(c(xmin = 130,
109 |             xmax = 146,
110 |             ymin = -36,
111 |             ymax = -28),
112 |           crs = st_crs("+proj=longlat +ellps=WGS84"))
113 | library(purrr)  ## is_null clashes with testthat::is_null
114 | tile_grid <- slippymath:::bb_to_tg(my_bbox, max_tiles = 36)
115 | zoom <- tile_grid$zoom
116 | 
117 | mapbox_query_string <-
118 |   paste0("https://api.mapbox.com/v4/mapbox.satellite/{zoom}/{x}/{y}.jpg90",
119 |          "?access_token=",
120 |          Sys.getenv("MAPBOX_API_KEY"))
121 | 
122 | library(ceramic)
123 | files <- unlist(down_loader(tile_grid, mapbox_query_string))
124 | tibble::tibble(filename = gsub(normalizePath(rappdirs::user_cache_dir(), winslash = "/"), 
125 |                                "", 
126 |                                normalizePath(files, winslash = "/")))
127 | #> # A tibble: 24 x 1
128 | #>    filename                                                   
129 | #>    <chr>                                                      
130 | #>  1 /.ceramic/api.mapbox.com/v4/mapbox.satellite/7/110/74.jpg90
131 | #>  2 /.ceramic/api.mapbox.com/v4/mapbox.satellite/7/111/74.jpg90
132 | #>  3 /.ceramic/api.mapbox.com/v4/mapbox.satellite/7/112/74.jpg90
133 | #>  4 /.ceramic/api.mapbox.com/v4/mapbox.satellite/7/113/74.jpg90
134 | #>  5 /.ceramic/api.mapbox.com/v4/mapbox.satellite/7/114/74.jpg90
135 | #>  6 /.ceramic/api.mapbox.com/v4/mapbox.satellite/7/115/74.jpg90
136 | #>  7 /.ceramic/api.mapbox.com/v4/mapbox.satellite/7/110/75.jpg90
137 | #>  8 /.ceramic/api.mapbox.com/v4/mapbox.satellite/7/111/75.jpg90
138 | #>  9 /.ceramic/api.mapbox.com/v4/mapbox.satellite/7/112/75.jpg90
139 | #> 10 /.ceramic/api.mapbox.com/v4/mapbox.satellite/7/113/75.jpg90
140 | #> # ... with 14 more rows
141 | 
142 | library(raster)
143 | #> Loading required package: sp
144 | br <- lapply(files, raster::brick)
145 | 
146 | for (i in seq_along(br)) {
147 |   br[[i]] <- setExtent(br[[i]],  
148 |                        mercator_tile_extent(tile_grid$tiles$x[i], tile_grid$tiles$y[i], zoom = zoom))
149 | }
150 | 
151 | im <- purrr::reduce(br, raster::merge)
152 | plotRGB(im)
153 | # devtools::install_github("mdsumner/ozmaps")
154 | dat <- sf::st_transform(ozmaps::ozmap_states, "+proj=merc +a=6378137 +b=6378137")
155 | plot(dat$geometry, add = TRUE, lwd = 5, border = "dodgerblue")
    156 |

    157 |

    There is a helper function to find existing tiles.

    158 | 176 |

    and every row has the extent values useable directly by raster:

    177 | 216 |

    Another example

    217 | 
    my_bbox <-
218 |   st_bbox(c(xmin = 144,
219 |             xmax = 147.99,
220 |             ymin = -44.12,
221 |             ymax = -40),
222 |           crs = st_crs("+proj=longlat +ellps=WGS84"))
223 | tile_grid <- slippymath:::bb_to_tg(my_bbox, max_tiles = 36)
224 | files <- unlist(down_loader(tile_grid, mapbox_query_string))
225 | br <- lapply(files, raster::brick)
226 | 
227 | for (i in seq_along(br)) {
228 |   br[[i]] <- setExtent(br[[i]],  
229 |                        mercator_tile_extent(tile_grid$tiles$x[i], tile_grid$tiles$y[i], zoom = tile_grid$zoom))
230 | }
231 | 
232 | im <- purrr::reduce(br, raster::merge)
233 | projection(im) <- "+proj=merc +a=6378137 +b=6378137"
234 | plotRGB(im)
235 | plot(st_transform(ozmaps::abs_lga$geometry, projection(im)), add = TRUE, lwd = 2, border = "white")
    236 |

    237 |

    An internal function sets up a plot of tiles at particular zoom levels.

    238 | 239 |
    240 | tile plot

    tile plot

    241 |
    242 |

    And we can add the tiles to an existing plot.

    243 | 
    plotRGB(im)
244 | ceramic::plot_tiles(ceramic_tiles(zoom = 7), add = TRUE)
    245 |
    246 | tile add plot

    tile add plot

    247 |
    248 |

    Please note that the ‘ceramic’ project is released with a Contributor Code of Conduct. By contributing to this project, you agree to abide by its terms.

    249 |
    250 |
    251 |
    252 | 253 | 278 | 279 |
    280 | 281 | 282 | 291 |
    292 | 293 | 294 | 295 | 296 | 297 | --------------------------------------------------------------------------------