Note

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

Introduction

Pending.

TODO

Examples

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

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)

# 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.

pig <- soilColorSignature(s, color = 'soil_color', method = 'colorBucket')

knitr::kable(head(pig), digits = 3, row.names = FALSE)
id .white.pigment .red.pigment .green.pigment .yellow.pigment .blue.pigment
AMADOR 0.693 0.052 0.000 0.255 0
ARGONAUT 0.485 0.201 0.000 0.313 0
CANEYHEAD 0.873 0.012 0.015 0.099 0
CECIL 0.405 0.277 0.000 0.317 0
DRUMMER 0.848 0.029 0.000 0.123 0
HANFORD 0.617 0.085 0.000 0.298 0 
# move row names over for distance matrix
row.names(pig) <- pig[, 1]


d <- daisy(pig[, -1], stand = FALSE, metric = 'euclidean')
dd.colorBucket <- diana(d)


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

d <- daisy(pig[, -1], stand = TRUE, metric = 'euclidean')
dd.colorBucket <- diana(d)

par(mar=c(0,0,1,1))
plotProfileDendrogram(s, dd.colorBucket, scaling.factor = 0.08, width = 0.33, cex.names = 0.45, shrink = TRUE, name.style = 'center-center', max.depth = 210)

d <- daisy(pig[, -1], weights = c(0.25, 1, 1, 1, 1), metric = 'gower')
dd.colorBucket <- diana(d)

par(mar=c(0,0,1,1))
plotProfileDendrogram(s, dd.colorBucket, scaling.factor = 0.006, 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, color = 'soil_color', method = 'depthSlices')

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.362 4.617 1.854 13.323 19.328 27.905 40.960 51.502 71.742
ARGONAUT 13.269 19.196 15.752 19.318 29.954 17.198 30.383 30.172 40.869
CANEYHEAD 3.052 1.389 -4.803 12.731 7.023 3.869 51.407 61.415 51.502
CECIL 7.608 32.614 28.139 25.976 29.267 35.870 40.953 40.890 40.974
DRUMMER 1.983 1.777 1.777 5.042 7.041 7.041 19.500 40.880 40.880
HANFORD 5.906 5.906 6.626 19.280 19.280 25.419 40.842 40.842 51.289 
# 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, scaling.factor = 0.48, width = 0.33, cex.names = 0.45, shrink = TRUE, name.style = 'center-center', max.depth = 210)

d <- soilColorSignature(s, color = 'soil_color', method = 'depthSlices', perceptualDistMat = TRUE)
dd.depthSlices <- diana(d)

par(mar=c(0,0,1,1))
plotProfileDendrogram(s, dd.depthSlices, 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, color = 'soil_color', 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.362 4.617 1.854 13.323 19.328 27.905 40.960 51.502 71.742
ARGONAUT 19.196 15.752 10.064 29.954 17.198 22.654 30.172 40.869 51.285
CANEYHEAD 0.102 -4.803 1.389 7.398 3.869 7.023 51.428 51.502 61.415
CECIL 32.614 7.608 28.139 29.267 25.976 35.870 40.890 40.953 40.974
DRUMMER 1.983 1.777 0.000 5.042 7.041 0.000 19.500 40.880 49.637
HANFORD 5.906 6.626 6.626 19.280 25.419 25.419 40.842 51.289 51.289 
# 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, width = 0.33, cex.names = 0.45, shrink = TRUE, name.style = 'center-center', max.depth = 210)

d <- soilColorSignature(s, color = 'soil_color', method = 'pam', perceptualDistMat = TRUE)
dd.pam <- diana(d)

par(mar=c(0,0,1,1))
plotProfileDendrogram(s, dd.pam, 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 = 24.5, scaling.factor = 0.07, y.offset = 1.1, width = 0.33, cex.names = 0.45, shrink = TRUE, name.style = 'center-center', max.depth = 200)
mtext('colorBucket', side = 3, at = 1, line = -2, cex = 0.85, font = 2)

plotProfileDendrogram(s, dd.depthSlices, dend.y.scale = 122, scaling.factor = 0.36, y.offset = 5.5, width = 0.33, cex.names = 0.45, shrink = TRUE, name.style = 'center-center', max.depth = 200)
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 = 200)
mtext('PAM', side = 3, at = 1, line = -2, cex = 0.85, font = 2)

Soil Color Art

Using the distance matrix / clustering from above.

d <- soilColorSignature(s, color = 'soil_color', method = 'pam', perceptualDistMat = TRUE)
dd <- diana(d)
# 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, scaling.factor = 0.67, y.offset = 5, dend.color = 'white', dend.width = 2,
  width = 0.4, hz.distinctness.offset = 'hzd', 
  max.depth = 210,
  name = NA, divide.hz = FALSE, print.id = FALSE, depth.axis = FALSE, 
)

par(mar = c(0, 0, 0, 0), bg = 'black', fg = 'white', lend = 1)

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

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.04592
## stress after  10 iters: 0.02078, magic = 0.500
## stress after  20 iters: 0.02077, 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.3.1.