Background

The following code is only a rough estimation of mixing soil material and not a physically-based model of subtractive mixing of pigments. We will get there eventually.

Example

Required packages, be sure to ge the latest versions from GitHub.

library(aqp)
library(soilDB)

Pick some colors and assign weights:

60% 10YR 3/5 + 30% 5YR 5/6 + 10% 2.5Y 5/6 = ?.

The parseMunsell function is used 3 times to:

split Munsell notation into hue/value/chroma components
convert to sRGB / CIELAB coordinates
convert to sRGB hex notation.

colors <- c('10YR 3/5', '5YR 5/6', '2.5Y 5/6')
weights <- c(60, 30, 10)

# combine into a data.frame and convert to sRGB + CIE LAB
d <- cbind(
  parseMunsell(colors, convertColors=FALSE),
  parseMunsell(colors, return_triplets=TRUE, returnLAB=TRUE),
  pct=weights,
  col=parseMunsell(colors, convertColors=TRUE)
)

d

##    hue value chroma         r         g          b        L         A        B pct       col
## 1 10YR     3      5 0.3817539 0.2599868 0.09323485 30.81482  9.000702 30.27227  60 #614218FF
## 2  5YR     5      6 0.6516906 0.4320947 0.27623886 51.63431 18.064255 31.11055  30 #A66E46FF
## 3 2.5Y     5      6 0.5907267 0.4641984 0.19181078 51.65941  4.903976 41.89806  10 #977631FF

Estimate mixture via weighted average in CIELAB color space. This is a nearly-perceptual color system so the weighted average is a reasonable estimate. Again, this is not as accurate as subtractive mixing of pigments via spectral data.

(mx <- estimateColorMixture(d, wt = 'pct', backTransform = TRUE))

##        r       g       b colorhue colorvalue colorchroma    sigma
## 1 0.4812 0.33025 0.15697     10YR          4           5 2.637697

mx.munsell <- sprintf("%s %s/%s", mx$colorhue, mx$colorvalue, mx$colorchroma)

60% 10YR 3/5 + 30% 5YR 5/6 + 10% 2.5Y 5/6 = 10YR 4/5.

Visualization Ideas

Demonstrate mixing soil colors in CIE LAB color spaces via estimateColorMixture().

mixColorDemo <- function(x) {
  x <- x[order(x$pct, decreasing = TRUE), ]
  n.cols <- nrow(x)
  x.vals <- 1:n.cols
  y.vals <- rep(0, times=n.cols)
  cols <- rgb(x[, c('r', 'g', 'b')])
  col.txt <- paste0(x$hue, ' ', x$value , '/', x$chroma, '\n(', x$pct, '%)')
  
  plot(x.vals, y.vals, col=cols, pch=15, cex=10, axes=FALSE, ylab='', xlab='', xlim=c(0.5, n.cols + 2.5))
  text(x.vals[-length(x.vals)] + 0.5, y.vals, '+', cex=2, lwd=2)
  text(max(x.vals) + 0.5, y.vals[1], '=', cex=2, lwd=2)
  
  text(x.vals, y.vals, col.txt, pos=1, offset=2.5, cex=0.75)
  
  # mix in CIELAB
  mixed.lab <- estimateColorMixture(x, wt = 'pct', backTransform = TRUE)
  
  # add mixed colors
  points(max(x.vals)+1, y.vals[1], col=rgb(mixed.lab[, c('r', 'g', 'b')]), cex=10, pch=15)
  col.txt <- paste0(mixed.lab$colorhue, ' ', mixed.lab$colorvalue , '/', mixed.lab$colorchroma)
  text(max(x.vals)+1, y.vals[1], col.txt, pos=1, offset=2.5, cex=0.75)
}


par(mar=c(1,1,1,1))
mixColorDemo(d)

Alternative Representation

# simulate mixture
mixed.lab <- estimateColorMixture(d, wt = 'pct', backTransform = TRUE)

# color vector
cols <- c(
  d$col, 
  rgb(mixed.lab[, c('r', 'g', 'b')])
  )

# label vector
labs <- c(
  colors,
  paste0(mixed.lab$colorhue, ' ', mixed.lab$colorvalue , '/', mixed.lab$colorchroma)
)

# add weights
labs <- sprintf("%s      (%s%%)", labs, c(weights, 100))

# plot
soilPalette(
  colors = cols,
  lab = labs,
  lab.cex = 1
  )

Mixing via Reference Spectra

colors <- c('10YR 3/5', '5YR 5/6', '2.5Y 5/6')
weights <- c(60, 30, 10)

plotColorMixture(x = colors, w = weights)

Mix a Lot

This is very inefficient code.

s <- seq(from = 0, to = 100, by = 10)
colors <- c('10YR 3/3', '2.5Y 6/4')

z <- lapply(s, function(i) {
  
  wts <- c(100 - i, i)
  
  d <- cbind(
  parseMunsell(colors, convertColors=FALSE),
  parseMunsell(colors, return_triplets=TRUE, returnLAB=TRUE),
  pct = wts,
  col = parseMunsell(colors, convertColors=TRUE)
)
  
  mx <- estimateColorMixture(d, wt = 'pct', backTransform = TRUE)
  
  res <- data.frame(
    m.x = colors[1],
    m.y = colors[2],
    col.x = parseMunsell(colors[1]),
    col.y = parseMunsell(colors[2]),
    wt.x = wts[1],
    wt.y = wts[2],
    mixed.chip = sprintf('%s %s/%s', mx$colorhue, mx$colorvalue, mx$colorchroma),
    mixed.col = rgb(mx$r, mx$g, mx$b),
    stringsAsFactors = FALSE
  )
  
  res
  
  return(res)
})

z <- do.call('rbind', z)


par(mar = c(1,1,1,1))
plot(1:nrow(z), rep(1:nrow(z)), xlim = c(0.25, nrow(z) + 0.25), ylim = c(0, 0.8), axes = FALSE, xlab = '', ylab = '', type = 'n')

rect(xleft = (1:nrow(z)) - 0.45, xright = (1:nrow(z)) + 0.45, ybottom = 0.25, ytop = 0.75, col = z$mixed.col, border = 'black', lwd = 2, lend = 2)

text(1:nrow(z), 0.2, z$mixed.chip)
text(1:nrow(z), 0.15, sprintf('%s/%s', z$wt.x, z$wt.y))

colorContrastPlot(z$m.y, z$mixed.chip)

colorContrastPlot(z$m.x, z$mixed.chip)

Mix via Munsell Spectra

Hmmm, those colors look a little strange to me.

s <- seq(from = 0, to = 100, by = 10)
colors <- c('10YR 3/3', '2.5Y 6/4')

z <- lapply(s, function(i) {
  
  wts <- c(100 - i, i)
  mx <- mixMunsell(colors, w = wts)
  
  d <- data.frame(
    m.x = colors[1],
    m.y = colors[2],
    col.x = parseMunsell(colors[1]),
    col.y = parseMunsell(colors[2]),
    wt.x = wts[1],
    wt.y = wts[2],
    mixed.chip = mx$munsell,
    mixed.col = parseMunsell(mx$munsell),
    dist = mx$distance,
    stringsAsFactors = FALSE
  )
  
  return(d)
})

z <- do.call('rbind', z)

par(mar = c(1,1,1,1))
plot(1:nrow(z), rep(1:nrow(z)), xlim = c(0.25, nrow(z) + 0.25), ylim = c(0, 0.8), axes = FALSE, xlab = '', ylab = '', type = 'n')

rect(xleft = (1:nrow(z)) - 0.45, xright = (1:nrow(z)) + 0.45, ybottom = 0.25, ytop = 0.75, col = z$mixed.col, border = 'black', lwd = 2, lend = 2)

text(1:nrow(z), 0.2, z$mixed.chip)
text(1:nrow(z), 0.15, sprintf('%s/%s', z$wt.x, z$wt.y))

text(1:nrow(z), 0.5, round(z$dist, 3), cex = 0.75, col = invertLabelColor(z$mixed.col))

colorContrastPlot(z$m.y, z$mixed.chip)

colorContrastPlot(z$m.x, z$mixed.chip)

This document is based on aqp version 1.27 and soilDB version 2.5.9.

Simulating a Mixture of Soil Colors

D.E. Beaudette

2021-02-04