new ice colours

DESCRIPTION

@@ -27,6 +27,6 @@ Suggests:
     viridis
 VignetteBuilder: knitr
 License: GPL-3
-RoxygenNote: 7.1.1
+RoxygenNote: 7.2.3
 URL: https://github.com/AustralianAntarcticDivision/palr
 BugReports: https://github.com/AustralianAntarcticDivision/palr/issues

NEWS.md

@@ -1,6 +1,8 @@
 # palr 0.4.0
 
+* `ice_pal()` now defaults to the more pleasing NSIDC blue palette (use `amsre = TRUE` to get the old behavour).
 
+* Fixed a problem with missing values in `d_pal()`. 
 # palr  0.3.0
 
 * New function `d_pal()` and alias `data_pal()` to colour data values (like {colourvalues} but

R/image_pal.R

@@ -26,11 +26,10 @@
 #' @export
 #' @importFrom grDevices hcl.colors
 #' @examples
-#' set.seed(28)
 #' vals <- sort(rnorm(100))
-#' cols <- image_pal(vals, zlim = c(-2.4, 2))
-#' plot(vals, col = cols); abline(h = 2)
-#' points(vals, pch  = 19, cex = 0.1) ## zlim excluded some of the range
+#' cols <- image_pal(vals, zlim = c(-2.4, .5))
+#' plot(vals, col = cols); abline(h = .5)
+#' points(vals, pch  = ".") ## zlim excluded some of the range
 image_pal <- function(x, col, ..., breaks = NULL, n = NULL, zlim = NULL) {
 
   if (missing(col)) {
@@ -63,21 +62,6 @@ image_pal <- function(x, col, ..., breaks = NULL, n = NULL, zlim = NULL) {
 
 #' @name image_pal
 #' @export
-#' @examples
-#' if (requireNamespace("raster", quietly = TRUE)) {
-#' im <- image_raster(volcano)
-#' library(raster)
-#' plotRGB(im)
-#' \donttest{
-#' vv <- unique(quantile(volcano, seq(0, 1, length = 12)))
-#' plotRGB(image_raster(volcano, breaks = vv))
-#' plotRGB(image_raster(volcano, breaks = vv[-c(4, 6)], col = gray.colors(9)))
-#' plotRGB(image_raster(volcano, n = 4))
-#' plotRGB(image_raster(volcano, col = grey(seq(0.2, 0.8, by = 0.1))))
-#'
-#' plotRGB(image_raster(volcano, col = viridis::magma(24)))
-#' }
-#' }
 image_raster <- function(x, col, ..., breaks = NULL, n = NULL, zlim = NULL) {
   if (!requireNamespace("raster", quietly = TRUE)) stop("raster package is required for 'image_raster()'")
   ## for matrix input
@@ -91,17 +75,6 @@ image_raster <- function(x, col, ..., breaks = NULL, n = NULL, zlim = NULL) {
 }
 #' @name image_pal
 #' @export
-#' @examples
-#' if (!requireNamespace("stars", quietly = TRUE)) {
-#' library(stars)
-#' x <- st_as_stars(volcano)
-#' plot(image_stars(x), rgb = 1:3)
-#' \donttest{
-#' plot(image_stars(x, col = gray.colors), rgb = 1:3)
-#' plot(image_stars(x))
-#' plot(image_stars(x, col = rainbow, breaks = c(94, 100, 120, 150, 195)), rgb = 1:3)
-#' }
-#' }
 image_stars <- function(x, col, ..., breaks = NULL, n = NULL, zlim = NULL) {
   if (!requireNamespace("stars", quietly = TRUE)) stop("stars package is required for 'image_stars()'")
   hex <- image_pal(as.vector(unclass(x[[1L]])), col = col, ..., breaks = breaks, n = n, zlim = zlim)  ## we aint proxy yet

R/palr.R

@@ -276,7 +276,9 @@ col2hex <- function(x, alpha = 1) {
 #' @param palette logical, if \code{TRUE} return a list with matching colours and values
 #' @param alpha value in 0,1 to specify opacity
 #' @param ... currently ignored
-#' @references Derived from \url{http://www.iup.uni-bremen.de/seaice/amsr/}.
+#' @param amsre use old AMSRE colours (`FALSE` by default)
+#' @references amsre colours derived from \url{http://www.iup.uni-bremen.de/seaice/amsr/}.,
+#'  nsidc colours extracted in data-raw/.
 #' @return colours, palette, or function, see Details
 #' @export
 #' @examples
@@ -288,9 +290,9 @@ col2hex <- function(x, alpha = 1) {
 #' plot(r, col = icp$col, zlim = range(icp$breaks),
 #' main = sprintf("NSIDC ice \\% %s", format(getZ(r))))
 #' }
-ice_pal <- function(x, palette = FALSE, alpha = 1, ...) {
+ice_pal <- function(x, palette = FALSE, alpha = 1, ..., amsre = FALSE) {
 
-  cols <- head(.amsrecols(), 201)
+  if (amsre) cols <- head(.amsrecols(), 201) else cols <- .nsidc_colours
  breaks <- seq(0, 100, length = length(cols))
  hexalpha <- as.hexmode(round(255 * alpha))
   if (nchar(hexalpha) == 1L) hexalpha <- paste(rep(hexalpha, 2L), collapse = "")

data-raw/nsidc_colours.R

@@ -0,0 +1,5 @@
+ r <- terra::rast("/vsicurl/https://noaadata.apps.nsidc.org/NOAA/G02135/south/daily/geotiff/2023/10_Oct/S_20231030_concentration_v3.0.tif")
+.nsidc_coltab <- terra::coltab(r) [[1]][1:1001, ]
+
+.nsidc_colours <- rgb(.nsidc_coltab[["red"]], .nsidc_coltab[["green"]], .nsidc_coltab[["blue"]], maxColorValue = 255)
+usethis::use_data(.nsidc_colours, internal = TRUE)