hypertidy / ximage

good image()
https://hypertidy.github.io/ximage/
Other
7 stars 1 forks source link

add mesh_plot mode from anglr #5

Open mdsumner opened 1 year ago

mdsumner commented 1 year ago

will need something like

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

and

mdsumner commented 1 year ago

what we really need though is

mdsumner commented 1 year ago

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)

image

mdsumner commented 1 year ago

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)