Introduction

Pending.

TODO

Examples

Source colors are in sRGB (D65) colorspace, as converted from Munsell notation using aqp::munsell2rgb().

Basic Idea

Trivial example using some of the aqp built-in data, not very interesting.

library(aqp)
library(plyr)
library(cluster)
library(ape)
library(colorspace)
library(soilDB)
library(sharpshootR)


data(sp1)
sp1$soil_color <- with(sp1, munsell2rgb(hue, value, chroma))
depths(sp1) <- id ~ top + bottom
plot(sp1)

# manually convert Munsell -> RGB
rgb.data <- munsell2rgb(sp1$hue, sp1$value, sp1$chroma, return_triplets = TRUE)
sp1$r <- rgb.data$r
sp1$g <- rgb.data$g
sp1$b <- rgb.data$b

pig <- soilColorSignature(sp1)
knitr::kable(pig, digits = 3, row.names = FALSE)
id .white.pigment .red.pigment .green.pigment .yellow.pigment .blue.pigment
P001 0.636 0.103 0 0.261 0
P002 0.670 0.123 0 0.207 0
P003 0.535 0.177 0 0.288 0
P004 0.598 0.150 0 0.252 0
P005 0.550 0.170 0 0.280 0
P006 0.639 0.123 0 0.239 0
P007 0.636 0.084 0 0.279 0
P008 0.614 0.097 0 0.289 0
P009 0.613 0.089 0 0.298 0

Plot results as dendrogram.

row.names(pig) <- pig[, 1]
d <- daisy(pig[, 2:6])
dd <- diana(d)

plotProfileDendrogram(sp1, dd, dend.y.scale = 0.25, scaling.factor = 0.001, y.offset = 0.02, width=0.15)

Colors from Official Series Descriptions

s.list <- c('amador', 'redding', 'pentz', 'willows', 'pardee', 'yolo', 'hanford', 'cecil', 'sycamore', 'KLAMATH', 'MOGLIA', 'boomer', 'vleck', 'drummer', 'CANEYHEAD', 'musick', 'sierra', 'HAYNER', 'zook', 'argonaut', 'PALAU')

# get these soil series
s <- fetchOSD(s.list)

# manually convert Munsell -> sRGB
rgb.data <- munsell2rgb(s$hue, s$value, s$chroma, return_triplets = TRUE)
s$r <- rgb.data$r
s$g <- rgb.data$g
s$b <- rgb.data$b

# check
par(mar=c(1,1,1,1))
plot(s)

Look at full range of OSD colors in this set.

rgb.colors <- munsell2rgb(s$hue, s$value, s$chroma, return_triplets = TRUE)
lab.colors <- as(RGB(rgb.colors[['r']], rgb.colors[['g']], rgb.colors[['b']]), 'LAB')@coords
cols <- cbind(rgb.colors, lab.colors)
cols <- na.omit(cols)
cols <- as.data.frame(cols)
pairs(~ L + A + B, data=cols, pch=16, cex=2, col=rgb(cols$r, cols$g, cols$b))

Soil Color Signature by "Pigment Proportions"

Compute proportions of white, red, green, yellow, and blue "pigments" based on the CIE LAB representation of soil colors distributed over horizons, weighted by horizon thickness. Pigment proportions are used so that shallow soils can be compared with deep soils. Each row is an observation, columns describe the multivariate soil color signature.

## colorBucket method
# what is appropriate rescaling of L?
pig <- soilColorSignature(s, RescaleLightnessBy = 5, method = 'colorBucket')

knitr::kable(head(pig), digits = 3, row.names = FALSE)
id .white.pigment .red.pigment .green.pigment .yellow.pigment .blue.pigment
AMADOR 0.312 0.124 0.00 0.564 0
ARGONAUT 0.159 0.328 0.00 0.513 0
BOOMER 0.143 0.289 0.00 0.568 0
CANEYHEAD 0.560 0.061 0.05 0.330 0
CECIL 0.120 0.413 0.00 0.467 0
DRUMMER 0.511 0.097 0.00 0.392 0
# move row names over for distance matrix
row.names(pig) <- pig[, 1]
d <- daisy(pig[, -1])
dd <- diana(d)


par(mar=c(1,1,1,1))
plotProfileDendrogram(s, dd, dend.y.scale = max(d) * 2, scaling.factor = max(d) / max(s), y.offset = max(d) / 10, width=0.15, cex.names=0.45)

Soil Color Signature by "Depth Slices"

Extract CIE LAB coordinates at the 10th, 50th, and 90th percentiles of horizon mid-points. Each row is an observation, columns describe the multivariate soil color signature.

pig <- soilColorSignature(s, RescaleLightnessBy = 5, method='depthSlices')

knitr::kable(head(pig), digits = 3, row.names = FALSE)
id A.0.1 A.0.5 A.0.9 B.0.1 B.0.5 B.0.9 L.0.1 L.0.5 L.0.9
AMADOR 3.681 4.870 1.919 13.298 18.956 27.828 8.250 10.324 14.333
ARGONAUT 13.549 19.311 15.876 19.548 30.215 17.613 6.159 6.161 8.250
BOOMER 10.730 18.737 18.548 21.982 30.686 46.905 6.160 8.254 10.331
CANEYHEAD 3.237 2.061 -4.926 12.699 7.409 4.158 10.322 12.340 10.318
CECIL 7.378 32.895 28.722 25.999 29.497 35.807 8.254 8.251 8.254
DRUMMER 2.189 1.478 1.478 5.367 6.176 6.176 4.111 8.247 8.247
# move row names over for distance matrix
row.names(pig) <- pig[, 1]
d <- daisy(pig[, -1])
dd <- diana(d)


par(mar=c(1,1,1,1))
plotProfileDendrogram(s, dd, dend.y.scale = max(d) * 2, scaling.factor = 0.25, y.offset = 6, width=0.15, cex.names=0.45)

Soil Color Signature by "PAM"

Select k-medoids (partitioning around medoids algorithm) from all possible colors within the profile or depth interval and use those CIE LAB coordinates as the signature. Each row is an observation, columns describe the multivariate soil color signature.

pig <- soilColorSignature(s, RescaleLightnessBy = 5, method = 'pam', pam.k = 3)

knitr::kable(head(pig), digits = 3, row.names = FALSE)
id A.1 A.2 A.3 B.1 B.2 B.3 L.1 L.2 L.3
AMADOR 3.681 4.870 1.919 13.298 18.956 27.828 8.250 10.324 14.333
ARGONAUT 15.876 19.311 9.878 17.613 30.215 22.664 8.250 6.161 10.325
BOOMER 10.730 18.737 18.548 21.982 30.686 46.905 6.160 8.254 10.331
CANEYHEAD 0.864 2.061 -4.926 7.437 7.409 4.158 10.319 12.340 10.318
CECIL 7.378 32.895 28.722 25.999 29.497 35.807 8.254 8.251 8.254
DRUMMER 2.189 1.478 0.000 5.367 6.176 0.000 4.111 8.247 10.717
# move row names over for distance matrix
row.names(pig) <- pig[, 1]
d <- daisy(pig[, -1])
dd <- diana(d)

par(mar=c(1,1,1,1))
plotProfileDendrogram(s, dd, dend.y.scale = max(d) * 2, scaling.factor = 0.25, y.offset = 6, width=0.15, cex.names=0.45)

Loafercreek Colors

data("loafercreek")
x <- loafercreek

pig <- soilColorSignature(x, r = 'm_r', g = 'm_g', b='m_b')

# account for missing data
idx <- which(complete.cases(pig[, -1]))
pig <- pig[idx, ]

# the first column is the ID
row.names(pig) <- pig[, 1]
d <- daisy(pig[, 2:6])
dd <- diana(d)

# index to those profiles present in `d`
idx <- which(profile_id(x) %in% pig$peiid)
x <- x[idx, ]

plotProfileDendrogram(x, dd, dend.y.scale = 0.25, scaling.factor = 0.001, y.offset = 0.01, width=0.15)