R/fracyr_to_DoYBreaks.R

In ksmiff33/FluxSynthU: Suite of functions to analyze eddy covariance data

#' Convert a vector of null fractional years (from 0.0 to 1.0) to DoY (1 to 366)


#' @export
#' @title Return a vector of null fractional years and their corresponding DoY
#' @param interval numeric. Specify the number of days to use as x-axis breaks in time series of "null" fractional year.
#' @param xmin numeric, minimum value of fracyr_null (0 = the start of the previous year, 1 = start of current year)
#' @param xmax numeric, maximum value of fracyr_null (3 = the start of the current year plus 2)
#' @param padding logical. If TRUE drops the last axis tick immediately preceding DoY = 1 for the subsequent year (prevents overlapping tick labels). Defaults to TRUE.


# fracyr_to_DoYBreaks
# Converts a vector of null fractional year values (from 0.00 - 1.00) to DoY
fracyr_to_DoYBreaks <- function(interval = 30, xmin = 0, xmax = 3, padding = TRUE) {

  DoYBreaks <- c(1, seq(interval,366,interval))

  fracyr_seq_null <- round(lubridate::decimal_date(seq(lubridate::ymd("2000-01-01"),lubridate::ymd("2000-12-31"), by = interval))  %% 1, 3)

  DoYBreaks_df <- data.frame(cbind(fracyr_seq_null, DoYBreaks))

  if (padding) {
    # Drop any rows where the distance between the final element (DoY 360) is less than the interval size to the 1st element (DoY = 1)
    test_for_nice_scale <- (366 - tail(DoYBreaks_df$DoYBreaks,1)) < interval

    if (test_for_nice_scale) {
      DoYBreaks_df <- head(DoYBreaks_df,-1)
    }
  }


  fracyr_seq_3yrs <- c(DoYBreaks_df$fracyr_seq_null,(DoYBreaks_df$fracyr_seq_null+1),(DoYBreaks_df$fracyr_seq_null+2))

  xlim <- c(xmin, xmax)

  xrange <- xlim[2] - xlim[1]

  xmin <- xmin - 0.05*xrange
  xmax <- xmax + 0.05*xrange

  fracyrBreaks <- subset(fracyr_seq_3yrs, fracyr_seq_3yrs >= xmin & fracyr_seq_3yrs <= xmax)
  fracyrBreaks_df <- data.frame(fracyrBreaks, "fracyr_seq_null" = round(fracyrBreaks %% 1, 3))

  fracyrBreaks_final <- fracyrBreaks_df %>%
    left_join(DoYBreaks_df, "fracyr_seq_null") %>%
    mutate("lwr" = xmin, "upr" = xmax)

  return(fracyrBreaks_final)

}