# profileApply-methods: Apply a function to soil profiles within a... In aqp: Algorithms for Quantitative Pedology

## Description

Apply a function to soil profiles within a SoilProfileCollection object, each iteration has access to a SoilProfileCollection object.

## Usage

 ```1 2``` ```# method for SoilProfileCollection objects profileApply(object, FUN, simplify=TRUE, ...) ```

## Arguments

 `object` a SoilProfileCollection `FUN` a function to be applied to each profile within the collection `simplify` logical, should the result be simplified to a vector? see examples `...` further arguments passsed to FUN

## Value

When simplify is TRUE, a vector of length `nrow(object)` (horizon data) or of length `length(object)` (site data). When simplify is FALSE, a list is returned.

## Methods

`signature(object = "SoilProfileCollection")`

`slab`, `estimateSoilDepth`
 ``` 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149``` ```data(sp1) depths(sp1) <- id ~ top + bottom # estimate soil depth using horizon designations profileApply(sp1, estimateSoilDepth, name='name', top='top', bottom='bottom') # scale properties within each profile # scaled = (x - mean(x)) / sd(x) sp1\$d <- profileApply(sp1, FUN=function(x) round(scale(x\$prop), 2)) plot(sp1, name='d') # compute depth-wise differencing by profile # note that our function expects that the column 'prop' exists f <- function(x) { c(x\$prop[1], diff(x\$prop)) } sp1\$d <- profileApply(sp1, FUN=f) plot(sp1, name='d') # compute depth-wise cumulative sum by profile # note the use of an anonymous function sp1\$d <- profileApply(sp1, FUN=function(x) cumsum(x\$prop)) plot(sp1, name='d') # compute profile-means, and save to @site # there must be some data in @site for this to work site(sp1) <- ~ group sp1\$mean_prop <- profileApply(sp1, FUN=function(x) mean(x\$prop, na.rm=TRUE)) # re-plot using ranks defined by computed summaries (in @site) plot(sp1, plot.order=rank(sp1\$mean_prop)) ## iterate over profiles, subsetting horizon data # example data data(sp1) # promote to SoilProfileCollection depths(sp1) <- id ~ top + bottom site(sp1) <- ~ group # make some fake site data related to a depth of some importance sp1\$dep <- profileApply(sp1, function(i) {round(rnorm(n=1, mean=mean(i\$top)))}) # custom function for subsetting horizon data, by profile # keep horizons with lower boundary < site-level attribute 'dep' fun <- function(i) { # extract horizons h <- horizons(i) # make an expression to subset horizons exp <- paste('bottom < ', i\$dep, sep='') # subset horizons, and write-back into current SPC horizons(i) <- subset(h, subset=eval(parse(text=exp))) # return modified SPC return(i) } # list of modified SoilProfileCollection objects l <- profileApply(sp1, fun, simplify=FALSE) # re-combine list of SoilProfileCollection objects into a single SoilProfileCollection sp1.sub <- do.call(rbind, l) # graphically check par(mfrow=c(2,1), mar=c(0,0,1,0)) plot(sp1) points(1:length(sp1), sp1\$dep, col='red', pch=7) plot(sp1.sub) ## Not run: ## ## helper functions: these must be modified to suit your own data ## # compute the weighted-mean of some property within a given diagnostic horizon # note that this requires conditional eval of data that may contain NA # see ?slab for details on the syntax # note that function expects certain columns within 'x' f.diag.wt.prop <- function(x, d.hz, prop) { # extract diagnostic horizon data d <- diagnostic_hz(x) # subset to the requested diagnostic hz d <- d[d\$diag_kind == d.hz, ] # if missing return NA if(nrow(d) == 0) return(NA) # extract depths and check for missing sv <- c(d\$featdept, d\$featdepb) if(any(is.na(sv))) return(NA) # create formula from named property fm <- as.formula(paste('~', prop)) # return just the (weighted) mean, accessed from @horizons s <- slab(x, fm, slab.structure=sv, slab.fun=mean)\$value return(s) } # conditional eval of thickness of some diagnostic feature or horizon # will return a vector of length(x), you can save to @site f.diag.thickness <- function(x, d.hz) { # extract diagnostic horizon data d <- diagnostic_hz(x) # subset to the requested diagnostic hz d <- d[d\$diag_kind == d.hz, ] # if missing return NA if(nrow(d) == 0) return(NA) # compute thickness thick <- d\$featdepb - d\$featdept return(thick) } # conditional eval of property within particle size control section # makes assumptions about the SPC that is passed-in f.psc.prop <- function(x, prop) { # these are accessed from @site sv <- c(x\$psctopdepth, x\$pscbotdepth) # test for missing PCS data if(any(is.na(sv))) return(NA) # this should never happen... unless someone made a mistake # check to make sure that the lower PSC boundary is shallower than the depth if(sv[2] > max(x)) return(NA) # create formula from named property fm <- as.formula(paste('~', prop)) # return just the (weighted) mean, accessed from @horizons s <- slab(x, fm, slab.structure=sv, slab.fun=mean)\$value return(s) } # try with some sample data data(loafercreek, package='soilDB') profileApply(loafercreek, f.diag.wt.prop, d.hz='argillic horizon', prop='clay') profileApply(loafercreek, f.diag.thickness, d.hz='argillic horizon') profileApply(loafercreek, f.psc.prop, prop='clay') ## End(Not run) ```