diff --git a/DESCRIPTION b/DESCRIPTION index 46bcf5c..ba1b490 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: ximage Title: Draw Images of Raster Data and Related Adornments -Version: 0.0.0.9007 +Version: 0.0.0.9008 Authors@R: person("Michael D.", "Sumner", , "mdsumner@gmail.com", role = c("aut", "cre")) Description: Draw images easily and as if doing that was considered desirable or @@ -18,3 +18,5 @@ Depends: R (>= 2.10) LazyData: true RoxygenNote: 7.2.3 +Imports: + palr diff --git a/NEWS.md b/NEWS.md index 38a460d..0721029 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ximage dev +* `ximage()` now handles `breaks` argument to go with `col` (for numeric input). + * `image()` now works with list output from gdalnara (same as gdal_raster_image but with nativeRaster). * Added suport for `xcontour()` for the output output of `gdal_raster_data()` in {vapour}. diff --git a/R/ximage.R b/R/ximage.R index 10237e2..bfed95e 100644 --- a/R/ximage.R +++ b/R/ximage.R @@ -25,7 +25,7 @@ flip_c <- function(x) { rg <- range(x, na.rm = TRUE) (x - rg[1L])/diff(rg) } -.make_hex_matrix <- function(x, cols = NULL) { +.make_hex_matrix <- function(x, cols = NULL, ..., breaks) { alpha <- 1 if (length(dim(x)) > 2) { if (dim(x)[3] == 4L) { @@ -151,7 +151,7 @@ ximage.list <- function(x, extent = NULL, zlim = NULL, add = FALSE, ..., xlab = } #' @export -ximage.default <- function(x, extent = NULL, zlim = NULL, add = FALSE, ..., xlab = NULL, ylab = NULL, col = hcl.colors(96, "YlOrRd", rev = TRUE)) { +ximage.default <- function(x, extent = NULL, zlim = NULL, add = FALSE, ..., xlab = NULL, ylab = NULL, col = hcl.colors(96, "YlOrRd", rev = TRUE), breaks = NULL) { if (is.list(x)) { ximage.list(x, extent = extent, zlim = zlim, add = add, ..., xlab = xlab, ylab = ylab, col = col) @@ -180,9 +180,17 @@ ximage.default <- function(x, extent = NULL, zlim = NULL, add = FALSE, ..., xlab } - x <- (x - rg[1L])/diff(rg) - x <- .make_hex_matrix(x, cols = col ) + #x <- .make_hex_matrix(x, cols = col ) + + if (!is.null(col)) { + + x <- matrix(palr::image_pal(x, col, breaks = breaks), dim(x)[1L], dim(x)[2L]) + } else { + x <- (x - rg[1L])/diff(rg) + + } + } else { ## else character