Open mdsumner opened 1 year ago
what we really need though is
this is scattered around
all the workd is done, just textures::quad probably shoul be {quad} and be done with that
dm <- c(360, 180)
z <- whatarelief::elevation(dimension = dm)
#image()
z <- t(z[dm[2]:1, ])
quadmesh <- textures::quad(dm, extent = c(-180, 180, -90, 90), ydown = FALSE)
library(affinity)
quadmesh$vb[3, ] <- colMeans(matrix(c(tl(z), tr(z), bl(z), br(z)), 4L, byrow = TRUE), na.rm = TRUE)
quadmesh$material$color <- palr::d_pal(1:ncol(quadmesh$ib))
quadmesh$material$color <- palr::d_pal(quadmesh$vb[3, quadmesh$ib[1, ]])
rp <- function(x, target) {
xy <- reproj::reproj(t(x$vb[1:2, ]), target, source = "OGC:CRS84")[,1:2, drop = F]
x$vb[1:2, ] <- t(xy)
x
}
anglr::mesh_plot(rp(quadmesh, "+proj=laea"), asp = 1)
bit more of a story
dm <- c(360, 180)
z <- whatarelief::elevation(dimension = dm)
## we need to be in R matrix orientation now
z <- t(z[dm[2]:1, ])
quadmesh <- textures::quad(dm, ydown = FALSE)
## we can use extent = in quad() or we can
quadmesh$vb[1,] <- scales::rescale(quadmesh$vb[1,], c(-180, 180))
quadmesh$vb[2,] <- scales::rescale(quadmesh$vb[2,], c(-90, 90))
## these functions put our centre-based values onto corners
ul <- function(x) {
cbind(NA_integer_, rbind(x, NA_integer_))
}
ur <- function(x) {
cbind(rbind(x, NA_integer_), NA_integer_)
}
ll <- function(x) {
cbind(rbind(NA_integer_, x), NA_integer_)
}
lr <- function(x) {
cbind(rbind(NA_integer_, x), NA_integer_)
}
## distribute centre based values onto their corners (just the mean, some have some NA but we don't care)
cxy <- function(x) {
colMeans(matrix(c(ul(x), ur(x), ll(x), lr(x)), 4L, byrow = TRUE), na.rm = TRUE)
}
## now, distribute the matrix onto the quad corners
quadmesh$vb[3, ] <- colMeans(matrix(c(tl(z), tr(z), bl(z), br(z)), 4L, byrow = TRUE), na.rm = TRUE)
## colorize it
quadmesh$material$color <- palr::d_pal(quadmesh$vb[3, quadmesh$ib[1, ]])
## plot it
anglr::mesh_plot(quadmesh)
## this is cool, because we can totally subvert the georeferencing up there
lon <- matrix(vaster::x_centre(dm, c(-180, 180, -90, 90)), dm[1], dm[2])
lat <- matrix(rep(vaster::y_centre(dm, c(-180, 180, -90, 90)), each = dm[1]), dm[1], dm[2])
## now, distribute the matrix onto the quad corners
quadmesh$vb[1, ] <- cxy(lon)
quadmesh$vb[2, ] <- cxy(lat)
quadmesh$vb[3, ] <- cxy(z)
anglr::mesh_plot(quadmesh)
maps::map(add = TRUE)
## now we can subvert this for reals
xy <- reproj::reproj(matrix(c(lon, lat), ncol = 2), "+proj=laea +lon_0=147", source = "OGC:CRS84")
x <- lon; x[] <- xy[,1]
y <- lat; y[] <- xy[,2]
## clean up a little first
x[abs(lon) > 179] <- NA
y[abs(lon) > 179] <- NA
quadmesh$vb[1, ] <- cxy(x)
quadmesh$vb[2, ] <- cxy(y)
quadmesh$vb[3, ] <- cxy(z)
anglr::mesh_plot(quadmesh, asp = 1)
will need something like
and