Note

All of these functions will be simplified / documented in the near future, stay tuned.

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.

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

# example data
data(sp5)

# semi-random subset
set.seed(10101)
idx <- sample(length(sp5), size = 15, replace = FALSE)

# truncate to 150cm for simplicity
x <- trunc(sp5[idx, ], 0, 150)

# quick check
par(mar = c(0, 0, 0, 1))
plotSPC(x, width = 0.35)

# convert HEX color notation -> sRGB [0,1]
rgb.data <- t(col2rgb(x$soil_color)) / 255

# copy to horizon level attributes of SPC
x$r <- rgb.data[, 1]
x$g <- rgb.data[, 2]
x$b <- rgb.data[, 3]

# develop color signature
pig <- soilColorSignature(x, method = 'depthSlices', RescaleLightnessBy = 5)
knitr::kable(pig, digits = 3, row.names = FALSE)
soil 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
soil100 5.447 8.769 9.510 15.982 22.157 21.267 6.177 10.191 12.184
soil102 7.275 13.824 11.642 8.138 16.434 20.356 6.235 10.186 8.212
soil107 4.794 7.275 7.049 9.798 8.138 21.026 6.296 6.235 6.274
soil155 7.275 7.275 7.275 8.138 8.138 8.138 6.235 6.235 6.235
soil156 2.037 2.037 13.220 5.446 5.446 19.206 6.148 6.148 10.165
soil167 4.794 4.794 15.597 9.798 9.798 17.731 6.296 6.296 8.250
soil168 7.275 7.275 9.453 8.138 8.138 5.188 6.235 6.235 16.139
soil189 7.275 12.172 16.673 8.138 19.396 31.254 6.235 12.308 10.235
soil226 2.037 2.037 2.037 5.446 5.446 5.446 6.148 6.148 6.148
soil332 8.630 7.275 1.346 8.687 8.138 6.864 6.306 6.235 8.321
soil340 7.275 11.642 13.220 8.138 20.356 19.206 6.235 8.212 10.165
soil341 7.275 8.826 8.558 8.138 14.803 13.285 6.235 8.294 6.323
soil40 2.037 4.794 5.447 5.446 9.798 15.982 6.148 6.296 6.177
soil419 7.275 19.442 5.293 8.138 26.882 24.202 6.235 8.259 16.177
soil79 7.275 6.103 8.096 8.138 7.305 8.186 6.235 4.293 8.229

Plot results as dendrogram.

# copy ID to rownames
row.names(pig) <- pig[, 1]

# euclidean distance, leaving out the ID
d <- daisy(pig[, -1], stand = FALSE, metric = 'euclidean')
dd <- diana(d)

plotProfileDendrogram(x, clust = dd, scaling.factor = 0.33, y.offset = 4, width = 0.35)

Colors from Official Series Descriptions

s.list <- c('amador', 'redding', 'pentz', 'willows', 'pardee', 'yolo', 'hanford', 'cecil', 'sycamore', 'KLAMATH', 'MOGLIA', '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(0, 0, 0, 1))
plotSPC(s, name.style = 'center-center', width = 0.33)

Look at full range of OSD colors in this set.

Colors, arranged by ΔE00.

previewColors(s$soil_color)

rgb.colors <- munsell2rgb(s$hue, s$value, s$chroma, return_triplets = TRUE)
lab.colors <- as(sRGB(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.

# 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.311 0.124 0.000 0.564 0.000
ARGONAUT 0.159 0.328 0.000 0.513 0.000
CANEYHEAD 0.560 0.061 0.050 0.330 0.000
CECIL 0.120 0.413 0.000 0.467 0.000
DRUMMER 0.473 0.103 0.004 0.417 0.003
HANFORD 0.244 0.162 0.000 0.594 0.000 
# move row names over for distance matrix
row.names(pig) <- pig[, 1]
d <- daisy(pig[, -1], stand = FALSE)
dd.colorBucket <- diana(d)


par(mar=c(0,0,1,1))
plotProfileDendrogram(s, dd.colorBucket, dend.y.scale = 1.18, scaling.factor = 0.0037, y.offset = 0.06, width = 0.33, cex.names = 0.45, shrink = TRUE, name.style = 'center-center', max.depth = 210)

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.660 4.855 1.917 13.220 18.895 27.799 8.183 10.281 14.314
ARGONAUT 13.394 19.091 15.783 19.325 29.870 17.510 6.052 6.054 8.183
CANEYHEAD 3.227 2.057 -4.910 12.658 7.395 4.144 10.278 12.311 10.275
CECIL 7.335 32.703 28.555 25.848 29.325 35.598 8.187 8.184 8.187
DRUMMER 2.134 1.469 1.469 5.232 6.140 6.140 3.927 8.180 8.180
HANFORD 5.596 5.596 6.590 19.731 19.731 25.398 8.185 8.185 10.283 
# move row names over for distance matrix
row.names(pig) <- pig[, 1]
d <- daisy(pig[, -1], stand = FALSE)
dd.depthSlices <- diana(d)


par(mar=c(0,0,1,1))
plotProfileDendrogram(s, dd.depthSlices, dend.y.scale = 122, scaling.factor = 0.39, y.offset = 5.5, width = 0.33, cex.names = 0.45, shrink = TRUE, name.style = 'center-center', max.depth = 210)

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, method = 'pam', RescaleLightnessBy = 5, 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.660 4.855 1.917 13.220 18.895 27.799 8.183 10.281 14.314
ARGONAUT 15.783 19.091 9.847 17.510 29.870 22.591 8.183 6.054 10.281
CANEYHEAD 2.057 0.861 -4.910 7.395 7.413 4.144 12.311 10.276 10.275
CECIL 7.335 32.703 28.555 25.848 29.325 35.598 8.187 8.184 8.187
DRUMMER 2.134 1.469 -0.326 5.232 6.140 -0.316 3.927 8.180 4.178
HANFORD 5.596 6.590 6.590 19.731 25.398 25.398 8.185 10.283 10.283 
# move row names over for distance matrix
row.names(pig) <- pig[, 1]
d <- daisy(pig[, -1], stand = FALSE)
dd.pam <- diana(d)

par(mar=c(0,0,1,1))
plotProfileDendrogram(s, dd.pam, dend.y.scale = 128, scaling.factor = 0.41, y.offset = 5.5, width = 0.33, cex.names = 0.45, shrink = TRUE, name.style = 'center-center', max.depth = 210)

Comparison

par(mfrow = c(3, 1), mar=c(0,0,1,1))

plotProfileDendrogram(s, dd.colorBucket, dend.y.scale = 1.18, scaling.factor = 0.0038, y.offset = 0.06, width = 0.33, cex.names = 0.45, shrink = TRUE, name.style = 'center-center', max.depth = 210)
mtext('colorBucket', side = 3, at = 1, line = -2, cex = 0.85, font = 2)

plotProfileDendrogram(s, dd.depthSlices, dend.y.scale = 122, scaling.factor = 0.38, y.offset = 5.5, width = 0.33, cex.names = 0.45, shrink = TRUE, name.style = 'center-center', max.depth = 210)
mtext('depthSlices', side = 3, at = 1, line = -2, cex = 0.85, font = 2)

plotProfileDendrogram(s, dd.pam, dend.y.scale = 128, scaling.factor = 0.38, y.offset = 5.5, width = 0.33, cex.names = 0.45, shrink = TRUE, name.style = 'center-center', max.depth = 210)
mtext('PAM', side = 3, at = 1, line = -2, cex = 0.85, font = 2)

Soil Color Signature by “PAM” and delta-E00

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. Distances are computed via delta-E (CIE2000), ΔE00 within each cluster and summed.

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

# iterate over clusters, result is a distance matrix (delta-E00)
delta.E00 <- lapply(1:k, function(i) {
  # LAB coordinates are named by cluster 1:k
  v.names <- paste(c('L', 'A', 'B'), i, sep = '.')
  # pair-wise delta-E00
  d.i <- farver::compare_colour(pig[, v.names], pig[, v.names], from_space='lab', white_from = 'D65', method='cie2000')
  # copy over SPC ids
  dimnames(d.i) <- list(pig[, 1], pig[, 1])
  # convert to dist object
  d.i <- as.dist(d.i)
  return(d.i)
})

# sum distance matrices
d <- Reduce('+', delta.E00)
# divisive clustering
dd <- diana(d)

par(mar=c(0,0,1,1))
plotProfileDendrogram(s, dd, dend.y.scale = max(d) * 2, scaling.factor = 0.55, y.offset = 7, width = 0.33, cex.names = 0.45, shrink = TRUE, name.style = 'center-center', max.depth = 210)

Soil Color Art

Using the distance matrix / clustering from above.

# adjust margins and default colors
par(mar=c(0,0,0,0), bg='black', fg='white', lend = 2)

# hang profiles from dendrogram
# note customization via arguments passed to plotSPC
plotProfileDendrogram(s, dd, dend.y.scale = max(d) * 2, scaling.factor = 0.55, y.offset = 2, width=0.4, name = NA, dend.color = 'white', dend.width = 2, divide.hz=FALSE, print.id=FALSE, depth.axis = FALSE, hz.distinctness.offset = 'hzd', max.depth = 210)

# adjust margins and default colors
par(mar=c(0,0,0,0), lend = 2)

# hang profiles from dendrogram
# note customization via arguments passed to plotSPC
plotProfileDendrogram(s, dd, dend.y.scale = max(d) * 1.5, scaling.factor = 0.38, y.offset = 2, width = 0.4, name = NA, dend.type = 'cladogram', dend.width = 2, divide.hz=FALSE, print.id=FALSE, depth.axis = FALSE, hz.distinctness.offset = 'hzd', max.depth = 210)

Soil Profile Sketch Ordination

Arrange OSD sketches according to locations defined by non-metric multidimensional scaling (ordination) of pair-wise distances. Needs work.

library(MASS)

# add tiny amount for 0-distance pairs (duplicate profiles)
mds <- sammon(d + 0.001)$points
## Initial stress        : 0.05849
## stress after  10 iters: 0.02385, magic = 0.500
## stress after  20 iters: 0.02378, magic = 0.500
# ensure ordering is preserved:
# profile IDs -> distance matrix -> nMDS
all(row.names(mds) == profile_id(s))
## [1] TRUE
# re-scale nMDS axis 1 to the typical horizontal scale used by plotSPC 
xoff <- aqp:::.rescaleRange(mds[, 1], x0 = 1, x1 = length(s))

# adjust to reduce overlap
# with an expansion of the x-axis out to length(s) + 5
set.seed(10110)
xoff.fixed <- fixOverlap(xoff, thresh = 0.65, min.x = 1, max.x = length(s) + 5)

# re-scale nMDS axis 2 to the typical vertical scale used by plotSPC  
yoff <- aqp:::.rescaleRange(mds[, 2], x0 = -10, x1 = max(s))

par(mar = c(0.25, 0.25, 0.25, 0.25), bg='black', fg='white')

plotSPC(s, y.offset = yoff, relative.pos = xoff.fixed, width = 0.25, name.style = 'center-center', hz.depths = FALSE, col.label = 'Generalized Horizon Label', print.id = TRUE, name = NA, scaling.factor = 0.8, shrink = TRUE)

Arrange OSD sketches according to (approximate) locations defined by non-metric multidimensional scaling (ordination) of pair-wise distances.

# use re-scaled nMDS coordinates as virtual transect
# adjust to reduce overlap
set.seed(10110)
pos <- alignTransect(xoff, x.min = 1, x.max = length(s) + 4, thresh = 0.7)

par(mar = c(0.25, 0.25, 0.25, 0.25))

plotSPC(s, n = length(s) + 4, y.offset = yoff[pos$order], plot.order = pos$order, relative.pos = pos$relative.pos, width = 0.25, name.style = 'center-center', hz.depths = FALSE, col.label = 'Generalized Horizon Label', print.id = TRUE, scaling.factor = 1.5, shrink = TRUE)

box()

This document is based on aqp version 2.01.