# 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

``````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:

1. split Munsell notation into hue/value/chroma components
2. convert to sRGB / CIELAB coordinates
3. 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)

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)
)

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))``````