library(aqp)
library(soilDB)
# library(plyr)
library(sharpshootR)
library(latticeExtra)
library(colorspace)
library(ggplot2)
library(treemapify)
plotSPC()
colorscience
packagepreviewColors()
colorQuantiles()
colordist
packagesoilColorSignature()
mix_and_clean_colors()
# 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
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 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)
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)
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()
)
# 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)')
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'))
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.