hypertidy/ximage

add mesh_plot mode from anglr

mdsumner opened this issue · 3 comments

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)

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

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

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)