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

Arrange colors in a grid, based on CIE2000 distances.

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

White borders.

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

No borders.

previewColors(s$moist_soil_color, border.col = NA)
title('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')

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

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)

Constant chip size, annotate with chip frequency.

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

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)

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)

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

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

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

Color Quantiles

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

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

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

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)

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

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

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


This document is based on aqp version 2.0.3, soilDB version 2.8.1, and sharpshootR version 2.2.