Nothing
# Author: Robert J. Hijmans
# May 2011
# Version 1.0
# Licence GPL v3
.processGo <- function(d, dpfrom, dpto, vars, type='mean') {
stopifnot(type %in% c('mean')) #, 'min', 'max'))
if (nrow(d) > 0) {
# d$contr <- (pmin(depth, d$hzdepb_r) - pmin(depth, d$hzdept_r)) / depth
maxdp <- aggregate(d$hzdepb_r, list(d$cokey), max)
colnames(maxdp) <- c('cokey', 'depth')
d$contr <- pmax(pmin(dpto, d$hzdepb_r) - pmax(dpfrom, d$hzdept_r), 0) / (dpto - dpfrom)
d <- subset(d, d$contr > 0)
}
if (nrow(d) == 0) {
d <- data.frame((matrix(nrow=0, ncol=length(vars)+4)))
colnames(d) <- c('mukey', vars, 'pctSoil', 'depth', 'sample')
return(d)
}
d <- merge(d, maxdp, by='cokey')
vars <- c(vars, 'depth')
d[, vars] <- d[, vars] * d$contr
mysum <- function(x) {
x <- na.omit(x)
if (length(x) == 0) {
return(NA)
} else {
return( sum(x) )
}
}
# aggregate horizons by soil type
dd1 = aggregate(d[, vars], list(d$cokey), mysum)
if (ncol(dd1)==2) {
# single variable...
colnames(dd1)[2] = vars
}
colnames(dd1)[1] = 'cokey'
# adjust if the contributions do not add up to 100%
dd2 = aggregate(d$contr, list(d$cokey), mysum)
colnames(dd2) = c('cokey', 'contr')
stopifnot(all(dd1[,1] == dd2[,1]))
dd1[,vars] = dd1[,vars] / dd2[,2]
#dd3 = merge(dd1, dd2, 'cokey')
m = unique(d[,c('mukey', 'cokey', 'comppct_r')])
md = merge(m, dd1, by='cokey')
# only for means...
md[,vars] = md[,vars] * md$comppct_r
# aggregate soil type by map unit
ddd = aggregate(md[,vars], list(md$mukey), mysum)
if (ncol(ddd)==2) {
# single variable...
colnames(ddd)[2] = vars
}
colnames(ddd)[1] = 'mukey'
# assure that contributions add up to 100%
ddd2 = aggregate(md$comppct_r, list(md$mukey), mysum)
stopifnot( all(ddd[,1] == ddd2[,1]) ) # should not be necessary to check, it seems
ddd$pctSoil <- ddd2[,2]
ddd[,vars] <- ddd[,vars] / ddd$pctSoil
ddd$sample <- paste(dpfrom, '-', dpto, sep='')
ddd
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.