-
Notifications
You must be signed in to change notification settings - Fork 1
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
add mesh_plot mode from anglr #5
Comments
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)
|
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
will need something like
and
The text was updated successfully, but these errors were encountered: