prototype: nested tibble raster for ggplot2

[mdsumner]

can this be workable for a geom_raster2?

rtab creates a single-row data frame with the values of that tile in a nested column (in raster order). This can generalized to multiple tiles, simply organized as nrow, ncol, extent of each.

sub_rtab subsamples by a constant factor, decimates the pixel values and updates nrows/ncols (needs to generalize to x, y factors and care for edge cases, and pass into GDAL for flexible subsampling and upsampling.

plot_rtab sets up a plot of an rtab with rasterImage.

library(raster)
r <- raster(volcano)
rtab(r)
plot_rtab(rtab(r))
plot_rtab(sub_rtab(rtab(r), 10), interpolate = FALSE)


rtab <- function(x, ...) {
  tibble::tibble(xmin = raster::xmin(x), 
         xmax = raster::xmax(x), 
         ymin = raster::ymin(x), 
         ymax = raster::ymax(x), 
         crs = raster::projection(x), 
         nrows = raster::nrow(x), 
         ncols = raster::ncol(x), 
         nlayers = raster::nlayers(x),
         raster_ = list(tabularaster::as_tibble(x, cell = FALSE)))
}

plot_rtab <- function(x, ...) {
  xr <- unlist(x[1, c("xmin", "xmax")])
  yr <- unlist(x[1, c("ymin", "ymax")])
  plot(NA, xlim = xr, 
           ylim = yr)
  m <- t(matrix(x$raster_[[1]][["cellvalue"]], x$ncols[1], x$nrows[1]))
  #browser()
  cols <-  viridis::viridis(100)
  rgb1 <- scales::rescale(col2rgb(cols), to = c(0, 1))
  a <- array(t(rgb1[, scales::rescale(m, to = c(1, length(cols)))]), c(nrow(m), ncol(m), 3))
  rasterImage(a, xr[1], yr[1], xr[2], yr[2], ...)
}
sub_rtab <- function(x, factor = 1, ...) {
  if (factor <= 1) return(x)
  xi <- seq(1, x$ncols[1], by = factor)
  yi <- seq(1, x$nrows[1], by = factor)
  #browser()
  m <- matrix(x$raster_[[1]][["cellvalue"]], x$ncols[1], x$nrows[1])[, x$nrows[1]:1]
  m1 <- m[xi, rev(yi)]
  x$raster_[[1]] <- tibble::tibble(cellvalue = c(m1))
  x$ncols[1] <- length(xi)
  x$nrows[1] <- length(yi)
  x
}

[mdsumner]

Pretty sure that can't work, here's the same idea inside out, the single row meta is the raster spec and the parent is just the pixel values

rtab <- function(x, ...) {
  meta <- tibble::tibble(xmin = raster::xmin(x), 
                 xmax = raster::xmax(x), 
                 ymin = raster::ymin(x), 
                 ymax = raster::ymax(x), 
                 crs = raster::projection(x), 
                 nrows = raster::nrow(x), 
                 ncols = raster::ncol(x), 
                 nlayers = raster::nlayers(x))
    structure(tabularaster::as_tibble(x, cell = FALSE), 
    meta = meta)
}

plot_rtab <- function(x, ...) {
  meta <- attr(x, "meta")
  xr <- unlist(meta[1, c("xmin", "xmax")])
  yr <- unlist(meta[1, c("ymin", "ymax")])
  plot(NA, xlim = xr, 
       ylim = yr)
  m <- t(matrix(x[["cellvalue"]], meta$ncols[1], meta$nrows[1]))
  #browser()
  cols <-  viridis::viridis(100)
  rgb1 <- scales::rescale(col2rgb(cols), to = c(0, 1))
  a <- array(t(rgb1[, scales::rescale(m, to = c(1, length(cols)))]), c(nrow(m), ncol(m), 3))
  rasterImage(a, xr[1], yr[1], xr[2], yr[2], ...)
}
sub_rtab <- function(x, factor = 1, ...) {
  if (factor <= 1) return(x)
  meta <- attr(x, "meta")
  xi <- seq(1, meta$ncols[1], by = factor)
  yi <- seq(1, meta$nrows[1], by = factor)
  #browser()
  m <- matrix(x[["cellvalue"]], meta$ncols[1], meta$nrows[1])[, meta$nrows[1]:1]
  m1 <- m[xi, rev(yi)]
  x <- tibble::tibble(cellvalue = c(m1))
  meta$ncols[1] <- length(xi)
  meta$nrows[1] <- length(yi)
  structure(x, meta = meta)
}