RGB for raster

[mdsumner]

where to put this

#' Raster data to RGB
#'
#' Map a raster of numeric values to an RGB 3-layer raster brick.
#'
#' If no `col` is provided, the default image palette is used. The density
#' can be controlled with `n` and the mapping  with the optional
#' `breaks`. If `breaks` is included as well as `n`, `n` is ignored.
#'
#' Please note that this is fairly wasteful thing to do, the overall data is expanded
#' from a single layer to three - it fills a specific task which is to create
#' textures for 3D mapping, and this is the only way to do it currently. (Plus
#' sometimes it's handy for other reasons, creating PNGs etc.).
#' @param x raster of values (single layer only)
#' @param col function to generate colours, or a vector of hex colours
#' @param ... ignored
#' @param breaks optionally used to specify color mapping
#' @param n optionally used to specify density of colours from `col` (ignored if breaks is set)
#'
#' @return
#' @export
#'
#' @examples
#' library(raster)
#' im <- raster_rgb(volcano)
#' plotRGB(im)
#' vv <- unique(quantile(volcano, seq(0, 1, length = 12)))
#' plotRGB(raster_rgb(volcano, breaks = vv))
#' plotRGB(raster_rgb(volcano, breaks = vv[-c(4, 6)], col = gray.colors(9)))
#' plotRGB(raster_rgb(volcano, n = 4))
#' plotRGB(raster_rgb(volcano, col = grey(seq(0.2, 0.8, by = 0.1))))
#'
#' plotRGB(raster_rgb(volcano, col = viridis::magma(24)))
raster_rgb <- function(x, col, ..., breaks = NULL, n = NULL) {
  ## for matrix input
  if (is.matrix(x)) {
    x <- raster::setExtent(raster::raster(x), raster::extent(0, ncol(x), 0, nrow(x)))
  }
  if (missing(col)) {
    col <- colorRampPalette(hcl.colors(12, "YlOrRd", rev = TRUE))  ## bear with
  }
  if (!is.null(breaks)) n <- length(breaks) - 1L
  if (is.function(col)) {
    if (is.null(n)) {
      n <- 56
    }
    col <- col(n)
  }
  ## scales::rescale(x)
  scl <- function(x) (x - min(x,na.rm= TRUE))/diff(range(x, na.rm = TRUE))
  if (!is.null(breaks)) {
    col <- colorRampPalette(col)(length(breaks) - 1)
    outcols <- col[cut(raster::values(x[[1]]), breaks)]
  } else {
    outcols <- col[scl(raster::values(x[[1]])) * (length(col) - 1) + 1]
  }
  ## used to need to give a 3 layer brick to setValues, but one layer is enough it expands by the values given
  raster::setValues(raster::brick(x[[1]]), t(col2rgb(outcols)))
}

[mdsumner]

@ozjimbob if you want to try this out

My todo list:

• check the breaks thing more carefully
• how to abstract over raster / stars format, assume matrix-input, then return the array of rgb for both to wrap with methods?
• bang out examples with ceramic elevation and land raster properties as texture

[mdsumner]

Working on pulling out the logic, not sure whether to return a vector of hex colours, or an array of rgb like grDevices::as.raster, I'm used to the t(col2rgb(hex)) workflow as per raster, but this looks promising

#' @param x numeric values
#' @param col function to generate colours, or a vector of hex colours
#' @param ... ignored
#' @param breaks optionally used to specify color mapping
#' @param n optionally used to specify density of colours from `col` (ignored if breaks is set)
#' @name cv_rgb
#' @export
cv_rgb <- function(x, col, ..., breaks = NULL, n = NULL) {
  if (missing(col)) {
    ## just not sure how to use hcl.colors to get a function, so ...
    col <- colorRampPalette(hcl.colors(12, "YlOrRd", rev = TRUE))
  }
  if (!is.null(breaks)) n <- length(breaks) - 1L
  if (is.function(col)) {
    if (is.null(n)) {
      n <- 24
    }
    col <- col(n)
  }
  ## scales::rescale(x)
  scl <- function(x) (x - min(x,na.rm= TRUE))/diff(range(x, na.rm = TRUE))
  if (!is.null(breaks)) {
    col <- colorRampPalette(col)(length(breaks) - 1)
    outcols <- col[cut(x, breaks)]
  } else {
    outcols <- col[scl(x) * (length(col) - 1) + 1]
  }
 outcols
}

[mdsumner]

See SymbolixAU/colourvalues#57

[mdsumner]

All done in #3

Seems quite clear now, with rename of functions and the role of image_pal() being to bake in the job that image() draws and generate as a data set.