extra control for breaks? - as in image()

[mdsumner]

I started this as a raster function, to convert a data layer to RGB, with options:

• auto palette choice
• provide colours or colour-fun, and n
• provide breaks
  • (todo) zlim

The behaviour is "do what image() can do but without rendering a bit map, give me the data in 3 channel RGB Byte".

I see now that it's a colourvalues-like function, but maybe only the addition of the breaks argument and control to colour_values()?

The function cv_rgb() does what I want to raw values - returning a hex vector. I include the raster and stars forms because they seem to work ... raster_rgb(), and stars_rgb() wrap cv_rgb() to give RGB forms (pretty rough and ready for stars).

#' 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
#' @name cv_rgb
#' @aliases raster_rgb stars_rgb
#' @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)))
  }
  vv <- raster::values(x[[1L]])
  outcols <- cv_rgb(vv, col = col, ..., breaks = breaks, n = n)
  ## 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)))
}
#' @name cv_rgb
#' @export
#' @examples
#' library(stars)
#' x <- st_as_stars(volcano)
#' plot(stars_rgb(x), rgb = 1:3)
#' plot(stars_rgb(x, col = gray.colors), rgb = 1:3)
#' plot(stars_rgb(x))
#' plot(stars_rgb(x, col = rainbow, breaks = c(94, 100, 120, 150, 195)), rgb = 1:3)
stars_rgb <- function(x, col, ..., breaks = NULL, n = NULL) {
  hex <- cv_rgb(x[[1L]], col = col, ..., breaks = breaks, n = n)  ## we aint proxy yet
  dm <- dim(x[[1L]])
  ## this is not completely proper stars fix-up yet :)
  out <- c(x, x, x, along = 3)
  out[[1L]] <- array(t(col2rgb(hex)), c(dm, 3L))
  out
}
#' @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
}

Brought from https://github.com/AustralianAntarcticDivision/palr/issues/2 for wider discussion

[mdsumner]

Actually, having zlim as well would be awesome, so that we can easily control the absolute scale without specifying breaks - I'll have a closer look at how this might fit in colourvalues

[SymbolixAU]

I see now that it's a colourvalues-like function, but maybe only the addition of the breaks argument and control to colour_values()?

In the absence of directly supporting a breaks argument, you can supply the "cuts" directly

colourvalues::colour_values( cut(1:20, breaks = 3) )
 [1] "#440154FF" "#440154FF" "#440154FF" "#440154FF" "#440154FF" "#440154FF" "#440154FF" "#21908CFF" "#21908CFF"
[10] "#21908CFF" "#21908CFF" "#21908CFF" "#21908CFF" "#FDE725FF" "#FDE725FF" "#FDE725FF" "#FDE725FF" "#FDE725FF"
[19] "#FDE725FF" "#FDE725FF"

colourvalues::colour_values_rgb( cut(1:20, breaks = 3) )
      [,1] [,2] [,3] [,4]
 [1,]   68    1   84  255
 [2,]   68    1   84  255
 [3,]   68    1   84  255
 [4,]   68    1   84  255
 [5,]   68    1   84  255
 [6,]   68    1   84  255
 [7,]   68    1   84  255
 [8,]   33  144  140  255
 [9,]   33  144  140  255
[10,]   33  144  140  255
[11,]   33  144  140  255
[12,]   33  144  140  255
[13,]   33  144  140  255
[14,]  253  231   37  255
[15,]  253  231   37  255
[16,]  253  231   37  255
[17,]  253  231   37  255
[18,]  253  231   37  255
[19,]  253  231   37  255
[20,]  253  231   37  255

Is this along the lines of what you're after?

[mdsumner]

Gee didn't think of that, colour the factor index - need to explore 👍

[SymbolixAU]

@mdsumner I haven't looked at this issue since my last comment; is this still relevant for you?

[mdsumner]

oh no, I built it into palr which is a better fit I think, can just close