# \donttest{
## 1. check out the influence depth-weight coef:
library(lattice)
z <- rep(1:100,4)
k <- rep(c(0,0.1,0.05,0.01), each=100)
w <- 100*exp(-k*z)
xyplot(z ~ w, groups=k, ylim=c(105,-5), xlim=c(-5,105), type='l',
       ylab='Depth', xlab='Weighting Factor', asp=1.5,
       auto.key=list(columns=4, lines=TRUE, points=FALSE, title="k", cex=0.8, size=3),
       panel=function(...) {
         panel.grid(h=-1,v=-1)
         panel.superpose(...)
       }
)
# more soil properties
data(sp2)
depths(sp2) <- id ~ top + bottom
d.1 <- profile_compare(sp2, vars=c('prop','field_ph','hue','value'),
                       max_d=100, k=0.01, plot.depth.matrix=TRUE)
# add some missing data:
sp2$prop[1:2] <- NA
d.2 <- profile_compare(sp2, vars=c('prop','field_ph','hue','value'),
                       max_d=100, k=0.01, plot.depth.matrix=TRUE)
# note small changes in D:
cor(d.1, d.2)
## 3. identify profiles within a collection that contain all NAs
set.seed(1010101)
s <- pbindlist(lapply(letters[1:10], random_profile, SPC=TRUE))
# replace first profile's data with NA
na.required <- nrow(s[1, ])
s$p1[1:na.required] <- NA
s$p2[1:na.required] <- NA
# attempt profile comparison: this won't work, throws an error
d <- profile_compare(s, vars=c('p1','p2'), max_d=100, k=0)
# check for soils that are missing all clay / total RF data
f.check.NA <- function(i) length(which(is.na(i$p1) | is.na(i$p2))) / nrow(i) == 1
missing.too.much.data.idx <- which(profileApply(s, f.check.NA))
# remove bad profiles and try again: works
s.no.na <- profile_compare(s[-missing.too.much.data.idx, ],
                           vars=c('p1','p2'),
                           max_d=100, k=0, plot.depth.matrix=TRUE)
## 4. better plotting of dendrograms with ape package:
if(require(ape) & require(cluster) & require(MASS)) {
  data(sp2)
  depths(sp2) <- id ~ top + bottom
  site(sp2) <- ~ surface
  d <- profile_compare(sp2, vars=c('prop','field_ph','hue','value'),
                         max_d=100, k=0)
  h <- diana(d)
  p <- as.phylo(as.hclust(h))
  plot(p, show.tip.label=FALSE)
  tiplabels(sp2$surface, col=cutree(h, 3), bg=NA, cex=0.75)
  ## 5. other uses of the dissimilarity matrix
  # Sammon Mapping: doesn't like '0' values in dissimilarity matrix
  d.sam <- sammon(d)
  # simple plot
  dev.off() ; dev.new()
  plot(d.sam$points, type = "n", xlim=range(d.sam$points[,1] * 1.5))
  text(d.sam$points, labels=row.names(as.data.frame(d.sam$points)),
       cex=0.75, col=cutree(h, 3))
}
## 6. try out the 'sample_interval' argument
# compute using sucessively larger sampling intervals
data(sp3)
d <- profile_compare(sp3, vars=c('clay','cec','ph'),
                     max_d=100, k=0.01)
d.2 <- profile_compare(sp3, vars=c('clay','cec','ph'),
                       max_d=100, k=0.01, sample_interval=2)
d.10 <- profile_compare(sp3, vars=c('clay','cec','ph'),
                        max_d=100, k=0.01, sample_interval=10)
d.20 <- profile_compare(sp3, vars=c('clay','cec','ph'),
                        max_d=100, k=0.01, sample_interval=20)
# check the results via hclust / dendrograms
oldpar <- par(mfcol=c(1,4), mar=c(2,1,2,2))
plot(as.dendrogram(hclust(d)), horiz=TRUE, main='Every Depth Slice')
plot(as.dendrogram(hclust(d.2)), horiz=TRUE, main='Every 2nd Depth Slice')
plot(as.dendrogram(hclust(d.10)), horiz=TRUE, main='Every 10th Depth Slice')
plot(as.dendrogram(hclust(d.20)), horiz=TRUE, main='Every 20th Depth Slice')
par(oldpar)
# }
Run the code above in your browser using DataLab