├── _config.yml ├── vignettes ├── .gitignore ├── figures │ └── hawaii.jpg ├── scene_with_gps_trace.Rmd └── hawaii_mapzen_dem.Rmd ├── .gitignore ├── tests ├── testthat.R └── testthat │ └── test_imagery.R ├── inst └── extdata │ ├── example.tif │ └── example_asc │ └── example_asc.zip ├── man ├── figures │ ├── example1.jpg │ ├── example2.jpg │ ├── example3.jpg │ ├── bw_example.jpg │ └── ullswater.jpg ├── dplyr_data.Rd ├── pipe.Rd ├── read_igc.Rd ├── example_igc.Rd ├── example_raster.Rd ├── raster_zscale.Rd ├── elevation_shade.Rd ├── latlong_to_rayshader_coords.Rd ├── crop_raster_square.Rd ├── crop_raster_track.Rd ├── ggslippy.Rd ├── drybrush.Rd ├── mapzen_dem.Rd ├── get_slippy_map.Rd ├── mapbox_dem.Rd ├── slippy_overlay.Rd ├── add_gps_to_rayshader.Rd ├── mosaic_files.Rd ├── slippy_raster.Rd └── elevation_transparency.Rd ├── .Rbuildignore ├── CRAN-RELEASE ├── R ├── utils-data.R ├── utils-pipe.R ├── load_extdata.R ├── raster_zscale.R ├── crop_raster_track.R ├── drybrush.R ├── ggslippy.R ├── crop_raster_square.R ├── mapzen_dem.R ├── elevation_shade.R ├── mapbox_dem.R ├── latlong_to_rayshader_coords.R ├── slippy_raster.R ├── read_igc.R ├── slippy_overlay.R ├── elevation_transparency.R ├── add_gps_to_rayshader.R ├── get_slippy_map.R ├── mosaic_files.R └── utils.R ├── .travis.yml ├── geoviz.Rproj ├── NAMESPACE ├── cran-comments.md ├── DESCRIPTION ├── news.md └── README.md /_config.yml: -------------------------------------------------------------------------------- 1 | theme: jekyll-theme-minimal -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | inst/doc 2 | .Rproj.user 3 | .Rhistory 4 | .RData 5 | .Ruserdata 6 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(geoviz) 3 | 4 | test_check("geoviz") 5 | -------------------------------------------------------------------------------- /inst/extdata/example.tif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilcharles/geoviz/HEAD/inst/extdata/example.tif -------------------------------------------------------------------------------- /man/figures/example1.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilcharles/geoviz/HEAD/man/figures/example1.jpg -------------------------------------------------------------------------------- /man/figures/example2.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilcharles/geoviz/HEAD/man/figures/example2.jpg -------------------------------------------------------------------------------- /man/figures/example3.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilcharles/geoviz/HEAD/man/figures/example3.jpg -------------------------------------------------------------------------------- /man/figures/bw_example.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilcharles/geoviz/HEAD/man/figures/bw_example.jpg -------------------------------------------------------------------------------- /man/figures/ullswater.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilcharles/geoviz/HEAD/man/figures/ullswater.jpg -------------------------------------------------------------------------------- /vignettes/figures/hawaii.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilcharles/geoviz/HEAD/vignettes/figures/hawaii.jpg -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^CRAN-RELEASE$ 2 | ^.*\.Rproj$ 3 | ^\.Rproj\.user$ 4 | ^cran-comments\.md$ 5 | ^news\.md$ 6 | ^\.travis\.yml$ 7 | -------------------------------------------------------------------------------- /inst/extdata/example_asc/example_asc.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neilcharles/geoviz/HEAD/inst/extdata/example_asc/example_asc.zip -------------------------------------------------------------------------------- /CRAN-RELEASE: -------------------------------------------------------------------------------- 1 | This package was submitted to CRAN on 2020-01-12. 2 | Once it is accepted, delete this file and tag the release (commit 589f403c8c). 3 | -------------------------------------------------------------------------------- /R/utils-data.R: -------------------------------------------------------------------------------- 1 | #' .data to allow column name use in dplyr 2 | #' 3 | #' See https://github.com/STAT545-UBC/Discussion/issues/451 4 | #' 5 | #' @name dplyr_data 6 | #' @importFrom rlang .data 7 | NULL 8 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # R for travis: see documentation at https://docs.travis-ci.com/user/languages/r 2 | 3 | language: R 4 | cache: packages 5 | before_install: 6 | - sudo apt-get -y install libgdal-dev libudunits2-dev libx11-dev mesa-common-dev libglu1-mesa-dev 7 | -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /man/dplyr_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-data.R 3 | \name{dplyr_data} 4 | \alias{dplyr_data} 5 | \title{.data to allow column name use in dplyr} 6 | \description{ 7 | See https://github.com/STAT545-UBC/Discussion/issues/451 8 | } 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 | -------------------------------------------------------------------------------- /man/read_igc.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/read_igc.R 3 | \name{read_igc} 4 | \alias{read_igc} 5 | \title{Load an IGC file} 6 | \usage{ 7 | read_igc(path) 8 | } 9 | \arguments{ 10 | \item{path}{target IGC file} 11 | } 12 | \value{ 13 | a tibble 14 | } 15 | \description{ 16 | Load an IGC file 17 | } 18 | \examples{ 19 | igc <- read_igc(system.file("extdata/example.igc", package = "geoviz")) 20 | } 21 | -------------------------------------------------------------------------------- /geoviz.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 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/example_igc.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/load_extdata.R 3 | \name{example_igc} 4 | \alias{example_igc} 5 | \title{Returns an example IGC file using read_igc()} 6 | \usage{ 7 | example_igc() 8 | } 9 | \value{ 10 | a tibble 11 | } 12 | \description{ 13 | Returns an example IGC file using read_igc() 14 | } 15 | \examples{ 16 | 17 | # Loads a paragliding flight GPS track, originally downloaded from xcleague.com 18 | 19 | igc <- example_igc() 20 | } 21 | -------------------------------------------------------------------------------- /man/example_raster.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/load_extdata.R 3 | \name{example_raster} 4 | \alias{example_raster} 5 | \title{Returns an example digital elevation model raster file()} 6 | \usage{ 7 | example_raster() 8 | } 9 | \value{ 10 | a raster 11 | } 12 | \description{ 13 | Returns an example digital elevation model raster file() 14 | } 15 | \examples{ 16 | 17 | # Load elevation data describing a small section of the English Lake District 18 | # Source: EU Copernicus https://land.copernicus.eu/terms-of-use 19 | 20 | example_raster <- example_raster() 21 | } 22 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export("%>%") 4 | export(add_gps_to_rayshader) 5 | export(crop_raster_square) 6 | export(crop_raster_track) 7 | export(drybrush) 8 | export(elevation_shade) 9 | export(elevation_transparency) 10 | export(example_igc) 11 | export(example_raster) 12 | export(get_slippy_map) 13 | export(ggslippy) 14 | export(latlong_to_rayshader_coords) 15 | export(mapbox_dem) 16 | export(mapzen_dem) 17 | export(mosaic_files) 18 | export(raster_zscale) 19 | export(read_igc) 20 | export(slippy_overlay) 21 | export(slippy_raster) 22 | importFrom(magrittr,"%>%") 23 | importFrom(rlang,.data) 24 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Test environments 2 | * local Windows 10 install, R 3.6.0 3 | * ubuntu 16.0.4.2 LTS, R 3.6.0 4 | * win builder devel and release 5 | ## R CMD check results 6 | * 0 errors v | 0 warnings v | 0 notes 7 | ## Downstream dependencies 8 | None 9 | ## Updates to remedy submission failure 10 | * Readme now links to full URI 11 | * R.E email question about citations in the description field, geoviz doesn't apply any published methods 12 | ## Changes summary from 0.2.1 13 | * 'Rayshader' changing coordinate system in v0.13.1 caused GPS tracks to be offset. latlong_to_rayshader_coords() updated to fix 14 | * Updated mosaic_files() example to prevent build note 15 | -------------------------------------------------------------------------------- /man/raster_zscale.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/raster_zscale.R 3 | \name{raster_zscale} 4 | \alias{raster_zscale} 5 | \title{Approximates the zscale of a raster Digital Elevation Model for 'rayshader'} 6 | \usage{ 7 | raster_zscale(raster, height_units = "m") 8 | } 9 | \arguments{ 10 | \item{raster}{A raster object of elevation data values} 11 | 12 | \item{height_units}{Elevation units of the raster, c("m", "feet")} 13 | } 14 | \value{ 15 | a number to be used as zscale in rayshader::plot_3d() 16 | } 17 | \description{ 18 | Approximates the zscale of a raster Digital Elevation Model for 'rayshader' 19 | } 20 | \examples{ 21 | raster_zscale(example_raster()) 22 | 23 | } 24 | -------------------------------------------------------------------------------- /R/load_extdata.R: -------------------------------------------------------------------------------- 1 | #' Returns an example digital elevation model raster file() 2 | #' 3 | #' @return a raster 4 | #' 5 | #' @examples 6 | #' 7 | #' # Load elevation data describing a small section of the English Lake District 8 | #' # Source: EU Copernicus https://land.copernicus.eu/terms-of-use 9 | #' 10 | #' example_raster <- example_raster() 11 | #' @export 12 | example_raster <- function(){ 13 | raster::raster(system.file("extdata/example.tif", package = "geoviz")) 14 | } 15 | 16 | 17 | #' Returns an example IGC file using read_igc() 18 | #' 19 | #' @return a tibble 20 | #' 21 | #' @examples 22 | #' 23 | #' # Loads a paragliding flight GPS track, originally downloaded from xcleague.com 24 | #' 25 | #' igc <- example_igc() 26 | #' @export 27 | example_igc <- function(){ 28 | read_igc(system.file("extdata/example.igc", package = "geoviz")) 29 | } 30 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: geoviz 2 | Type: Package 3 | Title: Elevation and GPS Data Visualisation 4 | Version: 0.2.3.9000 5 | Author: Neil Charles 6 | Maintainer: Neil Charles 7 | Description: Simpler processing of digital elevation model and GPS trace data for use with the 'rayshader' package. 8 | URL: https://github.com/neilcharles/geoviz/ 9 | License: GPL-3 10 | Encoding: UTF-8 11 | LazyData: true 12 | RoxygenNote: 7.0.2 13 | Language: en-GB 14 | Imports: 15 | dplyr, 16 | magrittr, 17 | tidyr, 18 | readr, 19 | tibble, 20 | purrr, 21 | stringr, 22 | raster, 23 | chron, 24 | sp, 25 | sf, 26 | rgeos, 27 | glue, 28 | png, 29 | abind, 30 | rgl, 31 | slippymath, 32 | curl, 33 | progress, 34 | methods, 35 | rlang, 36 | ggplot2, 37 | rgdal 38 | Suggests: 39 | testthat, 40 | knitr, 41 | rmarkdown 42 | VignetteBuilder: knitr 43 | -------------------------------------------------------------------------------- /man/elevation_shade.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/elevation_shade.R 3 | \name{elevation_shade} 4 | \alias{elevation_shade} 5 | \title{Produces an elevation shaded image from a raster} 6 | \usage{ 7 | elevation_shade( 8 | raster_dem, 9 | elevation_palette = c("#54843f", "#808080", "#FFFFFF"), 10 | return_png = TRUE, 11 | png_opacity = 0.9 12 | ) 13 | } 14 | \arguments{ 15 | \item{raster_dem}{a raster} 16 | 17 | \item{elevation_palette}{a vector of colours to use for elevation shading} 18 | 19 | \item{return_png}{\code{TRUE} to return an image. \code{FALSE} will return a raster} 20 | 21 | \item{png_opacity}{Opacity of the returned image. Ignored if \code{return_png = FALSE}} 22 | } 23 | \value{ 24 | elevation shaded image 25 | } 26 | \description{ 27 | Produces an elevation shaded image from a raster 28 | } 29 | \examples{ 30 | elevation_shade(example_raster()) 31 | } 32 | -------------------------------------------------------------------------------- /man/latlong_to_rayshader_coords.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/latlong_to_rayshader_coords.R 3 | \name{latlong_to_rayshader_coords} 4 | \alias{latlong_to_rayshader_coords} 5 | \title{Converts WGS84 lat long points into 'rayshader' coordinates. Useful for adding arbitrary points and text to a 'rayshader' scene.} 6 | \usage{ 7 | latlong_to_rayshader_coords(raster_input, lat, long) 8 | } 9 | \arguments{ 10 | \item{raster_input}{a raster} 11 | 12 | \item{lat}{vector of WGS84 latitude points} 13 | 14 | \item{long}{vector of WGS84 longitude points} 15 | } 16 | \value{ 17 | A tibble with x,y in 'rayshader' coordinates 18 | } 19 | \description{ 20 | Converts WGS84 lat long points into 'rayshader' coordinates. Useful for adding arbitrary points and text to a 'rayshader' scene. 21 | } 22 | \examples{ 23 | latlong_to_rayshader_coords(example_raster(), example_igc()$lat, example_igc()$long) 24 | } 25 | -------------------------------------------------------------------------------- /man/crop_raster_square.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/crop_raster_square.R 3 | \name{crop_raster_square} 4 | \alias{crop_raster_square} 5 | \title{Crops a raster and returns a smaller square raster} 6 | \usage{ 7 | crop_raster_square(rasterIn, lat, long, square_km, increase_resolution = 1) 8 | } 9 | \arguments{ 10 | \item{rasterIn}{a raster} 11 | 12 | \item{lat}{WGS84 latitude of the centre of the cropped square} 13 | 14 | \item{long}{WGS84 longitude of the centre of the cropped square} 15 | 16 | \item{square_km}{length of one side of the square in km} 17 | 18 | \item{increase_resolution}{optional multiplier to increase number of cells in the raster} 19 | } 20 | \value{ 21 | A cropped raster 22 | } 23 | \description{ 24 | Crops a raster and returns a smaller square raster 25 | } 26 | \examples{ 27 | crop_raster_square(example_raster(), lat = 54.513293, long = -3.045598, square_km = 0.01) 28 | } 29 | -------------------------------------------------------------------------------- /R/raster_zscale.R: -------------------------------------------------------------------------------- 1 | #' Approximates the zscale of a raster Digital Elevation Model for 'rayshader' 2 | #' 3 | #' @param raster A raster object of elevation data values 4 | #' @param height_units Elevation units of the raster, c("m", "feet") 5 | #' 6 | #' @return a number to be used as zscale in rayshader::plot_3d() 7 | #' 8 | #' @examples 9 | #' raster_zscale(example_raster()) 10 | #' 11 | #' @export 12 | raster_zscale <- function(raster, height_units = "m"){ 13 | 14 | raster_wgs84 <- raster::projectRaster(raster, crs = sp::CRS("+proj=longlat +datum=WGS84 +no_defs")) 15 | 16 | scaling <- raster::pointDistance( 17 | c( 18 | raster::extent(raster_wgs84)@xmin, 19 | raster::extent(raster_wgs84)@ymin 20 | ), 21 | c(raster::extent(raster_wgs84)@xmax, 22 | raster::extent(raster_wgs84)@ymin 23 | ), 24 | lonlat = TRUE 25 | ) / ncol(raster_wgs84) 26 | 27 | if(scaling=="feet"){ 28 | scaling <- scaling * 3.28 29 | } 30 | 31 | return(scaling) 32 | 33 | } 34 | -------------------------------------------------------------------------------- /man/crop_raster_track.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/crop_raster_track.R 3 | \name{crop_raster_track} 4 | \alias{crop_raster_track} 5 | \title{Crops a raster into a rectangle surrounding a set of lat long points} 6 | \usage{ 7 | crop_raster_track( 8 | raster_input, 9 | lat_points, 10 | long_points, 11 | width_buffer = 1, 12 | increase_resolution = 1 13 | ) 14 | } 15 | \arguments{ 16 | \item{raster_input}{a raster} 17 | 18 | \item{lat_points}{a vector of WGS84 latitudes} 19 | 20 | \item{long_points}{a vector of WGS84 longitudes} 21 | 22 | \item{width_buffer}{buffer distance around the provided points in km} 23 | 24 | \item{increase_resolution}{optional multiplier to increase number of cells in the raster. Default = 1.} 25 | } 26 | \value{ 27 | cropped raster 28 | } 29 | \description{ 30 | Crops a raster into a rectangle surrounding a set of lat long points 31 | } 32 | \examples{ 33 | crop_raster_track(example_raster(), example_igc()$lat, example_igc()$long) 34 | } 35 | -------------------------------------------------------------------------------- /man/ggslippy.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggslippy.R 3 | \name{ggslippy} 4 | \alias{ggslippy} 5 | \title{Adds a layer created using slippy_overlay() or slippy_raster() to a 'ggplot2' chart} 6 | \usage{ 7 | ggslippy(slippy_raster, alpha = 1, set_coord_equal = TRUE) 8 | } 9 | \arguments{ 10 | \item{slippy_raster}{A raster raster returned by either \code{slippy_raster()} or \code{slippy_overlay(return_png = FALSE)}} 11 | 12 | \item{alpha}{Opacity of the raster in 'ggplot2'} 13 | 14 | \item{set_coord_equal}{\code{TRUE} returns a square plot} 15 | } 16 | \value{ 17 | a ggplot object 18 | } 19 | \description{ 20 | Adds a layer created using slippy_overlay() or slippy_raster() to a 'ggplot2' chart 21 | } 22 | \examples{ 23 | library(ggplot2) 24 | library(geoviz) 25 | 26 | dem <- example_raster() 27 | 28 | dem <- raster::aggregate(dem, 10) #aggregate to speed up ggplot for testing 29 | 30 | gg_overlay_image <- slippy_overlay( 31 | dem, 32 | image_source = "stamen", 33 | image_type = "watercolor", 34 | return_png = FALSE, 35 | max_tiles = 2 36 | ) 37 | 38 | ggplot() + 39 | ggslippy(gg_overlay_image, set_coord_equal = FALSE) 40 | } 41 | -------------------------------------------------------------------------------- /R/crop_raster_track.R: -------------------------------------------------------------------------------- 1 | #' Crops a raster into a rectangle surrounding a set of lat long points 2 | #' 3 | #' @param raster_input a raster 4 | #' @param lat_points a vector of WGS84 latitudes 5 | #' @param long_points a vector of WGS84 longitudes 6 | #' @param width_buffer buffer distance around the provided points in km 7 | #' @param increase_resolution optional multiplier to increase number of cells in the raster. Default = 1. 8 | #' 9 | #' @return cropped raster 10 | #' 11 | #' @examples 12 | #' crop_raster_track(example_raster(), example_igc()$lat, example_igc()$long) 13 | #' @export 14 | crop_raster_track <- function(raster_input, lat_points, long_points, width_buffer = 1, increase_resolution = 1){ 15 | 16 | bounding_shape <- track_bounding_box(lat_points, long_points, width_buffer) 17 | 18 | #Convert to match raster projection and crop 19 | bounding_shape <- sp::spTransform(bounding_shape, sp::CRS(as.character(raster::crs(raster_input)))) 20 | 21 | raster_crop <- raster::crop(raster_input, bounding_shape) 22 | 23 | raster_crop <- raster::disaggregate(raster_crop, increase_resolution, 24 | method = "bilinear") 25 | 26 | return(raster_crop) 27 | } 28 | -------------------------------------------------------------------------------- /man/drybrush.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/drybrush.R 3 | \name{drybrush} 4 | \alias{drybrush} 5 | \title{Simulates a dry brushing effect. Differs from elevation_transparency() in that colour is applied based on local altitude peaks, not across the whole raster} 6 | \usage{ 7 | drybrush( 8 | raster_dem, 9 | aggregation_factor = 10, 10 | max_colour_altitude = 30, 11 | opacity = 0.5, 12 | elevation_palette = c("#3f3f3f", "#ffa500") 13 | ) 14 | } 15 | \arguments{ 16 | \item{raster_dem}{A raster} 17 | 18 | \item{aggregation_factor}{grid size to determine local altitude peaks} 19 | 20 | \item{max_colour_altitude}{Altitude below which colours will be graduated across elevation_palette} 21 | 22 | \item{opacity}{overall opacity of the returned image} 23 | 24 | \item{elevation_palette}{Colour scheme c(colour_for_low_altitude, colour_for_high_altitude)} 25 | } 26 | \value{ 27 | An image with a drybrushed colour effect, highlighting local peaks 28 | } 29 | \description{ 30 | Simulates a dry brushing effect. Differs from elevation_transparency() in that colour is applied based on local altitude peaks, not across the whole raster 31 | } 32 | \examples{ 33 | overlay_image <- drybrush(example_raster()) 34 | } 35 | -------------------------------------------------------------------------------- /man/mapzen_dem.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mapzen_dem.R 3 | \name{mapzen_dem} 4 | \alias{mapzen_dem} 5 | \title{Gets Digital Elevation Model (DEM) data from 'mapzen' via 'Amazon Public Datasets'} 6 | \usage{ 7 | mapzen_dem(lat, long, square_km, width_buffer = 1, max_tiles = 10) 8 | } 9 | \arguments{ 10 | \item{lat}{WGS84 latitude. Either a single point to use as the centre for a \code{square_km} sized raster, or a vector of track points} 11 | 12 | \item{long}{WGS84 longitude. Either a single point to use as the centre for a \code{square_km} sized raster, or a vector of track points} 13 | 14 | \item{square_km}{length of one edge the required square area, in km. Ignored if lat and long have length > 1} 15 | 16 | \item{width_buffer}{If lat and long have length > 1, used as buffer distance around the provided points in km} 17 | 18 | \item{max_tiles}{maximum number of map tiles to request. More tiles will give higher resolution scenes but take longer to download. Note that very small numbers of tiles may result in a scene that is not square.} 19 | } 20 | \value{ 21 | a raster with values corresponding to terrain height in metres 22 | } 23 | \description{ 24 | Gets Digital Elevation Model (DEM) data from 'mapzen' via 'Amazon Public Datasets' 25 | } 26 | \examples{ 27 | lat = 54.4502651 28 | long = -3.1767946 29 | square_km = 2 30 | 31 | dem <- mapzen_dem(lat, long, square_km, max_tiles = 2) 32 | } 33 | -------------------------------------------------------------------------------- /R/drybrush.R: -------------------------------------------------------------------------------- 1 | #' Simulates a dry brushing effect. Differs from elevation_transparency() in that colour is applied based on local altitude peaks, not across the whole raster 2 | #' 3 | #' @param raster_dem A raster 4 | #' @param aggregation_factor grid size to determine local altitude peaks 5 | #' @param max_colour_altitude Altitude below which colours will be graduated across elevation_palette 6 | #' @param opacity overall opacity of the returned image 7 | #' @param elevation_palette Colour scheme c(colour_for_low_altitude, colour_for_high_altitude) 8 | #' 9 | #' @return An image with a drybrushed colour effect, highlighting local peaks 10 | #' 11 | #' @examples 12 | #' overlay_image <- drybrush(example_raster()) 13 | #' @export 14 | drybrush <- function(raster_dem, aggregation_factor = 10, max_colour_altitude = 30, opacity = 0.5, elevation_palette = c("#3f3f3f", "#ffa500")){ 15 | 16 | rasterBase <- raster::aggregate(raster_dem, fun = min, fact = 10) 17 | 18 | rasterBase <- raster::resample(rasterBase, raster_dem) 19 | 20 | drybrush_distance <- raster_dem - rasterBase 21 | 22 | drybrush_distance[is.na(drybrush_distance)] <- 0 23 | drybrush_distance[drybrush_distance < 0] <- 0 24 | 25 | drybrush_distance_std <- drybrush_distance / max_colour_altitude 26 | 27 | drybrush_distance_std[drybrush_distance_std > 1] <- 1 28 | 29 | elevation_overlay <- elevation_shade(drybrush_distance_std, elevation_palette = elevation_palette) 30 | 31 | elevation_overlay[,,4] <- opacity 32 | 33 | elevation_overlay 34 | 35 | } 36 | -------------------------------------------------------------------------------- /R/ggslippy.R: -------------------------------------------------------------------------------- 1 | #' Adds a layer created using slippy_overlay() or slippy_raster() to a 'ggplot2' chart 2 | #' 3 | #' @param slippy_raster A raster raster returned by either \code{slippy_raster()} or \code{slippy_overlay(return_png = FALSE)} 4 | #' @param alpha Opacity of the raster in 'ggplot2' 5 | #' @param set_coord_equal \code{TRUE} returns a square plot 6 | #' 7 | #' @return a ggplot object 8 | #' 9 | #' @examples 10 | #' library(ggplot2) 11 | #' library(geoviz) 12 | #' 13 | #' dem <- example_raster() 14 | #' 15 | #' dem <- raster::aggregate(dem, 10) #aggregate to speed up ggplot for testing 16 | #' 17 | #' gg_overlay_image <- slippy_overlay( 18 | #' dem, 19 | #' image_source = "stamen", 20 | #' image_type = "watercolor", 21 | #' return_png = FALSE, 22 | #' max_tiles = 2 23 | #' ) 24 | #' 25 | #' ggplot() + 26 | #' ggslippy(gg_overlay_image, set_coord_equal = FALSE) 27 | #' @export 28 | ggslippy <- function(slippy_raster, alpha = 1, set_coord_equal = TRUE){ 29 | 30 | image_df <- raster::as.data.frame(slippy_raster, xy = TRUE) 31 | 32 | names(image_df) <- c("x", "y", "red", "green", "blue") 33 | 34 | image_df$hex <- grDevices::rgb(image_df$red, image_df$green, image_df$blue, maxColorValue = 255) 35 | 36 | gg_out <- list( 37 | ggplot2::geom_raster(data = image_df, ggplot2::aes_string(x = "x", y = "y", fill = "hex"), alpha = alpha), 38 | ggplot2::scale_fill_identity() 39 | ) 40 | 41 | if(set_coord_equal){ 42 | gg_out <- append(gg_out, ggplot2::coord_equal()) 43 | } 44 | 45 | gg_out 46 | } 47 | -------------------------------------------------------------------------------- /man/get_slippy_map.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_slippy_map.R 3 | \name{get_slippy_map} 4 | \alias{get_slippy_map} 5 | \title{Obtains and merges map tiles from various sources using the 'slippymath' package} 6 | \usage{ 7 | get_slippy_map( 8 | bounding_box, 9 | image_source = "stamen", 10 | image_type = "watercolor", 11 | max_tiles = 10, 12 | api_key 13 | ) 14 | } 15 | \arguments{ 16 | \item{bounding_box}{Any object for which raster::extent() can be calculated.} 17 | 18 | \item{image_source}{Source for the overlay image. Valid entries are "mapbox", "mapzen", "stamen".} 19 | 20 | \item{image_type}{The type of overlay to request. "satellite", "mapbox-streets-v8", "mapbox-terrain-v2", "mapbox-traffic-v1", "terrain-rgb", "mapbox-incidents-v1" (mapbox), "dem" (mapzen) or "watercolor", "toner", "toner-background", "toner-lite" (stamen). You can also request a custom Mapbox style by specifying \code{image_source = "mapbox", image_type = "username/mapid"}} 21 | 22 | \item{max_tiles}{Maximum number of tiles to be requested by 'slippymath'} 23 | 24 | \item{api_key}{API key (required for 'mapbox')} 25 | } 26 | \value{ 27 | a rasterBrick with the same dimensions (but not the same resolution) as bounding_box 28 | } 29 | \description{ 30 | Obtains and merges map tiles from various sources using the 'slippymath' package 31 | } 32 | \examples{ 33 | map <- get_slippy_map(example_raster(), 34 | image_source = "stamen", 35 | image_type = "watercolor", 36 | max_tiles = 5) 37 | } 38 | -------------------------------------------------------------------------------- /man/mapbox_dem.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mapbox_dem.R 3 | \name{mapbox_dem} 4 | \alias{mapbox_dem} 5 | \title{Gets Digital Elevation Model (DEM) data from 'mapbox'} 6 | \usage{ 7 | mapbox_dem(lat, long, square_km, width_buffer = 1, max_tiles = 10, api_key) 8 | } 9 | \arguments{ 10 | \item{lat}{WGS84 latitude. Either a single point to use as the centre for a \code{square_km} sized raster, or a vector of track points} 11 | 12 | \item{long}{WGS84 longitude. Either a single point to use as the centre for a \code{square_km} sized raster, or a vector of track points} 13 | 14 | \item{square_km}{length of one edge the required square area, in km. Ignored if lat and long have length > 1} 15 | 16 | \item{width_buffer}{If lat and long have length > 1, used as buffer distance around the provided points in km} 17 | 18 | \item{max_tiles}{maximum number of map tiles to request. More tiles will give higher resolution scenes but take longer to download. Note that very small numbers of tiles may result in a scene that is not square.} 19 | 20 | \item{api_key}{'Mapbox' API key} 21 | } 22 | \value{ 23 | a raster with values corresponding to terrain height in metres 24 | } 25 | \description{ 26 | Gets Digital Elevation Model (DEM) data from 'mapbox' 27 | } 28 | \examples{ 29 | \dontrun{ 30 | #NOT RUN 31 | #mapbox_dem() requires a 'mapbox' API key 32 | 33 | mapbox_key = "YOUR_MAPBOX_API_KEY" 34 | 35 | lat = 54.4502651 36 | long = -3.1767946 37 | square_km = 20 38 | 39 | dem <- mapbox_dem(lat, long, square_km, api_key = mapbox_key) 40 | 41 | } 42 | } 43 | -------------------------------------------------------------------------------- /R/crop_raster_square.R: -------------------------------------------------------------------------------- 1 | #' Crops a raster and returns a smaller square raster 2 | #' 3 | #' @param rasterIn a raster 4 | #' @param lat WGS84 latitude of the centre of the cropped square 5 | #' @param long WGS84 longitude of the centre of the cropped square 6 | #' @param square_km length of one side of the square in km 7 | #' @param increase_resolution optional multiplier to increase number of cells in the raster 8 | #' 9 | #' @return A cropped raster 10 | #' 11 | #' @examples 12 | #' crop_raster_square(example_raster(), lat = 54.513293, long = -3.045598, square_km = 0.01) 13 | #' @export 14 | crop_raster_square <- function(rasterIn, lat, long, square_km, increase_resolution = 1){ 15 | 16 | bounding_shape <- square_bounding_box(lat, long, square_km) 17 | 18 | bounding_shape <- sp::spTransform(bounding_shape, sp::CRS(as.character(raster::crs(rasterIn)))) 19 | 20 | raster_crop <- raster::crop(rasterIn, bounding_shape) 21 | 22 | # Check that the resulting raster is square (identical lat and long resolution) and resample if it isn't. Needed for NASA ASTER data and maybe others. 23 | square_error <- nrow(raster_crop) / ncol(raster_crop) 24 | 25 | if(square_error != 1){ 26 | 27 | max_edge <- max(c(nrow(raster_crop), ncol(raster_crop))) 28 | 29 | template <- raster::raster(raster::extent(raster_crop), crs = raster::crs(raster_crop), nrow = max_edge, ncol = max_edge) 30 | 31 | raster_crop <- raster::resample(raster_crop, template) 32 | 33 | } 34 | 35 | if(increase_resolution > 1){ 36 | raster_crop <- raster::disaggregate(raster_crop, increase_resolution, method = 'bilinear') 37 | } 38 | 39 | return(raster_crop) 40 | } 41 | -------------------------------------------------------------------------------- /R/mapzen_dem.R: -------------------------------------------------------------------------------- 1 | #' Gets Digital Elevation Model (DEM) data from 'mapzen' via 'Amazon Public Datasets' 2 | #' 3 | #' @param lat WGS84 latitude. Either a single point to use as the centre for a \code{square_km} sized raster, or a vector of track points 4 | #' @param long WGS84 longitude. Either a single point to use as the centre for a \code{square_km} sized raster, or a vector of track points 5 | #' @param square_km length of one edge the required square area, in km. Ignored if lat and long have length > 1 6 | #' @param width_buffer If lat and long have length > 1, used as buffer distance around the provided points in km 7 | #' @param max_tiles maximum number of map tiles to request. More tiles will give higher resolution scenes but take longer to download. Note that very small numbers of tiles may result in a scene that is not square. 8 | #' 9 | #' @return a raster with values corresponding to terrain height in metres 10 | #' 11 | #' @examples 12 | #' lat = 54.4502651 13 | #' long = -3.1767946 14 | #' square_km = 2 15 | #' 16 | #' dem <- mapzen_dem(lat, long, square_km, max_tiles = 2) 17 | #' @export 18 | mapzen_dem <- function(lat, long, square_km, width_buffer = 1, max_tiles = 10){ 19 | 20 | mapzen_terrain <- 21 | slippy_raster( 22 | lat, 23 | long, 24 | square_km, 25 | image_source = "mapzen", 26 | image_type = "dem", 27 | max_tiles = max_tiles 28 | ) 29 | 30 | #(red * 256 + green + blue / 256) - 32768 31 | 32 | DEM <- 33 | (raster::raster(mapzen_terrain, layer = 1) * 256 + 34 | raster::raster(mapzen_terrain, layer = 2) + 35 | raster::raster(mapzen_terrain, layer = 3) / 256) - 32768 36 | 37 | return(DEM) 38 | 39 | } 40 | -------------------------------------------------------------------------------- /man/slippy_overlay.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/slippy_overlay.R 3 | \name{slippy_overlay} 4 | \alias{slippy_overlay} 5 | \title{Creates an overlay image from 'Mapbox' or 'Stamen' Maps using the 'slippymath' package} 6 | \usage{ 7 | slippy_overlay( 8 | raster_base, 9 | image_source = "stamen", 10 | image_type = "watercolor", 11 | max_tiles = 10, 12 | api_key, 13 | return_png = TRUE, 14 | png_opacity = 0.9 15 | ) 16 | } 17 | \arguments{ 18 | \item{raster_base}{A raster to use to calculate dimensions for the overlay} 19 | 20 | \item{image_source}{Source for the overlay image. Valid entries are "mapbox", "stamen".} 21 | 22 | \item{image_type}{The type of overlay to request. "satellite", "mapbox-streets-v8", "mapbox-terrain-v2", "mapbox-traffic-v1", "terrain-rgb", "mapbox-incidents-v1" (mapbox), "dem" (mapzen) or "watercolor", "toner", "toner-background", "toner-lite" (stamen). You can also request a custom Mapbox style by specifying \code{image_source = "mapbox", image_type = "username/mapid"}} 23 | 24 | \item{max_tiles}{Maximum number of tiles to be requested by slippymath} 25 | 26 | \item{api_key}{API key (required for mapbox)} 27 | 28 | \item{return_png}{\code{TRUE} to return a png image. \code{FALSE} will return a raster} 29 | 30 | \item{png_opacity}{Opacity of the returned image. Ignored if \code{return_png = FALSE}} 31 | } 32 | \value{ 33 | an overlay image for raster_base 34 | } 35 | \description{ 36 | Creates an overlay image from 'Mapbox' or 'Stamen' Maps using the 'slippymath' package 37 | } 38 | \examples{ 39 | overlay_image <- slippy_overlay(example_raster(), 40 | image_source = "stamen", 41 | image_type = "watercolor", 42 | max_tiles = 2) 43 | } 44 | -------------------------------------------------------------------------------- /R/elevation_shade.R: -------------------------------------------------------------------------------- 1 | #' Produces an elevation shaded image from a raster 2 | #' 3 | #' @param raster_dem a raster 4 | #' @param elevation_palette a vector of colours to use for elevation shading 5 | #' @param return_png \code{TRUE} to return an image. \code{FALSE} will return a raster 6 | #' @param png_opacity Opacity of the returned image. Ignored if \code{return_png = FALSE} 7 | #' 8 | #' @return elevation shaded image 9 | #' 10 | #' @examples 11 | #' elevation_shade(example_raster()) 12 | #' @export 13 | elevation_shade <- function(raster_dem, elevation_palette = c("#54843f", "#808080", "#FFFFFF"), return_png = TRUE, png_opacity = 0.9){ 14 | 15 | if(length(is.na(raster_dem)) > 0){ 16 | message("There are NA values in raster_dem. Assuming they are min(raster_dem[], na.rm = TRUE) for shading.") 17 | raster_dem[is.na(raster_dem)] <- min(raster_dem[], na.rm = TRUE) 18 | } 19 | 20 | rasterValues <- raster::values(raster_dem) 21 | 22 | colours <- grDevices::colorRamp(elevation_palette)(rescale(rasterValues, 0,1,min(rasterValues), max(rasterValues))) 23 | 24 | red <- raster_dem 25 | raster::values(red) <- colours[,1] 26 | green <- raster_dem 27 | raster::values(green) <- colours[,2] 28 | blue <- raster_dem 29 | raster::values(blue) <- colours[,3] 30 | 31 | rasterImage <- raster::brick(list(red, green, blue)) 32 | 33 | if(!return_png){ 34 | return(rasterImage) 35 | } 36 | 37 | tempImage <- tempfile(fileext = ".png") 38 | 39 | raster_to_png(rasterImage, tempImage) 40 | 41 | terrain_image <- png::readPNG(tempImage) 42 | 43 | file.remove(tempImage) 44 | 45 | #add an alpha layer for ease of overlaying in 'rayshader' 46 | alpha_layer <- matrix(png_opacity, nrow = dim(terrain_image)[1], ncol = dim(terrain_image)[2]) 47 | 48 | terrain_image <- abind::abind(terrain_image, alpha_layer) 49 | 50 | terrain_image 51 | } 52 | -------------------------------------------------------------------------------- /R/mapbox_dem.R: -------------------------------------------------------------------------------- 1 | #' Gets Digital Elevation Model (DEM) data from 'mapbox' 2 | #' 3 | #' @param lat WGS84 latitude. Either a single point to use as the centre for a \code{square_km} sized raster, or a vector of track points 4 | #' @param long WGS84 longitude. Either a single point to use as the centre for a \code{square_km} sized raster, or a vector of track points 5 | #' @param square_km length of one edge the required square area, in km. Ignored if lat and long have length > 1 6 | #' @param width_buffer If lat and long have length > 1, used as buffer distance around the provided points in km 7 | #' @param max_tiles maximum number of map tiles to request. More tiles will give higher resolution scenes but take longer to download. Note that very small numbers of tiles may result in a scene that is not square. 8 | #' @param api_key 'Mapbox' API key 9 | #' 10 | #' @return a raster with values corresponding to terrain height in metres 11 | #' 12 | #' @examples 13 | #' \dontrun{ 14 | #' #NOT RUN 15 | #' #mapbox_dem() requires a 'mapbox' API key 16 | #' 17 | #' mapbox_key = "YOUR_MAPBOX_API_KEY" 18 | #' 19 | #' lat = 54.4502651 20 | #' long = -3.1767946 21 | #' square_km = 20 22 | #' 23 | #' dem <- mapbox_dem(lat, long, square_km, api_key = mapbox_key) 24 | #' 25 | #' } 26 | #' @export 27 | mapbox_dem <- function(lat, long, square_km, width_buffer = 1, max_tiles = 10, api_key){ 28 | 29 | mapbox_terrain <- 30 | slippy_raster( 31 | lat, 32 | long, 33 | square_km, 34 | image_source = "mapbox", 35 | image_type = "terrain-rgb", 36 | max_tiles = max_tiles, 37 | api_key = api_key 38 | ) 39 | 40 | DEM = -10000 + (( 41 | raster::raster(mapbox_terrain, layer = 1) * 256 * 256 + 42 | raster::raster(mapbox_terrain, layer = 2) * 256 + 43 | raster::raster(mapbox_terrain, layer = 3)) * 0.1) 44 | 45 | return(DEM) 46 | 47 | } 48 | -------------------------------------------------------------------------------- /R/latlong_to_rayshader_coords.R: -------------------------------------------------------------------------------- 1 | #' Converts WGS84 lat long points into 'rayshader' coordinates. Useful for adding arbitrary points and text to a 'rayshader' scene. 2 | #' 3 | #' @param raster_input a raster 4 | #' @param lat vector of WGS84 latitude points 5 | #' @param long vector of WGS84 longitude points 6 | #' 7 | #' @return A tibble with x,y in 'rayshader' coordinates 8 | #' 9 | #' @examples 10 | #' latlong_to_rayshader_coords(example_raster(), example_igc()$lat, example_igc()$long) 11 | #' @export 12 | latlong_to_rayshader_coords <- function(raster_input, lat, long){ 13 | 14 | #Convert the track to spatialpoints in raster_input's projection 15 | track <- sp::SpatialPoints(cbind(long, lat), proj4string = sp::CRS("+proj=longlat +datum=WGS84 +no_defs")) 16 | track <- sp::spTransform(track, sp::CRS(as.character(raster::crs(raster_input)))) 17 | 18 | track <- tibble::as.tibble(track@coords) 19 | 20 | lat <- track$lat 21 | 22 | long <- track$long 23 | 24 | #Work out the dimensions of raster_input and map the track onto it 25 | e <- raster::extent(raster_input) 26 | 27 | cell_size_x <- raster::pointDistance(c(e@xmin, e@ymin), 28 | c(e@xmax, e@ymin), lonlat = FALSE)/ncol(raster_input) 29 | 30 | cell_size_y <- raster::pointDistance(c(e@xmin, e@ymin), 31 | c(e@xmin, e@ymax), lonlat = FALSE)/nrow(raster_input) 32 | 33 | distances_x <- raster::pointDistance(c(e@xmin, e@ymin), 34 | cbind(long, rep(e@ymin, length(long))), lonlat = FALSE)/cell_size_x - (e@xmax - e@xmin)/2/cell_size_x 35 | 36 | distances_y <- raster::pointDistance(c(e@xmin, e@ymin), 37 | cbind(rep(e@xmin, length(lat)), lat), lonlat = FALSE)/cell_size_y - (e@ymax - e@ymin)/2/cell_size_y 38 | 39 | tibble::tibble(x = distances_x, 40 | y = distances_y) 41 | 42 | } 43 | -------------------------------------------------------------------------------- /man/add_gps_to_rayshader.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add_gps_to_rayshader.R 3 | \name{add_gps_to_rayshader} 4 | \alias{add_gps_to_rayshader} 5 | \title{Adds a GPS trace to a 'rayshader' scene} 6 | \usage{ 7 | add_gps_to_rayshader( 8 | raster_input, 9 | lat, 10 | long, 11 | alt, 12 | zscale, 13 | line_width = 1, 14 | colour = "red", 15 | alpha = 0.8, 16 | lightsaber = TRUE, 17 | clamp_to_ground = FALSE, 18 | raise_agl = 0, 19 | ground_shadow = FALSE, 20 | as_line = TRUE, 21 | point_size = 20 22 | ) 23 | } 24 | \arguments{ 25 | \item{raster_input}{a raster} 26 | 27 | \item{lat}{vector of decimal latitude points} 28 | 29 | \item{long}{vector of decimal longitude points} 30 | 31 | \item{alt}{vector of altitudes} 32 | 33 | \item{zscale}{ratio of raster cells to altitude} 34 | 35 | \item{line_width}{line width of the gps trace} 36 | 37 | \item{colour}{colour of the gps trace} 38 | 39 | \item{alpha}{alpha of the gps trace (has no effect if lightsaber = TRUE)} 40 | 41 | \item{lightsaber}{(default = TRUE) gives the GPS trace an inner glow affect} 42 | 43 | \item{clamp_to_ground}{(default = FALSE) clamps the gps trace to ground level + raise_agl} 44 | 45 | \item{raise_agl}{(default = 0) raises a clamped to ground track by the specified amount. Useful if gps track occasionally disappears into the ground.} 46 | 47 | \item{ground_shadow}{(default = FALSE) adds a ground shadow to a flight gps trace} 48 | 49 | \item{as_line}{(default = TRUE) Set to FALSE to render single points instead of a trace line (which then ignores line_width & lightsaber)} 50 | 51 | \item{point_size}{size of points when as_line = TRUE} 52 | } 53 | \value{ 54 | Adds GPS trace to the current 'rayshader' scene 55 | } 56 | \description{ 57 | Adds a GPS trace to a 'rayshader' scene 58 | } 59 | \examples{ 60 | flight <- example_igc() 61 | add_gps_to_rayshader(example_raster(), 62 | flight$lat, 63 | flight$long, 64 | flight$altitude, 65 | zscale = 25) 66 | 67 | } 68 | -------------------------------------------------------------------------------- /man/mosaic_files.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mosaic_files.R 3 | \name{mosaic_files} 4 | \alias{mosaic_files} 5 | \title{Stitches together files into a single raster 6 | Requires a target directory of files that can be read with raster::raster(), e.g. .asc files, or a directory of .zip files containing these files} 7 | \usage{ 8 | mosaic_files( 9 | path, 10 | extract_zip = FALSE, 11 | file_match = ".*.asc", 12 | zip_file_match = ".*.zip", 13 | raster_output_file = "mosaic_out.raster", 14 | file_crs = NULL, 15 | raster_todisk = FALSE 16 | ) 17 | } 18 | \arguments{ 19 | \item{path}{path to files that are to be stitched together} 20 | 21 | \item{extract_zip}{\code{FALSE} to target .asc files, \code{TRUE} if your .asc files are zipped.} 22 | 23 | \item{file_match}{regex pattern to match .asc files, either in \code{path} or in zip files.} 24 | 25 | \item{zip_file_match}{regex pattern to match .zip files} 26 | 27 | \item{raster_output_file}{raster file to be created (will overwrite existing files)} 28 | 29 | \item{file_crs}{projection string of the input files. Output will always be WGS84.} 30 | 31 | \item{raster_todisk}{Setting \code{TRUE} will set \code{rasterOptions(todisk=TRUE)}, which can help with memory issues.} 32 | } 33 | \value{ 34 | TRUE 35 | } 36 | \description{ 37 | Stitches together files into a single raster 38 | Requires a target directory of files that can be read with raster::raster(), e.g. .asc files, or a directory of .zip files containing these files 39 | } 40 | \examples{ 41 | # Merges two small example .asc files of LIDAR data 42 | # from https://environment.data.gov.uk (open government licence) 43 | 44 | path_to_files <- system.file("extdata/example_asc", package = "geoviz") 45 | 46 | path_to_output <- tempdir() 47 | 48 | mosaic_files(path_to_files, 49 | raster_output_file = paste0(path_to_output, '/mosaic_out.raster', sep = ''), 50 | extract_zip = TRUE, file_crs = "+init=epsg:27700") 51 | 52 | raster_mosaic <- raster::raster(paste0(path_to_output, '/mosaic_out.gri', sep = '')) 53 | } 54 | -------------------------------------------------------------------------------- /vignettes/scene_with_gps_trace.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Scene With GPS trace" 3 | author: "Neil Charles" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Scene With GPS trace} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | Use geoviz to draw a small 'rayshader' scene and add a GPS track to it 13 | 14 | ```R 15 | library(geoviz) 16 | library(rayshader) 17 | 18 | #Load an example IGC (GPS track log) file 19 | 20 | igc <- example_igc() 21 | 22 | #Load a small example elevation raster showing a piece of the English Lake district 23 | #You can use mapbox_dem() to obtain a 50m resolution digital elevation model 24 | #of any location but will need your own mapbox key 25 | 26 | DEM <- example_raster() 27 | 28 | sunangle = 270 29 | 30 | zscale = 25 31 | 32 | #Get a Stamen map using ggmap that will cover our DEM 33 | 34 | stamen_overlay <- slippy_overlay(DEM, image_source = "stamen", image_type = "watercolor", png_opacity = 0.3) 35 | 36 | #Make an elevation shading layer with dark valleys and light peaks (not essential but I like it!) 37 | 38 | elevation_overlay <- elevation_shade(DEM, elevation_palette = c("#000000", "#FFFFFF"), png_opacity = 0.6) 39 | 40 | 41 | #Calculate the 'rayshader' scene (see 'rayshader' documentation) 42 | 43 | elmat = matrix( 44 | raster::extract(DEM, raster::extent(DEM), method = 'bilinear'), 45 | nrow = ncol(DEM), 46 | ncol = nrow(DEM) 47 | ) 48 | 49 | scene <- elmat %>% 50 | sphere_shade(sunangle = sunangle, texture = "bw") %>% 51 | add_overlay(elevation_overlay) %>% 52 | add_overlay(stamen_overlay) 53 | 54 | 55 | #Render the 'rayshader' scene 56 | 57 | rayshader::plot_3d( 58 | scene, 59 | elmat, 60 | zscale = zscale, 61 | solid = FALSE, 62 | shadow = TRUE, 63 | shadowdepth = -100 64 | ) 65 | 66 | #Add the gps track 67 | 68 | add_gps_to_rayshader( 69 | DEM, 70 | igc$lat, 71 | igc$long, 72 | igc$altitude, 73 | line_width = 1.5, 74 | lightsaber = TRUE, 75 | colour = "red", 76 | zscale = zscale, 77 | ground_shadow = TRUE 78 | ) 79 | 80 | 81 | ``` 82 | -------------------------------------------------------------------------------- /man/slippy_raster.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/slippy_raster.R 3 | \name{slippy_raster} 4 | \alias{slippy_raster} 5 | \title{Creates a square raster centred on any lat long point, or a rectangular raster surrounding a set of lat long points from 'Mapbox', 'Mapzen' or 'Stamen' Maps using the 'slippymath' package} 6 | \usage{ 7 | slippy_raster( 8 | lat, 9 | long, 10 | square_km, 11 | width_buffer = 1, 12 | image_source = "stamen", 13 | image_type = "watercolor", 14 | max_tiles = 10, 15 | api_key 16 | ) 17 | } 18 | \arguments{ 19 | \item{lat}{WGS84 latitude. Either a single point to use as the centre for a \code{square_km} sized raster, or a vector of track points} 20 | 21 | \item{long}{WGS84 longitude. Either a single point to use as the centre for a \code{square_km} sized raster, or a vector of track points} 22 | 23 | \item{square_km}{length of one edge the required square area, in km. Ignored if lat and long have length > 1} 24 | 25 | \item{width_buffer}{If lat and long have length > 1, used as buffer distance around the provided points in km} 26 | 27 | \item{image_source}{Source for the overlay image. Valid entries are "mapbox", "mapzen", "stamen".} 28 | 29 | \item{image_type}{The type of overlay to request. "satellite", "mapbox-streets-v8", "mapbox-terrain-v2", "mapbox-traffic-v1", "terrain-rgb", "mapbox-incidents-v1" (mapbox), "dem" (mapzen) or "watercolor", "toner", "terrain" (stamen)} 30 | 31 | \item{max_tiles}{Maximum number of tiles to be requested by 'slippymath'} 32 | 33 | \item{api_key}{API key (required for 'mapbox')} 34 | } 35 | \value{ 36 | a rasterBrick image 37 | } 38 | \description{ 39 | Creates a square raster centred on any lat long point, or a rectangular raster surrounding a set of lat long points from 'Mapbox', 'Mapzen' or 'Stamen' Maps using the 'slippymath' package 40 | } 41 | \examples{ 42 | lat <- 54.4502651 43 | long <- -3.1767946 44 | square_km <- 1 45 | 46 | overlay_image <- slippy_raster(lat = lat, 47 | long = long, 48 | square_km = square_km, 49 | image_source = "stamen", 50 | image_type = "watercolor", 51 | max_tiles = 5) 52 | } 53 | -------------------------------------------------------------------------------- /man/elevation_transparency.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/elevation_transparency.R 3 | \name{elevation_transparency} 4 | \alias{elevation_transparency} 5 | \title{Turns overlay images transparent based on altitude. Can be used to create an 6 | image overlay that will only apply to valleys, or only to hills.} 7 | \usage{ 8 | elevation_transparency( 9 | overlay_image, 10 | raster_dem, 11 | alpha_max = 0.4, 12 | alpha_min = 0, 13 | pct_alt_low = 0.05, 14 | pct_alt_high = 0.25 15 | ) 16 | } 17 | \arguments{ 18 | \item{overlay_image}{the image on which to alter transparency} 19 | 20 | \item{raster_dem}{elevation model raster file that will be used to adjust transparency} 21 | 22 | \item{alpha_max}{Transparency required at higher altitudes} 23 | 24 | \item{alpha_min}{Transparency required at lower altitudes} 25 | 26 | \item{pct_alt_low}{The percent of maximum altitude contained in raster_dem 27 | at which alpha_max will apply} 28 | 29 | \item{pct_alt_high}{The percent of maximum altitude contained in raster_dem 30 | at which alpha_min will apply} 31 | } 32 | \value{ 33 | An image with transparency defined by altitude 34 | } 35 | \description{ 36 | Turns overlay images transparent based on altitude. Can be used to create an 37 | image overlay that will only apply to valleys, or only to hills. 38 | } 39 | \examples{ 40 | # elevation_transparency defaults to making hills transparent. Flip alpha_max 41 | # and alpha_min values to reverse it. 42 | # 43 | # Transparency in the range between pct_alt_low and pct_alt_high will 44 | # smoothly transition between alpha_max and alpha_min. 45 | 46 | overlay_image <- elevation_shade(example_raster(), elevation_palette = c("#000000", "#FF0000")) 47 | 48 | #Making hills transparent 49 | 50 | ggmap_overlay_transparent_hills <- elevation_transparency(overlay_image, 51 | example_raster(), alpha_max = 0.8, alpha_min = 0, pct_alt_low = 0.05, 52 | pct_alt_high = 0.25) 53 | 54 | # To make valleys transparent, flip alpha_max and alpha_min 55 | ggmap_overlay_transparent_valleys <- elevation_transparency(overlay_image, 56 | example_raster(), alpha_max = 0, alpha_min = 0.8, pct_alt_low = 0.05, 57 | pct_alt_high = 0.25) 58 | } 59 | -------------------------------------------------------------------------------- /R/slippy_raster.R: -------------------------------------------------------------------------------- 1 | #' Creates a square raster centred on any lat long point, or a rectangular raster surrounding a set of lat long points from 'Mapbox', 'Mapzen' or 'Stamen' Maps using the 'slippymath' package 2 | #' 3 | #' @param lat WGS84 latitude. Either a single point to use as the centre for a \code{square_km} sized raster, or a vector of track points 4 | #' @param long WGS84 longitude. Either a single point to use as the centre for a \code{square_km} sized raster, or a vector of track points 5 | #' @param square_km length of one edge the required square area, in km. Ignored if lat and long have length > 1 6 | #' @param width_buffer If lat and long have length > 1, used as buffer distance around the provided points in km 7 | #' @param image_source Source for the overlay image. Valid entries are "mapbox", "mapzen", "stamen". 8 | #' @param image_type The type of overlay to request. "satellite", "mapbox-streets-v8", "mapbox-terrain-v2", "mapbox-traffic-v1", "terrain-rgb", "mapbox-incidents-v1" (mapbox), "dem" (mapzen) or "watercolor", "toner", "terrain" (stamen) 9 | #' @param max_tiles Maximum number of tiles to be requested by 'slippymath' 10 | #' @param api_key API key (required for 'mapbox') 11 | #' 12 | #' @return a rasterBrick image 13 | #' 14 | #' @examples 15 | #' lat <- 54.4502651 16 | #' long <- -3.1767946 17 | #' square_km <- 1 18 | #' 19 | #' overlay_image <- slippy_raster(lat = lat, 20 | #' long = long, 21 | #' square_km = square_km, 22 | #' image_source = "stamen", 23 | #' image_type = "watercolor", 24 | #' max_tiles = 5) 25 | #' @export 26 | slippy_raster <- function(lat, long, square_km, width_buffer = 1, image_source = "stamen", image_type = "watercolor", max_tiles = 10, api_key){ 27 | 28 | if(length(lat) != length(long)){ 29 | stop("lengths of lat and long do not match") 30 | } 31 | 32 | #Calc bounding box 33 | if(length(lat)==1){ 34 | bounding_box <- square_bounding_box(lat, long, square_km) #single point bounding box 35 | } else { 36 | bounding_box <- track_bounding_box(lat, long, width_buffer) 37 | } 38 | 39 | #Request slippy map 40 | raster_out <- get_slippy_map(bounding_box, image_source = image_source, image_type = image_type, max_tiles = max_tiles, api_key = api_key) 41 | 42 | return(raster_out) 43 | } 44 | -------------------------------------------------------------------------------- /news.md: -------------------------------------------------------------------------------- 1 | ##0.2.3 2 | Bug fixes: 3 | - Merging OS terrain 50 didn't work with a single file and documentation had errors. Fixed. 4 | 5 | 6 | ## 0.2.2 7 | Bug fixes: 8 | - 'Rayshader' changing coordinate system in v0.13.1 caused GPS tracks to be offset. latlong_to_rayshader_coords() updated to fix 9 | 10 | ## 0.2.1 11 | 12 | New features: 13 | - New function mapzen_dem() provides higher resolution DEM's than mapbox_dem(), without requiring an api key. Mapzen data has variable maximum resolutions in different parts of the world, see [Mapzen data sources](https://github.com/tilezen/joerd/blob/master/docs/data-sources.md). 14 | - mapbox_dem() and mapzen_dem() will now accept a vector of lat-long points and create a rectangular raster to contain them, to make it easy to visualise GPS tracks 15 | - Mapbox custom styles can be downloaded using get_slippy_map(image_source = "mapbox", image_type = "username/mapid"). This also works for slippy_overlay() 16 | - New vignette illustrating how to use mapzen_dem() to draw Hawaii 17 | 18 | Bug fixes: 19 | - Projections changed to laea centred on the requested lat-long to ensure square areas are actually square and not distorted by map projection. 20 | - elevation_transparency() and elevation_shade() will now accept a raster_dem that contains NA values and raise a warning rather than an error 21 | - 'EPSG' changed to 'epsg' in add_gps_to_rayshader() 22 | - Changed readr::read_csv for readr::read_lines in read_igc() to remove parsing warnings 23 | - Check in slippy_overlay() whether map image already has an alpha layer before adding one (fixes stamen toner) 24 | - Removed stamen terrain in documentation, because terrain returns a DEM, not an image. Could create stamen_dem(), but seems unnecessary, when mapzen_dem() and mapbox_dem() already exist 25 | 26 | Changes: 27 | - mapbox_dem() and mapzen_dem() return a raster with the number of cells defined by 'max_tiles', rather than superimposing a resolution over the top, that had previously defaulted to 1000x1000. This allows you to more easily draw high resolution Rayshader scenes and doesn't arbitrarily drop the resolution of your scene if you forgot to increase resolution from the default. 28 | - resolution option in slippy_raster() is deprecated 29 | - Dropped max_tiles defaults from 30 to 10 as a better compromise between speed and rayshader scene resolution. 30 | 31 | 32 | ## 0.2.0 33 | 34 | Initial CRAN submission 35 | -------------------------------------------------------------------------------- /tests/testthat/test_imagery.R: -------------------------------------------------------------------------------- 1 | context("imagery") 2 | 3 | library(geoviz) 4 | 5 | igc <- example_igc() 6 | DEM <- example_raster() 7 | lat = 54.4502651 8 | long = -3.1767946 9 | square_km = 1 10 | 11 | test_that("slippy_overlay() has correct dimensions", { 12 | slippy_overlay_result <- expect_warning(slippy_overlay(DEM, max_tiles = 5)) 13 | 14 | expect_is(slippy_overlay_result, "array") 15 | expect_equal(ncol(slippy_overlay_result), ncol(DEM)) 16 | expect_equal(nrow(slippy_overlay_result), nrow(DEM)) 17 | }) 18 | 19 | test_that("slippy_raster() returns data", { 20 | slippy_rater_result <- expect_warning( 21 | slippy_raster( 22 | lat, 23 | long, 24 | square_km, 25 | image_source = "stamen", 26 | image_type = "watercolor", 27 | max_tiles = 5 28 | ) 29 | ) 30 | 31 | expect_is(slippy_rater_result, "RasterBrick") 32 | }) 33 | 34 | test_that("elevation_shade() has correct dimensions", { 35 | elevation_shade_result <- 36 | elevation_shade( 37 | DEM, 38 | elevation_palette = c("#54843f", "#808080", "#FFFFFF"), 39 | return_png = TRUE 40 | ) 41 | 42 | expect_is(elevation_shade_result, "array") 43 | expect_equal(ncol(elevation_shade_result), ncol(DEM)) 44 | expect_equal(nrow(elevation_shade_result), nrow(DEM)) 45 | }) 46 | 47 | test_that("elevation_transparency() has correct dimensions", { 48 | elevation_shade_result <- 49 | elevation_shade( 50 | DEM, 51 | elevation_palette = c("#54843f", "#808080", "#FFFFFF"), 52 | return_png = TRUE 53 | ) 54 | 55 | elevation_transparency_result <- 56 | elevation_transparency( 57 | elevation_shade_result, 58 | DEM, 59 | alpha_max = 0.4, 60 | alpha_min = 0, 61 | pct_alt_low = 0.05, 62 | pct_alt_high = 0.25 63 | ) 64 | 65 | expect_is(elevation_transparency_result, "array") 66 | expect_equal(ncol(elevation_transparency_result), ncol(DEM)) 67 | expect_equal(nrow(elevation_transparency_result), nrow(DEM)) 68 | }) 69 | 70 | test_that("drybrush() has correct dimensions", { 71 | drybrush_result <- 72 | drybrush( 73 | DEM, 74 | aggregation_factor = 10, 75 | max_colour_altitude = 30, 76 | opacity = 0.5, 77 | elevation_palette = c("#3f3f3f", "#ffa500") 78 | ) 79 | 80 | expect_is(drybrush_result, "array") 81 | expect_equal(ncol(drybrush_result), ncol(DEM)) 82 | expect_equal(nrow(drybrush_result), nrow(DEM)) 83 | }) 84 | -------------------------------------------------------------------------------- /R/read_igc.R: -------------------------------------------------------------------------------- 1 | #' Load an IGC file 2 | #' 3 | #' @param path target IGC file 4 | #' 5 | #' @return a tibble 6 | #' 7 | #' @examples 8 | #' igc <- read_igc(system.file("extdata/example.igc", package = "geoviz")) 9 | #' @export 10 | read_igc <- function(path){ 11 | 12 | igc.data <- readr::read_lines(path) 13 | 14 | igc.data <- tibble::tibble(X1 = igc.data) 15 | 16 | names(igc.data)[1] <- "X1" 17 | 18 | flight.points <- igc.data %>% 19 | dplyr::select("X1") %>% #Keeps first column only in case of stray commas creating additional fields 20 | dplyr::filter(substr(.data$X1, 1, 1) == "B") %>% 21 | #Separate points data 22 | tidyr::separate( 23 | .data$X1, 24 | sep = c(1, 7, 15, 24, 30, 35), 25 | into = c( 26 | "id", 27 | "time_igc", 28 | "lat_igc", 29 | "long_igc", 30 | "altitude_igc_pressure", 31 | "altitude_igc_gps", 32 | "discarded" 33 | ) 34 | ) %>% 35 | dplyr::filter(substr(.data$altitude_igc_pressure, 1, 1) != "V") %>% #Pressure alt starting V (rest of record will be enmpty) 36 | #Format degrees minutes seconds 37 | dplyr::mutate( 38 | time_char = paste0( 39 | substr(.data$time_igc, 1, 2), 40 | ":", 41 | substr(.data$time_igc, 3, 4), 42 | ":", 43 | substr(.data$time_igc, 5, 6) 44 | ), 45 | lat_dms = paste0( 46 | substr(.data$lat_igc, 1, 2), 47 | "d", 48 | substr(.data$lat_igc, 3, 4), 49 | ".", 50 | substr(.data$lat_igc, 5, 7), 51 | "'", 52 | substr(.data$lat_igc, 8, 8) 53 | ), 54 | long_dms = paste0( 55 | substr(.data$long_igc, 1, 3), 56 | "d", 57 | substr(.data$long_igc, 4, 5), 58 | ".", 59 | substr(.data$long_igc, 6, 8), 60 | "'", 61 | substr(.data$long_igc, 9, 9) 62 | ), 63 | altitude_pressure = as.numeric(gsub("A", "", .data$altitude_igc_pressure)), 64 | altitude = as.numeric(.data$altitude_igc_gps) 65 | ) %>% 66 | #Convert to decimal lat long 67 | dplyr::mutate( 68 | time_hms = chron::chron(times = .data$time_char), 69 | lat = methods::as(sp::char2dms(.data$lat_dms), "numeric"), 70 | long = methods::as(sp::char2dms(.data$long_dms), "numeric") 71 | ) %>% 72 | dplyr::arrange(.data$time_hms) %>% 73 | dplyr::filter(!(.data$lat==0 & .data$long==0 & .data$altitude==0)) #dump bad rows where all data is 0 74 | 75 | return(flight.points) 76 | } 77 | -------------------------------------------------------------------------------- /vignettes/hawaii_mapzen_dem.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Hawaii Elevation and Bathymetry Using 'Mapzen'" 3 | author: "Neil Charles" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Hawaii Elevation and Bathymetry Using 'Mapzen'} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | Get elevation and bathymetry data for Hawaii from 'mapzen', add a 'stamen' overlay and render the scene. 13 | 14 | ```R 15 | library(geoviz) 16 | library(rayshader) 17 | 18 | # Coordinates for Hawaii 19 | lat = 19.593335 20 | lon = -155.4880287 21 | square_km = 50 22 | 23 | # Set max tiles to request from 'mapzen' and 'stamen'. 24 | # Increase this for a higher resolution image. 25 | max_tiles = 10 26 | 27 | # Get elevation data. Increase max_tiles for a higher resolution image. 28 | # Set max_tiles = 40 to reproduce the example above. 29 | dem <- mapzen_dem(lat, lon, square_km, max_tiles = max_tiles) 30 | 31 | # Get a stamen overlay (or a satellite overlay etc. by changing image_source) 32 | overlay_image <- 33 | slippy_overlay(dem, 34 | image_source = "stamen", 35 | image_type = "watercolor", 36 | png_opacity = 0.3, 37 | max_tiles = max_tiles) 38 | 39 | # Render the 'rayshader' scene. 40 | 41 | elmat = matrix( 42 | raster::extract(dem, raster::extent(dem), method = 'bilinear'), 43 | nrow = ncol(dem), 44 | ncol = nrow(dem) 45 | ) 46 | 47 | scene <- elmat %>% 48 | sphere_shade(sunangle = 270, texture = "bw") %>% 49 | add_overlay(overlay_image) # %>% 50 | 51 | # For a slower but higher quality render with more realistic shadows (see 'rayshader' documentation) 52 | # add_shadow( 53 | # ray_shade( 54 | # elmat, 55 | # anglebreaks = seq(30, 60), 56 | # sunangle = 270, 57 | # multicore = TRUE, 58 | # lambert = FALSE, 59 | # remove_edges = FALSE 60 | # ) 61 | # ) %>% 62 | # add_shadow(ambient_shade(elmat, multicore = TRUE, remove_edges = FALSE)) 63 | 64 | 65 | rayshader::plot_3d( 66 | scene, 67 | elmat, 68 | zscale = raster_zscale(dem) / 3, #exaggerate elevation by 3x 69 | solid = TRUE, 70 | shadow = FALSE, 71 | soliddepth = -raster_zscale(dem), 72 | water=TRUE, 73 | waterdepth = 0, 74 | wateralpha = 0.5, 75 | watercolor = "lightblue", 76 | waterlinecolor = "white", 77 | waterlinealpha = 0.5 78 | ) 79 | 80 | rgl::view3d(theta =290, phi = 18, zoom = 0.5, fov = 5) 81 | 82 | #rayshader::render_depth( 83 | # focus = 0.3, 84 | # fstop = 18, 85 | # filename = "LIDAR.png") 86 | 87 | 88 | ``` 89 | -------------------------------------------------------------------------------- /R/slippy_overlay.R: -------------------------------------------------------------------------------- 1 | #' Creates an overlay image from 'Mapbox' or 'Stamen' Maps using the 'slippymath' package 2 | #' 3 | #' @param raster_base A raster to use to calculate dimensions for the overlay 4 | #' @param image_source Source for the overlay image. Valid entries are "mapbox", "stamen". 5 | #' @param image_type The type of overlay to request. "satellite", "mapbox-streets-v8", "mapbox-terrain-v2", "mapbox-traffic-v1", "terrain-rgb", "mapbox-incidents-v1" (mapbox), "dem" (mapzen) or "watercolor", "toner", "toner-background", "toner-lite" (stamen). You can also request a custom Mapbox style by specifying \code{image_source = "mapbox", image_type = "username/mapid"} 6 | #' @param max_tiles Maximum number of tiles to be requested by slippymath 7 | #' @param api_key API key (required for mapbox) 8 | #' @param return_png \code{TRUE} to return a png image. \code{FALSE} will return a raster 9 | #' @param png_opacity Opacity of the returned image. Ignored if \code{return_png = FALSE} 10 | #' 11 | #' @return an overlay image for raster_base 12 | #' 13 | #' @examples 14 | #' overlay_image <- slippy_overlay(example_raster(), 15 | #' image_source = "stamen", 16 | #' image_type = "watercolor", 17 | #' max_tiles = 2) 18 | #' @export 19 | slippy_overlay <- function(raster_base, image_source = "stamen", image_type = "watercolor", max_tiles = 10, api_key, return_png = TRUE, png_opacity = 0.9){ 20 | 21 | #Calc bounding box to cover the raster 22 | bounding_box <- methods::as(raster::extent(raster_base), "SpatialPolygons") 23 | 24 | sp::proj4string(bounding_box) <- as.character(raster::crs(raster_base)) 25 | 26 | bounding_box <- sp::spTransform(bounding_box, sp::CRS("+proj=longlat +datum=WGS84 +no_defs")) 27 | 28 | #Request slippy map 29 | raster_out <- get_slippy_map(bounding_box, image_source = image_source, image_type = image_type, max_tiles = max_tiles, api_key = api_key) 30 | 31 | #Transform slippy map to a png that covers raster_input 32 | raster_out = raster::projectRaster(raster_out, crs = raster::crs(raster_base)) 33 | 34 | raster_out <- raster::resample(raster_out, raster_base) 35 | 36 | if(!return_png){ 37 | return(raster_out) 38 | } 39 | 40 | temp_map_image <- tempfile(fileext = ".png") 41 | 42 | raster_to_png(raster_out, temp_map_image) 43 | 44 | map_image <- png::readPNG(temp_map_image) 45 | file.remove(temp_map_image) 46 | 47 | #add an alpha layer if one is not present 48 | if(dim(map_image)[3]==3){ 49 | alpha_layer <- matrix(png_opacity, nrow = dim(map_image)[1], ncol = dim(map_image)[2]) 50 | 51 | map_image <- abind::abind(map_image, alpha_layer) 52 | } else { 53 | map_image[,,4] <- png_opacity 54 | } 55 | 56 | return(map_image) 57 | } 58 | -------------------------------------------------------------------------------- /R/elevation_transparency.R: -------------------------------------------------------------------------------- 1 | #' Turns overlay images transparent based on altitude. Can be used to create an 2 | #' image overlay that will only apply to valleys, or only to hills. 3 | #' 4 | #' @param overlay_image the image on which to alter transparency 5 | #' @param raster_dem elevation model raster file that will be used to adjust transparency 6 | #' @param alpha_max Transparency required at higher altitudes 7 | #' @param alpha_min Transparency required at lower altitudes 8 | #' @param pct_alt_low The percent of maximum altitude contained in raster_dem 9 | #' at which alpha_max will apply 10 | #' @param pct_alt_high The percent of maximum altitude contained in raster_dem 11 | #' at which alpha_min will apply 12 | #' 13 | #' @return An image with transparency defined by altitude 14 | #' 15 | #' @examples 16 | #' # elevation_transparency defaults to making hills transparent. Flip alpha_max 17 | #' # and alpha_min values to reverse it. 18 | #' # 19 | #' # Transparency in the range between pct_alt_low and pct_alt_high will 20 | #' # smoothly transition between alpha_max and alpha_min. 21 | #' 22 | #' overlay_image <- elevation_shade(example_raster(), elevation_palette = c("#000000", "#FF0000")) 23 | #' 24 | #' #Making hills transparent 25 | #' 26 | #' ggmap_overlay_transparent_hills <- elevation_transparency(overlay_image, 27 | #' example_raster(), alpha_max = 0.8, alpha_min = 0, pct_alt_low = 0.05, 28 | #' pct_alt_high = 0.25) 29 | #' 30 | #' # To make valleys transparent, flip alpha_max and alpha_min 31 | #' ggmap_overlay_transparent_valleys <- elevation_transparency(overlay_image, 32 | #' example_raster(), alpha_max = 0, alpha_min = 0.8, pct_alt_low = 0.05, 33 | #' pct_alt_high = 0.25) 34 | #' @export 35 | elevation_transparency <- function(overlay_image, raster_dem, alpha_max = 0.4, alpha_min = 0, pct_alt_low = 0.05, pct_alt_high = 0.25){ 36 | 37 | if (pct_alt_high == pct_alt_low){ 38 | stop("pct_alt_high must be > pct_alt_low") 39 | } 40 | 41 | if(length(is.na(raster_dem)) > 0){ 42 | message("There are NA values in raster_dem. Assuming they are min(raster_dem[], na.rm = TRUE) for shading.") 43 | raster_dem[is.na(raster_dem)] <- min(raster_dem[], na.rm = TRUE) 44 | } 45 | 46 | pct_max_height <- (raster::as.array(raster_dem) - min(raster::as.array(raster_dem))) / (max(raster::as.array(raster_dem)) - min(raster::as.array(raster_dem))) 47 | 48 | pct_max_height_alpha <- pct_max_height 49 | 50 | pct_max_height_alpha[pct_max_height[] < pct_alt_low] <- alpha_max 51 | 52 | pct_max_height_alpha[pct_max_height[] > pct_alt_high] <- alpha_min 53 | 54 | if(alpha_min < alpha_max){ 55 | pct_max_height_alpha[pct_max_height <= pct_alt_high & 56 | pct_max_height >= pct_alt_low] <- 57 | (1 - (pct_max_height[pct_max_height[] <= pct_alt_high & 58 | pct_max_height[] >= pct_alt_low] - pct_alt_low) / (pct_alt_high - pct_alt_low)) * alpha_max 59 | } else { 60 | pct_max_height_alpha[pct_max_height <= pct_alt_high & 61 | pct_max_height >= pct_alt_low] <- 62 | ((pct_max_height[pct_max_height[] <= pct_alt_high & 63 | pct_max_height[] >= pct_alt_low] - pct_alt_low) / (pct_alt_high - pct_alt_low)) * alpha_min 64 | } 65 | 66 | overlay_image[,,4] <- pct_max_height_alpha 67 | 68 | overlay_image 69 | } 70 | -------------------------------------------------------------------------------- /R/add_gps_to_rayshader.R: -------------------------------------------------------------------------------- 1 | #' Adds a GPS trace to a 'rayshader' scene 2 | #' 3 | #' @param raster_input a raster 4 | #' @param lat vector of decimal latitude points 5 | #' @param long vector of decimal longitude points 6 | #' @param alt vector of altitudes 7 | #' @param zscale ratio of raster cells to altitude 8 | #' @param line_width line width of the gps trace 9 | #' @param colour colour of the gps trace 10 | #' @param alpha alpha of the gps trace (has no effect if lightsaber = TRUE) 11 | #' @param lightsaber (default = TRUE) gives the GPS trace an inner glow affect 12 | #' @param clamp_to_ground (default = FALSE) clamps the gps trace to ground level + raise_agl 13 | #' @param raise_agl (default = 0) raises a clamped to ground track by the specified amount. Useful if gps track occasionally disappears into the ground. 14 | #' @param ground_shadow (default = FALSE) adds a ground shadow to a flight gps trace 15 | #' @param as_line (default = TRUE) Set to FALSE to render single points instead of a trace line (which then ignores line_width & lightsaber) 16 | #' @param point_size size of points when as_line = TRUE 17 | #' 18 | #' @return Adds GPS trace to the current 'rayshader' scene 19 | #' 20 | #' @examples 21 | #' flight <- example_igc() 22 | #' add_gps_to_rayshader(example_raster(), 23 | #' flight$lat, 24 | #' flight$long, 25 | #' flight$altitude, 26 | #' zscale = 25) 27 | #' 28 | #' @export 29 | add_gps_to_rayshader <- function(raster_input, lat, long, alt, zscale, line_width = 1, colour = "red", alpha = 0.8, lightsaber = TRUE, clamp_to_ground = FALSE, raise_agl = 0, ground_shadow = FALSE, as_line = TRUE, point_size = 20){ 30 | 31 | coords <- latlong_to_rayshader_coords(raster_input, lat, long) 32 | 33 | distances_x <- coords$x 34 | 35 | distances_y <- coords$y 36 | 37 | 38 | if (clamp_to_ground | ground_shadow) { 39 | 40 | sp_gps <- sp::SpatialPoints(cbind(long, lat), proj4string = sp::CRS('+init=epsg:4326')) 41 | 42 | sp_gps <- sp::spTransform(sp_gps, sp::CRS(as.character(raster::crs(raster_input)))) 43 | 44 | gps_ground_line <- raster::extract(raster_input, sp_gps) 45 | 46 | } 47 | 48 | if(clamp_to_ground){ 49 | 50 | track_altitude <- gps_ground_line 51 | 52 | } else { 53 | 54 | track_altitude <- alt 55 | } 56 | 57 | if(as_line){ 58 | 59 | if(!lightsaber){ 60 | rgl::lines3d( 61 | distances_x, #lat 62 | track_altitude / zscale, #alt 63 | -distances_y, #long 64 | color = colour, 65 | alpha = alpha, 66 | lwd = line_width 67 | ) 68 | } else { 69 | 70 | #render track 3 times with transparent & thicker outside 71 | 72 | rgl::lines3d( 73 | distances_x, 74 | track_altitude / zscale, 75 | -distances_y, 76 | color = colour, 77 | alpha = 0.2, 78 | lwd = line_width * 6, 79 | shininess = 25, 80 | fog = TRUE 81 | ) 82 | 83 | rgl::lines3d( 84 | distances_x, 85 | track_altitude / zscale, 86 | -distances_y, 87 | color = colour, 88 | alpha = 0.6, 89 | lwd = line_width * 3, 90 | shininess = 80, 91 | fog = TRUE 92 | ) 93 | 94 | rgl::lines3d( 95 | distances_x, 96 | track_altitude / zscale, 97 | -distances_y, 98 | color = lighten(colour), 99 | alpha = 1, 100 | lwd = 1, 101 | shininess = 120 102 | ) 103 | 104 | } 105 | 106 | if(ground_shadow){ 107 | rgl::lines3d( 108 | distances_x, 109 | gps_ground_line / zscale + raise_agl, 110 | -distances_y, 111 | color = "black", 112 | alpha = 0.4, 113 | lwd = line_width * 2, 114 | shininess = 25, 115 | fog = TRUE 116 | ) 117 | } 118 | } else { 119 | 120 | rgl::points3d( 121 | distances_x, #lat 122 | track_altitude / zscale, #alt 123 | -distances_y, #long 124 | color = colour, 125 | alpha = alpha, 126 | size = point_size 127 | ) 128 | } 129 | } 130 | -------------------------------------------------------------------------------- /R/get_slippy_map.R: -------------------------------------------------------------------------------- 1 | #' Obtains and merges map tiles from various sources using the 'slippymath' package 2 | #' 3 | #' @param bounding_box Any object for which raster::extent() can be calculated. 4 | #' @param image_source Source for the overlay image. Valid entries are "mapbox", "mapzen", "stamen". 5 | #' @param image_type The type of overlay to request. "satellite", "mapbox-streets-v8", "mapbox-terrain-v2", "mapbox-traffic-v1", "terrain-rgb", "mapbox-incidents-v1" (mapbox), "dem" (mapzen) or "watercolor", "toner", "toner-background", "toner-lite" (stamen). You can also request a custom Mapbox style by specifying \code{image_source = "mapbox", image_type = "username/mapid"} 6 | #' @param max_tiles Maximum number of tiles to be requested by 'slippymath' 7 | #' @param api_key API key (required for 'mapbox') 8 | #' 9 | #' @return a rasterBrick with the same dimensions (but not the same resolution) as bounding_box 10 | #' 11 | #' @examples 12 | #' map <- get_slippy_map(example_raster(), 13 | #' image_source = "stamen", 14 | #' image_type = "watercolor", 15 | #' max_tiles = 5) 16 | #' @export 17 | get_slippy_map <- function(bounding_box, image_source = "stamen", image_type = "watercolor", max_tiles = 10, api_key){ 18 | 19 | #Transform bounding_box to WGS84 20 | if(stringr::str_detect(class(bounding_box)[1], "Raster")){ 21 | bounding_box <- raster::projectRaster(bounding_box, crs = "+proj=longlat +datum=WGS84 +no_defs") 22 | } else { 23 | bounding_box <- sp::spTransform(bounding_box, sp::CRS("+proj=longlat +datum=WGS84 +no_defs")) 24 | } 25 | 26 | xt_scene <- raster::extent(bounding_box) 27 | 28 | overlay_bbox <- 29 | sf::st_bbox(c(xmin = xt_scene@xmin, 30 | xmax = xt_scene@xmax, 31 | ymin = xt_scene@ymin, 32 | ymax = xt_scene@ymax), 33 | crs = sf::st_crs("+proj=longlat +datum=WGS84 +no_defs")) 34 | 35 | tile_grid <- slippymath::bbox_to_tile_grid(overlay_bbox, max_tiles = max_tiles) 36 | 37 | if(tile_grid$zoom > 11 & image_source == "mapbox" & image_type == "terrain-rgb"){ 38 | message(glue::glue("Zoom level with max_tiles = {max_tiles} is {tile_grid$zoom}. Resetting zoom to 11, which is max for mapbox.terrain-rgb.")) 39 | tile_grid <- slippymath::bbox_to_tile_grid(overlay_bbox, zoom = 11) 40 | } 41 | 42 | 43 | #Stamen Maps 44 | if(image_source=="stamen"){ 45 | if(stringr::str_detect(image_type, "watercolor")){ 46 | query_string <- paste0("http://tile.stamen.com/", image_type, "/{zoom}/{x}/{y}.jpg") 47 | } else { 48 | query_string <- paste0("http://tile.stamen.com/", image_type, "/{zoom}/{x}/{y}.png") 49 | } 50 | 51 | #Mapbox maps 52 | } else if (image_source=="mapbox"){ 53 | 54 | if(stringr::str_detect(image_type, "\\/")){ #image_type is a custom mapbox map url 55 | 56 | query_string <- paste0("https://api.mapbox.com/styles/v1/", image_type, "/tiles/{zoom}/{x}/{y}", 57 | "?access_token=", 58 | api_key) 59 | 60 | } else { 61 | 62 | query_string <- paste0("https://api.mapbox.com/v4/mapbox.", image_type, "/{zoom}/{x}/{y}.jpg90", 63 | "?access_token=", 64 | api_key) 65 | } 66 | 67 | #Mapzen maps 68 | } else if (image_source=="mapzen" & image_type=="dem"){ 69 | 70 | query_string <- "https://s3.amazonaws.com/elevation-tiles-prod/terrarium/{zoom}/{x}/{y}.png" 71 | 72 | } else { 73 | stop(glue::glue("unknown source '{image_source}'")) 74 | } 75 | 76 | #create a temporary dir to hold tiles 77 | tile_dir <- tempfile(pattern = "map_tiles_") 78 | dir.create(tile_dir) 79 | 80 | images <- 81 | purrr::pmap(tile_grid$tiles, 82 | function(x, y, zoom){ 83 | outfile <- glue::glue("{tile_dir}/{x}_{y}.jpg") 84 | curl::curl_download(url = glue::glue(query_string), 85 | destfile = outfile) 86 | outfile 87 | }, 88 | zoom = tile_grid$zoom) 89 | 90 | raster_out <- compose_tile_grid(tile_grid, images) #not slippymath version due to png issue 91 | 92 | #Transform raster to match projection of the original bounding box 93 | raster_out <- raster::projectRaster(raster_out, crs = raster::crs(bounding_box)) 94 | 95 | unlink(tile_dir, recursive = TRUE) #kill the temp directory containing tiles 96 | 97 | return(raster_out) 98 | } 99 | -------------------------------------------------------------------------------- /R/mosaic_files.R: -------------------------------------------------------------------------------- 1 | #' Stitches together files into a single raster 2 | #' Requires a target directory of files that can be read with raster::raster(), e.g. .asc files, or a directory of .zip files containing these files 3 | #' 4 | #' @param path path to files that are to be stitched together 5 | #' @param extract_zip \code{FALSE} to target .asc files, \code{TRUE} if your .asc files are zipped. 6 | #' @param file_match regex pattern to match .asc files, either in \code{path} or in zip files. 7 | #' @param zip_file_match regex pattern to match .zip files 8 | #' @param raster_output_file raster file to be created (will overwrite existing files) 9 | #' @param file_crs projection string of the input files. Output will always be WGS84. 10 | #' @param raster_todisk Setting \code{TRUE} will set \code{rasterOptions(todisk=TRUE)}, which can help with memory issues. 11 | #' 12 | #' @return TRUE 13 | #' 14 | #' @examples 15 | #' # Merges two small example .asc files of LIDAR data 16 | #' # from https://environment.data.gov.uk (open government licence) 17 | #' 18 | #' path_to_files <- system.file("extdata/example_asc", package = "geoviz") 19 | #' 20 | #' path_to_output <- tempdir() 21 | #' 22 | #' mosaic_files(path_to_files, 23 | #' raster_output_file = paste0(path_to_output, '/mosaic_out.raster', sep = ''), 24 | #' extract_zip = TRUE, file_crs = "+init=epsg:27700") 25 | #' 26 | #' raster_mosaic <- raster::raster(paste0(path_to_output, '/mosaic_out.gri', sep = '')) 27 | #' @export 28 | mosaic_files <- 29 | function(path, 30 | extract_zip = FALSE, 31 | file_match = ".*.asc", 32 | zip_file_match = ".*.zip", 33 | raster_output_file = "mosaic_out.raster", 34 | file_crs = NULL, 35 | raster_todisk = FALSE) { 36 | if (substr(path, nchar(path), nchar(path)) != "/") { 37 | path <- glue::glue("{path}/") 38 | } 39 | 40 | if(raster_todisk){raster::rasterOptions(todisk=TRUE)} 41 | 42 | read_from_zip <- function(zip_file, file_match, extract_path) { 43 | asc_files_in_zip <- utils::unzip(zip_file, list = TRUE) %>% 44 | dplyr::filter(stringr::str_detect(.data$Name, file_match)) %>% 45 | dplyr::pull(.data$Name) 46 | 47 | utils::unzip(zip_file, asc_files_in_zip, exdir = extract_path) 48 | } 49 | 50 | if (extract_zip) { 51 | message("Unzipping files...") 52 | 53 | #create a temporary dir to hold unzipped asc files 54 | unzip_dir <- tempfile(pattern = "asc_unzip_") 55 | dir.create(unzip_dir) 56 | 57 | zip_files <- 58 | tibble::tibble(zip_files = list.files(path, zip_file_match, full.names = TRUE)) %>% 59 | dplyr::pull("zip_files") %>% 60 | purrr::walk(.f = ~ read_from_zip(., file_match, unzip_dir)) 61 | 62 | path = glue::glue("{unzip_dir}/") 63 | } 64 | 65 | grid_files <- list.files(path, file_match) 66 | 67 | if(length(grid_files)==0){stop(glue::glue("No files found matching {file_match}"))} 68 | 69 | #Load all terrain files in input directory 70 | raster_layers <- tibble::tibble(filename = grid_files) 71 | 72 | message("Merging files...") 73 | 74 | #Intialise a raster to merge in the rest of the files one at a time. Can't do it all at once due to memory issues. 75 | raster_mosaic <- 76 | raster::raster(glue::glue( 77 | "{path}{raster_layers$filename[1]}" 78 | )) 79 | 80 | if(is.na(raster::crs(raster_mosaic))){ 81 | if(is.null(file_crs)){stop("Input files have no CRS, use the file_crs option to set it")} 82 | raster::crs(raster_mosaic) <- file_crs 83 | } 84 | 85 | pb <- progress::progress_bar$new(total = nrow(raster_layers)-1) 86 | 87 | #Merge additional layers one at a time 88 | if(nrow(raster_layers) > 1){ 89 | for (i in 2:nrow(raster_layers)) { 90 | new_raster <- 91 | raster::raster(glue::glue( 92 | "{path}{raster_layers$filename[i]}" 93 | )) 94 | 95 | if(is.na(raster::crs(raster_mosaic))){ 96 | raster::crs(new_raster) <- file_crs 97 | } 98 | 99 | raster_mosaic <- 100 | raster::mosaic(raster_mosaic, new_raster, fun = "mean") 101 | 102 | pb$tick() 103 | } 104 | } 105 | 106 | raster::writeRaster(raster_mosaic, raster_output_file, overwrite = TRUE) 107 | 108 | if(extract_zip){unlink(unzip_dir, recursive = TRUE)} #kill the temp directory if unzipping 109 | 110 | message("Done") 111 | 112 | return(TRUE) 113 | 114 | } 115 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | square_bounding_box <- function(lat, long, square_km){ 2 | #create point 3 | bounding_box <- sp::SpatialPoints(cbind(long, lat, square_km), proj4string = sp::CRS("+proj=longlat +datum=WGS84 +no_defs")) 4 | 5 | #Round target lat long to use to use as centre for equal area projection 6 | lat_round <- round(lat, 0) 7 | long_round <- round(long, 0) 8 | 9 | #Transform to be able to buffer 10 | bounding_box <- 11 | sp::spTransform(bounding_box, sp::CRS(paste0("+proj=laea +lat_0=", lat_round, 12 | " +lon_0=", long_round, 13 | " +x_0=4321000 +y_0=3210000 +ellps=GRS80 ", 14 | "+towgs84=0,0,0,0,0,0,0 +units=m +no_defs"))) 15 | 16 | #create buffer square 17 | bounding_shape <- rgeos::gBuffer(bounding_box, width = bounding_box$square_km * 1000, quadsegs=1, capStyle="SQUARE") 18 | 19 | return(bounding_shape) 20 | } 21 | 22 | track_bounding_box <- function(lat_points, long_points, width_buffer){ 23 | 24 | #Error: package rgdal is required for spTransform methods 25 | #rgdal added to Imports and called here to pass checks 26 | temp_rgdal <- rgdal::getGDALCheckVersion() 27 | 28 | #Make a bounding box around the track points 29 | bounding_box <- sp::SpatialPoints(cbind(long_points, lat_points), 30 | proj4string = sp::CRS("+proj=longlat +datum=WGS84 +no_defs")) 31 | 32 | bounding_box <- methods::as(raster::extent(bounding_box), 'SpatialPolygons') 33 | 34 | sp::proj4string(bounding_box) <- "+proj=longlat +datum=WGS84 +no_defs" 35 | 36 | #Reproject for rgeos 37 | bounding_box <- sp::spTransform(bounding_box, sp::CRS("+proj=laea +lat_0=52 +lon_0=10 +x_0=4321000 +y_0=3210000 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs")) 38 | 39 | #Pad a border around the bounding box 40 | bounding_shape <- rgeos::gBuffer(bounding_box, capStyle = "SQUARE", width = width_buffer * 1000) 41 | 42 | return(bounding_shape) 43 | 44 | } 45 | 46 | rescale <- function (x, nx1, nx2, minx, maxx){ 47 | nx = nx1 + (nx2 - nx1) * (x - minx)/(maxx - minx) 48 | return(nx) 49 | } 50 | 51 | lighten <- function(color, factor=0.2){ 52 | col <- grDevices::col2rgb(color) 53 | col <- col+ (255 - col) * factor 54 | col <- grDevices::rgb(t(col), maxColorValue=255) 55 | col 56 | } 57 | 58 | 59 | compose_tile_grid <- function (tile_grid, images) 60 | { 61 | #Adapted from slippymath to cope with 8 bit png images (1 layer). Slippymath saves them as .jpg but they aren't 62 | bricks <- purrr::pmap(.l = list(x = tile_grid$tiles$x, y = tile_grid$tiles$y, 63 | image = images), .f = function(x, y, image, zoom) { 64 | bbox <- slippymath::tile_bbox(x, y, zoom) 65 | 66 | raster_img <- raster::brick(image, crs = attr(bbox, 67 | "crs")$proj4string) 68 | #adaptation -------------------- 69 | if (dim(raster_img)[3]==1){ #tile_raster has one layer 70 | raster_img <- raster::raster(image, crs = attr(bbox, 71 | "crs")$proj4string) 72 | 73 | #Apply the raster's colortable to create a 3 layer rgb version 74 | raster_img <- raster::setValues(raster::brick(raster_img, raster_img, raster_img), 75 | t(grDevices::col2rgb(raster_img@legend@colortable))[raster::values(raster_img) + 1,]) 76 | } 77 | #------------------------------- 78 | 79 | raster::extent(raster_img) <- raster::extent(bbox[c("xmin", 80 | "xmax", "ymin", "ymax")]) 81 | raster_img 82 | }, zoom = tile_grid$zoom) 83 | geo_refd_raster <- do.call(raster::merge, bricks) 84 | geo_refd_raster 85 | } 86 | 87 | 88 | raster_to_png <- function(tile_raster, file_path) 89 | { 90 | 91 | #Adapted from slippymath to fix margin problem 92 | tile_raster@data@values <- sweep(tile_raster@data@values, 93 | MARGIN = 2, STATS = tile_raster@data@max, FUN = "/") 94 | 95 | png::writePNG(raster::as.array(tile_raster), target = file_path) 96 | 97 | } 98 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![lifecycle](https://img.shields.io/badge/lifecycle-maturing-blue.svg)](https://www.tidyverse.org/lifecycle/#maturing) 2 | [![CRAN status](https://www.r-pkg.org/badges/version/geoviz)](https://cran.r-project.org/package=geoviz) 3 | ![Downloads](https://cranlogs.r-pkg.org/badges/grand-total/geoviz) 4 | [![Travis build status](https://travis-ci.org/neilcharles/geoviz.svg?branch=master)](https://travis-ci.org/neilcharles/geoviz) 5 | # Geoviz 6 | 7 | Helper functions to draw ['rayshader'](https://github.com/tylermorganwall/rayshader) scenes. 8 | - Using elevation data from 'Mapzen' and 'Mapbox' 9 | - With map and satellite overlays 10 | - Blending between different overlays at different altitudes 11 | - with added GPS tracks 12 | - From EU Copernicus, NASA ASTER or any other DEM (Digital Elevation Model) data 13 | - With elevation shading (green valleys and snow capped peaks, or anything else you want) 14 | 15 | ['Rayshader'](https://github.com/tylermorganwall/rayshader) is an awesome bit of kit! I'm just doing some colouring in. 16 | 17 | Tutorials below and more [here](http://www.hilltop-analytics.com/category/rstats/geoviz/). 18 | 19 | ### Installing 20 | 21 | geoviz is on CRAN: 22 | 23 | ```R 24 | install.packages("geoviz") 25 | ``` 26 | 27 | Or for the latest development version: 28 | 29 | ```R 30 | remotes::install_github("neilcharles/geoviz") 31 | ``` 32 | 33 | Read [news](https://github.com/neilcharles/geoviz/blob/master/news.md) to understand the latest updates and bug fixes. 34 | 35 | Geoviz helps you to draw images like these. 36 | 37 | ![](man/figures/bw_example.jpg) 38 | 39 | ![](man/figures/ullswater.jpg) 40 | 41 | 42 | ![](vignettes/figures/hawaii.jpg) 43 | 44 | ### Example 45 | 46 | ```R 47 | library(geoviz) 48 | library(rayshader) 49 | 50 | #Load an example IGC (GPS track log) file 51 | 52 | igc <- example_igc() 53 | 54 | #Load a small example elevation raster showing a piece of the English Lake district 55 | 56 | DEM <- example_raster() 57 | 58 | sunangle = 270 59 | 60 | zscale = 25 61 | 62 | #Get a Stamen map that will cover our DEM 63 | 64 | stamen_overlay <- slippy_overlay(DEM, image_source = "stamen", image_type = "watercolor", png_opacity = 0.3) 65 | 66 | #Make an elevation shading layer with dark valleys and light peaks (not essential but I like it!) 67 | 68 | elevation_overlay <- elevation_shade(DEM, elevation_palette = c("#000000", "#FFFFFF"), png_opacity = 0.6) 69 | 70 | 71 | #Calculate the 'rayshader' scene (see 'rayshader' documentation) 72 | 73 | elmat = matrix( 74 | raster::extract(DEM, raster::extent(DEM), method = 'bilinear'), 75 | nrow = ncol(DEM), 76 | ncol = nrow(DEM) 77 | ) 78 | 79 | scene <- elmat %>% 80 | sphere_shade(sunangle = sunangle, texture = "bw") %>% 81 | add_overlay(elevation_overlay) %>% 82 | add_overlay(stamen_overlay) 83 | 84 | 85 | #Render the 'rayshader' scene 86 | 87 | rayshader::plot_3d( 88 | scene, 89 | elmat, 90 | zscale = zscale, 91 | solid = FALSE, 92 | shadow = TRUE, 93 | shadowdepth = -100 94 | ) 95 | ``` 96 | 97 | ![](man/figures/example1.jpg) 98 | 99 | 100 | ```R 101 | 102 | #Add the gps track 103 | 104 | add_gps_to_rayshader( 105 | DEM, 106 | igc$lat, 107 | igc$long, 108 | igc$altitude, 109 | line_width = 1.5, 110 | lightsaber = TRUE, 111 | colour = "red", 112 | zscale = zscale, 113 | ground_shadow = TRUE 114 | ) 115 | 116 | 117 | ``` 118 | 119 | ![](man/figures/example2.jpg) 120 | 121 | ### Quick access to digital elevation model data 122 | 123 | To draw scenes using sub 2m resolution DEM's, you'll need to download your own data (see below), but geoviz also has helpful functions to obtain DEM data from [Mapbox](https://docs.mapbox.com/help/troubleshooting/access-elevation-data/) and [Mapzen](https://www.mapzen.com/). Mapzen doesn't require an API key and gives access to higher resolution data, depending on where in the world you request. 124 | 125 | ```R 126 | 127 | library(rayshader) 128 | library(geoviz) 129 | 130 | mapbox_key <- "YOUR MAPBOX KEY" 131 | 132 | lat <- 54.4502651 133 | long <- -3.1767946 134 | square_km <- 20 135 | 136 | #Get elevation data from Mapbox 137 | dem <- mapbox_dem(lat, long, square_km, api_key = mapbox_key) 138 | 139 | #Note: You can get elevation data from Mapzen instead, which doesn't require an API key. 140 | #You'll still need an API key for any mapbox image overlays. 141 | #Get a DEM from mapzen with: 142 | #dem <- mapzen_dem(lat, long, square_km) 143 | 144 | #Get an overlay image (Stamen for this example because it doesn't need an API key) 145 | overlay_image <- 146 | slippy_overlay(dem, image_source = "stamen", image_type = "watercolor", png_opacity = 0.5) 147 | 148 | #Optionally, turn mountainous parts of the overlay transparent 149 | overlay_image <- 150 | elevation_transparency(overlay_image, 151 | dem, 152 | pct_alt_high = 0.5, 153 | alpha_max = 0.9) 154 | 155 | 156 | #Draw the 'rayshader' scene 157 | elmat = matrix( 158 | raster::extract(dem, raster::extent(dem), method = 'bilinear'), 159 | nrow = ncol(dem), 160 | ncol = nrow(dem) 161 | ) 162 | 163 | scene <- elmat %>% 164 | sphere_shade(sunangle = 270, texture = "desert") %>% 165 | add_overlay(overlay_image) 166 | 167 | rayshader::plot_3d( 168 | scene, 169 | elmat, 170 | zscale = raster_zscale(dem), 171 | solid = FALSE, 172 | shadow = TRUE, 173 | shadowdepth = -150 174 | ) 175 | ``` 176 | 177 | ![](man/figures/example3.jpg) 178 | 179 | ```R 180 | # You can also visualise your data in ggplot2 rather than 'rayshader'. 181 | 182 | gg_overlay_image <- 183 | slippy_overlay( 184 | dem, 185 | image_source = "stamen", 186 | image_type = "watercolor", 187 | return_png = FALSE 188 | ) 189 | 190 | ggplot2::ggplot() + 191 | ggslippy(gg_overlay_image) 192 | 193 | 194 | ``` 195 | 196 | 197 | ### Handling digital elevation model data 198 | 199 | DEM files can be downloaded from various sources, usually in .asc or .tif format. Often, they will be small files that need to be stitched together to render the scene that you want. 200 | 201 | If you have downloaded a set of DEM files, use mosaic_files() to create a single raster for use with 'rayshader'. The mosaic_files() function is flexible and will accept a directory of files or zipped files, using any naming convention and file extension. 202 | 203 | ```R 204 | mosaic_files( 205 | "path/to/zip/files", 206 | extract_zip = TRUE, 207 | file_match = ".*.TIF", 208 | raster_output_file = "mosaic_out.raster" 209 | ) 210 | 211 | raster_mosaic <- raster::raster("mosaic_out.gri") 212 | ``` 213 | 214 | ### DEM data sources 215 | 216 | The following is by no means an exhaustive list of data sources, but it will get you started. 217 | 218 | 219 | **EU Copernicus** 220 | 221 | EU coverage. 222 | 223 | Copernicus map tiles are large, typically 3-5GB each and covering a country sized area. Download [Copernicus](https://land.copernicus.eu/imagery-in-situ/eu-dem/eu-dem-v1.1?tab=mapview) 224 | 225 | ```R 226 | zscale <- 25 227 | ``` 228 | 229 | **OS Terrain 50** 230 | 231 | UK coverage. Copernicus also covers the UK and comes as a single file covering the whole UK if you want to use that instead. 232 | 233 | Download [OS Terrain 50](https://www.ordnancesurvey.co.uk/business-and-government/products/terrain-50.html) 234 | 235 | ```R 236 | mosaic_files( 237 | "path/to/zip/files", 238 | extract_zip = TRUE, 239 | zip_file_match = ".*GRID.*.zip", 240 | file_match = ".*.asc$", 241 | raster_output_file = "mosaic_out.raster", 242 | file_crs = '+proj=tmerc +lat_0=49 +lon_0=-2 +k=0.9996012717 +x_0=400000 +y_0=-100000 +ellps=airy +datum=OSGB36 +units=m +no_defs' 243 | ) 244 | 245 | raster_mosaic <- raster::raster("mosaic_out.gri") 246 | 247 | zscale <- 50 248 | ``` 249 | 250 | **NASA ASTER** 251 | 252 | Whole world coverage but quite noisy. Copernicus is better if you're mapping in the EU. 253 | 254 | Download [NASA Aster](https://search.earthdata.nasa.gov/search/granules?p=C197265171-LPDAAC_ECS&q=aster&ok=aster). 255 | Search for "ASTER" in the top left box and select "ASTER Global Digital Elevation Model V002" underneath the map. You won't realistically be able to stitch together a single file of the whole world - it would be enormous - so just download the areas you need. 256 | 257 | Stitching together the separate files is the same process as for OS Terrain 50. 258 | 259 | ```R 260 | zscale <- 30 261 | ``` 262 | 263 | 264 | ### Slicing pieces out of the DEM 265 | 266 | You probably don't want to render everything in your DEM data, you'll want to cut out a piece. Geoviz has two functions to help you do this. 267 | 268 | Crop out a square around a point... 269 | 270 | ```R 271 | 272 | library(ggmap) 273 | 274 | register_google(key = your_google_key) 275 | 276 | #Note that the below will only work if you point it at DEM data that contains Keswick! 277 | 278 | coords <- geocode("Keswick, UK") 279 | 280 | DEM <- crop_raster_square(big_DEM, coords$lat, coords$lon, square_km) 281 | ``` 282 | 283 | Or crop a section from your DEM to fit a GPS track... 284 | 285 | ```R 286 | 287 | igc <- example_igc() 288 | 289 | DEM <- crop_raster_track(example_raster(), igc$lat, igc$long, width_buffer = 2) 290 | ``` 291 | 292 | ### Loading GPS tracks 293 | 294 | You can load GPS track data any way that you like and pass decimal lat-longs as vectors to geoviz functions (see code examples above). 295 | 296 | If your GPS data is in IGC format - commonly used for glider flight data - then geoviz has a function read_igc(), which will do all the formatting work for you. 297 | 298 | If your GPS data is in .gpx format, the plotKML package has a handy function readGPX(). 299 | 300 | ```R 301 | igc <- read_igc("path/to/your/file.igc") 302 | ``` 303 | 304 | ### Adding GPS traces to 'rayshader' scenes 305 | 306 | Geoviz converts decimal lat-long GPS traces into the 'rayshader' coordinate system and then plots the GPS track using the function add_gps_to_rayshader(). Rather than adding a trace to a scene, if you just want to convert lat-long points into 'rayshader' coordinates and see the converted data (e.g. so you can add your own rgl shapes to the scene or for use with 'rayshder' render_label() function), use latlong_to_rayshader_coords(). 307 | --------------------------------------------------------------------------------