Skip to content
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

Open
4 tasks
mdsumner opened this issue Dec 20, 2022 · 3 comments
Open
4 tasks

add mesh_plot mode from anglr #5

mdsumner opened this issue Dec 20, 2022 · 3 comments

Comments

@mdsumner
Copy link
Member

will need something like

f (is.list(extent) && length(extent) == 2) {
    ximage_meshplot(x, extent, add = add)
  }

and

  • unpack raster/nativeraster to colours
  • no transformations but do
  • add ability for extent to be 2 2D arrays, or just all the xy coords
  • handle corner cases (for ROMS etc)
@mdsumner
Copy link
Member Author

what we really need though is

  • the as.mesh3d logic (a lot is in textures?)
  • we need the ability go from centre coords to corner coords
  • because, even a straightforward expand.grid mesh doesn't know how a centre point maps to a corne
  • that's why as.mesh3d has this heinous indexing, it doesn't have one quad verts after another their all interleaved based on the aright logic

@mdsumner
Copy link
Member Author

this is scattered around

  • tl, tr, br, bl are in {affinity} and they replace internal anglr vxy() by simple array ops
  • textures::quad( ydown) does the basic conversion to mesh, with optional extent to scale them (but that's easily done outside)
  • when it comes to mesh3d, if we convert an array to mesh-z, we probably don't care about x, y, (lon or lat)
  • because, they are now z - we want to spread them around the corners

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)

image

@mdsumner
Copy link
Member Author

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
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant