R/align_cambial.R

In cszang/garlic: Dendro utils

#' align all series according to cambial age
#'
#' similarly to dplR::rcs(), a pith-offset can be supplied. curves may contain 
#' missing values as NA
#' @title Align series to cambial age
#' @param x ein data.frame mit Jahrringbreiten
#' @param po ein data.frame mit pith offsets
#' @return ein data.frame mit Jahrringbreiten 
#' @export
align_cambial <- function(x, po = NULL) {

  ring_or_not <- apply(x, MARGIN = 1:2, FUN = function(x) {
    ifelse(is.na(x), 0, 1)
  })
  start_pos <- apply(ring_or_not, MARGIN = 2, FUN = function(x) {
    which(x == 1)[1]
  })
  end_pos <- apply(ring_or_not, MARGIN = 2, FUN = function(x) {
    tail(which(x == 1), 1)
  })

  lengths <- mapply(
    function(x, y) {length(x:y)},
    start_pos,
    end_pos)

  if (is.null(po)) {
    po <- rep(0, dim(x)[2])
  }

  out <- matrix(NA, nrow = max(lengths + po), ncol = dim(x)[2])

  for (i in 1:dim(x)[2]) {
    start_index <- 1 + po[i]
    end_index <- start_index + lengths[i] - 1
    out[(start_index:end_index),i] <- x[(start_pos[i]:end_pos[i]),i]
  }

  rownames(out) <- 1:dim(out)[1]
  out <- data.frame(out)
  colnames(out) <- colnames(x)
  out
  
}