sprintf() to formatMunsell()

Author: dylanbeaudette

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: aqp
-Version: 2.3.1
+Version: 2.3.2
 Title: Algorithms for Quantitative Pedology
 Authors@R: c(person(given="Dylan", family="Beaudette", role = c("aut", "cre"), email = "dylan.beaudette@usda.gov", comment = c(ORCID="0009-0008-2780-4785")), 
              person(given="Pierre", family="Roudier", email="roudierp@landcareresearch.co.nz", role = c("aut", "ctb")), 

R/colorChart.R

@@ -41,7 +41,7 @@
 #' )
 #' 
 #' # combine hue, value, chroma into standard Munsell notation
-#' ric <- sprintf("%s %s/%s", ric$hue, ric$value, ric$chroma)
+#' ric <- formatMunsell(ric$hue, ric$value, ric$chroma)
 #' 
 #' # note that chip frequency-based size is disabled
 #' # because all chips have equal frequency

R/colorVariation.R

@@ -163,7 +163,7 @@ colorVariation <- function(m, method = c('frequency', 'centroid', 'L1', 'referen
 
     # convert back to Munsell notation for colorContrast()
     m.centroid <- col2Munsell(t(lab.centroid), space = 'CIELAB')
-    m.centroid <- sprintf("%s %s/%s", m.centroid$hue, m.centroid$value, m.centroid$chroma)
+    m.centroid <- formatMunsell(m.centroid$hue, m.centroid$value, m.centroid$chroma)
 
     # color contrast vs. centroid
     cc <- colorContrast(m1 = wt.m, m2 = rep(m.centroid, times = length(wt)))
@@ -191,7 +191,7 @@ colorVariation <- function(m, method = c('frequency', 'centroid', 'L1', 'referen
 
     # convert back to Munsell notation for colorContrast()
     m.centroid <- col2Munsell(lab.centroid, space = 'CIELAB')
-    m.centroid <- sprintf("%s %s/%s", m.centroid$hue, m.centroid$value, m.centroid$chroma)
+    m.centroid <- formatMunsell(m.centroid$hue, m.centroid$value, m.centroid$chroma)
 
     # color contrast vs. centroid
     cc <- colorContrast(m1 = wt.m, m2 = rep(m.centroid, times = length(wt)))

R/contrastChart.R

@@ -108,7 +108,7 @@ contrastChart <- function(m, hues, ccAbbreviate = 1, style = 'hue', gridLines =
 
   # convert into hex notation for plotting
   x$color <- munsell2rgb(x$hue, x$value, x$chroma)
-  x$munsell <- sprintf("%s %s/%s", x$hue, x$value, x$chroma)
+  x$munsell <- formatMunsell(x$hue, x$value, x$chroma)
 
   # re-level hues according to color contrast guidance
   hh <- unique(x$hue)

R/equivalentMunsellChips.R

@@ -143,10 +143,10 @@
 
   # create a nice lookup table to add to aqp
   equivalent_munsell <- xin1
-  names(equivalent_munsell) <- sprintf("%s %s/%s", munsell$hue, munsell$value, munsell$chroma)
+  names(equivalent_munsell) <- formatMunsell(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)
 }
@@ -215,7 +215,7 @@
 #' par(mar=c(0,0,1,1))
 #' 
 #' pie(rep(1, nrow(veryred)), col = with(veryred, munsell2rgb(hue, value, chroma)),
-#'     label = with(veryred, sprintf("%s %s/%s", hue, value, chroma)))
+#'     label = with(veryred, formatMunsell(hue, value, chroma)))
 #' 
 #' table(veryred$hue) # 2 hues
 #' #> 
@@ -250,7 +250,7 @@ equivalentMunsellChips <- function(hue = NULL, value = NULL, chroma = NULL) {
             munsell$chroma == chipdata$chroma[x])
   })
   res <- lapply(lidx, function(i) munsell[equivalent_munsell[i][[1]],])
-  names(res) <- sprintf("%s %s/%s", hue, value, chroma)
+  names(res) <- formatMunsell(hue, value, chroma)
   rownames(res) <- NULL
   return(res)
 }

R/launderMunsell.R

@@ -14,7 +14,9 @@
 #'   * '10YR 2/0' -> 'N 2/0'
 #'   * 'N 4/1 -> 'N 4/0'
 #'   * '5Z 3/3' -> NA
+#'   * '5YR 3/' -> NA (hues other than N must have a valid chroma)
 #' 
+#' See [formatMunsell()] for additional details. 
 #'
 #' @param m character vector of Munsell colors
 #' @param verbose logical, optionally return a `data.frame` comparing modifications
@@ -50,6 +52,9 @@
 #' # missing chroma, not N => NA
 #' launderMunsell('2.5Y 4/')
 #' 
+#' # invalid chroma => NA
+#' launderMunsell('2.5Y 4/A')
+#' 
 launderMunsell <- function(m, verbose = FALSE, ...) {
 
   # split into components
@@ -73,7 +78,6 @@ launderMunsell <- function(m, verbose = FALSE, ...) {
 
   # combine back into standard notation
   # following conventions
-  # .res <- sprintf("%s %s/%s", .p$hue, .p$value, .p$chroma)
   .res <- formatMunsell(hue = .p$hue, value = .p$value, chroma = .p$chroma, ...)
 
   # optionally combine into a data.frame for inspection

R/mixMunsell.R

@@ -379,7 +379,7 @@ mixMunsell <- function(x, w = rep(1, times = length(x)) / length(x), mixingMetho
       } else {
         # mx is a data.frame 
         res <- data.frame(
-          munsell = sprintf("%s %s/%s", mx$hue, mx$value, mx$chroma),
+          munsell = formatMunsell(mx$hue, mx$value, mx$chroma),
           distance = mx$sigma,
           scaledDistance = NA,
           distanceMetric = 'dE00',

R/simulateColor.R

@@ -93,7 +93,7 @@
 
   # convert into hex notation for plotting
   x$color <- munsell2rgb(x$hue, x$value, x$chroma)
-  x$munsell <- sprintf("%s %s/%s", x$hue, x$value, x$chroma)
+  x$munsell <- formatMunsell(x$hue, x$value, x$chroma)
 
   # re-level hues according to color contrast guidance
   hh <- unique(x$hue)

R/soilColorIndices.R

@@ -23,7 +23,7 @@
 #' site(sp1) <- ~ group
 #' 
 #' # use Munsell color notation as horizon name
-#' sp1$m <- sprintf("%s %s/%s", sp1$hue, sp1$value, sp1$chroma)
+#' sp1$m <- formatMunsell(sp1$hue, sp1$value, sp1$chroma)
 #' 
 #' # compute indices
 #' # merged into `sp1` with left-join on hzidname(sp1)

R/soilColorSignature.R

@@ -328,7 +328,7 @@
 #' depths(sp1) <- id ~ top + bottom
 #' 
 #' # Munsell notation
-#' sp1$m <- sprintf("%s %s/%s", sp1$hue, sp1$value, sp1$chroma)
+#' sp1$m <- formatMunsell(sp1$hue, sp1$value, sp1$chroma)
 #' 
 #' # extract color signature
 #' pig <- soilColorSignature(sp1, color = 'm')