library(aqp)
library(soilDB)
# library(plyr)
library(sharpshootR)
library(latticeExtra)
library(colorspace)
library(ggplot2)
library(treemapify)

Topics

  • photos
  • box photos
  • aqp sketches via plotSPC()
  • Munsell color spectra
  • colorscience package
  • previewColors()
  • colorQuantiles()
  • binning of soil profile photos via colordist package
  • soilColorSignature()
  • color mixing mix_and_clean_colors()
  • color RIC vis color book presentation
  • colors in context with common soil pigments
  • colors in context with full CIELAB space
  • examples of exotic colors: sulphides, manganese, etc.
  • poorly drained soils, reduced iron color ranges, gley pages
  • color by drainage class

Clarksville.

# get lab / morphologic data
# simplify colors
x <- fetchKSSL(series='clarksville', returnMorphologicData = TRUE, simplifyColors = TRUE)

# extract pedons into SoilProfileCollection
s <- x$SPC

# genhz
s$genhz <- generalize.hz(
  x = s$hzn_desgn, 
  new = c('A', 'E', 'Bt', '2Bt', '3Bt'), 
  pattern = c('A', 'E', '^Bt', '2B', '3B'),
  non.matching.code = NA
)

s$genhz <- factor(s$genhz, levels = guessGenHzLevels(s, "genhz")$levels)

table(s$genhz, useNA = 'always')
## 
##    A    E   Bt  2Bt  3Bt <NA> 
##  179  206  363  343  115   68

Previewing Colors

MDS representation of unique colors, based on CIE2000 distances.

previewColors(s$moist_soil_color, method = 'MDS', pt.cex = 1.5)
title('Clarksville Soil Colors')

mds[,1] mds[,2] Clarksville Soil Colors

Arrange colors in a grid, based on CIE2000 distances.

previewColors(s$moist_soil_color)
title('Clarksville Soil Colors')

Clarksville Soil Colors

White borders.

previewColors(s$moist_soil_color, border.col = 'white')
title('Clarksville Soil Colors')

Clarksville Soil Colors

No borders.

previewColors(s$moist_soil_color, border.col = NA)
title('Clarksville Soil Colors')

Clarksville Soil Colors

Order colors by horizon top depth.

no.na.idx <- which(!is.na(s$moist_soil_color))
previewColors(s$moist_soil_color[no.na.idx], method = 'manual', col.order = order(s$hzn_top[no.na.idx]), border.col = NA)
title('Clarksville Soil Colors')

Clarksville Soil Colors

Order colors by generalized horizon.

no.na.idx <- which(!is.na(s$moist_soil_color))
previewColors(s$moist_soil_color[no.na.idx], method = 'manual', col.order = order(s$genhz[no.na.idx]), border.col = NA)
title('Clarksville Soil Colors')

Clarksville Soil Colors

Color Book Style Presentation

Color book style range for colors, frequency is represented as chip size.

# prepare vectors of Munsell chips + groups (generalized horizon labels)
m <- paste0(s$m_hue, ' ', s$m_value, '/', s$m_chroma)
g <- s$genhz

colorChart(m, g = g, chip.cex = 2)

Chroma Value 2 4 6 8 2 3 4 5 6 7 8 10R A 2 4 6 8 2.5YR 2 4 6 8 5YR 2 4 6 8 7.5YR 2 4 6 8 10YR 2 4 6 8 2 3 4 5 6 7 8 2.5Y 2 3 4 5 6 7 8 E 2 3 4 5 6 7 8 2 3 4 5 6 7 8 Bt 2 3 4 5 6 7 8 2 3 4 5 6 7 8 2Bt 2 3 4 5 6 7 8 2 3 4 5 6 7 8 2 4 6 8 3Bt 2 4 6 8 2 4 6 8 2 4 6 8 2 4 6 8 2 4 6 8 2 3 4 5 6 7 8

Constant chip size, annotate with chip frequency.

colorChart(m, g = g, chip.cex = 2, size = FALSE, annotate = TRUE)

chip labels represent counts Chroma Value 2 4 6 8 2 3 4 5 6 7 8 10R A 2 4 6 8 2.5YR 2 4 6 8 5YR 2 4 6 8 1 7.5YR 2 4 6 8 1 1 47 34 30 10 1 1 2 3 13 5 1 1 1 1 10YR 2 4 6 8 2 3 4 5 6 7 8 1 2.5Y 2 3 4 5 6 7 8 E 1 2 1 1 3 2 1 39 1 1 1 29 4 3 2 3 4 38 1 26 4 2 1 2 2 3 4 5 6 7 8 2 3 4 5 6 7 8 Bt 5 1 2 3 2 4 2 5 1 2 2 10 2 2 2 2 6 2 19 6 3 1 1 4 2 16 1 12 57 2 1 2 1 7 7 2 24 18 2 50 3 2 1 3 1 1 1 2 3 4 5 6 7 8 2 3 4 5 6 7 8 3 3 6 2Bt 2 37 2 3 2 9 3 1 10 1 1 3 1 2 2 2 3 9 8 5 11 31 4 1 1 1 2 19 4 1 1 4 38 1 1 4 2 2 1 2 2 1 1 2 5 8 2 1 2 3 4 5 6 7 8 2 3 4 5 6 7 8 2 4 6 8 2 3Bt 2 4 6 8 1 11 1 2 4 2 1 3 2 4 6 8 1 1 4 15 1 7 2 4 6 8 1 1 13 5 2 1 4 2 2 4 6 8 1 1 1 1 2 4 6 8 2 3 4 5 6 7 8

Soil Color Aggregation

a <- aggregateColor(s, "genhz", col = 'moist_soil_color')
a.reduced <- aggregateColor(s, "genhz", col = 'moist_soil_color', k = 8)

par(mar = c(4.5, 2.5, 4.5, 0))
aggregateColorPlot(a, label.cex = 0.65, main = "Clarksville Moist Colors\nGeneralized Horizons", print.n.hz = FALSE, print.label = FALSE, rect.border = NA, horizontal.borders = TRUE)

Clarksville Moist Colors Generalized Horizons Cumulative Proportion 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 3Bt 2Bt Bt E A 

par(mar = c(4.5, 2.5, 4.5, 0))
aggregateColorPlot(a.reduced, label.cex = 0.65, main = "Clarksville Moist Colors\nGeneralized Horizons\n8 Colors per Group", print.n.hz = TRUE)

Clarksville Moist Colors Generalized Horizons 8 Colors per Group Cumulative Proportion 10YR 4/2 (49) 10YR 3/2 (35) 10YR 4/3 (30) 10YR 5/3 (22) 10YR 6/3 (67) 10YR 5/4 (65) 7.5YR 5/6 (97) 10YR 5/4 (68) 10YR 6/4 (45) 7.5YR 4/5 (44) 2.5YR 4/6 (55) 7.5YR 5/7 (56) 5YR 4/6 (38) 7.5YR 4/6 (38) 5YR 5/5 (28) 2.5YR 3/6 (23) 7.5YR 6/5 (24) 2.5YR 4/6 (27) 7.5YR 5/6 (33) 7.5YR 5/6 (11) 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 3Bt 2Bt Bt E A

Soil Color RIC via treemap

a <- do.call('rbind', a.reduced$scaled.data)
a.unique <- unique(a[, c('munsell', 'moist_soil_color')])
a.cols <- a.unique$moist_soil_color
names(a.cols) <- a.unique$munsell

ggplot(data = a) + 
  geom_treemap(aes(area = weight, fill = munsell)) +
  geom_treemap_text(aes(area = weight, label = munsell, colour = I(invertLabelColor(moist_soil_color)))) +
  facet_wrap(~ .id, strip.position = "top") + 
  scale_fill_manual(
    guide = 'none',
    values = a.cols
  ) +
  coord_equal() +
  theme_bw() + 
  labs(title = 'Clarksville Moist Color RIC, KSSL Pedons') + 
  theme(
    strip.background = element_blank(),
    strip.text = element_text(face = "bold"),
    panel.border = element_rect(fill = NA, colour = NA),
    panel.grid = element_blank(),
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    axis.title = element_blank()
  )

10YR 4/2 10YR 3/2 10YR 4/3 10YR 5/3 10YR 3/3 2.5YR 4/6 7.5YR 5/7 5YR 4/6 7.5YR 4/6 5YR 5/5 2.5YR 3/6 7.5YR 6/5 10YR 6/4 10YR 6/3 10YR 5/4 2.5YR 4/6 7.5YR 5/6 7.5YR 5/6 7.5YR 5/4 2.5YR 5/6 2.5YR 3/6 7.5YR 5/6 10YR 5/4 10YR 6/4 7.5YR 4/5 2.5YR 4/6 7.5YR 5/5 2Bt 3Bt A E Bt Clarksville Moist Color RIC, KSSL Pedons

Soil Color Simulation

# simulation parameters
p <- list(
  list(m = '7.5YR 4/6', thresh = 12, hues = c('5YR', '7.5YR', '10YR'))
)

# simulation
sim <- simulateColor(method = 'dE00', n = 100, parameters = p)

# present via color chart / tabulation
pp <- colorChart(sim[[1]], annotate = FALSE, chip.cex = 3)
update(pp, asp = 1, main = 'RV Color: 7.5YR 4/6\ndE00 threshold < 12')

RV Color: 7.5YR 4/6 dE00 threshold < 12 Chroma Value 2 4 6 8 10 12 14 2 3 4 5 6 7 8 2 4 6 8 10 12 14 5YR All 2 4 6 8 10 12 14 2 4 6 8 10 12 14 7.5YR 2 4 6 8 10 12 14 2 4 6 8 10 12 14 2 3 4 5 6 7 8 10YR 

# extract horizons, to generate a data.frame of moist colors
h <- horizons(s)

# remove horizons that are missing moist colors
idx <- which(complete.cases(h[, c('m_hue', 'm_value', 'm_chroma', 'genhz')]))
h <- h[idx, ]

# simulation parameters
p <- list(
  list(hvc = data.frame(hue = h$m_hue, value = h$m_value, chroma = h$m_chroma))
)

# simulation
sim <- simulateColor(method = 'mvnorm', n = 100, parameters = p)

# present via color chart / tabulation
pp <- colorChart(sim[[1]], annotate = FALSE, chip.cex = 3)
update(pp, main = 'Multivariate Simulation (All Colors)')

Multivariate Simulation (All Colors) Chroma Value 2 3 4 5 6 7 8 2 3 4 5 6 7 8 2 3 4 5 6 7 8 2.5YR All 2 3 4 5 6 7 8 2 3 4 5 6 7 8 5YR 2 3 4 5 6 7 8 2 3 4 5 6 7 8 7.5YR 2 3 4 5 6 7 8 2 3 4 5 6 7 8 10YR 2 3 4 5 6 7 8 2 3 4 5 6 7 8 2.5Y 2 3 4 5 6 7 8 2 3 4 5 6 7 8 5Y 2 3 4 5 6 7 8 2 3 4 5 6 7 8 2 3 4 5 6 7 8 10Y

Color Quantiles

x <- colorQuantiles(na.omit(s$moist_soil_color))

# result from plotColorQuantiles() is a lattice graphics object
update(
  plotColorQuantiles(x),
  main = 'All Colors'
)

All Colors 5th, 50th, 95th Percentiles Marginal P L1 Median 30 35 40 45 50 55 60 10YR 3/2 (0.178) 10YR 5/4 (0.129) 10YR 6/4 (0.110) 7.5YR 5/5 (2.092) CIELAB L-Coordinate Marginal P L1 Median 4 6 8 10 12 14 16 18 20 22 24 10YR 4/2 (0.392) 7.5YR 5/5 (1.888) 2.5YR 3/6 (0.128) 7.5YR 5/5 (2.092) CIELAB A-Coordinate Marginal P L1 Median 15 20 25 30 35 40 10YR 4/2 (0.392) 7.5YR 6/4 (4.113) 10YR 5/6 (0.208) 7.5YR 5/5 (2.092) CIELAB B-Coordinate

Compute color quantiles by generalized horizon label.

h.by.genhz <- split(s$moist_soil_color, f = s$genhz)

l <- lapply(h.by.genhz, function(i) {
  colorQuantiles(na.omit(i))
})

# print figures to current graphics device (multiple pages)
for(i in names(l)) {
  # make figure
  fig <- plotColorQuantiles(l[[i]])
  # format title
  main.txt <- sprintf("Generalized Horizon: %s", i)
  # add figure title
  fig <- update(fig, main = main.txt)
  print(fig)
}

Generalized Horizon: A 5th, 50th, 95th Percentiles Marginal P L1 Median 30 32 34 36 38 40 42 44 46 48 50 52 10YR 3/3 (0.307) 10YR 4/3 (0.406) 10YR 5/3 (0.459) 10YR 4/2 (1.280) CIELAB L-Coordinate Marginal P L1 Median 3.0 3.5 4.0 4.5 5.0 5.5 6.0 6.5 10YR 6/2 (0.266) 10YR 3/2 (0.178) 10YR 5/4 (0.129) 10YR 4/2 (1.280) CIELAB A-Coordinate Marginal P L1 Median 12 13 14 15 16 17 18 19 20 21 22 23 24 10YR 3/2 (0.178) 10YR 4/2 (0.392) 10YR 3/4 (0.105) 10YR 4/2 (1.280) CIELAB B-Coordinate Generalized Horizon: E 5th, 50th, 95th Percentiles Marginal P L1 Median 44 46 48 50 52 54 56 58 60 62 10YR 4/3 (2.929) 10YR 5/3 (0.459) 10YR 6/4 (0.110) 10YR 5/4 (3.747) CIELAB L-Coordinate Marginal P L1 Median 4.5 5.0 5.5 6.0 6.5 7.0 7.5 8.0 8.5 9.0 9.5 10YR 5/3 (3.366) 10YR 6/4 (0.110) 10YR 5/6 (0.208) 10YR 5/4 (3.747) CIELAB A-Coordinate Marginal P L1 Median 18 20 22 24 26 28 30 32 10YR 5/3 (3.738) 7.5YR 5/4 (0.215) 10YR 6/5 (0.173) 10YR 5/4 (3.747) CIELAB B-Coordinate Generalized Horizon: Bt 5th, 50th, 95th Percentiles Marginal P L1 Median 40 42 44 46 48 50 52 54 56 58 60 62 7.5YR 4/6 (0.107) 10YR 5/6 (0.208) 10YR 6/4 (0.110) 7.5YR 5/5 (1.236) CIELAB L-Coordinate Marginal P L1 Median 6 8 10 12 14 16 18 20 10YR 6/4 (0.110) 7.5YR 4/4 (0.187) 5YR 5/7 (2.363) 7.5YR 5/5 (1.236) CIELAB A-Coordinate Marginal P L1 Median 20 22 24 26 28 30 32 34 36 38 10YR 7/3 (0.144) 10YR 6/5 (2.242) 10YR 5/6 (0.208) 7.5YR 5/5 (1.236) CIELAB B-Coordinate Generalized Horizon: 2Bt 5th, 50th, 95th Percentiles Marginal P L1 Median 30 35 40 45 50 55 10R 3/6 (0.094) 5YR 4/6 (4.739) 7.5YR 6/4 (3.862) 5YR 4/6 (4.626) CIELAB L-Coordinate Marginal P L1 Median 8 10 12 14 16 18 20 22 24 26 7.5YR 5/3 (1.741) 5YR 5/6 (2.804) 10R 3/6 (0.094) 5YR 4/6 (4.626) CIELAB A-Coordinate Marginal P L1 Median 20 22 24 26 28 30 32 34 36 38 10R 3/6 (0.094) 5YR 4/6 (4.739) 5YR 4/8 (5.346) 5YR 4/6 (4.626) CIELAB B-Coordinate Generalized Horizon: 3Bt 5th, 50th, 95th Percentiles Marginal P L1 Median 34 36 38 40 42 44 46 48 50 52 54 56 58 2.5YR 3/6 (3.636) 5YR 5/8 (0.180) 5YR 6/5 (3.288) 5YR 5/6 (1.551) CIELAB L-Coordinate Marginal P L1 Median 10 12 14 16 18 20 22 24 7.5YR 5/4 (0.215) 5YR 5/6 (0.285) 5YR 5/8 (0.180) 5YR 5/6 (1.551) CIELAB A-Coordinate Marginal P L1 Median 22 24 26 28 30 32 34 36 38 40 42 2.5YR 5/5 (3.332) 5YR 5/6 (0.285) 5YR 5/8 (0.180) 5YR 5/6 (1.551) CIELAB B-Coordinate

Reduce lists to data.frame objects for further use or reporting.

L1.data <- do.call('rbind', lapply(l, '[[', 'L1'))
m.data <- do.call('rbind', lapply(l, '[[', 'marginal'))

Soil Color Palettes

Examples for creating a soil-inspired palette of colors.

# aggregate colors over all depths into 6 medoid colors
site(s)$grp <- 'a'
a <- aggregateColor(s, group = "grp", col = 'moist_soil_color', k = 6)

# setup margins
par(mar=c(0.25,0.25,0.25,0.25), bg='white')

# using L1 medians, in depth-order
soilPalette(L1.data$L1_color, L1.data$L1_chip)

10YR 4/2 (1.280) 10YR 5/4 (3.747) 7.5YR 5/5 (1.236) 5YR 4/6 (4.626) 5YR 5/6 (1.551) 

# using 6 medoid colors
soilPalette(a$scaled.data$a$moist_soil_color, a$scaled.data$a$munsell)

7.5YR 5/6 7.5YR 6/4 7.5YR 5/4 5YR 4/6 2.5YR 4/6 10YR 4/3 

L1.cols <- L1.data$L1_color
medoid.cols <- a$scaled.data$a$moist_soil_color

swatchplot(
  list(
    "L1 Median Colors" = L1.cols,
    "Medoid Colors" = medoid.cols)
)

L1 Median Colors Medoid Colors 

swatchplot(
  list(
    "L1 Median Colors" = L1.cols,
    "Medoid Colors" = medoid.cols),
  cvd = TRUE
)

L1 Median Colors Original Deuteranope Protanope Tritanope Desaturated Medoid Colors Original Deuteranope Protanope Tritanope Desaturated

This document is based on aqp version 2.2-1, soilDB version 2.8.10, and sharpshootR version 2.3.3.