R/bai.out.R

Defines functions bai.out

Documented in bai.out

bai.out <- function(rwl, diam = NULL) {

    if(!is.data.frame(rwl))
        stop("'rwl' must be a data.frame")
    if(!is.null(diam)) {
        if(ncol(rwl) != nrow(diam))
            stop("dimension problem: ", "'ncol(rw)' != 'nrow(diam)'")
        if(!all(diam[, 1] %in% names(rwl)))
            stop("series ids in 'diam' and 'rwl' do not match")
        diam.vec <- diam[, 2]
    }

    out <- rwl
    ## vector of years
    n.vec <- seq_len(nrow(rwl))
    for(i in seq_len(ncol(rwl))){
        ## series to work with
        dat <- rwl[[i]]
        ## strip out data from NA
        dat2 <- na.omit(dat)
        ## get diameter if not given
        if(is.null(diam)) d <- sum(dat2)*2
        else d <- diam.vec[i]
        ## get ring area
        r0 <- d/2 - c(0, cumsum(rev(dat2)))
        bai <- -pi*rev(diff(r0*r0))
        ## find NA / not NA locations
        na <- attributes(dat2)$na.action
        no.na <- n.vec[!n.vec %in% na]
        ## write result
        out[no.na, i] <- bai
    }
    ## return result
    out
}

Try the dplR package in your browser

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

dplR documentation built on May 24, 2018, 3 a.m.