R/seasonalShift.R

In environmentalinformatics-marburg/GSODTools: R Functions to Select, Download, and Process GSOD Data

#' Plot seasonal shifts in GSOD temperature data
#' 
#' @description
#' This function aims at visualizing seasonal shifts in GSOD data aggregated on 
#' a monthly level. The seasonal shifts are derived from a harmonic trend model 
#' fitted to the desired start and end range of a measurement series.  
#' 
#' @param fls Character vector containing filepath(s) to the GSOD data set(s) to
#' visualize, or \code{list} containing \code{data.frame} objects
#' holding the data, or a single \code{data.frame} in case only one GSOD station
#' shall be visualized.
#' @param start Character. A vector containing the temporal range of the start
#' interval to fit a harmonic trend model to.
#' @param end Character. A vector containing the temporal range of the end
#' interval to fit a harmonic trend model to.
#' @param prm Character, default is "TEMP". Determines which parameter to 
#' visualize. 
#' @param stations Character. Name(s) of the station(s) corresponding to 
#' \code{fls} that will be displayed above each facet.
#' @param ... Additional arguments passed to \code{\link{element_text}}.
#' 
#' @return
#' An object of class \code{ggplot}.
#' 
#' @author
#' Florian Detsch
#' 
#' @examples
#' # visualize seasonal shifts in monthly averaged air temperature
#' cleansed_data = subset(
#'   eastafrica
#'   , Status == "cleansed"
#' )
#' 
#' cleansed_list = split(
#'   cleansed_data
#'   , f = cleansed_data$PlotId
#' )
#' 
#' seasonalShift(
#'   cleansed_list
#'   , start = c("1980-01-01", "1983-12-31")
#'   , end = c("1998-01-01", "2000-12-31")
#'   , stations = c("Kilimanjaro Intl. Airport", "Jomo Kenyatta Intl. Airport")
#'   , prm = "MAX"
#' )
#' 
#' @importFrom zoo as.yearmon
#' 
#' @export
seasonalShift <- function(fls, 
                          start = c("1973-01-01", "1977-12-31"),
                          end = c("2008-01-01", "2012-12-31"), 
                          prm = "TEMP",
                          stations,
                          #                           cols = NULL, 
                          ...) {
  
  year = month = value = variable = NULL
  
  # Import data
  tmp.all <- do.call(
    rbind
    , Map(
      \(i, j) {
        
        Reduce(
          function(...) merge(..., by = c(1, 2), sort = FALSE)
          , Map(
            \(k, l) {
              if (is.character(i)) {
                tmp <- utils::read.csv(i, stringsAsFactors = FALSE)
              } else {
                tmp <- i
              }
              tmp$year <- as.Date(substr(tmp$Datetime, 1, 10))
              tmp$yearmon <- zoo::as.yearmon(tmp$year)
              
              tmp.st <- subset(tmp, year >= as.Date(k[1]) & year <= as.Date(k[2]))
              tmp.st.agg <- stats::aggregate(tmp.st[, c("TEMP", "MAX", "MIN")], 
                                      by = list(tmp.st$yearmon), 
                                      FUN = function(...) mean(..., na.rm = TRUE))
              
              tmp.nd <- subset(tmp, year >= as.Date(l[1]) & year <= as.Date(l[2]))
              tmp.nd.agg <- stats::aggregate(tmp.nd[, c("TEMP", "MAX", "MIN")], 
                                      by = list(tmp.nd$yearmon), 
                                      FUN = function(...) mean(..., na.rm = TRUE))
              
              tst.st <- vectorHarmonics(tmp.st.agg[, prm], frq = 12, fun = mean, m = 2,
                                        st = c(as.numeric(substr(k[1], 1, 4)), 01), 
                                        nd = c(as.numeric(substr(k[2], 1, 4)), 12))
              tst.nd <- vectorHarmonics(tmp.nd.agg[, prm], frq = 12, fun = mean, m = 2,
                                        st = c(as.numeric(substr(l[1], 1, 4)), 01), 
                                        nd = c(as.numeric(substr(l[2], 1, 4)), 12))
              
              tmp.df <- data.frame("station" = j, 
                                   "month" = month.abb, 
                                   "st" = tst.st, 
                                   "nd" = tst.nd)
              
              index <- c(grep("^st$", names(tmp.df)), grep("^nd$", names(tmp.df)))
              names(tmp.df)[index] <- 
                c(paste(substr(k, 1, 4), collapse = "-"), 
                  paste(substr(l, 1, 4), collapse = "-"))
              
              return(tmp.df)
            }
            , k = list(start)
            , l = list(end)
          )
        )
      }
      , i = fls
      , j = stations
    )
  )
  
  # Reformat data
  tmp.all <- melt(tmp.all, id.vars = 1:2)
  # Reorder factor levels of 'month' column
  tmp.all$month <- factor(tmp.all$month, levels = month.abb)
  
  
  ## ggplot
  label.st <- paste(substr(start, 1, 4), collapse = "-")
  label.nd <- paste(substr(end, 1, 4), collapse = "-")
  
  ggplot(aes(x = month, y = value, colour = variable, group = variable), 
         data = tmp.all) + 
    geom_line(lwd = 1) + 
    facet_wrap(~ station, ncol = 1, scales = "free_y") + 
    scale_colour_manual("", values = c("cornflowerblue", "red2"), 
                        labels = c(label.st, label.nd)) + 
    labs(list(x = "\nMonth", y = "Temperature [\u00B0C]\n")) + 
    theme_bw() + 
    theme(text = element_text(...), 
          legend.key = element_rect(fill = "transparent"), 
          panel.grid.major = element_blank(), 
          panel.grid.minor = element_blank())
  
  #   }
  
}