# R/zoc.R In diveMove: Dive analysis and calibration

```## \$Id: zoc.R 600 2014-01-30 03:31:47Z sluque \$

".depthFilter" <- function(depth, k, probs, depth.bounds, na.rm)
{
## Value: A matrix with the filtered depths at each step, and corrected
## depth as last column, so it has dimensions length(depth) rows by
## length(k) + 1 columns
## --------------------------------------------------------------------
## Arguments: depth=depth vector; k=vector of window width integers to
## be applied sequentially (coerced to integer in runquantile());
## probs=vector of quantiles to extract at each step indicated by k (so
## must be as long as k); depth.bounds=minimum and maximum depth bounds
## where search should be restricted to; na.rm=do we remove NA from
## depth before filtering (recommended if there are no level shifts)?
## --------------------------------------------------------------------
## Purpose: Calculate running quantiles on sequential filters, starting
## with the original depth vector and correct depth as: original depth
## - the filtered/smoothed depth
## --------------------------------------------------------------------
## Author: Sebastian P. Luque
## --------------------------------------------------------------------
if (length(k) != length(probs))
stop("k and probs should have the same length")
if (length(depth.bounds) != 2 && !is.numeric(depth.bounds))
stop("depth.bounds must be a 2-element numeric vector")
d.na <- is.na(depth)
d.in.bounds <- depth > depth.bounds & depth < depth.bounds
if (na.rm) {
d.ok <- !d.na & d.in.bounds     # logical
} else d.ok <- which(d.in.bounds | is.na(depth))   # numeric
filters <- matrix(depth, ncol=1)
for (i in seq(length(k))) {
filters <- cbind(filters, depth)
dd <- filters[d.ok, i]
filters[d.ok, i + 1] <- caTools::runquantile(dd, k=k[i],
probs=probs[i])
## Linear interpolation for depths out of bounds
offbounds <- which(!d.in.bounds)
offbounds.fun <- approxfun(seq(length(depth))[d.in.bounds],
filters[d.in.bounds, i + 1], rule=2)
filters[offbounds, i + 1] <- offbounds.fun(offbounds)
## NA input should be NA output regardless of na.rm
filters[d.na, i + 1] <- NA
}
dnames <- c("depth",
paste("smooth", paste(k, probs, sep="_"), sep="."))
dimnames(filters)[] <- dnames
depth.adj <- depth - filters[, ncol(filters)]
cbind(filters[, -1], depth.adj)     # don't output original depth
}

".zoc" <- function(time, depth, method, control)
{
## Value: Vector with all corrected depths for time windows based on
## 'method'. Make depths < 0 equal 0
## --------------------------------------------------------------------
## Arguments: time=POSIXct; depth=uncalibrated depth; method=method to
## use for adjusting depth; control=named list of control parameters to
## be used for the chosen method (zoc.filter: k, probs, na.rm; offset:
## offset)
## --------------------------------------------------------------------
## Author: Sebastian Luque (thanks to Roland Fried for suggesting
## something like method="filter")
## --------------------------------------------------------------------
switch(method,
visual = {zoclims <- plotTDR(time, depth)
dev.off()
if (length(zoclims) == 0) {
message("No ZOC performed.")
} else {
## Subtract the ZOC from depths in each window
## If there's any overlap, the latest window prevails
zocdives <- lapply(zoclims, function(x) {
newdep <- depth[time >= x[] &
time < x[]] - x[]
indsnewdep <- which(time >= x[] &
time < x[])
cbind(indsnewdep, newdep)
})
message(paste("ZOC procedure completed\n",
length(zocdives),
" time windows have been corrected",
sep=""))
zocdives <- do.call("rbind", zocdives)
## Correct depths within chosen time windows
depth[zocdives[, 1]] <- zocdives[, 2]
}},
offset = {offset <- control\$offset
depth <- depth - offset},
filter = {k <- control\$k
probs <- control\$probs
depth.bounds <- control\$depth.bounds
na.rm <- control\$na.rm
depthmtx <- .depthFilter(depth, k, probs,
depth.bounds, na.rm)
depth <- depthmtx[, ncol(depthmtx)]})
## Turn all negative and NA depths into zeroes (we don't care now about
## dry time, since we've already done that, and we need surface and dry
## time to be zero from this point on).
depth[depth < 0 & !is.na(depth)] <- 0
depth
}
```

## Try the diveMove package in your browser

Any scripts or data that you put into this service are public.

diveMove documentation built on May 2, 2019, 4:47 p.m.