Ecosyste.ms: Awesome
An open API service indexing awesome lists of open source software.
https://github.com/statnmap/maps2ray
Transform maps (vector with {sf}, {raster}) to be added in a {rayshader} scene
https://github.com/statnmap/maps2ray
Last synced: 3 months ago
JSON representation
Transform maps (vector with {sf}, {raster}) to be added in a {rayshader} scene
- Host: GitHub
- URL: https://github.com/statnmap/maps2ray
- Owner: statnmap
- License: other
- Created: 2019-10-07T06:41:59.000Z (about 5 years ago)
- Default Branch: master
- Last Pushed: 2019-12-06T13:21:25.000Z (almost 5 years ago)
- Last Synced: 2024-05-21T02:11:39.070Z (6 months ago)
- Language: R
- Size: 4.81 MB
- Stars: 9
- Watchers: 4
- Forks: 2
- Open Issues: 2
-
Metadata Files:
- Readme: README.Rmd
- License: LICENSE
Awesome Lists containing this project
README
---
output: github_document
---
```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.path = "man/figures/README-",
out.width = "100%"
)
```
# maps2ray
The goal of maps2ray is to transform spatial objects from {sf} and {raster} to
be used in {rayshader} 3D outputs.
## Installation
You can install the development version from [GitHub](https://github.com/) with:
``` r
# install.packages("devtools")
devtools::install_github("statnmap/maps2ray")
```
## Example
This procedure is explained in a blog post at: https://statnmap.com/2019-10-06-follow-moving-particle-trajectory-on-raster-with-rayshader/
```{r, message=FALSE}
library(maps2ray)
library(rayshader)
library(sf)
library(raster)
library(rasterVis)
library(ggplot2)
library(dplyr)
library(rgl)
```
- Read internal raster file
```{r}
f <- system.file("extdata/altitude_l93.tif", package = "maps2ray")
altitude <- raster(f)
```
### Create rayshaded raster basis
Create the {rayshader} terrain object to be used in both 2D and 3D outputs
```{r, message=FALSE}
# Transform raster as matrix
datamat <- t(as.matrix(altitude))
# Rayshade raster
zscale <- 5
ambmat <- ambient_shade(datamat, zscale = zscale)
raymat <- ray_shade(datamat, zscale = zscale, lambert = TRUE)
# Create ray_image
ray_image <- datamat %>%
sphere_shade(texture = "imhof4") %>%
add_shadow(raymat, max_darken = 0.5) %>%
add_shadow(ambmat, max_darken = 0.5)
# Plot 2D
plot_map(ray_image)
```
### Example with points trajectory
- Create a trajectory as {sf} object
```{r}
line_mat <- matrix(c(280000, 370000, 6700000, 6700000), ncol = 2)
line_traject <- st_linestring(x = line_mat)
point_traject <- st_sample(line_traject, size = 50, type = "regular") %>%
st_set_crs(2154) %>%
st_sf()
# Plot
gplot(altitude) +
geom_tile(aes(fill = value)) +
geom_sf(data = point_traject, colour = "white", inherit.aes = FALSE) +
scale_fill_viridis_c()
```
- Transform {sf} trajectory to {rayshader} coordinates reference system, relative to the `altitude` raster
```{r, message=FALSE, warning=FALSE}
points_ray <- sf_proj_as_ray(r = altitude, sf = point_traject,
z_pos = maxValue(altitude) + 10,
zscale = zscale)
```
- Plot rayshader image in 2D and add points with new coordinates reference system of {rayshader}: `sf` list in the output of `sf_proj_as_ray()`.
```{r ray2dtotal, warning=FALSE}
# plot rayshader in 2D
plot_map(ray_image)
plot(points_ray$sf, col = "blue", pch = 20, add = TRUE, reset = FALSE)
```
- Plot {rayshader} image in 3D and overlay points with the new coordinates reference system of {rayshader}: `coords` list in the output of `sf_proj_as_ray()`.
```{r, eval=FALSE}
# Create 3D scene
ray_image %>%
plot_3d(
datamat,
zscale = zscale, windowsize = c(500, 500),
soliddepth = -max(datamat, na.rm = TRUE)/zscale,
water = TRUE, wateralpha = 0,
theta = 15, phi = 40,
zoom = 0.6,
fov = 60)
# Add points over rayshader scene
spheres3d(
bind_rows(points_ray$coords$coords),
col = "blue", add = TRUE, radius = 10,
alpha = 1)
# rgl::snapshot3d(file.path("img", "ray3dtotal.png"))
# rgl::rgl.close()
```
```{r, echo=FALSE}
knitr::include_graphics("img/ray3dtotal.png")
```
### Example with line
```{r, eval=FALSE}
line_mat <- matrix(c(280000, 370000, 6680000, 6720000), ncol = 2)
line_mat2 <- matrix(c(280000, 370000, 6680000, 6680000), ncol = 2)
line_traject <- st_sf(
geometry = st_sfc(list(
st_multilinestring(list(st_linestring(x = line_mat))),
st_multilinestring(list(st_linestring(x = line_mat2)))
)), crs = 2154)
# With no tranformation
plot(altitude)
plot(line_traject, col = "blue", pch = 20, add = TRUE)
# Transform for rayshader
zscale <- 5
lines_ray <- sf_proj_as_ray(r = altitude, sf = line_traject,
z_pos = maxValue(altitude) + 10,
zscale = zscale)
# Plot
# plot rayshader in 2D
plot_map(ray_image)
plot(lines_ray$sf, col = "blue", pch = 20, add = TRUE, reset = FALSE)
```
In 3D
```{r, eval=FALSE}
ray_image %>%
plot_3d(
datamat,
zscale = zscale, windowsize = c(500, 500),
soliddepth = -max(datamat, na.rm = TRUE)/zscale,
water = TRUE, wateralpha = 0,
theta = 15, phi = 40,
zoom = 0.6,
fov = 60)
# Add points over rayshader scene
lines3d(
bind_rows(lines_ray$coords$coords),
col = "blue", add = TRUE, radius = 10,
alpha = 1)
# rgl::snapshot3d(file.path("img", "ray3d_lines.png"))
# rgl::rgl.close()
```
```{r, echo=FALSE}
knitr::include_graphics("img/ray3d_lines.png")
```
### Example with polygons
```{r}
pol_mat <- matrix(
c(280000, 370000, 370000, 280000,
6680000, 6720000, 6680000, 6680000), ncol = 2)
pol_mat2 <- matrix(
c(280000, 370000, 280000, 280000,
6680000, 6720000, 6720000, 6680000), ncol = 2)
pol_traject <- st_sf(
geometry = st_sfc(list(
st_multipolygon(list(st_polygon(x = list(pol_mat)))),
st_multipolygon(list(st_polygon(x = list(pol_mat2))))
)), crs = 2154)
# With no tranformation
plot(altitude)
plot(pol_traject, col = c("red", "blue"), pch = 20, add = TRUE)
# Transform for rayshader
zscale <- 5
pols_ray <- sf_proj_as_ray(r = altitude, sf = pol_traject,
z_pos = maxValue(altitude) + 10,
zscale = zscale)
# Plot
# plot rayshader in 2D
plot_map(ray_image)
plot(pols_ray$sf, col = c("red", "blue"), pch = 20, add = TRUE, reset = FALSE)
```
In 3D
```{r, eval=FALSE}
ray_image %>%
plot_3d(
datamat,
zscale = zscale, windowsize = c(500, 500),
soliddepth = -max(datamat, na.rm = TRUE)/zscale,
water = TRUE, wateralpha = 0,
theta = 15, phi = 40,
zoom = 0.6,
fov = 60)
# Add points over rayshader scene
lines3d(
bind_rows(pols_ray$coords$coords),
col = "blue", add = TRUE, radius = 10,
alpha = 1)
# rgl::snapshot3d(file.path("img", "ray3d_polygons.png"))
# rgl::rgl.close()
```
```{r, echo=FALSE}
knitr::include_graphics("img/ray3d_polygons.png")
```