Merge pull request #319 from ncss-tech/half-value-chips-ahoy

Add half-value Munsell chips beyond 2.5

DESCRIPTION

@@ -15,6 +15,6 @@ URL: https://github.com/ncss-tech/aqp, https://ncss-tech.github.io/AQP/
 BugReports: https://github.com/ncss-tech/aqp/issues
 Language: en-US
 Encoding: UTF-8
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Roxygen: list(markdown = TRUE)
 VignetteBuilder: knitr

NEWS.md

@@ -1,7 +1,9 @@
-# aqp 2.0.4 (2024-07-30)
+# aqp 2.0.4 (2024-10-04)
  * CRAN release
  * ragged bottom lines in `plotSPC()` now adjusted as function of number of profiles and device width
  * additional metadata from `plotSPC()` saved to `last_spc_plot` in `aqp.env`
+ * added Munsell values of 8.5 and 9.5 to Munsell LUT and (interpolated) reference spectra (#318)
+ * `munsell2rgb()` now safely selects the closest Munsell value and chroma to those available in the package LUT 
 
 # aqp 2.0.3 (2024-04-18)
  * CRAN release

R/similarMunsellChips.R → R/equivalentMunsellChips.R

@@ -9,7 +9,7 @@
 #' @references
 #' Gaurav Sharma, Wencheng Wu, Edul N. Dalal. (2005). The CIEDE2000 Color-Difference Formula: Implementation Notes, Supplementary Test Data, and Mathematical Observations. COLOR research and application. 30(1):21-30. http://www2.ece.rochester.edu/~gsharma/ciede2000/ciede2000noteCRNA.pdf
 #' 
-#'  Thomas Lin Pedersen, Berendea Nicolae and Romain François (2020). farver: High Performance Colour Space Manipulation. R package version 2.0.3. https://CRAN.R-project.org/package=farver
+#' Thomas Lin Pedersen, Berendea Nicolae and Romain François (2020). farver: High Performance Colour Space Manipulation. R package version 2.0.3. https://CRAN.R-project.org/package=farver
 #'  
 #' Dong, C.E., Webb, J.B., Bottrell, M.C., Saginor, I., Lee, B.D. and Stern, L.A. (2020). Strengths, Limitations, and Recommendations for Instrumental Color Measurement in Forensic Soil Characterization. J Forensic Sci, 65: 438-449. https://doi.org/10.1111/1556-4029.14193
 #' 
@@ -50,7 +50,8 @@
 .makeEquivalentMunsellLUT <- function(threshold = 0.001) {
   munsell <- NULL
   load(system.file("data/munsell.rda", package = "aqp")[1])
-
+
+  # 2024-10-04: added 8.5 and 9.5 value chips 
   # 2022-03-31: updated neutral chips and 2.5 value chips now included
 
 
@@ -72,16 +73,22 @@
   # user  system elapsed 
   # 190.73    0.73  194.42
   system.time(
-    x <- farver::compare_colour(from = munsell[,c('L','A','B')], from_space = 'lab',
-                              to = munsell[,c('L','A','B')], to_space = 'lab',
-                              method = 'cie2000', white_from = 'D65', white_to = 'D65')
+    x <- farver::compare_colour(
+      from = munsell[, c('L', 'A', 'B')],
+      from_space = 'lab',
+      to = munsell[, c('L', 'A', 'B')],
+      to_space = 'lab',
+      method = 'cie2000',
+      white_from = 'D65',
+      white_to = 'D65'
+    )
   )
 
   xdat <- x
   x[lower.tri(x, diag = TRUE)] <- NA 
   # remove lower triangle for statistics (only count each pair distance 1x)
 
-  # roughly dE00 ~ 2.24 -- this is close to the perceptible limit of average human color vision with "good" lighting
+  # dE00 ~2.158 -- this is close to the perceptible limit of average human color vision with "good" lighting
   # calculate quantiles
   xqtl <- quantile(x, p = threshold, na.rm = TRUE)[1]
 
@@ -134,7 +141,7 @@
   names(equivalent_munsell) <- sprintf("%s %s/%s", munsell$hue, munsell$value, munsell$chroma)
 
   # this is only 107kB written to Rda
-  # save(equivalent_munsell, file="data/equivalent_munsell.rda")
+  save(equivalent_munsell, file="data/equivalent_munsell.rda")
 
   return(equivalent_munsell)
 }
@@ -147,7 +154,7 @@
 #' 
 #' The intention is to identify Munsell chips that may be "functionally equivalent" to some other given whole value/chroma chip elsewhere in the Munsell color space -- as discretized in the \code{aqp::munsell} data table. This basic assumption needs to be validated against your end goal: probably by visual inspection of some or all of the resulting sets. See \code{\link{colorContrast}} and \code{\link{colorContrastPlot}}.
 #'
-#' "Equivalent" chips table are based (fairly arbitrarily) on the 0.001 probability level of dE00 (default Type 7 \code{quantile}) within the upper triangle of the 8467x8467 contrast matrix. This corresponds to a \code{dE00} contrast threshold of approximately 2.15. 
+#' "Equivalent" chips table are based (fairly arbitrarily) on the 0.001 probability level of dE00 (default Type 7 \code{quantile}) within the upper triangle of the 8467x8467 contrast matrix. This corresponds to a \code{dE00} contrast threshold of approximately 2.16. 
 
 #' @param hue A character vector containing Munsell hues
 #' @param value A numeric vector containing Munsell values (integer only)

R/factor-level-setters.R

@@ -1,6 +1,25 @@
 ##
 ##
 
+
+## TODO: helper function for soil texture color palette
+## final color scheme, after some editing
+# c("s", "ls", "sl", "scl", "l", "sc", "c", "sic", "cl", "sil", "sicl", "si")
+# cols <- c(
+#   "#BEBEBE", "#FDFD9E", "#ebd834", "#307431", "#CD94EA", "#546BC3", "#92C158", "#EA6996", "#6D94E5", "#4C5323", "#E93F4A", "#AF4732"
+# )
+
+# # coordinate with basic and extended soil texture classes via col
+# colorspace::swatchplot(
+#   list(
+#     basic = cols,
+#     extended = colorRampPalette(cols)(21)
+#   )
+# )
+# 
+
+
+
 ## TODO: consider various sorting strategies: WMPD, AWC, {PWP,FC,SAT}
 ## http://ncss-tech.github.io/AQP/aqp/water-retention-curves.html
 

R/getClosestMunsellChip.R

@@ -3,7 +3,7 @@
 #' 
 #' @description Non-standard Munsell notation ('7.9YR 2.7/2.0') can be matched (nearest-neighbor, no interpolation) to the closest color within the `munsell` sRGB/CIELAB look-up table via `getClosestMunsellChip()`. A more accurate estimate of sRGB values from non-standard notation can be achieved with the \href{https://CRAN.R-project.org/package=munsellinterpol}{munsellinterpol} package. For example, conversion from Munsell to CIELAB, assuming a D65 illuminant via: `MunsellToLab('0.1Y 3.3/4.4', white='D65', adapt='Bradford')`.
 #'
-#' @param munsellColor character vector of strings containing Munsell notation of color, e.g. '10YR 4/3'
+#' @param munsellColor character vector of strings containing Munsell notation of color, e.g. '10YR 4/3', not NA-safe
 #' @param convertColors logical, should parsed Munsell colors be converted into sRGB values
 #' @param ... further arguments to \code{munsell2rgb}
 #'
@@ -30,6 +30,20 @@ getClosestMunsellChip <- function(munsellColor, convertColors = TRUE, ...) {
   # This is a hack to avoid munsell2rgb: "no visible binding for global variable munsell" at package R CMD check
   munsell <- NULL
 
+  # # init working vectors
+  # # for NA propagation
+  # n <- length(munsellColor)
+  # closest.hue <- vector(mode = 'character', length = n)
+  # closest.value <- vector(mode = 'numeric', length = n)
+  # closest.chroma <- vector(mode = 'numeric', length = n)
+  # 
+  # # remove NA for now
+  # na.idx <- which(is.na(munsellColor))
+  # if(length(na.idx) > 0) {
+  #   x.na <- x[na.idx]
+  #   x <- x[-na.idx]
+  # }
+
   # extract hue, value, chroma from single string
   cd <- parseMunsell(munsellColor, convertColors = FALSE)
 
@@ -41,21 +55,27 @@ getClosestMunsellChip <- function(munsellColor, convertColors = TRUE, ...) {
   ##       -> interpreting 10YR as the same as 0Y
 
 
+  ## TODO: make NA-safe  
+
+
   # note: this is incompatible with LazyData: true
   # extract pieces from unique Munsell hues
-  load(system.file("data/munsell.rda", package="aqp")[1])
+  load(system.file("data/munsell.rda", package = "aqp")[1])
   all.hue.data <- na.omit(.parseMunsellHue(unique(munsell$hue)))
 
   # locate closest chip in `munsell` set of hues
-  closest.hue <- vector(mode = 'character', length=nrow(hue.data))
+  closest.hue <- vector(mode = 'character', length = nrow(hue.data))
   for(i in 1:nrow(hue.data)) {
     # index possible rows based on character part of hue
     idx <- which(all.hue.data$hue.character == hue.data[i, ]$hue.character)
+
     # compute Euclidean distance to all possible numeric parts of hue
     distances <- abs(hue.data$hue.numeric[i] - all.hue.data$hue.numeric[idx])
     closest.idx <- which.min(distances)
+
     # compile closest hue
     closest.hue[i] <- paste0(all.hue.data[idx, ][closest.idx, ], collapse = '')
+
   }
 
   # valid value / chroma in our LUT

R/huePosition.R

@@ -1,4 +1,7 @@
 
+## TODO: consider hue-based, angular distance between 2 hues
+
+
 #' @title Munsell Hue Reference and Position Searching
 #'
 #' @description The 40 Munsell hues are typically arranged from 5R to 2.5R moving clock wise on the unit circle. This function matches a vector of hues to positions on that circle, with options for setting a custom origin or search direction.
@@ -54,6 +57,7 @@
 #' par(op)
 #'
 huePosition <- function(x, returnHues = FALSE, includeNeutral = FALSE, origin = '5R', direction = c('cw', 'ccw')) {
+
   # ordering via Tech Note #2
   # Soil Survey Technical Note 2 [wayback machine URL](https://web.archive.org/web/20220704214918/https://www.nrcs.usda.gov/wps/portal/nrcs/detail/soils/ref/?cid=nrcs142p2_053569)
 
@@ -62,7 +66,7 @@ huePosition <- function(x, returnHues = FALSE, includeNeutral = FALSE, origin =
 
   # note: this is incompatible with LazyData: true
   # load look-up table from our package
-  load(system.file("data/munsellHuePosition.rda", package="aqp")[1])
+  load(system.file("data/munsellHuePosition.rda", package = "aqp")[1])
 
   ## basic error checking / argument processing