ggplot for generic coords - (approx) continuous fill with mesh3d

[mdsumner]

library(ggplot2)
sfx <- sf::st_transform(sf::st_cast(dplyr::filter(silicate::inlandwaters, Province == "Tasmania"), "POLYGON")[2, ], 4326)
topo <- ceramic::cc_elevation(sfx, zoom = 9)

mesh <- anglr::as.mesh3d(anglr::copy_down(anglr::DEL(sfx, max_area = .0001), 
                                          topo))
fortify.mesh3d <- function(x, ...) {
  idx <- if (!is.null(x$it)) x$it else x$ib
  nc <- dim(idx)[2L]
  idx <- as.vector(idx)
  xx <- x ## workaround the tibble name-steal
  tibble::tibble(x = xx$vb[1L, idx],
                 y = xx$vb[2L, idx],
                 z = xx$vb[3L, idx],
                 group = rep(seq_len(nc), each = 3L))
}
ggplot(mesh) + geom_polygon(aes(x, y, group = group, fill = z), colour = NA) + 
  coord_sf(crs = sf::st_crs(silicate::inlandwaters))

[mdsumner]

This implies a "mesh colouring" facility in palr, maybe mesh_pal()? I.e. https://github.com/AustralianAntarcticDivision/palr/issues/8

[mdsumner]

Here's a more native approach

  library(anglr)
#> This is an early developmental version of anglr (0.4.8.9604),
#>  still in an experimental state with changes pending.
  x <- sf::st_cast(dplyr::filter(silicate::inlandwaters, Province == "Tasmania"), "POLYGON")[2, ]
#> Warning in st_cast.sf(dplyr::filter(silicate::inlandwaters, Province == :
#> repeating attributes for all sub-geometries for which they may not be constant

topo <- ceramic::cc_elevation(x, zoom = 9)
#> Preparing to download: 56 tiles at zoom = 9 from 
#> https://api.mapbox.com/v4/mapbox.terrain-rgb/
xx <- DEL(x, max_area = 2e6)
mesh <- as.mesh3d(copy_down(xx, topo))
#> transforming model vertices to raster coordinate system for copy down

mesh$material$color <- colourvalues::colour_values(colMeans(matrix(mesh$vb[3, mesh$it], 3)))
mesh_plot(mesh, asp = 1)

^{Created on 2020-04-07 by the reprex package (v0.3.0)}

[mdsumner]

3d version just for fun

library(anglr)
#> This is an early developmental version of anglr (0.4.8.9604),
#>  still in an experimental state with changes pending.
x <- sf::st_cast(dplyr::filter(silicate::inlandwaters, Province == "Tasmania"), "POLYGON")[2, ]
#> Warning in st_cast.sf(dplyr::filter(silicate::inlandwaters, Province == :
#> repeating attributes for all sub-geometries for which they may not be constant

topo <- ceramic::cc_elevation(x, zoom = 9)
#> Preparing to download: 56 tiles at zoom = 9 from 
#> https://api.mapbox.com/v4/mapbox.terrain-rgb/
xx <- DEL(x, max_area = 1e5)
mesh <- as.mesh3d(copy_down(xx, topo))
#> transforming model vertices to raster coordinate system for copy down

mesh$material$color <- colourvalues::colour_values(colMeans(matrix(mesh$vb[3, mesh$it], 3)))
##mesh_plot(mesh, asp = 1)
plot3d(mesh); rgl::aspect3d(1, 1, 0.02); rgl::clear3d("bboxdeco")