R/plot_distribution_helpers.R

In dendRoAnalyst: A Tool for Processing and Analyzing Dendrometer Data

# Internal shared calendar grouping: observations are never aggregated here.
.dm_plot_period <- function(time, temporal) {
  temporal <- match.arg(temporal, c('raw','subdaily','daily','weekly','monthly','yearly','event','cycle'))
  d <- as.Date(time)
  switch(temporal,
    daily = format(d,'%Y-%m-%d'),
    weekly = format(as.Date(cut(d,'week')),'%Y-%m-%d'),
    monthly = format(d,'%Y-%m'), yearly = format(d,'%Y'),
    rep('All events',length(d)))
}

.dm_cycle_distribution <- function(x, kind, stat, temporal, phase, Year, DOY) {
  dat <- x[[paste0(kind,'_cycle')]]
  if (!is.data.frame(dat) || !all(c('Start',stat) %in% names(dat)))
    stop('Cycle table must contain Start and the requested statistic: ',stat,call.=FALSE)
  if (!is.numeric(dat[[stat]])) stop('stat must name a numeric cycle measurement.',call.=FALSE)
  dat <- as.data.frame(dat)
  time <- as.POSIXct(dat$Start, tz='UTC')
  keep <- !is.na(time)
  if (!is.null(Year)) keep <- keep & as.integer(format(time,'%Y')) %in% Year
  if (!is.null(DOY)) {
    if (length(DOY)!=2 || any(!is.finite(DOY)) || any(DOY<1 | DOY>366)) stop('DOY must contain two values between 1 and 366.',call.=FALSE)
    doy <- as.integer(format(time,'%j'))
    keep <- keep & if(DOY[1]<=DOY[2]) doy>=DOY[1] & doy<=DOY[2] else doy>=DOY[1] | doy<=DOY[2]
  }
  labels <- if(kind=='ZG') c('TWD','GRO') else c('Shrinkage','Expansion','Increment')
  col <- intersect(c('Phases','Phase','phase'),names(dat))
  dat$.phase <- if(length(col)) as.character(dat[[col[1]]]) else 'All'
  for(i in seq_along(labels)) dat$.phase[dat$.phase==as.character(i)] <- labels[i]
  if (!identical(phase,'all')) {
    if(any(!phase %in% labels)) stop('Unknown phase selection.',call.=FALSE)
    keep <- keep & dat$.phase %in% phase
  }
  dat$.period <- .dm_plot_period(time,temporal)
  dat <- dat[keep & is.finite(dat[[stat]]),,drop=FALSE]
  if(!nrow(dat)) stop('No finite cycle measurements remain for this selection.',call.=FALSE)
  dat$.value <- dat[[stat]]
  dat$.period <- factor(dat$.period,levels=sort(unique(dat$.period)))
  p <- ggplot2::ggplot(dat,ggplot2::aes(x=.data$.period,y=.data$.value,fill=.data$.phase)) +
    ggplot2::geom_boxplot() +
    ggplot2::labs(x=if(temporal %in% c('raw','event','cycle','subdaily')) 'Events' else temporal,
      y=stat,fill='Phase',title=paste(kind,'event distributions'),
      subtitle='One observation per event; grouped by event start date') +
    ggplot2::theme_minimal() + ggplot2::theme(axis.text.x=ggplot2::element_text(angle=45,hjust=1))
  if('Tree' %in% names(dat) && length(unique(dat$Tree))>1) p <- p + ggplot2::facet_wrap(~Tree)
  p
}