Home

Map unit spatial adjacency analysis

Sat, 18 Mar 2017 22:48:54 +0000

Linework Evaluation

library(spdep)
library(rgdal)
library(igraph)
library(sharpshootR)
library(lattice)
library(Cairo)

# load active survey
# x <- readOGR(dsn='l:/CA630/FG_CA630_OFFICIAL.gdb', layer='ca630_a', stringsAsFactors=FALSE)
x <- readOGR(dsn='l:/CA792/ca792_spatial/FG_CA792_OFFICIAL.gdb', layer='ca792_a', stringsAsFactors=FALSE)

## OGR data source with driver: OpenFileGDB 
## Source: "l:/CA792/ca792_spatial/FG_CA792_OFFICIAL.gdb", layer: "ca792_a"
## with 2397 features
## It has 6 fields

# remove NOTCOM, DA, and empty (non-NA) symbols
x <- x[which(! x$MUSYM %in% c('NOTCOM', 'DA', ' ', '', 'WATER', 'W')), ]

# create polygon adjacency matrix
res <- polygonAdjacency(x, v='MUSYM')

# # graphical check: slow for large number of features
# plot(x)
# plot(x[res$commonLines, ], col='red', add=TRUE)

# save to SHP
# writeOGR(x[res$commonLines, ], dsn='l:/CA630/MapUnits', layer='common-soil-lines', driver='ESRI Shapefile', overwrite_layer=TRUE)

# plot spatial adjacency information
par(mar=c(0,0,0,0))
plotSoilRelationGraph(res$adjMat, vertex.scaling.factor = 1)

plotSoilRelationGraph(res$adjMat, spanning.tree=0.9, edge.scaling.factor=0.1)

plotSoilRelationGraph(res$adjMat, spanning.tree='max', edge.scaling.factor=0.1, vertex.scaling.factor=1.5)

# compute diversity by map unit symbol
g <- plotSoilRelationGraph(res$adjMat, vertex.scaling.factor = 1, plot.style = 'none')
dotplot(sort(graph.diversity(g)))

Aggregate properties by taxon name

Sat, 18 Mar 2017 22:48:49 +0000

This document is based on aqp version 1.10-1 and soilDB version 1.8.1.

Introduction

# load required libaries
library(soilDB)
library(sharpshootR)
library(cluster)
library(lattice)
library(reshape2)
library(plyr)
library(colorspace)

# init vector of taxonnames to summarize
soils <- c('Whiterock', 'Copperopolis', 'Amador', 'Auburn', 'Loafercreek', 'Argonaut', 'Crimeahouse', 'Hennekenot')

Optionally re-make cached data. Requires NASIS and relevant soils in the selected set.

# get all pedons from the selected set
x <- fetchNASIS(rmHzErrors = FALSE, nullFragsAreZero = FALSE)

# convert vector of taxonnames into REGEX pattern for matching
pat <- paste0(soils, collapse='|')

# subset pedons that match our REGEX pattern
idx <- grep(pat, x$taxonname, ignore.case = TRUE)
x <- x[idx, ]

# save for later
save(x, file='profile-summary-SPC.rda')

# load cached copy
load(url('http://ncss-tech.github.io/AQP/aqp/profile-summary-SPC.rda'))

# normalize taxonname via REGEX
for(i in soils)
  x$taxonname[grep(i, x$taxonname, ignore.case = TRUE)] <- i

# tabulate number of profiiles
table(x$taxonname)

Amador	Argonaut	Auburn	Copperopolis	Crimeahouse	Hennekenot	Loafercreek	Whiterock
19	20	112	22	27	20	85	31

# convert soil colors to LAB colorspace
# moist colors
cols.lab <- as(sRGB(x$m_r, x$m_g, x$m_b), 'LAB')@coords
x$m_L <- cols.lab[, 1]
x$m_A <- cols.lab[, 2]
x$m_B <- cols.lab[, 3]

# dry colors
cols.lab <- as(sRGB(x$d_r, x$d_g, x$d_b), 'LAB')@coords
x$d_L <- cols.lab[, 1]
x$d_A <- cols.lab[, 2]
x$d_B <- cols.lab[, 3]


# aggregate data by normalized taxonname, via slice-wise median
a.colors <- slab(x, taxonname ~ d_r + d_g + d_b + d_L + d_A + d_B + clay + phfield + total_frags_pct)

# throw out aggregate data that are deeper than 150cm
a.colors <- subset(a.colors, subset=bottom < 150)

# convert long -> wide format
x.colors <- dcast(a.colors, taxonname + top + bottom ~ variable, value.var = 'p.q50')

# check
head(a.colors)

variable	taxonname	p.q5	p.q25	p.q50	p.q75	p.q95	top	bottom	contributing_fraction
d_r	Amador	0.4823269	0.5789309	0.6316626	0.6675592	0.6826665	0	1	0.6842105
d_r	Amador	0.4823269	0.5789309	0.6316626	0.6675592	0.6826665	1	2	0.6842105
d_r	Amador	0.4823269	0.5789309	0.6316626	0.6675592	0.6826665	2	3	0.6842105
d_r	Amador	0.4823269	0.5789309	0.6316626	0.6675592	0.6826665	3	4	0.6842105
d_r	Amador	0.4823692	0.5812506	0.6334787	0.6675894	0.6826666	4	5	0.6842105
d_r	Amador	0.4062669	0.5553961	0.6330297	0.6675890	0.6826666	5	6	0.6842105

head(x.colors)

taxonname	top	bottom	d_r	d_g	d_b	d_L	d_A	d_B	clay	phfield	total_frags_pct
Amador	0	1	0.6316626	0.5264226	0.3892964	57.77242	5.630916	21.63351	13.28053	5.482295	6.647779
Amador	1	2	0.6316626	0.5264226	0.3892964	57.77242	5.630916	21.63351	13.28053	5.482295	6.647779
Amador	2	3	0.6316626	0.5264226	0.3892964	57.77242	5.630916	21.63351	13.28053	5.482295	6.647779
Amador	3	4	0.6316626	0.5264226	0.3892964	57.77242	5.630916	21.63351	13.28053	5.482295	6.647779
Amador	4	5	0.6334787	0.5263167	0.3917715	57.77208	5.641995	21.10100	13.61498	5.502247	6.647779
Amador	5	6	0.6330297	0.5255969	0.3909398	57.75578	5.709881	20.62976	13.63533	5.536855	7.401305

# composite sRGB triplets into an R-compatible color
# note that missing colors must be padded with NA
x.colors$soil_color <- NA
not.na <- which(complete.cases(x.colors[, c('d_L', 'd_A', 'd_B')]))
cols.srgb <- data.frame(as(LAB(x.colors$d_L, x.colors$d_A, x.colors$d_B), 'sRGB')@coords)

x.colors$soil_color[not.na] <- with(cols.srgb[not.na, ], rgb(R, G, B, maxColorValue = 1))

# aggregate bedrock depth probabilty by taxonname
# at 90% level of confidence
dp <- aggregateSoilDepth(x, 'taxonname', crit.prob=0.9)

# init a new SoilProfileCollection from aggregate data
depths(x.colors) <- taxonname ~ top + bottom
# join-in our depth to contact data
site(x.colors) <- dp

# generate index for new ordering
new.order <- match(c('Whiterock', 'Copperopolis', 'Amador', 'Auburn', 'Loafercreek', 'Argonaut', 'Crimeahouse', 'Hennekenot'), profile_id(x.colors))

par(mar=c(1,0,3,0))
plot(x.colors, divide.hz=FALSE, name='', plot.order=new.order, col.label='Soil Color', lwd=1.25, axis.line.offset=-6, cex.depth.axis=1, cex.id=1)
addBracket(x.colors$soil.top, x.colors$soil.bottom, col='black', label='P(soil >= 90%)', label.cex=0.85)
title('Aggregate Soil Properties')

d <- profile_compare(x.colors, vars=c('d_L', 'd_A', 'd_B'), max_d=150, k=0)
plotProfileDendrogram(x.colors, diana(d), scaling.factor = 1, name='',  divide.hz=FALSE, y.offset=10)
addBracket(x.colors$soil.top, x.colors$soil.bottom, col='black', label='P(soil >= 90%)', label.cex=0.6)
title('Aggregate Soil Properties')

par(mar=c(1,0,3,0))
plot(x.colors, divide.hz=FALSE, color='clay', name='', plot.order=new.order, col.label='Clay Content (%)', lwd=1.25, axis.line.offset=-6, cex.depth.axis=1, cex.id=1)
addBracket(x.colors$soil.top, x.colors$soil.bottom, col='black', label='P(soil >= 90%)', label.cex=0.85)

plot(x.colors, divide.hz=FALSE, color='phfield', name='', plot.order=new.order, col.label='pH', lwd=1.25, axis.line.offset=-6, cex.depth.axis=1, cex.id=1)
addBracket(x.colors$soil.top, x.colors$soil.bottom, col='black', label='P(soil >= 90%)', label.cex=0.85)

plot(x.colors, divide.hz=FALSE, color='total_frags_pct', name='', plot.order=new.order, col.label='Total Rock Fragment Volume (%)', lwd=1.25, axis.line.offset=-6, cex.depth.axis=1, cex.id=1)
addVolumeFraction(x.colors, 'total_frags_pct')
addBracket(x.colors$soil.top, x.colors$soil.bottom, col='black', label='P(soil >= 90%)', label.cex=0.85)

d <- profile_compare(x.colors, vars=c('clay', 'phfield', 'total_frags_pct'), max_d=150, k=0)

plotProfileDendrogram(x.colors, diana(d), scaling.factor = 0.5, name='',  divide.hz=FALSE, y.offset=10)

plotProfileDendrogram(x.colors, diana(d), scaling.factor = 0.5, name='',  divide.hz=FALSE, y.offset=10, color='clay')
addBracket(x.colors$soil.top, x.colors$soil.bottom, col='black', label='P(soil >= 90%)', label.cex=0.6)
addVolumeFraction(x.colors, 'total_frags_pct')

plotProfileDendrogram(x.colors, diana(d), scaling.factor = 0.5, name='',  divide.hz=FALSE, y.offset=10, color='phfield')

plotProfileDendrogram(x.colors, diana(d), scaling.factor = 0.5, name='',  divide.hz=FALSE, y.offset=10, color='total_frags_pct')

d <- profile_compare(x.colors, vars=c('d_L', 'clay', 'phfield', 'total_frags_pct'), max_d=150, k=0)

plotProfileDendrogram(x.colors, diana(d), scaling.factor = 0.5, name='',  divide.hz=FALSE, y.offset=10)
addBracket(x.colors$soil.top, x.colors$soil.bottom, col='black', label='P(soil >= 90%)', label.cex=0.6, offset = -0.25)

pig <- soilColorSignature(x.colors, r='d_r', g='d_g', b='d_b', RescaleLightnessBy = 1, method = 'colorBucket')
# move row names over for distance matrix
row.names(pig) <- pig$taxonname

head(pig)

	taxonname	.white.pigment	.red.pigment	.yellow.pigment
Amador	Amador	0.7707712	0.0356233	0.1936055
Argonaut	Argonaut	0.5489614	0.1234697	0.3275689
Auburn	Auburn	0.5831313	0.1273263	0.2895423
Copperopolis	Copperopolis	0.7583637	0.0334275	0.2082088
Crimeahouse	Crimeahouse	0.5224745	0.1736273	0.3038982
Hennekenot	Hennekenot	0.6166673	0.1096758	0.2736568

d <- daisy(pig[, -1])
dd <- diana(d)

par(mar=c(1,1,1,1))
plotProfileDendrogram(x.colors, dd, dend.y.scale = max(d) * 2, scaling.factor = 0.002, y.offset = 0.04, width=0.15, name='',  divide.hz=FALSE)
addBracket(x.colors$soil.top, x.colors$soil.bottom, col='black', label='P(soil >= 90%)', label.cex=0.6, offset = -0.25)

pig <- soilColorSignature(x.colors, r='d_r', g='d_g', b='d_b', RescaleLightnessBy = 1, method = 'depthSlices')
# move row names over for distance matrix
row.names(pig) <- pig$taxonname

d <- daisy(pig[, -1])
dd <- diana(d)

par(mar=c(1,1,1,1))
plotProfileDendrogram(x.colors, dd, dend.y.scale = max(d) * 2, scaling.factor = 0.5, y.offset = 7, width=0.15, name='',  divide.hz=FALSE)
addBracket(x.colors$soil.top, x.colors$soil.bottom, col='black', label='P(soil >= 90%)', label.cex=0.6, offset = -0.25)

pig <- soilColorSignature(x.colors, r='d_r', g='d_g', b='d_b', RescaleLightnessBy = 1, method = 'pam')
# move row names over for distance matrix
row.names(pig) <- pig$taxonname

d <- daisy(pig[, -1])
dd <- diana(d)

par(mar=c(1,1,1,1))
plotProfileDendrogram(x.colors, dd, dend.y.scale = max(d) * 2, scaling.factor = 0.5, y.offset = 7, width=0.15, name='',  divide.hz=FALSE)
addBracket(x.colors$soil.top, x.colors$soil.bottom, col='black', label='P(soil >= 90%)', label.cex=0.6, offset = -0.25)

Vertical vs. perpendicular horizon measurements

Sat, 18 Mar 2017 22:48:45 +0000

Introduction

This is a simple demonstration of how to do some soils-related stuff in R with the aqp package.

A Visual Demonstration of Horizon Depths Measured Vertically vs. Perpendicular to the Surface Slope

The relationship between perpendicular horizon depth ($T_{p}$) and vertical horizon depth ($T_{v}$) is defined as:

\[T_{p} = T_{v} cos(\theta)\]

where $\theta$ is the surface slope measured in radians. Surface slope measured in percent ($s$) can be converted to radians with $\theta = atan(s / 100)$.

Setup environment by loading required packages, and user-defined functions

# load required packages, you may have to install these if missing:
# install.packages('Hmisc', dep=TRUE)
library(lattice)
library(Hmisc)
library(Cairo)
library(aqp)
library(xtable)

# convert angle in percent to radians
pct2rad <- function(pct) {
    atan(pct / 100)
}

# compute difference in thickness as a function of slope pct
thickDiff <- function(pct, Tv) {
    Tp <- Tv * cos(pct2rad(pct))
    return(Tv - Tp)
}

# transform vertical to perpendicular depths
# operates on a single SPC object
VtoP <- function(i, which) {
    # get vector of bottom or top depths
    b <- horizons(i)[[which]]
    # convert vertical to perpendicular depths and round to an integer
    b.p <- round(b * cos(pct2rad(i$slope)))
    return(b.p)
}

Generate a sample data set for subsequent demonstrations

# generate a single profile, keep only the relevant stuff
set.seed(54321)
p <- random_profile(1)[, c('id', 'top', 'bottom', 'name')]

# stack 10 copies of these data
pp <- rbind(p, p, p, p, p, p, p, p, p, p)

# add a unique ID to each chunk copy
pp$id <- rep(1:10, each=nrow(p))

# upgrade our data.frame into a SoilProfileCollection object
depths(pp) <- id ~ top + bottom

# generate a sequence of (10) simulated slope values
s <- data.frame(id=1:10, slope=seq(from=1, to=70, length.out=10))
# assign these values into the 'site' attribute table of our pedons
site(pp) <- s

# assume data were generated with vertical horizon depths
# compute corresponding perpendicular horizon bottom depths
pp$Tp <- profileApply(pp, VtoP, which='bottom')

# check our new object:
print(pp)

## Object of class SoilProfileCollection
## Number of profiles: 10
## Depth range: 48-48 cm
## 
## Horizon attributes:
##   id top bottom name Tp
## 1  1   0     17   H1 17
## 2  1  17     26   H2 26
## 3  1  26     38   H3 38
## 4  1  38     48   H4 48
## 5  2   0     17   H1 17
## 6  2  17     26   H2 26
## 
## Sampling site attributes:
##   id     slope
## 1  1  1.000000
## 2  2  8.666667
## 3  3 16.333333
## 4  4 24.000000
## 5  5 31.666667
## 6  6 39.333333

Plot differences in horizon depth as a function of slope

# adjust figure margins
par(mar=c(2,0,0.75,0))
# plot SoilProfileCollection
plot(pp, n.depth.ticks=10)

# add a title
title('Vertical Horizon Depths (black) vs. Perpendicular Horizon Depths (blue)', cex.main=0.75)

# add axis with slope values
axis(side=1, cex.axis=0.75, line=-1.25, at=1:10, labels=round(s$slope))
mtext(side=1, 'Slope (%)', line=0.5, cex=0.75)

# iterate over profiles and add offset hz boundaries
for(i in 1:length(pp)) {
    pp.i <- pp[i, ]
    # use color to show only those offsets that are > 1 cm
    cols <- ifelse(abs(pp.i$bottom - pp.i$Tp) > 1, 'RoyalBlue', NA)
    arrows(x0=i, x1=i, y0=pp.i$bottom, y1=pp.i$Tp, length=0.08, col=cols)
    segments(x0=i-0.2, x1=i+0.2, y0=pp.i$Tp, y1=pp.i$Tp, col=cols, lty=2)
}

This time plot after converting horizon depths from vertical basis to perpendicular basis

# make a copy of the original profiles
pp.perp <- pp

# convert horizon top and bottom depths from vertical to perpendicular basis
pp.perp$top <- profileApply(pp.perp, VtoP, which='top')
pp.perp$bottom <- profileApply(pp.perp, VtoP, which='bottom')

# setup margins
par(mar=c(2,0,0.75,0))
# plot profiles
plot(pp.perp, n.depth.ticks=10)
# add title
title('Changes in Horizon Depth as a Function of Surface Slope', cex.main=0.75)
# add slope axis
axis(side=1, cex.axis=0.75, line=-1.25, at=1:10, labels=round(s$slope))
mtext(side=1, 'Slope (%)', line=0.5, cex=0.75)
# add horizontal lines to assist with perception of depth
abline(h=seq(from=5, to=75, by=5), lty=3, col='grey')

Tabulate the mean and cumulative difference in horizon depths by pedon

# compute difference in horizon thickness
diff.thick <- (pp$bottom - pp$top) - (pp.perp$bottom - pp.perp$top)
theID <- horizons(pp)$id # extract IDs
# compute mean and total difference by pedon
diff.by.pedon <- by(diff.thick, theID, function(i) cbind(mean.diff.cm=mean(i), total.diff.cm=sum(i)))
# composite into a data.frame and add slope values
diff.by.pedon.df <- data.frame(do.call('rbind', diff.by.pedon), slope=round(s$slope))
# convert tabular output into HTML
print(xtable(diff.by.pedon.df), type='html')

	mean.diff.cm	total.diff.cm	slope
1	0.00	0.00	1.00
2	0.00	0.00	9.00
3	0.25	1.00	16.00
4	0.25	1.00	24.00
5	0.50	2.00	32.00
6	0.75	3.00	39.00
7	1.25	5.00	47.00
8	1.50	6.00	55.00
9	1.75	7.00	62.00
10	2.25	9.00	70.00

Another visualization of differences in vertical vs. perpendicular depths as a function of slope

# make a grid of horizon thickness and slope percents
d <- expand.grid(thick=c(5,10,20,50,100), slope=1:70)

# compute the difference between vertical and perpendicular depths
d$thickDiff <- thickDiff(d$slope, d$thick)

# check the results
head(d)

##   thick slope    thickDiff
## 1     5     1 0.0002499813
## 2    10     1 0.0004999625
## 3    20     1 0.0009999250
## 4    50     1 0.0024998125
## 5   100     1 0.0049996250
## 6     5     2 0.0009997001

# plot these data
# note the different syntax-- this is lattice-style plotting
xYplot(thickDiff ~ slope, data=d, groups=factor(thick, labels=paste(c(5,10,20,50,100), 'cm depth')), type='l',
ylab='(Vertical - Perpendicular) Hz Thickness', xlab='Slope (%)', 
main='Difference in Apparent Horizon Thickness as a Function of Slope', 
scales=list(alternating=3, tick.number=10), 
par.settings=list(superpose.line=list(col='black', lwd=1.5)), 
label.curves=list(cex=1), 
panel=function(...) {
    panel.abline(v=seq(0, 70, by=10), h=seq(0, 20, by=2), col=grey(0.75), lty=3)
    panel.xYplot(...)
    })

OSD Dendrogram

Sat, 18 Mar 2017 22:48:45 +0000

Arrange OSD Data Graphically

# need these
library(soilDB)
library(sharpshootR)

# soils of interest
s.list <- c('hornitos', 'perkins', 'argonaut', 'inks', 'mokelumne', 'dunstone', 'auburn', 'pentz', 'pardee', 'peters', 'amador', 'laniger')

# fetch and convert data into an SPC
s <- fetchOSD(s.list)

# estimate soil depth based on horizon designation
s$soil.depth <- profileApply(s, estimateSoilDepth, name='hzname', top='top', bottom='bottom')

# plot profiles, order by soil depth
par(mar=c(0,0,0,0))
plot(s, name='hzname', plot.order=order(s$soil.depth), cex.names=0.85, axis.line.offset=-5)

# plot dendrogram + profiles
SoilTaxonomyDendrogram(s, cex.taxon.labels=0.8)

This document is based on aqp version 1.7-4 and soilDB version 1.3-4.

Dealing with bad data

Sat, 18 Mar 2017 22:48:44 +0000

Dealing With Troublesome Data

A quick tutorial on how to search for and accommodate messy data. Inconsistent horizon depths, missing horizons, overlapping horizons, and other such mayhem can lead to unexpected results. It is best to search for and filter (or fix) these kind of errors before proceeding to analyze soil profile data. While classes and methods within the aqp package are fairly tolerant of messy data, it is recommended that you apply these tests to your data before feeding into aqp functions. This tutorial requires the plyr package; if you don’t already have it, you can get it like this: install.packages('plyr', dep=TRUE).

Sample Data

Copy and paste this code into an R session to familiarize yourself with the sample data set used in this tutorial.

library(aqp)

# load sample data set, a simple data.frame object with horizon-level data from 10 profiles
data(sp1)
str(sp1)

# optionally read about it...
# ?sp1

# upgrade to SoilProfileCollection
# 'id' is the name of the column containing the profile ID
# 'top' is the name of the column containing horizon upper boundaries
# 'bottom' is the name of the column containing horizon lower boundaries
depths(sp1) <- id ~ top + bottom

# check it out:
class(sp1)
print(sp1)
plot(sp1)

Data Cleaning

Soil data often contain records where the lower depth of the deepest horizon is missing (NA). These data can either be filtered out or “cleaned” by replacing the missing lower depth with the corresponding upper depth. Older soils data with may have O horizons that start above the soil surface (e.g. “Oe 3 to 0 cm). Data containing these type of horizons must either be filtered or fixed before use with classes or methods defined in the aqp package.

# replace missing bottom depths
sp1$bottom[!is.na(sp1$top) & is.na(sp1$bottom)] <- sp1$top[!is.na(sp1$top) & is.na(sp1$bottom)]

# remove O horizons where top > bottom
bad.O.hz.idx <- which(sp1$top > sp1$top)
if(length(bad.O.hz.idx) > 0)
    sp1 <- sp1[-bad.O.hz.idx, ]

Checking for Bad Data

Lets break some good data to make a point.

# load required libraries
library(aqp)
library(plyr)

# load sample data (you already tried this right?)
data(sp1)

# make a copy of the example data set, we will insert errors later
bad <- sp1

# insert a missing horizon boundary in profile P001
bad$top[4] <- NA

# create an overlapping horizon in profile P002
bad$top[9] <- 15

# check:
head(sp1[, c('id', 'top', 'bottom')], 10) # good data

##      id top bottom
## 1  P001   0      2
## 2  P001   2     14
## 3  P001  14     49
## 4  P001  49     57
## 5  P001  57     89
## 6  P001  89     89
## 7  P002   0      5
## 8  P002   5     19
## 9  P002  19     33
## 10 P002  33     59

head(bad[, c('id', 'top', 'bottom')], 10) # bad data

##      id top bottom
## 1  P001   0      2
## 2  P001   2     14
## 3  P001  14     49
## 4  P001  NA     57
## 5  P001  57     89
## 6  P001  89     89
## 7  P002   0      5
## 8  P002   5     19
## 9  P002  15     33
## 10 P002  33     59

# test for missing horizon depths OR overlapping horizons
ddply(sp1, 'id', test_hz_logic, topcol='top', bottomcol='bottom') # TRUE is good

##     id hz_logic_pass
## 1 P001          TRUE
## 2 P002          TRUE
## 3 P003          TRUE
## 4 P004          TRUE
## 5 P005          TRUE
## 6 P006          TRUE
## 7 P007          TRUE
## 8 P008          TRUE
## 9 P009          TRUE

ddply(bad, 'id', test_hz_logic, topcol='top', bottomcol='bottom') # FALSE is bad

##     id hz_logic_pass
## 1 P001         FALSE
## 2 P002         FALSE
## 3 P003          TRUE
## 4 P004          TRUE
## 5 P005          TRUE
## 6 P006          TRUE
## 7 P007          TRUE
## 8 P008          TRUE
## 9 P009          TRUE

Filtering out Bad Data

The test_hz_logic() function is applied to each profile using the ddply() function, with results returned as a simple table. We can use this table to determine which profiles should either be filtered or fixed. Note that we previously corrupted the horizons in profiles P001 and P002.

# apply test to our 'bad' data and save result
bad.test <- ddply(bad, 'id', test_hz_logic, topcol='top', bottomcol='bottom')

# which are the good (valid) profiles?
good.profiles <- as.character(bad.test$id[which(bad.test$hz_logic_pass)])

# keep the good ones
good <- subset(bad, id %in% good.profiles)

# promote to SoilProfileCollection
depths(good) <- id ~ top + bottom

# set figure margins to 0
par(mar=c(0,0,0,0))
# plot
plot(good)

Concluding Notes

Classes and methods within the aqp package can accommodate missing horizons (e.g. a horizon that was not submitted for lab characterization), however the following conditions are not allowed: * missing horizon boundaries (bottom of an R horizon) * top depth > bottom depth (old-style O horizon) * overlapping horizons (data-entry error or multiple samples from overlapping depths)

This document is based on aqp version 1.9.3.

SoilProfileCollection object introduction

Sat, 18 Mar 2017 22:48:43 +0000

Introduction

This is a very basic introduction to the SoilProfileCollection class object defined in the aqp package for R. The SoilProfileCollection class was designed to simplify the process of working with the collection of data associated with soil profiles: site-level data, horizon-level data, spatial data, diagnostic horizon data, metadata, etc. Examples listed below are meant to be copied/pasted from this document and interactively run within R. Comments (green text) briefly describe what the code in each line does. This document assumes a basic level of proficiency with R which can be gained by reviewing some of the material in tutorials like this. Further documentation on objects and functions from the aqp package can be accessed by typing help(aqp) (or more generally, ?function_name) at the R console.

Object Creation

SoilProfileCollection objects are typically created by "promoting" data.frame objects (rectangular tables of data) that contain at least three essential columns: * 1) an ID column uniquely identifying groups of horizons (e.g. pedons) * 2) horizon top boundaries * 3) horizon bottom boundaries

The data.frame should be pre-sorted according to the profile ID and horizon top boundary. Formula notation is used to define the columns used to promote a data.frame object:

idcolumn ~ hz_top_column + hz_bottom_column

In this tutorial we will use some sample data included with the aqp package, based on characterization data from 10 soils sampled on serpentinitic parent material as described in McGahan et al, 2009.

# load required packages, you may have to install these if missing:
# install.packages('aqp', dep=TRUE)
library(aqp)
library(Hmisc)
library(lattice)
library(MASS)

# load sample data set, a data.frame object with horizon-level data from 10 profiles
data(sp4)
str(sp4)

## 'data.frame':    30 obs. of  13 variables:
##  $ id         : chr  "colusa" "colusa" "colusa" "colusa" ...
##  $ name       : chr  "A" "ABt" "Bt1" "Bt2" ...
##  $ top        : int  0 3 8 30 0 9 0 4 13 0 ...
##  $ bottom     : int  3 8 30 42 9 34 4 13 40 6 ...
##  $ K          : num  0.3 0.2 0.1 0.1 0.2 0.3 0.2 0.6 0.8 0.4 ...
##  $ Mg         : num  25.7 23.7 23.2 44.3 21.9 18.9 12.1 12.1 17.7 16.4 ...
##  $ Ca         : num  9 5.6 1.9 0.3 4.4 4.5 1.4 7 4.4 24.1 ...
##  $ CEC_7      : num  23 21.4 23.7 43 18.8 27.5 23.7 18 20 31.1 ...
##  $ ex_Ca_to_Mg: num  0.35 0.23 0.08 0.01 0.2 0.2 0.58 0.51 0.25 1.47 ...
##  $ sand       : int  46 42 40 27 54 49 43 36 27 43 ...
##  $ silt       : int  33 31 28 18 20 18 55 49 45 42 ...
##  $ clay       : int  21 27 32 55 25 34 3 15 27 15 ...
##  $ CF         : num  0.12 0.27 0.27 0.16 0.55 0.84 0.5 0.75 0.67 0.02 ...

# optionally read about it...
# ?sp4

# upgrade to SoilProfileCollection
# 'id' is the name of the column containing the profile ID
# 'top' is the name of the column containing horizon upper boundaries
# 'bottom' is the name of the column containing horizon lower boundaries
depths(sp4) <- id ~ top + bottom

# check it out:
class(sp4) # class name

## [1] "SoilProfileCollection"
## attr(,"package")
## [1] "aqp"

print(sp4)

## Object of class SoilProfileCollection
## Number of profiles: 10
## Depth range: 16-49 cm
## 
## Horizon attributes:
##       id name top bottom   K   Mg  Ca CEC_7 ex_Ca_to_Mg sand silt clay   CF
## 1 colusa    A   0      3 0.3 25.7 9.0  23.0        0.35   46   33   21 0.12
## 2 colusa  ABt   3      8 0.2 23.7 5.6  21.4        0.23   42   31   27 0.27
## 3 colusa  Bt1   8     30 0.1 23.2 1.9  23.7        0.08   40   28   32 0.27
## 4 colusa  Bt2  30     42 0.1 44.3 0.3  43.0        0.01   27   18   55 0.16
## 5  glenn    A   0      9 0.2 21.9 4.4  18.8        0.20   54   20   25 0.55
## 6  glenn   Bt   9     34 0.3 18.9 4.5  27.5        0.20   49   18   34 0.84
## 
## Sampling site attributes:
##          id
## 1    colusa
## 2     glenn
## 3     kings
## 4  mariposa
## 5 mendocino
## 6      napa

Accessing, Setting, and Replacing Data

"Accessor" functions are used to extract specfic components from within SoilProfileCollection objects.

# methods for object inspection
idname(sp4) # self-explanitory
horizonDepths(sp4) # self-explanitory
depth_units(sp4) # defaults to 'cm'
metadata(sp4) # not much to start with
profile_id(sp4) # vector of profile IDs
horizonNames(sp4) # column names from horizon data
siteNames(sp4) # column names from site data

# further inspection with common function overloads
length(sp4) # number of profiles in the collection
nrow(sp4) # number of horizons in the collection
names(sp4) # column names from site and horizon data, concatenated into a single vector
min(sp4) # shallowest profile depth in collection
max(sp4) # deepest profile depth in collection

Several accessor functions can also be used to define, modify, or replace components within SoilProfileCollection objects. For example,

horizons(sp4)

will extract horizon data and

# careful!
horizons(sp4) <- x

will replace horizon data. Further examples include:

# extraction of soil profile components
site(sp4)  # get or set site data
diagnostic_hz(sp4) # get or set diagnostic horizons
proj4string(sp4)
coordinates(sp4)

Horizon and Site Data

Typically, horizon and site data are the most important components of SoilProfileCollection objects. Both are internally stored as data.frame objects; with one or more rows (per profile ID) in the horizon table and one row (per profile ID) in the site table. Columns from either table can be accessed with the $ style notation of data.frames. New data can be assigned to either table in the same manner, as long as the length of the new data is either: * 1) same length as the number of profiles in the collection (target is the site table) * 2) same length as the number of horizons in the collection (target is the horizon table)

# assignment of new data to existing or new attributes
sp4$elevation <- rnorm(n=length(sp4), mean=1000, sd=150) # site-level, based on length of assigned data
sp4$thickness <- sp4$bottom - sp4$top # horizon-level

# extraction of specific attributes by name
sp4$clay # vector of clay content (horizon data)

##  [1] 21 27 32 55 25 34  3 15 27 32 25 31 33 13 21 23 15 17 12 19 14 14 22 25 40 51 67 24 25 32

sp4$elevation # vector of simulated elevation (site data)

##  [1]  962.8334 1191.1386 1146.4100  776.1801  742.5612  980.9592 1195.9719 1196.9343 1052.5285
## [10]  979.5454

# assign a single single value into horizon-level attributes
sp4$constant <- rep(1, times=nrow(sp4))

# promote horizon-level data to site-level data (when it makes sense to do so)
# note that this _moves_ the named column from horizon to site
site(sp4) <- ~ constant

Horizon and site data can also be modified via extraction to data.frame followed by replacement (horizon data) or join (site data). Note that while this approach gives the most flexibility, it is also the most dangerous-- replacement of horizon data with new data that don't exactly conform to the original sorting may corrupt your SoilProfileCollection.

# extract horizon data to data.frame
h <- horizons(sp4)

# add a new column and save back to original object
h$random.numbers <- rnorm(n=nrow(h), mean=0, sd=1)

# _replace_ original horizon data with modified version
# ! row-order should not be altered !
horizons(sp4) <- h

# extract site data to data.frame
s <- site(sp4)

# add a fake group to the site data
s$group <- rep(c('A', 'B'), length.out=nrow(s))

# join new site data with previous data: old data are _not_ replaced
site(sp4) <- s

# check:
sp4

## Object of class SoilProfileCollection
## Number of profiles: 10
## Depth range: 16-49 cm
## 
## Horizon attributes:
##       id name top bottom   K   Mg  Ca CEC_7 ex_Ca_to_Mg sand silt clay   CF thickness
## 1 colusa    A   0      3 0.3 25.7 9.0  23.0        0.35   46   33   21 0.12         3
## 2 colusa  ABt   3      8 0.2 23.7 5.6  21.4        0.23   42   31   27 0.27         5
## 3 colusa  Bt1   8     30 0.1 23.2 1.9  23.7        0.08   40   28   32 0.27        22
## 4 colusa  Bt2  30     42 0.1 44.3 0.3  43.0        0.01   27   18   55 0.16        12
## 5  glenn    A   0      9 0.2 21.9 4.4  18.8        0.20   54   20   25 0.55         9
## 6  glenn   Bt   9     34 0.3 18.9 4.5  27.5        0.20   49   18   34 0.84        25
##   random.numbers
## 1     -0.6683685
## 2     -0.1659401
## 3      2.2048580
## 4      1.0036559
## 5      1.4565510
## 6     -0.6600243
## 
## Sampling site attributes:
##          id elevation constant group
## 1    colusa  962.8334        1     A
## 2     glenn 1191.1386        1     B
## 3     kings 1146.4100        1     A
## 4  mariposa  776.1801        1     B
## 5 mendocino  742.5612        1     A
## 6      napa  980.9592        1     B

Diagnostic Horizons

Diagnostic horizons typically span several genetic horizons and may or may not be present in all profiles. To accomodate the wide range of possibilities, diagnostic horizon data are stored as a data.frame in "long format": each row corresponds to a diagnostic horizon, identified with a column matching the ID column used to initialize the SoilProfileCollection object.

# manually create some diagnostic horizon data
# there is no restrictions on data format, as long as each row has an ID that exists within the collection
# be sure to use the ID column name that was used to initialize the SoilProfileCollection object
# check via: idname(sp4)
dh <- data.frame(id='colusa', kind='argillic', top=8, bottom=42, stringsAsFactors=FALSE)

# overwrite any existing diagnostic horizon data
diagnostic_hz(sp4) <- dh

# append to diagnostic horizon data
dh <- diagnostic_hz(sp4)
dh.new <- data.frame(id='napa', kind='argillic', top=6, bottom=20, stringsAsFactors=FALSE)

# overwrite existing diagnostic horizon data with appended data
diagnostic_hz(sp4) <- rbind(dh, dh.new)

Spatial Data

Spatial data can be explicitly stored within a SoilProfileCollection object and accessed with methods imported from the sp package. The use of sp classes (in this case SpatialPoints and SpatialPointsDataFrame objects) simplifies operations such as plotting spatial data, coordinate system transformations, and spatial queries.

# generate some fake coordinates as site level attributes
sp4$x <- rnorm(n=length(sp4), mean=354000, sd=100)
sp4$y <- rnorm(n=length(sp4), mean=4109533, sd=100)

# initialize spatial coordinates
coordinates(sp4) <- ~ x + y

# extract coordinates as matrix
coordinates(sp4)

x	y
354037.2	4109772
354005.0	4109539
353955.0	4109688
354003.6	4109512
353937.6	4109561
354165.7	4109516
353934.5	4109474
354045.0	4109402
353988.7	4109516
354160.8	4109541

# get/set spatial reference system using PROJ4 syntax
proj4string(sp4) <- '+proj=utm +zone=11 +datum=NAD83'
proj4string(sp4)

## [1] "+proj=utm +zone=11 +datum=NAD83 +ellps=GRS80 +towgs84=0,0,0"

# extract spatial data + site level attribtutes
# see ?SpatialPointsDataFrame for details
sp4.sp <- as(sp4, 'SpatialPointsDataFrame')

# plot the fake coordinates
plot(sp4.sp)
box()

Subsetting SoilProfileCollection Objects

SoilProfileCollection objects can be subset using the familiar [-style notiation used by matrix and data.frame objects, such that: spc[i, j] will return profiles identified by the integer vector i, and horizons identified by the integer vector j. Ommitting either index will result in all profiles (i ommitted) or all horizons (j ommitted). Typically, site-level attributes will be used as the subsetting criteria. Functions that return an index to matches (such as grep() or which()) provide the link between attributes and an index to matching profiles. Some examples:

# explicit string matching
idx <- which(sp4$group == 'A')

# numerical expressions
idx <- which(sp4$elevation < 1000)

# regular expression, matches any profile ID containing 'shasta'
idx <- grep('shasta', profile_id(sp4), ignore.case=TRUE)

# perform subset based on index
sp4[idx, ]

The subsetProfiles() function can be used to subset collections based on criteria from both horizon and site level attributes. Several examples are given below.

# matrix-style subsetting
sp4[1:2, ] # profiles 1--2 from the collection
sp4[, 1:2] # horizons 1--2 from each profile

# in the presence of spatial data, subsetting can either result in 
# 1. a new SoilProfileCollection (> 1 horizon / profile)
# 2. a new SpatialPointsDataFrame (1 horizon / profile)
class(sp4[1, ]) # profile 1 from the collection
class(sp4[, 1]) # horizon 1 from each profile

# filtering criteria from horizon and site level data
subsetProfiles(sp4, h='clay < 20', s='group == "A"')

Concatenation of SoilProfileCollection Objects

If the internal structures of several SoilProfileCollection objects are identical (e.g. same ID name, horizon, site, diagnostic horizon, and spatial attributes) they can be safely combined into a new object.

# subset data into chunks
s1 <- sp4[1:2, ]
s2 <- sp4[4, ]
s3 <- sp4[c(6, 8, 9), ]

# re-combine: think "row-bind"
s <- rbind(s1, s2, s3)

# double-check object
all.equal(profile_id(s), site(s)[[idname(s)]])

Plotting SoilProfileCollection Objects

The plot() method for SoilProfileCollection objects generates sketches of profiles within the collection based on horizon boundaries, vertically aligned to an integer sequence from 1 to the number of profiles. Horizon names are automatically extracted from a horizon-level attribute name (if present), or via an alternate attributed given as an argument: name='column.name'. Horizon colors are automatically generated from the horizon-level attribute soil_color, or any other attribute of R-compatible color description given as an argument: color='column.name'. This function is highly customizable, therefore, it is prudent to consult help(plotSPC) from time to time. Soil colors in Munsell notation can be converted to R-compatible colors via munsell2rgb().

# plot uses base graphics, so it is simple to add low-level annotation layers
plot(sp4, name='name')

# inspect plotting area, very simple to overlay graphical elements
abline(v=1:length(sp4), lty=3, col='blue')

# profiles are centered at integers, from 1 to length(obj)
axis(1, line=0, at=1:10, cex.axis=0.75, font=4, col='blue', col.axis='blue', lwd=2)
mtext('profile axis', side=1, line=2, font=4, col='blue')

# y-axis is based on profile depths
axis(2, line=-1, at=pretty(1:max(sp4)), cex.axis=0.75, font=4, las=1, col='blue', col.axis='blue', lwd=2)
mtext('depth axis', side=2, line=1, font=4, col='blue')

Horizon-level attributes can be symbolized with color, in this case using the horizon-level attribute "clay":

# plot again, this time using new colors
par(mar=c(0,0,3,0)) # tighter figure margins
plot(sp4, name='name', color='clay')

Horizon-level attributes that represent a volume fraction (e.g. coarse-fragment percentage) can be added to an existing figure:

par(mar=c(0,0,3,0)) # tighter figure margins
sp4$frag_pct <- sp4$CF * 100 # convert fraction -> percent
plot(sp4, name='name', color='frag_pct')
addVolumeFraction(sp4, 'frag_pct') # symbolize volume fraction data

Annotation of depth-intervals can be accomplished using:

# generate some fake depth brackets:
fake.tops <- rep(0, times=length(sp4))
fake.bottoms <- runif(n=length(sp4), min=0, max=20)
par(mar=c(0,0,3,0)) # tighter figure margins
plot(sp4, name='name')
addBracket(fake.tops, fake.bottoms, col='red') # add depth brackets

It is possible to arrange profile sketches by site-level grouping variable:

# use improvised site-level attribute 'group' 
par(mar=c(0,0,3,0)) # tighter figure margins
groupedProfilePlot(sp4, groups='group')
# note that depth brackets "know which profiles to use"
addBracket(fake.tops, fake.bottoms, col='red') # add depth brackets

Iterating Over Profiles in a Collection

The profileApply() function is an extension of the familiar apply() family of functions that operate on vectors (sapply and tapply), matrices (apply), and lists (lapply)-- extended to SoilProfileCollection objects. The function named in the FUN argument is evaluated once for each profile in the collection, typicially returning a single value per profile. In this case, the ordering of the results would match the ordering of values in the site level attribute table.

# max() returns the depth of a soil profile
sp4$soil.depth <- profileApply(sp4, FUN=max)
# max() with additional argument give max depth to non-missing 'clay'
sp4$soil.depth.clay <- profileApply(sp4, FUN=max, v='clay')
# nrow() returns the number of horizons
sp4$n.hz <- profileApply(sp4, FUN=nrow)
# compute the mean clay content by profile using an inline function
sp4$mean.clay <- profileApply(sp4, FUN=function(i) mean(i$clay))
# estimate soil depth based on horizon designation
sp4$soil.depth <- profileApply(sp4, estimateSoilDepth, name='name', top='top', bottom='bottom')

When FUN returns a vector of the same length as the number of horizons in a profile, profileApply() can be used to create new horizon-level attributes. For example, the change in clay content with depth could be calculated via:

# save as horizon-level attribute
sp4$delta.clay <- profileApply(sp4, FUN=function(i) c(NA, diff(i$clay)))

# check results:
horizons(sp4)[1:6, c('id', 'top', 'bottom', 'clay', 'delta.clay')]

id	top	bottom	clay	delta.clay
colusa	0	3	21	NA
colusa	3	8	27	6
colusa	8	30	32	5
colusa	30	42	55	23
glenn	0	9	25	NA
glenn	9	34	34	9

More complex summaries can be generated by writing a custom function that is then called by profileApply(). Note that each profile is passed into this function and accessed via a temporary variable (i), which is a SoilProfileCollection object containing a single profile. A list of SoilProfileCollection objects returned from a custom function can be re-constituted into a single SoilProfileCollection object via rbind. See help(profileApply) for details.

# compute hz-thickness weighted mean exchangeable-Ca:Mg
wt.mean.ca.mg <- function(i) {
    # use horizon thickness as a weight
    thick <- i$bottom - i$top
    # compute the weighted mean, accounting for the possibility of missing data
    m <- wtd.mean(i$ex_Ca_to_Mg, weights=thick, na.rm=TRUE)
    return(m)
    }

# apply our custom function and save results as a site-level attribute
sp4$wt.mean.ca.to.mg <- profileApply(sp4, wt.mean.ca.mg)

We can now use our some of our new site-level attributes to order the profiles when plotting. In this case profiles are ordered based on the horizon-thickness weighted mean, exchageable Ca:Mg values. Horizons are colored by exchangeable Ca:Mg values.

# the result is an index of rank
new.order <- order(sp4$wt.mean.ca.to.mg)
# plot the data using our new order based on Ca:Mg
par(mar=c(4,0,3,0)) # tighten figure margins
plot(sp4, name='name', color='ex_Ca_to_Mg', plot.order=new.order)
# add an axis labeled with the sorting criteria
axis(1, at=1:length(sp4), labels=round(sp4$wt.mean.ca.to.mg, 3), cex.axis=0.75)
mtext(1, line=2.25, text='Horizon Thickness Weighted Mean Ex. Ca:Mg', cex=0.75)

Slicing Soil Profile Collections

Collections of soil profiles can be sliced (or re-sampled) into regular depth-intervals with the slice() function. The slicing structure and variables of interest are defined via formula notation:

# slice select horizon-level attributes
seq ~ var.1 + var.2 + var.3 + ...
# slice all horizon-level attributes
seq ~ .

where seq is a sequence of integers (e.g. 0:15, c(5,10,15,20), etc.) and var.1 + var.2 + var.3 + ... are horizon-level attributes to slice. Both continuous and categorical variables can be named on the right-hand-side of the formula. The results returned by slice() is either a SoilProfileCollection, or data.frame when called with the optional argument just.the.data=TRUE. For example, to slice our sample data set into 1-cm intervals, from 0--15 cm:

# slice data
sliced <- slice(sp4, fm= 0:15 ~ sand + silt + clay + name + ex_Ca_to_Mg)
# check the result
class(sliced)

## [1] "SoilProfileCollection"
## attr(,"package")
## [1] "aqp"

# plot sliced data
par(mar=c(0,0,3,0)) # tighten figure margins
plot(sliced, name='name', color='ex_Ca_to_Mg')

Once soil profile data have been sliced, it is simple to extract "chunks" of data by depth interval via matrix-style subsetting:

# slice from 0 to max depth in the collection
sliced <- slice(sp4, fm= 0:max(sp4) ~ sand + silt + clay + name + ex_Ca_to_Mg)
# extract all data over the range of 5--10 cm:
plot(sliced[, 5:10])
# extract all data over the range of 25--50 cm:
plot(sliced[, 25:50])
# extract all data over the range of 10--20 and 40--50 cm:
plot(sliced[, c(10:20, 40:50)])

Aggregating Soil Profile Collections Along Regular "Slabs"

Depth-wise summary of horizon-level attributes is performed with the slab() function. Profile grouping criterial and horizon attribute selection is parametrized via formula: either groups ~ var1 + var2 + var3 where named variables are aggregated within groups OR where named variables are aggregated across the entire collection ~ var1 + var2 + var3. The default summary function (slab.fun) computes the 5th, 25th, 50th, 75th, and 95th percentiles via Harrell-Davis quantile estimator.

The depth structure ("slabs") over which summaries are computed is defined with the slab.structure argument using:

a single integer (e.g. 10): data are aggregated over a regular sequence of 10-unit thickness slabs
a vector of 2 integers (e.g. c(50, 60)): data are aggregated over depths spanning 50--60 units
a vector of 3 or more integers (e.g. c(0, 5, 10, 50, 100)): data are aggregated over the depths spanning 0--5, 5--10, 10--50, 50--100 units

# aggregate a couple of the horizon-level attributes, 
# across the entire collection, 
# from 0--10 cm
# computing the mean value ignoring missing data
slab(sp4, fm= ~ sand + silt + clay, slab.structure=c(0,10), slab.fun=mean, na.rm=TRUE)

variable	all.profiles	value	bottom	contributing_fraction
sand	1	47.63	10	1
silt	1	31.15	10	1
clay	1	21.11	10	1

# again, this time within groups defined by a site-level attribute:
slab(sp4, fm= group ~ sand + silt + clay, slab.structure=c(0,10), slab.fun=mean, na.rm=TRUE)

variable	group	value	bottom	contributing_fraction
sand	A	48.26	10	1
silt	A	31.52	10	1
clay	A	20.30	10	1
sand	B	47.00	10	1
silt	B	30.78	10	1
clay	B	21.92	10	1

# again, this time over several depth ranges
slab(sp4, fm= ~ sand + silt + clay, slab.structure=c(0,10,25,40), slab.fun=mean, na.rm=TRUE)

variable	all.profiles	value	top	bottom	contributing_fraction
sand	1	47.63000	0	10	1.0000000
sand	1	42.38931	10	25	0.8733333
sand	1	32.14607	25	40	0.5933333
silt	1	31.15000	0	10	1.0000000
silt	1	29.41221	10	25	0.8733333
silt	1	31.34831	25	40	0.5933333
clay	1	21.11000	0	10	1.0000000
clay	1	28.10687	10	25	0.8733333
clay	1	36.26966	25	40	0.5933333

# again, this time along 1-cm slices, computing quantiles
agg <- slab(sp4, fm= ~ Mg + Ca + ex_Ca_to_Mg + CEC_7 + clay)

# see ?slab for details on the default aggregate function
head(agg)

variable	all.profiles	p.q5	p.q25	p.q50	p.q75	p.q95	top	bottom	contributing_fraction
Mg	1	4.168501	10.78693	15.37732	22.22149	27.71002	0	1	1
Mg	1	4.168501	10.78693	15.37732	22.22149	27.71002	1	2	1
Mg	1	4.174176	11.32581	19.02084	25.60437	28.04662	2	3	1
Mg	1	4.254672	12.52545	20.31176	25.89652	32.56386	3	4	1
Mg	1	4.254672	12.52545	20.31176	25.89652	32.56386	4	5	1
Mg	1	4.254673	12.52694	20.46020	27.00139	32.88077	5	6	1

# plot median +/i bounds defined by the 25th and 75th percentiles
# this is lattice graphics, syntax is a little rough
xyplot(top ~ p.q50 | variable, data=agg, ylab='Depth',
             xlab='median bounded by 25th and 75th percentiles',
             lower=agg$p.q25, upper=agg$p.q75, ylim=c(42,-2),
             panel=panel.depth_function,
             alpha=0.25, sync.colors=TRUE,
             par.settings=list(superpose.line=list(col='RoyalBlue', lwd=2)),
             prepanel=prepanel.depth_function,
             cf=agg$contributing_fraction, cf.col='black', cf.interval=5, 
             layout=c(5,1), strip=strip.custom(bg=grey(0.8)),
             scales=list(x=list(tick.number=4, alternating=3, relation='free'))
             )

Depth-wise aggregation can be useful for visual evaluation of multivariate similarity among groups of profiles.

# processing the "napa" and tehama profiles
idx <- which(profile_id(sp4) %in% c('napa', 'tehama'))
napa.and.tehama <- slab(sp4[idx, ], fm= ~ Mg + Ca + ex_Ca_to_Mg + CEC_7 + clay)

# combine with the collection-wide aggregate data
g <- make.groups(collection=agg, napa.and.tehama=napa.and.tehama)

# compare graphically:
xyplot(top ~ p.q50 | variable, groups=which, data=g, ylab='Depth',
             xlab='median bounded by 25th and 75th percentiles',
             lower=g$p.q25, upper=g$p.q75, ylim=c(42,-2),
             panel=panel.depth_function,
             alpha=0.25, sync.colors=TRUE, cf=g$contributing_fraction, cf.interval=10, 
             par.settings=list(superpose.line=list(col=c('RoyalBlue', 'Red4'), lwd=2, lty=c(1,2))),
             prepanel=prepanel.depth_function,
             layout=c(5,1), strip=strip.custom(bg=grey(0.8)),
             scales=list(x=list(tick.number=4, alternating=3, relation='free')),
             auto.key=list(columns=2, lines=TRUE, points=FALSE)
             )

Change of Support: re-alignment of horizon depths via aggregation

Occasionally there is a need for converting data associated with soil horizons, as described in the field, to a new set of depth intervals. This kind of change of support operation requires some form of aggregation (mean, median, etc.) and possibly interpolation (e.g. splines). The slab function is the simplest way to implement a change of depth support via aggregation. The following example is based on a set of 9 randomly generated profiles, re-aligned to the Global Soil Map (GSM) standard depths.

library(plyr)
library(reshape2)
library(RColorBrewer)

# 9 random profiles with properties simulated via logistic power peak (LPP) function
d <- ldply(1:9, random_profile, n=c(6, 7, 8), n_prop=1, method='LPP')

# promote to SPC
depths(d) <- id ~ top + bottom

# GSM depths
gsm.depths <- c(0, 5, 15, 30, 60, 100, 200)

# aggregate using mean: wt.mean within slabs
# see ?slab for ideas on how to parameterize slab.fun
d.gsm <- slab(d, fm=id ~ p1, slab.structure = gsm.depths, slab.fun = mean, na.rm=TRUE)

# note: result is in long-format
# note: horizon names are lost due to aggregation
head(d.gsm, 7)

variable	id	value	top	bottom	contributing_fraction
p1	1	9.543995	0	5	1.000000
p1	1	9.543995	5	15	1.000000
p1	1	18.147862	15	30	1.000000
p1	1	23.266091	30	60	1.000000
p1	1	18.877035	60	100	1.000000
p1	1	14.133578	100	200	0.890625
p1	2	5.310340	0	5	1.000000

A simple graphical comparison of the original and re-aligned soil profile data.

# reshape to wide format
# this scales to > 1 aggregated variables
d.gsm.pedons <- dcast(d.gsm, id + top + bottom ~ variable, value.var = 'value')
depths(d.gsm.pedons) <- id ~ top + bottom

# iterate over aggregated profiles and make new hz names
d.gsm.pedons$hzname <- profileApply(d.gsm.pedons, function(i) {paste0('GSM-', 1:nrow(i))})

# compare original and aggregated
par(mar=c(1,0,3,3), mfrow=c(2,1))
plot(d, color='p1')
plot(d.gsm.pedons, color='p1')

Note that re-aligned data may not represent reality (and should therefore be used with caution) when the original soil depth is shallower than the deepest of the new (re-aligned) horizon depths. The contributing_fraction metric returned by slab() can be useful for assessing how much real data were used to generate the new set of re-aligned data.

# reshape to wide format
d.gsm.pedons.2 <- dcast(d.gsm, id + top + bottom ~ variable, value.var = 'contributing_fraction')
depths(d.gsm.pedons.2) <- id ~ top + bottom

# compare original and aggregated
par(mar=c(1,0,3,3), mfrow=c(2,1))
plot(d.gsm.pedons, name='', color='p1')
plot(d.gsm.pedons.2, name='', color='p1', col.label='Contributing Fraction', col.palette=brewer.pal(10, 'Spectral'))

Pair-Wise Dissimilarity

Calculation of between-profile dissimilarity is performed using the profile_compare() function. Dissimilarity values depend on attributes selection (e.g. clay, CEC, pH , etc.), optional depth-weighting parameter (k), and a maximum depth of evaluation (max_d). This topic is further documented in a related tutorial, the function manual page (type help(profile_compare) in the R console), and this paper.

library(cluster)
library(sharpshootR)

# eval dissimilarity:
# using Ex-Ca:Mg and CEC at pH 7
# with no depth-weighting (k=0)
# to a maximum depth of 40 cm
d <- profile_compare(sp4, vars=c('ex_Ca_to_Mg', 'CEC_7'), k=0, max_d=40)

# check distance matrix:
round(d, 1)

## Dissimilarities :
##                colusa glenn kings mariposa mendocino napa san benito shasta shasta-trinity
## glenn            13.5                                                                     
## kings            16.0  12.7                                                               
## mariposa          8.4  11.3  16.5                                                         
## mendocino        11.5   8.0  16.4     15.0                                                
## napa             30.4  24.1  29.4     29.2      21.6                                      
## san benito       25.7  20.6  26.3     28.2      15.8 18.0                                 
## shasta           17.2  13.3   8.7     17.6      17.1 33.7       22.2                      
## shasta-trinity    6.4  16.6  22.3      9.6      16.5 29.8       27.2   23.3               
## tehama           28.7  22.9  27.9     27.3      20.0  8.8       15.1   31.4           27.9
## 
## Metric :  mixed ;  Types = I, I 
## Number of objects : 10

# vizualize dissimilarity matrix via divisive hierarchical clustering
d.diana <- diana(d)

# this function is from the sharpshootR package
# requires some manual adjustments
par(mar=c(1,1,5,1))
plotProfileDendrogram(sp4, d.diana, scaling.factor = 0.8, y.offset = 10, color='ex_Ca_to_Mg')

Object Metadata

# print metadata:
metadata(sp4)

# alter the depth unit metadata attribute
depth_units(sp4) <- 'inches' # units are really 'cm'

# more generic interface for adjusting metadata
md <- metadata(sp4) # save original metadata

# add columns
md$describer <- 'DGM'
md$date <- as.Date('2009-01-01')
md$citation <- 'McGahan, D.G., Southard, R.J, Claassen, V.P. 2009. Plant-Available Calcium Varies Widely in Soils on Serpentinite Landscapes. Soil Sci. Soc. Am. J. 73: 2087-2095.'

# re-assign user defined metadata to original object
metadata(sp4) <- md

# check:
metadata(sp4)

# fix depth units, set back to 'cm'
depth_units(sp4) <- 'cm'

Object Structure and Coercion

# check our work by viewing the internal structure
str(sp4)

# deconstruct SoilProfileCollection into a data.frame, with horizon+site data
as(sp4, 'data.frame')

# extraction of site + spatial data as SpatialPointsDataFrame
as(sp4, 'SpatialPointsDataFrame')

This document is based on aqp version 1.10.

An introduction to `profile_compare()`

Sat, 18 Mar 2017 22:48:41 +0000

Introduction

Interpreting Dendrograms

Dendrograms are a convenient way of depicting pair-wise dissimilarity between objects, commonly associated with the topic of cluster analysis. This is a complex subject that is best left to experts and textbooks, so I won't even attempt to cover it here. Unfortunately the interpretation of dendrograms is not very intuitive, especially when the source data are complex. In addition, pair-wise dissimilarity computed between soil profiles and visualized via dendrogram should not be confused with the use of dendrograms in the field of cladistics– where relation to a common ancestor is depicted.

An example is presented below that illustrates the relationship between dendrogram and dissimilarity as evaluated between objects with 2 variables. Essentially, the level at which branches merge (relative to the “root” of the tree) is related to their similarity. In the example below it is clear that (in terms of clay and rock fragment content) soils 4 and 5 are more similar to each other than to soil 2. In addition, soils 1 and 3 are more similar to each other than soils 4 and 5 are to soil 2. Recall that in this case pair-wise dissimilarity is based on the Euclidean distance between soils in terms of their clay content and rock fragment content. Therefore proximity in the scatter plot of frock frags vs. clay is directly related to our simple evaluation of “dissimilarity”. Inline-comments in the code below elaborate further.

# load required libraries
library(cluster) # clustering functions
library(ape) # nicer plotting of dendrograms

# simulate some aggregate profile data
frags <- c(16, 5, 25, 6, 3) # rock fragments
clay <- c(8, 15, 17, 25, 31) # clay contents

# combine into single data.frame
s <- data.frame(clay, frags)

# evaluate pair-wise dissimilarity based on clay and frag %
# since both measurements are on the same scale, no standardization is needed
d <- daisy(s)

# inspect pair-wise dissimilarity matrix
print(d)

## Dissimilarities :
##           1         2         3         4
## 2 13.038405                              
## 3 12.727922 20.099751                    
## 4 19.723083 10.049876 20.615528          
## 5 26.419690 16.124515 26.076810  6.708204
## 
## Metric :  euclidean 
## Number of objects : 5

# perform divisive hierarcical clustering for dendrogram creation
d.diana <- diana(d)

# convert object into 'phylo' class for plotting
d.phylo <- as.phylo(as.hclust(d.diana))

# 2-figure plot of original data and resulting dendrogram repsesentation of dissimilarity matrix
par(mfcol=c(1,2), mar=c(4.5,4,1,1))
# original data: setup plot, but don't actually plot it
plot(frags ~ clay, data=s, type='n', xlab='% Clay', ylab='% Rock Fragments')
# add grid lines to assist the eye
grid()
# annotate empty plot with soil numbers
text(s$clay, s$frags, row.names(s), font=2)

# plot dendrogram representation, annotated with the same labels
plot(d.phylo, font=2, label.offset=0.5, adj=0.5, direction='down', srt=90, y.lim=c(-1, 15))

A Soils Example

library(aqp)
library(cluster)
library(ape)
library(RColorBrewer)
library(latticeExtra)
library(plotrix)

# setup some colors
cols <- brewer.pal(3, 'Set1')

# setup horizon-level data: data are from lab sampled pedons
d <- read.csv(
    textConnection('
series,top,bottom,clay,frags,ph
auburn,0,3,21,6,5.6
auburn,3,15,21,13,5.6
auburn,15,25,20,9,5.8
auburn,25,47,21,28,5.8
dunstone,0,5,16,13,6
dunstone,5,17,17,19,6.3
dunstone,17,31,20,6,6.3
dunstone,31,41,21,15,6.3
sobrante,0,5,18,0,5.8
sobrante,5,10,16,2,5.7
sobrante,10,28,15,21,5.8
sobrante,28,51,18,13,6.2
sobrante,51,74,20,12,6.2
'), as.is=TRUE)

# establish site-level data
s <- data.frame(
    series=c('auburn', 'dunstone', 'sobrante'), 
    precip=c(24, 30, 32),
    stringsAsFactors=FALSE
    )

# generate fake horizon names with clay / frags / ph
d$name <- with(d, paste(clay, frags, ph, sep='/'))

# upgrade to SoilProfile Collection object
depths(d) <- series ~ top + bottom
site(d) <- s

# inspect variables used to determine dissimilarity
cloud(clay ~ ph + frags, groups=series, data=horizons(d), 
auto.key=list(columns=3, points=TRUE, lines=FALSE), 
par.settings=list(superpose.symbol=list(pch=16, col=cols, cex=1.5))
)

# compute betwee-profile dissimilarity, no depth weighting
d.dis <- profile_compare(d, vars=c('clay', 'ph', 'frags'), k=0, 
max_d=61, replace_na=TRUE, add_soil_flag=TRUE)

# check total, between-profile dissimilarity, normalized to maximum
d.m <- signif(as.matrix(d.dis / max(d.dis)), 2)
print(d.m)

##          auburn dunstone sobrante
## auburn     0.00     0.67     1.00
## dunstone   0.67     0.00     0.94
## sobrante   1.00     0.94     0.00

# group via divisive hierarchical clustering
d.diana <- diana(d.dis)
# convert classes, for better plotting
d.phylo <- as.phylo(as.hclust(d.diana))


# plot: 2 figures side-by-side
par(mfcol=c(1,2), mar=c(2,2,2,2))
# profiles
plot(d, width=0.1, name='name')
# annotate shallow-mod.deep break
abline(h=50, col='red', lty=2)
# add dissimilarity matrix
addtable2plot(0.8, 70, format(d.m, digits=2), display.rownames=TRUE, 
xjust=0, yjust=0, cex=0.6, title='Total Dissimilarity')
# plot dendrogram in next panel
plot(d.phylo, direction='down', adj=0.5, srt=0, 
label.offset=0.5, font=1, y.lim=c(-5, 25), cex=0.7)

# continuing from example above...

# return dissimilarity matrices at each depth slice
d.dis.all <- profile_compare(d, vars=c('clay', 'ph', 'frags'), k=0, 
max_d=61, replace_na=TRUE, add_soil_flag=TRUE, return_depth_distances=TRUE)

# check between-profile dissimilarity, at slice 1
print(as.matrix(d.dis.all[[1]]))

##             auburn  dunstone  sobrante
## auburn   0.0000000 0.8461538 0.5205128
## dunstone 0.8461538 0.0000000 0.6333333
## sobrante 0.5205128 0.6333333 0.0000000

# init functions for extracting pair-wise dissimilarity: 
f.12 <- function(i) as.matrix(i)[1, 2] # between auburn and dunstone
f.13 <- function(i) as.matrix(i)[1, 3] # between auburn and sobrante
f.23 <- function(i) as.matrix(i)[2, 3] # between dunstone and sobrante

# apply functions at each slice
d.12 <- sapply(d.dis.all, f.12)
d.13 <- sapply(d.dis.all, f.13)
d.23 <- sapply(d.dis.all, f.23)

# combine into single data.frame
d.all <- make.groups(
auburn.dunstone=data.frame(slice=1:61, d=d.12, d.sum=cumsum(d.12)),
auburn.sobrante=data.frame(slice=1:61, d=d.13, d.sum=cumsum(d.13)),
dunstone.sobrante=data.frame(slice=1:61, d=d.23, d.sum=cumsum(d.23))
)

# plot slice-wise dissimilarity between all three soils
p.1 <- xyplot(slice ~ d, groups=which, data=d.all, 
ylim=c(62,0), type=c('l','g'), xlim=c(0.2,1.2), ylab='Depth (cm)', xlab='', 
horizontal=TRUE, auto.key=list(columns=3, lines=TRUE, points=FALSE), asp=1)

# plot slice-wise, cumulative dissimilarity between all three soils
p.2 <- xyplot(slice ~ d.sum, groups=which, data=d.all, 
ylim=c(62,0), type=c('l','g'), ylab='Depth (cm)', xlab='', 
horizontal=TRUE, auto.key=list(columns=3, lines=TRUE, points=FALSE), asp=1)

# combine into panels of a single figure
p.3 <- c('Slice-Wise Distance'=p.1, 'Cumulative Distance'=p.2)
# setup plotting style
trellis.par.set(
    superpose.line=list(col=cols, lwd=2, lty=c(1,2,4)), strip.background=list(col=grey(0.85))
    )
# render figure
print(p.3)

Loading NASIS component data

Sat, 18 Mar 2017 22:48:38 +0000

This tutorial is based on essential background material described in the soilDB and related NASIS ODBC connection tutorials. If you have not reviewed those tutorials, please do so before proceeding.

The functions and documentation described in this tutorial are still a work in progress.

Introduction

The soilDB package contains a number of convenience functions (usually having a prefix of "fetch") for extracting data from commonly used databases, performing basic quality control checks, and returning the result as a SoilProfileCollection object. In order to simplify the process of stitching-together the many linked (and sometimes nested) tables associated with data in NASIS, convenience functions (e.g. fetchNASIS() or fetchNASIS_component_data()) must make a number of assumptions about the data. This document describes how those assumptions can be adjusted and how they may affect subsequent data analysis.

Pedon Data

Please see the related tutorial on loading NASIS pedon data into R.

Component Data

Load up your local database and selected set with some components. NASIS queries should "target" the tables:

Component
Data Mapunit
Correlation
Mapunit
Legend Mapunit
Legend
Area

The most commonly used data from the data map unit, component, component horizon tables can be quickly loaded using the fetchNASIS_component_data() function.

# load required libraries
library(soilDB)
library(ggplot2)
library(plyr)

# get component + component horizon data as a SoilProfileCollection, using defaults
nc <- fetchNASIS_component_data()

The result is a SoilProfileCollection object and can be subset or visualized as such. Lets try extracting just the components with names that match the pattern "Amador".

# filter out just those components named "Amador"
idx <- grep('Amador', nc$compname, ignore.case = TRUE)
nc.sub <- nc[idx, ]

# plot
par(mar=c(2,0,3,0))
plot(nc.sub, color='claytotal_r', label='dmudesc')
title(sub='Components named "Amador"', line=0)

There appear to be many duplicate components. This isn't surprising as a single component template is commonly shared among many map units. Lets filter out a unique subset of components based on horizon depth, horizon designation, and clay content.

# generate an index to unique components and subset
idx <- unique(nc.sub, vars=c('hzdept_r', 'hzdepb_r', 'claytotal_r', 'hzname'))
nc.sub.unique <- nc.sub[idx, ]

# plot the subset
par(mar=c(2,0,3,0))
plot(nc.sub.unique, color='claytotal_r', print.id=FALSE, n=length(nc.sub))
title(sub='Unique components named "Amador"', line=0)

Accessing Additional Types of "Component" Data

Linked Pedons

Sometimes it is convenient to know which pedons are linked to components. The following function returns a data.frame (table) of data containing component record IDs, pedon record IDs, and pedon IDs. This can be used to link the results of fetchNASIS_component_data() to the results of fetchNASIS() (pedon data). Lets assemble a list of all pedons linked to a component named "Amador", using the subset from above.

# get the full set of linked pedon data from the selected set
nc.linked.pedons <- get_copedon_from_NASIS_db()
# check format
head(nc.linked.pedons)

##     coiid  peiid     pedon_id representative
## 1 1710250 144163 2004CA630008              1
## 2 1413310 157549   04CA632028              0
## 3 1413310 157988 S04CA099-001              1
## 4 1297559 158468 S04CA099-003              1
## 5 1297566 158468 S04CA099-003              1
## 6 1297567 158467 S04CA099-004              1

# list just those pedons that are linked to our subset of components
# note that we are using the component record ID (coiid) to connect the two data sources
idx <- which(nc.linked.pedons$coiid %in% site(nc.sub)$coiid)
nc.linked.pedons[idx, ]

##       coiid  peiid      pedon_id representative
## 4   1297559 158468  S04CA099-003              1
## 5   1297566 158468  S04CA099-003              1
## 573 2331927 542170 2012CA6303043              1
## 577 2073965 620526 2012CA6304005              1

Map Unit, Correlation, Legend, Area Tables

The NASIS data elements that exist at levels higher than the data map unit table must be loaded with a different function because there isn't always a 1:1 mapping between data map unit objects and map unit / legend objects.

nc.correlation <- get_component_correlation_data_from_NASIS_db()
head(nc.correlation, 1)

##     muiid musym nationalmusym                                           muname  mukind mustatus
## 1 1612048 101sa         1r3gk Amador-Gillender complex, 2 to 15 percent slopes Complex        3
##   muacres          farmlndcl repdmu dmuiid areasymbol                areaname ssastatus    cordate
## 1     113 Not prime farmland      1 291184      CA628 Amador Area, California Published 1963-03-01

Lets tabulate the occurrence of components named "Amador" by soil survey area and component kind, using data loaded in the above examples.

# combine basic site data + correlation / legend data
# note that there is a 1:many relationship
nc.combined <- join(site(nc.sub), nc.correlation, by='dmuiid')

# cross-tabulate
xtabs( ~ areasymbol + compkind, data=nc.combined)

##           compkind
## areasymbol Family Taxon above family Miscellaneous area Series Taxadjunct Variant
##      CA067      0                  0                  0      2          0       0
##      CA077      0                  0                  0      1          0       0
##      CA628      0                  0                  0      1          0       0
##      CA630      0                  0                  0      6          0       0
##      CA632      0                  0                  0      0          2       0
##      CA644      0                  0                  0      4          0       0
##      CA648      0                  0                  0      3          0       0

Component Month Table

It can be convenient to join elements from the DMU, component, and comonth tables into a single data.frame. Lets start by loading the DMU/component records and creating a new ID that combines the DMU description and component name.

# load only the component table
comp <- get_component_data_from_NASIS_db()
# make a new ID by combining DMU name + comp name
comp$id <- paste0(comp$dmudesc, '-', comp$compname)

The comonth records are indexed by coiid values. In some cases there are no records populated in this table. You can "fill" missing records with NA by using the fill=TRUE argument.

# load comonth as-is: there will be missing records
cm <- get_comonth_from_NASIS_db()
nrow(cm)

## [1] 5724

# load comonth after filling missing months
cm <- get_comonth_from_NASIS_db(fill = TRUE)
nrow(cm)

## [1] 13032

# there should be the same number of "coiid" values after filling missing comonth records
length(comp$coiid) == length(unique(cm$coiid))

## [1] TRUE

# join component table to "filled" comonth table
x <- join(comp, cm, by='coiid')
nrow(x)

## [1] 13032

Try plotting some of the combined data, for select DMU and components. NULL values are displayed as grey squares.

ggplot(subset(x, subset= dmudesc == 'CA6305015'), aes(month, factor(id), flodfreqcl)) + geom_tile(aes(fill = flodfreqcl), color='white', lwd=1) + scale_fill_brewer(palette = "Spectral", drop=FALSE, na.value='grey80', name='Flooding Frequency') + scale_x_discrete(drop=FALSE) + theme_minimal() + xlab('') + ylab('')

ggplot(subset(x, subset= compname == 'Gillender'), aes(month, factor(id), flodfreqcl)) + geom_tile(aes(fill = flodfreqcl), color='white', lwd=1) + scale_fill_brewer(palette = "Spectral", drop=FALSE, na.value='grey80', name='Flooding Frequency') + scale_x_discrete(drop=FALSE) + theme_minimal() + xlab('') + ylab('')

Try plotting those components with flooding / ponding frequency classes that are something other than "None" (or NULL).

ggplot(subset(x, subset= coiid %in% x$coiid[x$flodfreqcl != 'None']), aes(month, factor(id), flodfreqcl)) + geom_tile(aes(fill = flodfreqcl), color='white', lwd=1) + scale_fill_brewer(palette = "Spectral", drop=FALSE, na.value='grey80', name='Flooding Frequency') + scale_x_discrete(drop=FALSE) + theme_minimal() + xlab('') + ylab('')

ggplot(subset(x, subset= coiid %in% x$coiid[x$floddurcl != 'None']), aes(month, factor(id), floddurcl)) + geom_tile(aes(fill = floddurcl), color='white', lwd=1) + scale_fill_brewer(palette = "Spectral", drop=FALSE, na.value='grey80', name='Flooding Duration') + scale_x_discrete(drop=FALSE) + theme_minimal() + xlab('') + ylab('')

ggplot(subset(x, subset=coiid %in% x$coiid[x$pondfreqcl != 'None']), aes(month, factor(id), pondfreqcl)) + geom_tile(aes(fill = pondfreqcl), color='white', lwd=1) + scale_fill_brewer(palette = "Spectral", drop=FALSE, na.value='grey80', name='Ponding Frequency') + scale_x_discrete(drop=FALSE) + theme_minimal() + xlab('') + ylab('')

ggplot(subset(x, subset= coiid %in% x$coiid[x$ponddurcl != 'None']), aes(month, factor(id), ponddurcl)) + geom_tile(aes(fill = ponddurcl), color='white', lwd=1) + scale_fill_brewer(palette = "Spectral", drop=FALSE, na.value='grey80', name='Ponding Duration') + scale_x_discrete(drop=FALSE) + theme_minimal() + xlab('') + ylab('')

Component Ecological Site Data

Details pending.

nc.esd <- get_component_esd_data_from_NASIS_db()

Example Applications

These examples are still a work in progress. Detailed descriptions pending...

Check for DMU Linked to Multiple Map Units

There are some cases where a single DMU may be linked to multiple map units (such as...).

library(igraph)

# re-load relevant data from NASIS: 
# just MU/DMU objects with components named "Amador"
nc <- get_component_data_from_NASIS_db()
idx <- grep('Amador', nc$compname, ignore.case = TRUE)
nc.sub <- nc[idx, ]
nc.correlation <- get_component_correlation_data_from_NASIS_db()
nc.combined <- join(nc.sub, nc.correlation, by='dmuiid')

# extract edges of graph linking DMU --> MU
e <- na.omit(nc.combined[, c('dmuiid', 'nationalmusym')])

# create vertex attributes
v <- rbind(cbind(name=e[, 1], color='RoyalBlue', label.cex=0.75), cbind(name=e[, 2], color='Orange', label.cex=0.85))
v <- as.data.frame(v, stringsAsFactors = FALSE)
v$label.font <- 2
v$label.cex <- as.numeric(v$label.cex)

# optionally flag DMUs that connect to multiple MU
if(exists('multiple.mu.per.dmu', envir=soilDB.env)) {
  dupe.dmu <- get('multiple.mu.per.dmu', envir=soilDB.env)
  v$color[which(v$name %in% dupe.dmu)] <- 'Yellow' 
}

# create graph
g <- graph.data.frame(e, directed=TRUE, vertices = unique(v))
V(g)$size <- 5

# check
par(mar=c(0,0,0,0))
set.seed(10101)
plot(g, vertex.label.color='black', vertex.label.family='sans',  edge.arrow.size=0.5)
legend('bottomleft', legend = c('MU (national musym)', 'DMU (dmu description)', 'flagged DMU (dmu description)'), pt.bg=c('Orange', 'RoyalBlue', 'Yellow'), pch=21, pt.cex=2, cex=0.85, bty='n')

Rank Component Records Based on Horizon Data Population

Rank data map units that contain a major component named "Amador" based on the degree to which component horizon data has been populated.

library(lattice)
# re-load relevant data from NASIS:
# get the component data
nc <- get_component_data_from_NASIS_db()
# subset columns to those we are using
nc <- nc[, c('dmuiid', 'dmudesc', 'coiid', 'compname', 'comppct_r', 'majcompflag')]
# just MU/DMU objects with components named "Amador"
idx <- grep('Amador', nc$compname, ignore.case = TRUE)
nc <- nc[idx, ]
# look only at major components for now
nc <- nc[which(nc$majcompflag == 1), ]

# get component horizon data
nc.hz <- fetchNASIS_component_data()
# subset the unique set of component IDs that have horizon data
nc.hz.coiids <- site(nc.hz)$coiid

# make a new column and fill with '0' when no horizon data present, '1' when horizon data present
nc$hz.data.present <- 0
nc$hz.data.present[which(nc$coiid %in% nc.hz.coiids)] <- 1

# get correlation data and join to component data
nc.correlation <- get_component_correlation_data_from_NASIS_db()
nc.combined <- join(nc, nc.correlation, by='dmuiid', type='inner')

# tabulate components w/o hz data, w/ hz data, and total components
addmargins(table(nc.combined$hz.data.present))

## 
##   0   1 Sum 
##   2  18  20

# compute weighted fraction of hz data populated using component pct
p <- ddply(nc.combined, 'dmudesc', function(i) {
  with(i, sum((comppct_r / 100) * hz.data.present), na.rm=TRUE)
})
names(p) <- c('dmudesc', 'frac.populated')

# re-order musym labels in increasing order of hz data populated
p$dmudesc <- factor(p$dmudesc, levels=p$dmudesc[order(p$frac.populated)])

dotplot(dmudesc ~ frac.populated, data=p, cex=1.25, ylab='DMU Description', xlab='Fraction Component Hz Data Populated', main='Major Components Named "Amador"', scales=list(x=list(alternating=TRUE, tick.number=10)), subset=dmudesc != 'NOTCOM National DMU', panel=function(...){
  panel.abline(v=seq(0, 1, by=0.1), col='grey')
  panel.dotplot(...)
})

Boring Details

Just kidding, this stuff matters.

Status and QC Messages

As part of the quality control process, a number of possible messages are printed to the console when running fetchNASIS_component_data(). These messages and their meaning are described below:

-> QC: horizon errors detected ... Horizon depths are checked for gaps, overlap, or bottom depths than are shallower than top depths. In most cases pedons flagged as having errors suggests a quality control issue. However, combination horizons (e.g. B/C) that have been entered as two distinct horizons sharing the same horizon depths will trigger this warning.
-> QC: DMUs assigned to multiple MU ... This message means that some data map units in the selected set have been used within several different map units.
-> QC: duplicate muiids: multiple 'representative' DMU / MU ... This message means that there may be several "representative" DMU assigned to a single map unit.

Adjusting the Defaults

Some of the assumptions made by fetchNASIS_component_data() can be adjusted using arguments to the function:

rmHzErrors = TRUE Setting this value to TRUE (the default) will enable checks for horizon depth consistency. Consider setting this argument to FALSE if you aren't concerned about horizon depth errors, or know that your selected set contains many combination horizons. Note that any records flagged as having horizon depths errors (rmHzErrors = TRUE) will be omitted from the data returned by fetchNASIS_component_data().

An increased level of verbosity in the quality control messages can be enabled by setting the option: options(soilDB.verbose=TRUE). This is not generally suggested, but may be useful if you are having difficulty loading data from NASIS.

This document is based on aqp version 1.10 and soilDB version 1.8.1.

Unified interface to SCAN/SNOTEL data

Sat, 18 Mar 2017 22:48:29 +0000

Introduction

This document demonstrates how to use the soilDB package to download climate data from the SCAN/SNOTEL network. Stay tuned for updates and more detailed examples.

Note

This interface is very much a work in progress. There are some SCAN / SNOTEL site with multiple (above-ground) sensors per sensor prefix, which can lead to confusing results. For now the first above-ground sensor is selected for each above-ground sensor prefix: c('TAVG', 'PRCP', 'PREC', 'SNWD', 'WTEQ', 'WDIRV', 'WSPDV', 'LRADT').

There are some sites with multiple below-ground sensors installed at the same depth. A message is printed when this happens. You can use the sensor.id column to access specific sensors. We are working on a solution.

Installation

With a recent version of R (>= 2.15), it is possible to get all of the packages that this tutorial depends on via:

# run these commands in the R console
install.packages('latticeExtra', dep=TRUE)
install.packages('plyr', dep=TRUE)
install.packages('rvest', dep=TRUE)
install.packages('httr', dep=TRUE)
install.packages('reshape2', dep=TRUE)
install.packages('soilDB', dep=TRUE)

You will also need the latest version of soilDB and aqp:

install.packages('devtools', dep=TRUE)
devtools::install_github("ncss-tech/aqp", dependencies=FALSE, upgrade_dependencies=FALSE)
devtools::install_github("ncss-tech/soilDB", dependencies=FALSE, upgrade_dependencies=FALSE)

Quick Example: getting sensor metadata

Each SCAN / SNOTEL station may have a different set of sensors.

# load required packages
library(aqp)
library(soilDB)
library(reshape2)
library(plyr)
library(latticeExtra)

# get basic sensor metadata for several SCAN/SNOTEL sites
m <- SCAN_sensor_metadata(site.code=c(2072,356,2148,2187))

# print a list of sensor types by station
dlply(m, 'site.code', function(i) unique(i$Ecode))

## $`356`
##  [1] "WTEQ" "PREC" "TOBS" "TMAX" "TMIN" "TAVG" "SNWD" "SMS"  "STO"  "SAL"  "RDC"  "BATT"
## 
## $`2072`
##  [1] "PREC"  "TOBS"  "TMAX"  "TMIN"  "TAVG"  "PRCP"  "SMS"   "STO"   "SAL"   "RDC"   "BATT"  "WDIRV"
## [13] "WSPDV" "RHUM"  "RHENC" "LRADT"
## 
## $`2148`
##  [1] "PREC"  "TOBS"  "TMAX"  "TMIN"  "TAVG"  "PRCP"  "SMS"   "STO"   "SAL"   "RDC"   "BATT"  "WDIRV"
## [13] "WSPDV" "RHUM"  "RHENC"
## 
## $`2187`
##  [1] "PREC"  "TOBS"  "TMAX"  "TMIN"  "TAVG"  "PRCP"  "SMS"   "STO"   "SAL"   "RDC"   "BATT"  "WDIRV"
## [13] "WSPDV" "RHUM"  "RHENC" "LRADT"
## 
## attr(,"split_type")
## [1] "data.frame"
## attr(,"split_labels")
##   site.code
## 1       356
## 2      2072
## 3      2148
## 4      2187

Getting Data from a Single Station

Lets get some recent (daily) climate data from the Rogers Farm #1 SCAN station; site number 2001. The fetchSCAN() function does all of the work. Notice that the resulting object is a list, each element is a suite of sensor data. For example, the SMS element contains soil moisture from several depths

# fetchSCAN can accept multiple years
x <- fetchSCAN(site.code=2001, year=c(2013,2014,2015,2016))

# check the results
str(x, 1)

## List of 11
##  $ SMS  :'data.frame':   7325 obs. of  5 variables:
##  $ STO  :'data.frame':   7325 obs. of  5 variables:
##  $ SAL  :'data.frame':   0 obs. of  0 variables
##  $ TAVG :'data.frame':   1465 obs. of  5 variables:
##  $ PRCP :'data.frame':   1465 obs. of  5 variables:
##  $ PREC :'data.frame':   1465 obs. of  5 variables:
##  $ SNWD :'data.frame':   0 obs. of  0 variables
##  $ WTEQ :'data.frame':   0 obs. of  0 variables
##  $ WDIRV:'data.frame':   0 obs. of  0 variables
##  $ WSPDV:'data.frame':   0 obs. of  0 variables
##  $ LRADT:'data.frame':   0 obs. of  0 variables

# tabulate number of soil moisture measurements per depth (cm)
table(x$SMS$depth)

5	10	20	51	102
1465	1465	1465	1465	1465

# get unique set of soil moisture sensor depths
sensor.depths <- unique(x$SMS$depth)

# generate a better axis for dates
date.axis <- seq.Date(as.Date(min(x$SMS$Date)), as.Date(max(x$SMS$Date)), by='3 months')

# plot soil moisture time series, panels are depth
xyplot(value ~ Date | factor(depth), data=x$SMS, as.table=TRUE, type=c('l','g'), strip=strip.custom(bg=grey(0.80)), layout=c(1,length(sensor.depths)), scales=list(alternating=3, x=list(at=date.axis, format="%b\n%Y")), ylab='Volumetric Water Content', main='Soil Moisture at Several Depths')

Getting Data from Multiple Stations

That was interesting, but most of the time we want to make comparisons between stations. Note that the format of data returned makes it possible "stack" data from several stations that do not share the same collection of sensors.

# get more data
x <- fetchSCAN(site.code=c(356, 2072), year=c(2015, 2016))

# same format as before, sensor data are "stacked" within each list element
str(x, 1)

## List of 11
##  $ SMS  :'data.frame':   5864 obs. of  5 variables:
##  $ STO  :'data.frame':   5864 obs. of  5 variables:
##  $ SAL  :'data.frame':   0 obs. of  0 variables
##  $ TAVG :'data.frame':   1466 obs. of  5 variables:
##  $ PRCP :'data.frame':   733 obs. of  5 variables:
##  $ PREC :'data.frame':   1466 obs. of  5 variables:
##  $ SNWD :'data.frame':   733 obs. of  5 variables:
##  $ WTEQ :'data.frame':   733 obs. of  5 variables:
##  $ WDIRV:'data.frame':   0 obs. of  0 variables
##  $ WSPDV:'data.frame':   0 obs. of  0 variables
##  $ LRADT:'data.frame':   0 obs. of  0 variables

# deeper look
str(x$SMS)

## 'data.frame':    5864 obs. of  5 variables:
##  $ Site     : int  356 356 356 356 356 356 356 356 356 356 ...
##  $ Date     : Date, format: "2015-01-01" "2015-01-02" "2015-01-03" ...
##  $ value    : num  0 0 0 0 0 0 0 0 0 0 ...
##  $ depth    : num  5 5 5 5 5 5 5 5 5 5 ...
##  $ sensor.id: Factor w/ 5 levels "SMS.I_2","SMS.I_8",..: 1 1 1 1 1 1 1 1 1 1 ...

# get unique set of soil moisture sensor depths
sensor.depths <- unique(x$SMS$depth)

# generate a better axis for dates
date.axis <- seq.Date(as.Date(min(x$SMS$Date)), as.Date(max(x$SMS$Date)), by='3 months')

# plot soil moisture time series, panels are depth
xyplot(value ~ Date | factor(depth), groups=factor(Site), data=x$SMS, as.table=TRUE, type=c('l','g'), auto.key=list(columns=2, lines=TRUE, points=FALSE), strip=strip.custom(bg=grey(0.80)), layout=c(1,length(sensor.depths)), scales=list(alternating=3, x=list(at=date.axis, format="%b\n%Y")), ylab='Volumetric Water Content', main='Soil Moisture at Several Depths')

Example Figures

# combine sensors
g <- make.groups('soil moisture'=x$SMS, 'soil temperature'=x$STO)

# get unique set of soil moisture sensor depths
sensor.depths <- unique(g$depth)

# generate a better axis for dates
date.axis <- seq.Date(as.Date(min(g$Date)), as.Date(max(g$Date)), by='3 months')

# plot soil moisture time series, panels are depth
p <- xyplot(value ~ Date | factor(Site) + which, groups=factor(depth), data=g, as.table=TRUE, type=c('l','g'), auto.key=list(columns=length(sensor.depths), lines=TRUE, points=FALSE), strip=strip.custom(bg=grey(0.80)), scales=list(alternating=3, x=list(at=date.axis, format="%b\n%Y"), y=list(relation='free', rot=0)), ylab='', main='Soil Moisture and Temperature at Several Depths')

useOuterStrips(p)

# plot a single suite of sensors
# compare sites / depths
# no SAL sensors for these sites
# xyplot(value ~ Date | factor(depth), groups=factor(Site), data=x$SAL, as.table=TRUE, type=c('l','g'), auto.key=list(title='site', columns=2, lines=TRUE, points=FALSE), layout=c(1,length(sensor.depths)), scales=list(alternating=3, y=list(relation='free', rot=0)))

xyplot(value ~ Date, groups=factor(Site), data=x$TAVG, as.table=TRUE, type=c('l','g'), auto.key=list(title='site', columns=2, lines=TRUE, points=FALSE), scales=list(alternating=3, x=list(at=date.axis, format="%b\n%Y")), main='Average Air Temperature by Site')

xyplot(value ~ Date, groups=factor(Site), data=x$PRCP, as.table=TRUE, type=c('l','g'), auto.key=list(title='site', columns=2, lines=TRUE, points=FALSE), scales=list(alternating=3, x=list(at=date.axis, format="%b\n%Y")), main='Daily Precipitation by Site')

xyplot(value ~ Date, groups=factor(Site), data=x$PREC, as.table=TRUE, type=c('l','g'), auto.key=list(title='site', columns=2, lines=TRUE, points=FALSE), scales=list(alternating=3, x=list(at=date.axis, format="%b\n%Y")), main='Accumulated Precipitation by Site')

xyplot(value ~ Date, groups=factor(Site), data=x$WTEQ, as.table=TRUE, type=c('l','g'), auto.key=list(title='site', columns=2, lines=TRUE, points=FALSE), scales=list(alternating=3, x=list(at=date.axis, format="%b\n%Y")), main='Daily Snow Water Equivalent by Site')

xyplot(value ~ Date, groups=factor(Site), data=x$SNWD, as.table=TRUE, type=c('l','g'), auto.key=list(title='site', columns=2, lines=TRUE, points=FALSE), scales=list(alternating=3, x=list(at=date.axis, format="%b\n%Y")), main='Daily Snow Depth (in) by Site')

Case Study: Pine Nut SCAN Site

Get SCAN data from the Pine Nut site(2144) for years 2008 through 2015. Note that this site has multiple soil temperature sensors installed at each depth.

x <- fetchSCAN(site.code=c(2144), year=2008:2015)

# check available data
str(x, 1)

## List of 11
##  $ SMS  :'data.frame':   14650 obs. of  5 variables:
##  $ STO  :'data.frame':   29300 obs. of  5 variables:
##  $ SAL  :'data.frame':   0 obs. of  0 variables
##  $ TAVG :'data.frame':   2930 obs. of  5 variables:
##  $ PRCP :'data.frame':   2930 obs. of  5 variables:
##  $ PREC :'data.frame':   2930 obs. of  5 variables:
##  $ SNWD :'data.frame':   1465 obs. of  5 variables:
##  $ WTEQ :'data.frame':   0 obs. of  0 variables
##  $ WDIRV:'data.frame':   0 obs. of  0 variables
##  $ WSPDV:'data.frame':   0 obs. of  0 variables
##  $ LRADT:'data.frame':   0 obs. of  0 variables

## still working on a solution for this issue: https://github.com/ncss-tech/soilDB/issues/14
# ! multiple soil temperature sensors installed at each depth
table(sensor.id=x$STO$sensor.id, sensor.depth=x$STO$depth)

sensor.id/sensor.depth	5	10	20	51	102
STO.I_2	2930	0	0	0	0
STO.I_4	0	2930	0	0	0
STO.I_8	0	0	2930	0	0
STO.I_20	0	0	0	2930	0
STO.I_40	0	0	0	0	2930
STO.I-2_2	2930	0	0	0	0
STO.I-2_4	0	2930	0	0	0
STO.I-2_8	0	0	2930	0	0
STO.I-2_20	0	0	0	2930	0
STO.I-2_40	0	0	0	0	2930

# extract SMS data to a new data.frame
sms <- x$SMS

# add parts of date for plotting
sms$year <- format(sms$Date, "%Y")
sms$doy <- as.numeric(format(sms$Date, "%j"))

# cast long -> wide format for later use
sms.wide <- dcast(sms, Site + Date ~ depth, value.var = 'value', mean, na.rm=TRUE)

# check:
head(sms)

Site	Date	value	depth	sensor.id	year	doy
2144	2008-01-01	2.1	5	SMS.I_2	2008	1
2144	2008-01-02	1.8	5	SMS.I_2	2008	2
2144	2008-01-03	2.6	5	SMS.I_2	2008	3
2144	2008-01-04	3.3	5	SMS.I_2	2008	4
2144	2008-01-05	5.1	5	SMS.I_2	2008	5
2144	2008-01-06	12.1	5	SMS.I_2	2008	6

head(sms.wide)

Site	Date	5	10	20	51	102
2144	2008-01-01	2.1	4.4	8.8	9.2	2.0
2144	2008-01-02	1.8	4.1	8.1	9.3	1.6
2144	2008-01-03	2.6	5.2	8.2	9.2	1.6
2144	2008-01-04	3.3	6.2	8.2	9.0	NaN
2144	2008-01-05	5.1	7.7	8.2	9.1	2.0
2144	2008-01-06	12.1	18.8	12.7	9.1	2.1

# make some pretty colors for plotting daily VWC
cols <- colorRampPalette(brewer.pal(11, 'RdYlBu'), space='Lab', interpolate='spline', bias=2)

# plot VWC by year/day, panels by depth
levelplot(value ~ doy * factor(year) | factor(depth), main='Daily Mean VWC (%)',
          data=sms, layout=c(1,5), col.regions=cols,
          colorkey=list(space='top'), as.table=TRUE, scales=list(alternating=3, cex=0.75, x=list(tick.number=20)), 
          par.strip.text=list(cex=0.85), strip=strip.custom(bg='grey'), 
          xlab='Julian Day', ylab='Year')

# plot VWC by year/day, panels by year with depths stacked
levelplot(value ~ doy * rev(factor(depth)) | factor(year), main='Daily Mean VWC (%)',
          data=sms, layout=c(1,8), col.regions=cols, 
          colorkey=list(space='top'), as.table=TRUE, scales=list(alternating=3, cex=0.75, x=list(tick.number=20)), 
          par.strip.text=list(cex=0.85), strip=strip.custom(bg='grey'), 
          xlab='Julian Day', ylab='Sensor Depth (cm)', ylim=rev(levels(factor(sms$depth))))

Water Retention Curve Development

Get KSSL data for this site, via user pedon ID. This will include estimated parameters for the van Genuchten model which can be used to derive a water retention curve.

Previously the VG parameters had to be obtained manually from these reports.

# get KSSL data
s <- fetchKSSL(pedon_id = 'S08NV003003')

# VG parameters now returned by fetchKSSL() as of 2016-11-17
(horizons(s)[, c('hzn_desgn', 'hzn_top', 'hzn_bot', 'theta_r', 'theta_s', 'alpha', 'npar')])

hzn_desgn	hzn_top	hzn_bot	theta_r	theta_s	alpha	npar
A	0	9	0.0337216	0.4864061	-1.581517	0.1227247
ABk	9	31	0.0445697	0.4701070	-1.605478	0.1267858
Btk1	31	48	0.0516780	0.4647200	-1.795169	0.1317818
Btk2	48	83	0.0562656	0.4179194	-2.058838	0.1377132
2Bk	83	152	NA	NA	NA	NA

Conversion of VWC to Matric Potential: Single Depth

Generate water retention curve for sensor at 20cm. This requires extracting VG parameters from the KSSL data from the associated horizon. See ?KSSL_VG_model or this tutorial for details.

# get VG parameters for sensor at 20cm depth
s.vg.hz <- slice(s, 20 ~ theta_r + theta_s + alpha + npar, just.the.data = TRUE)

# get VG curve and inverse function
# this is based on several assumptions about the source data... details pending
vg.hz <- KSSL_VG_model(VG_params = s.vg.hz)

# check: looks good
p.model <- xyplot(phi ~ theta, data=vg.hz$VG_curve, type=c('l', 'g'), scales=list(alternating=3, x=list(tick.number=10), y=list(log=10, tick.number=10)), yscale.components=yscale.components.logpower, ylab=expression("Suction " (kPa)), xlab=expression("Volumetric Water Content " (cm^3/cm^3)), par.settings = list(plot.line=list(col='RoyalBlue', lwd=2)))

update(p.model, main='Estimated Water Retention Curve at 20cm', sub='van Genuchten Model Parameters fit by USDA-ARS Rosetta')

Lets add some points on the water retention curve from the measured VWC values.

# add quantiles from measured values
sms.q <- data.frame(theta=quantile(sms.wide$`20`/100, probs=c(0, 0.05, 0.25, 0.5, 0.75, 0.95, 1), na.rm=TRUE))
sms.q$phi <- vg.hz$VG_inverse_function(sms.q$theta)

p.points <- xyplot(phi ~ theta, data=sms.q, type='p', par.settings = list(plot.symbol=list(col='orange', pch=16, cex=1.25)), scales=list(alternating=3, x=list(tick.number=10), y=list(log=10, tick.number=10)), yscale.components=yscale.components.logpower, ylab=expression("Suction " (kPa)), xlab=expression("Volumetric Water Content " (cm^3/cm^3)), panel=function(x, y, ...) {
  panel.xyplot(x, y, ...)
  panel.text(x, y, row.names(sms.q), adj=c(0,-0.75), cex=0.65)
})

update(p.model + p.points, main='Select Percentiles of Data Measured at 20cm', sub='van Genuchten Model Parameters fit by USDA-ARS Rosetta')

Conversion of VWC to Matric Potential: All Depths

This time we will iterate over all sensors, develop water retention curves, and convert VWV to water potential values. Note that this approach will only work with a SoilProfileCollection object that contains a single profile.

# split soil moisture data by sensor depth
sms.list <- split(sms, sms$depth)

# convert VWC -> phi (KPa)
sms.phi <- ldply(sms.list, function(i) {
  # i is a DF associated with a single sensor depth
  this.depth <- unique(i$depth)
  # get VG params for this depth
  fm <- as.formula(paste0(this.depth, ' ~ theta_r + theta_s + alpha + npar'))
  s.vg.hz <- slice(s, fm, just.the.data = TRUE)

  # get VG curve and inverse function
  # this is based on several assumptions about the source data...
  vg.hz <- KSSL_VG_model(VG_params = s.vg.hz)
  
  # estimate phi
  if(!is.null(vg.hz$VG_inverse_function))
    i$phi <- vg.hz$VG_inverse_function(i$value / 100.0)
  else
    i$phi <- NA
  
  # done
  return(i)
})


# classify each day as <= 1500 kPa (15 bar)
sms.phi$phi_leq_15_bar <- factor(sms.phi$phi <= 1500, levels=c('FALSE', 'TRUE'))

# new color palette
cols.phi <- colorRampPalette(rev(brewer.pal(11, 'RdYlBu')), space='Lab', interpolate='spline', bias=1.5)

# plot daily mean water potential in log10-kPa
levelplot(log(phi, base=10) ~ doy * factor(year) | factor(depth), main='Daily Mean Water Potential log10(-kPa)',
          data=sms.phi, layout=c(1,5), col.regions=cols.phi,
          colorkey=list(space='top'), as.table=TRUE, scales=list(alternating=3, cex=0.75, x=list(tick.number=20)), 
          par.strip.text=list(cex=0.85), strip=strip.custom(bg='grey'), 
          xlab='Julian Day', ylab='Year')

# plot daily mean water potential in log10-kPa by year and sensor stack
levelplot(log(phi, base=10) ~ doy * rev(factor(depth)) | factor(year), main='Daily Mean Water Potential log10(-kPa)',
          data=sms.phi, layout=c(1,8), col.regions=cols.phi,
          colorkey=list(space='top'), as.table=TRUE, scales=list(alternating=3, cex=0.75, x=list(tick.number=20)), 
          par.strip.text=list(cex=0.85), strip=strip.custom(bg='grey'), 
          xlab='Julian Day', ylab='Sensor Depth (cm)', ylim=rev(levels(factor(sms.phi$depth))))

levelplot(phi_leq_15_bar ~ doy * factor(year) | factor(depth), main='Daily Mean Water Potential <= 15 bar (1500 kPa)',
          data=sms.phi, layout=c(1,5), col.regions=c(grey(0.85), 'RoyalBlue'), cuts=1,
          colorkey=FALSE, as.table=TRUE, scales=list(alternating=3, cex=0.75, x=list(tick.number=20)), 
          par.strip.text=list(cex=0.85), strip=strip.custom(bg='grey'), 
          xlab='Julian Day', ylab='Year')

This document is based on aqp version 1.10 and soilDB version 1.8.1.

Component Relation Graphs

Sat, 18 Mar 2017 22:48:23 +0000

Details pending. A recent discussion on the topic.

Simple Example

# load libraries
library(soilDB)
library(sharpshootR)
library(plyr)
library(igraph)
library(RColorBrewer)

# load sample data associated with the amador soil series
data(amador)

# map unit keys, component names, component percentages
head(amador)

mukey	compname	comppct_r
461845	amador	45
461845	gillender	40
461845	pardee	3
461845	peters	3
461845	ranchoseco	3
461845	vleck	3

# convert into adjacency matrix, based on no. times component co-occur
m.1 <- component.adj.matrix(amador, method='occurrence')
print(m.1)

##            amador auburn bellota exchequer gillender hornitos pardee pentz peters ranchoseco vleck
## amador          0      2       1         4         2        4      2     7      4          2     2
## auburn          0      0       0         0         0        0      0     2      2          0     0
## bellota         0      0       0         0         0        0      0     1      0          0     0
## exchequer       0      0       0         0         0        4      0     4      0          0     0
## gillender       0      0       0         0         0        0      2     0      2          2     2
## hornitos        0      0       0         0         0        0      0     4      0          0     0
## pardee          0      0       0         0         0        0      0     0      2          2     2
## pentz           0      0       0         0         0        0      0     0      2          0     0
## peters          0      0       0         0         0        0      0     0      0          2     2
## ranchoseco      0      0       0         0         0        0      0     0      0          0     2
## vleck           0      0       0         0         0        0      0     0      0          0     0
## attr(,"method")
## [1] "occurrence"

# convert into adjacency matrix, weighted by component percent
m.2 <- component.adj.matrix(amador)
print(round(m.2, 2))

##            amador auburn bellota exchequer gillender hornitos pardee pentz peters ranchoseco vleck
## amador          0      0    0.01      0.03       0.2     0.03   0.01  0.04   0.02       0.01  0.01
## auburn          0      0    0.00      0.00       0.0     0.00   0.00  0.09   0.21       0.00  0.00
## bellota         0      0    0.00      0.00       0.0     0.00   0.00  0.22   0.00       0.00  0.00
## exchequer       0      0    0.00      0.00       0.0     1.00   0.00  0.61   0.00       0.00  0.00
## gillender       0      0    0.00      0.00       0.0     0.00   0.08  0.00   0.07       0.08  0.08
## hornitos        0      0    0.00      0.00       0.0     0.00   0.00  0.61   0.00       0.00  0.00
## pardee          0      0    0.00      0.00       0.0     0.00   0.00  0.00   0.79       1.00  1.00
## pentz           0      0    0.00      0.00       0.0     0.00   0.00  0.00   0.07       0.00  0.00
## peters          0      0    0.00      0.00       0.0     0.00   0.00  0.00   0.00       0.79  0.79
## ranchoseco      0      0    0.00      0.00       0.0     0.00   0.00  0.00   0.00       0.00  1.00
## vleck           0      0    0.00      0.00       0.0     0.00   0.00  0.00   0.00       0.00  0.00
## attr(,"standardization")
## [1] "max"
## attr(,"metric")
## [1] "jaccard"
## attr(,"method")
## [1] "community.matrix"

# compare two methods
par(mfcol=c(1,2), mar=c(0,0,1,0))
plotSoilRelationGraph(m.1, s='amador')
title('Occurence')
plotSoilRelationGraph(m.2, s='amador')
title('Community Matrix')

# compare vertex scaling methods
par(mfcol=c(1,2), mar=c(0,0,1,0))
plotSoilRelationGraph(m.2, s='amador')
title('Degree')
plotSoilRelationGraph(m.2, s='amador', vertex.scaling.method = 'distance')
title('Distance from "Amador"')

# compute adjacency matrix via community matrix method
m <- component.adj.matrix(amador)
# try a bunch of layouts
par(mfrow=c(2,3), mar=c(0,0,1,0))
plotSoilRelationGraph(m, s='amador', main='Fruchterman-Reingold (default)')
plotSoilRelationGraph(m, s='amador', g.layout=layout_on_grid, main='grid')
plotSoilRelationGraph(m, s='amador', g.layout=layout_in_circle, main='circle')
plotSoilRelationGraph(m, s='amador', g.layout=layout_with_mds, main='MDS')
plotSoilRelationGraph(m, s='amador', g.layout=layout_with_gem, main='GEM')
plotSoilRelationGraph(m, s='amador', g.layout=layout_as_star, main='star')

# setup page
par(mfcol=c(1,2), mar=c(0,0,0,0))
# plot as network diagram, with Amador soil highlighted
plotSoilRelationGraph(m, s='amador')
# plot as dendrogram, with Amador soil highlighted
plotSoilRelationGraph(m, s='amador', plot.style='dendrogram')

# tighten margins
par(mfcol=c(1,2), mar=c(0,0,1,0))
# plot as network diagram, with Amador soil highlighted
plotSoilRelationGraph(m, s='amador', main='Full Graph')
plotSoilRelationGraph(m, s='amador', spanning.tree='max', main='Maximum Spanning Tree')

# tighten margins
par(mfcol=c(1,2), mar=c(0,0,1,0))
# plot as network diagram, with Amador soil highlighted
plotSoilRelationGraph(m, s='amador', main='Full Graph')
plotSoilRelationGraph(m, s='amador', spanning.tree='min', main='Minumum Spanning Tree')

par(mar=c(1,1,1,1), mfcol=c(1,5))
for(i in seq(0, 1, length.out = 5)) {
  plotSoilRelationGraph(m, s='amador', vertex.scaling.factor=3, del.edges=i)
  title(paste0('Edge weight < ', i, '-tile pruned'), cex.main=0.9, line=-1)
  box()
}

par(mar=c(1,1,1,1), mfcol=c(1,5))
for(i in seq(0, 1, length.out = 5)) {
  plotSoilRelationGraph(m, s='amador', vertex.scaling.factor=3, del.edges=i, spanning.tree='max')
  title(main=paste0('Edge weight < ', i, '-tile pruned'), sub='Max Spanning Tree', cex.main=0.9, line=-1)
  box()
}

NASIS via local database

# get legend/DMU/component data from NASIS
# in this case, CA630 data
d <- get_component_data_from_NASIS_db()

# normalize component names
d$compname <- tolower(d$compname)

# remove misc. areas components
d <- subset(d, compkind != 'Miscellaneous area')

# remove some higher-taxa and non-soil components
d <- subset(d, ! compname %in% c('lithic haploxeralfs', 'rock outcrop', 'aquic haploxeralfs', 'ultic haploxeralfs', 'riparian'))

# select only those columns that we really need
d <- d[, c('dmudesc', 'compname', 'comppct_r', 'majcompflag')]

# how frequently is any given component a "major" component?
maj.comp.freq <- ddply(d, 'compname', summarize, 1 - prop.table(table(majcompflag))[1])
names(maj.comp.freq) <- c('compname', 'freq')

# extract map unit symbols from DMU description labels
d$musym <- gsub('CA630', '', d$dmudesc)

# check top couple of rows
head(d)

	dmudesc	compname	comppct_r	majcompflag	musym
3	CA6301011	orthents	50	1	1011
5	CA6301012	orthents	50	1	1012
6	CA6301030	aquic argixerolls	95	1	1030
7	CA6301030	typic haploxeralfs	5	0	1030
8	CA6301031	aquic argixerolls	5	0	1031
9	CA6301031	typic haploxeralfs	95	1	1031

# convert into adjacency matrix, weighted by component percentage
m <- component.adj.matrix(d, mu='musym', co='compname', wt='comppct_r')

# tighten margins
par(mar=c(0,0,2,0))
plotSoilRelationGraph(m, vertex.scaling.factor=1, main='CA630 Components')

plotSoilRelationGraph(m, spanning.tree='max', vertex.scaling.factor=1, edge.scaling.factor=8, s='amador', main='CA630 Components\n(max spanning tree)')

plotSoilRelationGraph(m, spanning.tree=0.75, vertex.scaling.factor=1, edge.scaling.factor=8, s='amador', main='CA630 Components\n(max spanning tree + edges with weights > 75th percentile)')

plotSoilRelationGraph(m, vertex.scaling.factor=1, edge.scaling.factor=8, s='loafercreek', del.edges=0.25, main='CA630 Components\n(edge weights < 25th percentile pruned)')

plotSoilRelationGraph(m, spanning.tree='max', vertex.scaling.factor=1, edge.scaling.factor=8, s='amador', main='CA630 Components\n(max spanning tree and maj. component flag label adjustment)', vertex.label.cex=sqrt(maj.comp.freq$freq+0.5))

SSURGO via SDA

# select by survey area(s)
q <- "SELECT 
component.mukey, comppct_r, lower(compname) as compname
FROM legend
INNER JOIN mapunit ON mapunit.lkey = legend.lkey
LEFT OUTER JOIN component ON component.mukey = mapunit.mukey
WHERE legend.areasymbol IN ('CA654')
AND compkind IN ('Series', 'Taxadjunct')"

# run query, process results, and return as data.frame object
res <- SDA_query(q)

# convert into adj. matrix using component percentage weights
m <- component.adj.matrix(res)

# tighten margins
par(mar=c(0,0,2,0))
plotSoilRelationGraph(m, vertex.scaling.factor=1, edge.scaling.factor=8, main='CA654 Components\nFull Graph')

plotSoilRelationGraph(m, vertex.scaling.factor=1, edge.scaling.factor=8, spanning.tree='max', main='CA654 Components\nMaximum Spanning Tree')

plotSoilRelationGraph(m, vertex.scaling.factor=1, edge.scaling.factor=8, spanning.tree=0.75, main='CA654 Components\nMaximum Spanning Tree + edges with weight > 75th percentile')

This document is based on aqp version 1.9.16, soilDB version 1.8-10, and sharpshootR version 1.2.

Assignment of generalized horizon labels

Mon, 13 Mar 2017 00:00:00 +0000

Assigning Generalized Horizon Labels

D.E. Beaudette, J. Skovlin (edited for clarity by Jenny Sutherland)
2017-03-13
This document is based on aqp version 1.10 and soilDB version 1.8-7.

Introduction

An Example

Consider this situation: you have a collection of pedons that have been correlated to a named soil series (or component) and would like to objectively compute a range in characteristics ("low-rv-high" values) and horizon depths. As with most collections of pedon data, there may be considerable variation in description style and horizons used, horizon depths, and number of horizons described:

alt text

In this scenario, there are several obvious “micro-correlation” decisions that need to be made before horizons can be grouped for aggregation. For example, what horizonation prototype scheme (e.g., A-Bt1-Bt2-Bt3-Cr-R) best conveys the concept of this soil series or soil component? Does it make sense to group [Bt3, Bt4, BCt, CBt] horizons for aggregation? Or what about grouping [Bt3, 2Bt3] horizons? Do [BA, AB] horizons occur frequently enough to be included in the horizonation prototype?

Based on your knowledge of the area, pedon 2 might be a good "typical" pedon to use in developing a horizonation prototype. After careful review of the data and consultation with your crew, a new set of labels are assigned to each horizon (red labels in figure above) that define groups over which soil properties will be aggregated. These new labels define functionally similar groups that may span multiple genetic horizons.

Formalized Approach

This document describes an aggregation strategy based on the use of "generalized horizon labels" (GHL) through a combination of narrative, R code, and figures. You can follow along in an R session by copying code from the grey boxes and pasting it into the R console.

Here is a basic outline of the process:

Select a set of GHL that best represents a group of pedons to be aggregated. This could be based on series descriptions, expert knowledge, or even inspection of the most frequently occurring horizon designations.
Assign GHL to each horizon using whatever information is available for grouping horizons. This micro-correlation of horizon designations will likely require slightly different "rules" in each instance. Careful inspection of horizon designation and observed properties is critical.
Evaluate GHL assignments and manually refine as needed.
Keep track of final GHL assignments in NASIS or text file.
Estimate a most likely horizonation e.g., top and bottom depths for each generalized horizon label.
Compute range in characteristics, aka low-rv-high values, for clay, sand, pH, etc. over GHL. (next document in this series)

Setup R Envionment

If you have never used the aqp or soildb packages before, you will likely need to install them. This only needs to be done once.

# stable version from CRAN + dependencies
install.packages('ape', dep=TRUE) 
install.packages('latticeExtra', dep=TRUE)
install.packages('plyr', dep=TRUE) 
install.packages('aqp', dep=TRUE) 
install.packages('soilDB', dep=TRUE)
install.packages('sharpshootR', dep=TRUE)

Once you have all of the R packages on which this document depends, it is a good idea to load them. R packages must be installed anytime you change versions of R (e.g., after an upgrade) and loaded anytime you want to access functions from within those packages.

library(aqp)
library(soilDB)
library(sharpshootR)
library(igraph)
library(ape)
library(latticeExtra)
library(plyr)
library(lattice)
library(cluster)
library(MASS)

Sample Data

While the methods outlined in this document can be applied to any collection of pedons, it is convenient to work with a standardized set of data. You can follow along with the analysis by copying code from the following blocks and running it in your R session. The sample data used in this document is based on 15 soil profiles that have been correlated to the Loafercreek soil series from the Sierra Nevada Foothill Region of California. Note that the internal structure of the loafercreek data is identical to the structure returned by fetchNASIS() from the soilDB package. All horizon-level values are pulled from the pedon horizon table of the pedons being analyzed.

# load sample data from the soilDB package
data(loafercreek, package = 'soilDB')
# keep only the first 15 pedons
pedons <- loafercreek[1:15, ]
# plot profile sketches
par(mar=c(0,0,0,0))
plot(pedons, name='hzname', print.id=FALSE, cex.names=0.75, axis.line.offset=-4)

15 pedons correlated to the Loafercreek soil series.

Optional: Follow Along with Your Data

The following code block demonstrates how to pull data in using the fetchNASIS() function from the soilDB package.

# first load the desired data set within NASIS into your NASIS selected set
# then load data from the NASIS selected set into R
# note that the `nullFragsAreZero` argument converts NULL rock fragment class data into 0s
pedons <- fetchNASIS(nullFragsAreZero=TRUE)
# optionally subset the data by taxon name - enter your taxon name
pedons <- pedons[grep(pattern='ENTER_YOUR_TAXON_NAME', pedons$taxonname, ignore.case=TRUE), ]

Methods

Selection of Generalized Horizon Labels

Generalized horizon labels represent an expert-guided selection of designations that were consistently observed in the field and are meaningful in terms of soil morphology and management. The very first step in this process is to tabulate the number of times each horizon designation occurs.

sort(table(pedons$hzname), decreasing=TRUE)

A	Bt1	Bt2	Bt3	Cr	R	BCt	Crt	Oi	BAt	Bw	2Bt3	2Cr	BA	Bt	2BCt	2Bt4	Bt4	CBt
15	14	14	9	9	9	5	4	4	3	3	2	2	2	2	1	1	1	1

In this case, [A, Bt1, Bt2, Bt3] horizon designations appear to be a good starting point. However, relying on field experience and expert knowledge of these soils, cross-checking against the OSD, and talking with other soil scientists may be more important than the previous tabulation.

Constructing a graph of transitions from one horizon to the next ("transition probabilities") can highlight those horizon designations that are most commonly used together. A follow-up tutorial on transition probability matrix interpretation is planned.

tp <- hzTransitionProbabilities(pedons, 'hzname')
par(mar=c(1,1,1,1))
plotSoilRelationGraph(tp, graph.mode = 'directed', edge.arrow.size=0.5, edge.scaling.factor=2, vertex.label.cex=0.75, vertex.label.family='sans')

Graph constructed from transition probabilities.

A quick summary of horizon depth mid-points (e.g., average depth of horizon) can help in organizing the various designations and possibly give some clues as to how they can be grouped. The following plot is called a box and whisker plot.

# compute horizon mid-points
pedons$mid <- with(horizons(pedons), (hzdept + hzdepb) / 2)

# sort horizon designation by group-wise median values
hz.designation.by.median.depths <- names(sort(tapply(pedons$mid, pedons$hzname, median)))

# plot the distribution of horizon mid-points by designation
bwplot(mid ~ factor(hzname, levels=hz.designation.by.median.depths), 
       data=horizons(pedons), 
       ylim=c(155, -5), ylab='Horizon Mid-Point Depth (cm)', 
       scales=list(y=list(tick.number=10)), 
       panel=function(...) {
  panel.abline(h=seq(0, 140, by=10), v=1:length(hz.designation.by.median.depths), col=grey(0.8), lty=3)
    panel.bwplot(...)
})

Range in horizon depth mid-point for original horizon designations.

Next, a similar summary of soil properties (clay content and total rock fragment volume) is presented. The goal is to determine which horizons designations can be grouped and which generalized horizon labels to assign to each group.

# box and wisker plot by clay content
bwplot(clay ~ factor(hzname, levels=hz.designation.by.median.depths), 
       data=horizons(pedons), 
       ylab='Clay Content (%)', 
       scales=list(y=list(tick.number=10)), 
       panel=function(...) {
  panel.abline(h=seq(0, 100, by=5), v=1:length(hz.designation.by.median.depths), col=grey(0.8), lty=3)
  panel.bwplot(...)
})

Range in clay content for original horizon designations.

# box and wisker plot by total rock fragment volume
bwplot(total_frags_pct ~ factor(hzname, levels=hz.designation.by.median.depths), 
       data=horizons(pedons), 
       ylab='Total Rock Fragment Volume (%)', 
       scales=list(y=list(tick.number=10)), 
       panel=function(...) {
  panel.abline(h=seq(0, 100, by=10), v=1:length(hz.designation.by.median.depths), col=grey(0.8), lty=3)
  panel.bwplot(...)
})

Range in total rock fragment content for original horizon designations.

Sometimes looking at thematic soil profile sketches can be informative.

# color horizons by clay content
par(mar=c(0,0,3,0))
plot(pedons, name='hzname', print.id=FALSE, cex.names=0.75, axis.line.offset=-4, color='clay')

Horizon colors are based on clay content.

Assignment of Generalized Horizon Labels

Once a set of generalized horizon labels have been determined, a corresponding set of regular expression (REGEX) rules are developed to convert field-described designations into GHL. Pattern matching with REGEX will typically assign useful GHL; however, there will always be cases where manual intervention is required. More on that will follow.

From the above analysis and the OSD, it seems like the following sequence of GHL is appropriate: (A, Bt1, Bt2, Bt3, Cr, R) -- an A horizon, followed by 3 Bt horizons, then Cr, and finally R. For each GHL, a corresponding REGEX rule is needed. For example, '^A$|Ad|Ap' will match 'A', 'Ad', and 'Ap'.

# save our GHL
n <- c('A','Bt1','Bt2','Bt3','Cr','R')
# REGEX rules
p <- c('^A$|Ad|Ap',
       'Bt1$',
       '^Bt2$',
       '^Bt3|^Bt4|CBt$|BCt$|2Bt|2CB$|^C$',
       'Cr',
       'R')

Apply GHL pattern-matching rules, save to a new column called genhz, and cross-tabulate the occurrence of GHL and original designations.

pedons$genhz <- generalize.hz(pedons$hzname, n, p)
# cross-tabulate original horizon designations and GHL
tab <- table(pedons$genhz, pedons$hzname)
addmargins(tab)

/	2BCt	2Bt3	2Bt4	2Cr	A	BA	BAt	BCt	Bt	Bt1	Bt2	Bt3	Bt4	Bw	CBt	Cr	Crt	Oi	R	Sum
A	0	0	0	0	15	0	0	0	0	0	0	0	0	0	0	0	0	0	0	15
Bt1	0	0	0	0	0	0	0	0	0	14	0	0	0	0	0	0	0	0	0	14
Bt2	0	0	0	0	0	0	0	0	0	0	14	0	0	0	0	0	0	0	0	14
Bt3	1	2	1	0	0	0	0	5	0	0	0	9	1	0	1	0	0	0	0	20
Cr	0	0	0	2	0	0	0	0	0	0	0	0	0	0	0	9	4	0	0	15
R	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	9	9
not-used	0	0	0	0	0	2	3	0	2	0	0	0	0	3	0	0	0	4	0	14
Sum	1	2	1	2	15	2	3	5	2	14	14	9	1	3	1	9	4	4	9	101

In the above cross-tabulation, we can see that a couple of original designations were not matched (not-used in the table) by our REGEX rules, namely, BA, Bw, and Oi horizons. For this example, we are going to assume that those horizons are not common enough for inclusion in our set of GHL.

It is also possible to display GHL assignment as a network graph.

# convert contingency table -> adj. matrix
m <- genhzTableToAdjMat(tab)
# plot using a function from the sharpshootR package
par(mar=c(1,1,1,1))
plotSoilRelationGraph(m, graph.mode = 'directed', edge.arrow.size=0.5)

Evaluation of Generalized Horizon Labels

An initial evaluation of our GHL assignment can be accomplished by plotting profile sketches with horizons colored by GHL. The result looks correct, but further investigation may be warranted.

# make a palette of colors, last color is for not-used class
cols <- c(grey(0.33), 'orange', 'orangered', 'chocolate', 'green', 'blue', 'yellow')
# assign a color to each generalized horizon label
hz.names <- levels(pedons$genhz)
pedons$genhz.soil_color <- cols[match(pedons$genhz, hz.names)]
# plot generalized horizons via color and add a legend
par(mar=c(4,0,0,0))
plot(pedons, name='hzname', print.id=FALSE, cex.names=0.75, axis.line.offset=-4, color='genhz.soil_color')
legend('bottomleft', legend=hz.names, pt.bg=c(cols), pch=22, bty='n', cex=1)

Horizon colors are based on assigned GHL.

A box and whisker plot of the depth-ranges for each of the generalized horizon labels helps to visualize the degree of overlap. Slicing the collection of profiles along 1-cm intervals generates a more precise figure.

# slice profile collection from 0-150 cm
s <- slice(pedons, 0:150 ~ genhz)
# convert horizon name back to factor, using original levels
s$genhz <- factor(s$genhz, levels = hz.names)
# plot depth-ranges of generalized horizon slices
bwplot(hzdept ~ genhz, data=horizons(s), 
       ylim=c(155, -5), ylab='Generalized Horizon Depth (cm)', 
       scales=list(y=list(tick.number=10)), asp=1, 
       panel=function(...) {
          panel.abline(h=seq(0, 140, by=10), v=1:length(hz.names),col=grey(0.8), lty=3)
            panel.bwplot(...)
          }
       )

Range in GHL horizon depth.

Advanced: Multivariate Soil Property Summary

The evaluation of generalized horizon labels typically requires a review of more information than field-described horizon labels and depth. For example, clay content, sand content, pH, total rock fragment volume, and horizon mid-points are soil properties that can be used to differentiate horizons-- as long as the data are populated. In this document, clay content, total rock fragment volume, and horizon mid-points are used. Multivariate comparisons are commonly based on the concept of pair-wise dissimilarity and subsequent reduction of the resulting distance matrix into a simpler representation. Non-metric multidimensional scaling (nMDS) is one method for reducing the distance matrix into a new set of coordinates in two-dimensional space. A related document explores this idea further.

# store the column names of our variables of interest
vars <- c('clay', 'mid', 'total_frags_pct')
# result is a list of several items
hz.eval <- evalGenHZ(pedons, 'genhz', vars)
# extract MDS coords
pedons$mds.1 <- hz.eval$horizons$mds.1
pedons$mds.2 <- hz.eval$horizons$mds.2
# extract silhouette widths and neighbor
pedons$sil.width <- hz.eval$horizons$sil.width
pedons$neighbor <- hz.eval$horizons$neighbor

In the following figure, generalized horizon labels are plotted at nMDS coordinates as colored circles, along with original horizon designations and pedon IDs. Ideally, groupings of GHL should form relatively homogeneous clusters in this figure; however, there will always be some overlap at the edges. Heterogeneous regions should be inspected in cases where the assigned GHL may not make sense. In this example, the original designation of "Bt3" for pedon ID 09CKS036 does not seem to fit into the "Bt3" generalized horizon. According to the soil properties used (clay content, total rock fragments, horizon mid-point), the horizon may better fit the "Bt2" generalized horizon. In addition, it appears that "Bw" and "BA" horizons can be included into the "A" generalized horizon. Decisions on issues such as this can only be made based on field experience or at least some level of expert knowledge about the soils in question. Once a decision has been made, additions to the GHL rules (e.g. adding "Bw" and "BA" to the "A" GHL) and possibly manual adjustment can be used to accomodate the changes.

# convert pedons to a data.frame
pedons.df <- as(pedons, 'data.frame')
# plot generalized horizon labels at MDS coordinates
mdsplot <- xyplot(mds.2 ~ mds.1, groups=genhz, data=pedons.df, 
                  xlab='', ylab='', aspect=1,
                  scales=list(draw=FALSE), 
                  auto.key=list(columns=length(levels(pedons.df$genhz))), 
                  par.settings=list(
                    superpose.symbol=list(pch=16, cex=3, alpha=0.5)
                  )
)

# annotate with original hzname and pedon ID
mdsplot +
  layer(panel.abline(h=0, v=0, col='grey', lty=3)) + 
  layer(panel.text(pedons.df$mds.1, pedons.df$mds.2, pedons.df$hzname, cex=0.85, font=2, pos=3)) +
  layer(panel.text(pedons.df$mds.1, pedons.df$mds.2, pedons.df$pedon_id, cex=0.55, font=1, pos=1))

Horizon designations and GHL as plotted along nMDS axes.

The silhouette width metric is a useful indicator of how consistently group labels partition observations in a dissimilarity matrix. Silhouette widths closer to 1 indicate excellent partitioning, while values closer to 0 indicate less effective partitioning. Silhouette widths less than 0 are often associated with inappropriate label assignment. A sketch of profiles with horizons colored by silhouette width can indicate possible horizons with inappropriate GHL assignment or a pedon that does not fit within the concept of Loafercreek. For example, many of the horizons associated with pedon ID 09CKS036 do not appear to fit within the collection of soil properties associated with generalized horizon labels "Bt1", "Bt2", and "Bt3". Keep in mind that this evaluation is only based on three soil properties-- expert judgement will be required for a final assignment of GHL.

# plot silhouette width metric
par(mar=c(0,0,3,0))
plot(pedons, name='hzname', label='pedon_id', cex.names=0.75, axis.line.offset=-4, color='sil.width')

Blue and green colors warrant further investigation.

The following table contains information on those horizons with silhouette widths less than 0. The "neighbor" column contains the next closest GHL (in terms of the soil properties used in the pair-wise dissimilarity calculation), which may be more appropriate to use.

# index those horizons with silhouette widths less than 0
check.idx <- which(pedons.df$sil.width < 0)
# sort this index based on min sil.width
check.idx.sorted <- check.idx[order(pedons.df$sil.width[check.idx])]
# list those pedons/horizons that may need some further investigation
pedons.df[check.idx.sorted, c('peiid', 'pedon_id', 'hzname', 'genhz', 'neighbor', 'sil.width', vars)]

	peiid	pedon_id	hzname	genhz	neighbor	sil.width	clay	mid	total_frags_pct
97	374232	09CKS036	Bt2	Bt2	Bt1	-0.5865998	21.0	23.5	5
98	374232	09CKS036	Bt3	Bt3	Bt1	-0.5277029	23.0	40.0	10
96	374232	09CKS036	Bt1	Bt1	A	-0.4688128	16.0	9.5	3
31	249585	07RJV004	Bt2	Bt2	Bt1	-0.2536782	26.0	27.0	5
12	115595	300J	Bt1	Bt1	Bt2	-0.2036515	29.0	39.5	5
44	268820	07SKC003	2Bt3	Bt3	Bt2	-0.1899319	38.0	40.5	10
19	115819	S2000CA007009	Bt3	Bt3	Bt2	-0.1808786	35.0	62.5	0
45	268820	07SKC003	2BCt	Bt3	Bt2	-0.1567631	28.0	56.0	23
6	64505	716Q	Bt3	Bt3	Bt2	-0.1541668	21.5	68.5	20
29	249585	07RJV004	A	A	Bt1	-0.0579239	20.0	4.0	2
38	252820	S2007CA109005	Bt2	Bt2	Bt3	-0.0426314	18.0	89.0	20
68	374201	09CKS006	Bt3	Bt3	Bt2	-0.0422248	26.0	40.0	48
91	374219	09CKS024	BCt	Bt3	Bt2	-0.0304170	34.0	89.5	0
37	252820	S2007CA109005	Bt1	Bt1	Bt2	-0.0234966	18.0	66.0	15
26	115827	S2000CA007012	Bt3	Bt3	Bt2	-0.0133317	30.0	68.5	20

The folowing table contains mean and standard deviations (values in parenthesis) of soil properties (clay content, total rock fragments, horizon mid-point) and silhouette widths summarized by GHL. Generalized horizons with the largest silhouette widths are the most internally consistent, while those with silhouette widths close to 0 are the least consistent.

hz.eval$stats

genhz	clay	mid	total_frags_pct	sil.width
A	14.19 (2.33)	3.43 (1.53)	5.6 (6.45)	0.54 (0.22)
Bt1	20.33 (3.44)	21.21 (14.93)	9.21 (6.68)	0.16 (0.25)
Bt2	25.97 (4.91)	40.14 (17.59)	20.36 (17.47)	0.03 (0.21)
Bt3	28.73 (5.34)	62.77 (17.03)	38.4 (24.41)	0.05 (0.21)
Cr	NaN (NA)	87.37 (22.26)	0 (0)	NaN (NA)
R	NaN (NA)	132.67 (16.85)	0 (0)	NaN (NA)
not-used	17.38 (4.21)	11.71 (12.35)	6.21 (8.68)	NaN (NA)

Plot profiles with only those horizons with silhouette widths less than 0 flagged.

# add a column containing a color (red) that flags horizons with silhouette width less than 0
pedons$sil.flag <- ifelse(pedons$sil.width < 0, 'red', 'white')
par(mar=c(0,0,3,0))
plot(pedons, name='hzname', label='pedon_id', cex.names=0.75, axis.line.offset=-4, color='sil.flag')

Horizons with red colors warrant further investigation.

Saving GHL to NASIS

GHL assignment as described thus far applies only to in-memory objects in the current R session. In order to use these GHL in further analysis or perform manual adjustments, the GHL need to be saved externally. If you are a NASIS user (working with data derived from NASIS) then the following code will create a text file that can be read by NASIS and stored in the dspcomplayerid field of the pedon horizon table. The "Update horizon group aggregations" calculation ("Calculations" -> "Pedon Horizon" -> "Update horizon group aggregations") expects a text file at the C:/data/horizon_agg.txt location on your system, containing phiid and generalized horizon labels.

Note that some people prefer to adjust GHL assignments in R while others prefer to make adjustments after loading the data into NASIS.

# clear-out any existing files
rules.file <- 'C:/data/horizon_agg.txt'
write.table(data.frame(), file=rules.file, row.names=FALSE, quote=FALSE, na='', col.names=FALSE, sep='|')
# extract horizon data
h <- horizons(pedons)
# strip-out 'not-used' genhz labels and retain horizon ID and genhz assignment
h <- h[which(h$genhz != 'not-used'), c('phiid', 'genhz')]
# append to NASIS import file
write.table(h, file=rules.file, row.names=FALSE, quote=FALSE, na='', col.names=FALSE, sep='|', append=TRUE)

Concluding Remarks

In the next document, we will work with pedon data from NASIS and use our GHL to generate estimates of "low-rv-high" style range in characteristics. An alternative approach to assignment of GHL can be performed with the "Update comp layer id by hzname (horizon group Aggregation)" calculation. This calculation, however, performs only basic pattern matching and likely requires considerable manual intervention.

Export NASIS pedon data to Google Earth

Fri, 06 Jan 2017 00:00:00 +0000

Viewing Pedon Data from NASIS in Google Earth

2017-01-06 Jay Skovlin

This document demonstrates how to use the soilDB package to export pedon locations from a local NASIS database and then use the plotKML package to generate KML files for viewing in Google Earth.

Setup Local NASIS DB

load selected set with pedons and sites of interest
select site-level attributes of interest to use as point labels
modify output directory accordingly

Install R Packages

With a recent version of R, it should be possible to get all of the packages that this tutorial depends on with the following commands. Note that you only need to do this once.

# run these commands in the R console
install.packages('soilDB', dep=TRUE) # stable version from CRAN + dependencies
install.packages('rgdal', dep=TRUE)
install.packages('sp', dep=TRUE)
install.packages('plotKML', dep=TRUE)

Load Pedons and Generate KML files

Copy and paste the following code into a new R script document. Step through the lines of code (e.g. run each line starting from the top) by moving the cursor to the top line and then press ctrl + enter repeatedly.

require(soilDB)
require(rgdal)
require(plotKML)

# check working directory path and set output location
getwd()
setwd('C:/temp/')

# load pedon data from selected set in NASIS
f <- fetchNASIS()

# some pedon data may be missing coordinates in NASIS
# filter to keep only those pedons with coordinates
good.idx <- which(!is.na(f$x_std) & !is.na(f$y_std))
f <- f[good.idx, ]

# initialize coordinates from WGS84 decimal degrees
coordinates(f) <- ~ x_std + y_std
# assign the appropriate projection string
proj4string(f) <- '+proj=longlat +datum=WGS84'

# extract only site-level data
s <- as(f, 'SpatialPointsDataFrame')

# graphically check by plotting them in R
par(mar=c(1,1,1,1))
plot(s)

# subset to columns from the site data that may useful as labels
s <- s[, c('site_id', 'pedon_id', 'obs_date', 'pedlabsampnum', 'taxonname', 'hillslope_pos', 'elev_field', 'slope_field', 'aspect_field', 'plantassocnm', 'bedrckdepth', 'bedrock_kind', 'pmkind', 'pmorigin')]

# generate a basic KML file of site locations with site_id specified as the placemark labels
# set KML file path
kml_file_path <- 'C:/temp/R_sites.kml'
kml_open(file.name=kml_file_path, folder.name='Sites', overwrite=TRUE)
kml_layer.SpatialPoints(s, title='Sites', colour='royalblue', labels=site_id, shape="http://maps.google.com/mapfiles/kml/pal2/icon18.png")
kml_close(kml_file_path)

# could also be scripted this way using the plotKML() which automatically wraps the above functions
# notice that in this version, the paste function is used to concatenate the site_id and taxonname for labels
plotKML(s, colour_scale=rep('royalblue', 2), points_names=paste(s$site_id, s$taxonname, sep=", "), folder.name="Sites", file.name="R_sites.kml")

Screenshot from Google Earth

Building timestamps into Pedon data KML files using site observation date information

The following example uses the site observation date/time field to animate a KML file using the timeslider option in Google Earth. This can be useful if you are interested in viewing the chronologic order in which pedons were sampled for an area.

# set the timespan begin and end parameters and use paste to concatenate site_id with taxonname fields as the labels
plotKML(s, colour_scale=rep('royalblue', 2), points_names=paste(s$site_id, s$taxonname, sep=", "), folder.name="Sites_date-time", file.name='R_sites_with_date-time.kml', TimeSpan.begin=format(s$obs_date, "%Y-%m-%d"), TimeSpan.end=format(s$obs_date, "%Y-%m-%d"))

Embedding a link to NASIS pedon description report into KML files

The script below builds a URL to a web-based NASIS pedon description report for each site and then embeds the link within each placemark balloon in the resulting KML file. This demonstrates some of the potential of what could be embedded within kml files. Notice that the other attributes in the subset of site-level data above also appear within the placemark balloon.

# build URL to NASIS Web Pedon Description Report and add this as a column to our site data
s$report_link <- paste(']]><![CDATA[<a href="https://nasis.sc.egov.usda.gov/NasisReportsWebSite/limsreport.aspx?report_name=Pedon+Description+html+(userpedid)&pedon_id=', s$pedon_id, '">Pedon Description Report</a>]]><![CDATA[', sep='')

kml_file_path <- 'C:/temp/R_sites_with_report_link.kml'
kml_open(file.name=kml_file_path, folder.name='Sites_with_URL', overwrite=TRUE)
kml_layer.SpatialPoints(s, title='Sites_with_URL', colour='royalblue', balloon=s$report_link, labels=site_id, shape="http://maps.google.com/mapfiles/kml/pal2/icon18.png")
kml_close(kml_file_path)