R/timestamp.R

In btupper/obpgtools: obpgtools for Ocean Biology Processing Group

# for mangling timestamps

#' Convert year-day timestamps in various formats to other formats.
#'
#' @export
#' @param x the input date indicator - see \code{from}
#' @param from character indicating the input format
#' \itemize{
#'    \item Y1234D123 this is the default input format Yj
#'    \item POSIXct for POSIXct class
#'    \item matrix an nx2 numeric matrix of [year, day]
#'    \item Date for Date class
#'    \item pretty for character in Y-j format
#' }
#' @param to character indicating the desired output
#' \describe{
#'    \item{matrix}{returns an nx2 numeric matrix of [year, day]}
#'    \item{Date}{returns a vector of Date values, see \code{day} - default}
#'    \item{POSIXct}{returns a vector of POSIXct values, see \code{day}}
#'    \item{pretty}{returns a character vector of Y-j}
#'    \item{Y1234D123}{returns a yrday stamp in format YyDj}
#'    \item{year}{returns the year as numeric}
#'    \item{month}{return the month as numeric}
#'    \item{day}{return the day number as numeric}
#' }
#' @return converted yearday string to desired format
convert_yrday <- function(x, from = "Y1234D123", to = "Date"){

   from = tolower(from)
   to = tolower(to)
   if (from == to) return(x)
   
   if (from == "y1234d123" || from == "pretty"){
      if (typeof(x) != "character"){
         stop("input must be character")
      }
      if (from == "y1234d123"){
         nc <- nchar(x)
         if (!(all(nc == 9))){
            stop("input must have 9 characters per element ala Y1234D123")
         }
         Y <- substring(x, 2, 5)
         day <- substring(x, 7)
      } else {
         Y <- substring(x, 1, 4)
         day <- substring(x, 6)
      }
   } else if (from == "matrix"){
      Y <- sprintf("%0.4i", as.numeric(x[,1]))
      day <- sprintf("%0.3i", as.numeric(x[,2]))
   } else if (from == "posixct" || from == "date"){
      Y <- format(x, "%Y")
      day <- format(x, "%j")
   } else {
      stop(paste("input format not known:", from))
   }
   
   # the value returned by the switch is the value of the function
   switch(to,
      "matrix" = cbind(as.numeric(Y), as.numeric(day) ) ,
      "pretty" = sprintf("%0.4i-%0.3i", as.numeric(Y), as.numeric(day)),
      "posixct" = as.POSIXct(paste(Y, as.character(as.numeric(day))), format = "%Y %j", tz = "UTC"),
      "y1234d123" = sprintf("Y%0.4iD%0.3i", as.numeric(Y), as.numeric(day)),
      "year" = as.numeric(Y),
      "day" = as.numeric(day),
      as.Date(paste(Y, as.character(as.numeric(day))), format = "%Y %j"))
} # convert_yrday

#' Convert year-week timestamps in various formats to other formats.
#'
#' @export
#' @param x the input date indicator - see \code{from}
#' @param from character indicating the input format
#' \itemize{
#'    \item Y1234W12 this is the default input format
#'    \item POSIXct for POSIXct class
#'    \item matrix an nx2 numeric matrix of [year, week]
#'    \item Date for Date class
#'    \item pretty for character in Y-w format
#' }
#' @param to character indicating the desired output
#' \describe{
#'    \item{matrix}{returns an nx2 numeric matrix of [year, week]}
#'    \item{Date}{returns a vector of Date values, see \code{day}}
#'    \item{POSIXct}{returns a vector of POSIXct values, see \code{day}}
#'    \item{pretty}{returns a character vector of Y-w}
#'    \item{Y1234D123}{returns a yrday stamp in format YyWw}
#'    \item{year}{returns the year as numeric}
#'    \item{week}{return the week (1-46) as numeric}
#'    \item{day}{return the day number as numeric}
#' }
#' @return converted yearday string to desired format
convert_yrweek <- function(x, from = "Y1234W12", to = "POSIXct"){

   from = tolower(from)
   to = tolower(to)
   if (from == to) return(x)
   
   if (from == "y1234w12" || from == "pretty"){
      if (typeof(x) != "character"){
         stop("input must be character")
      }
      if (from == "y1234w12"){
         nc <- nchar(x)
         if (!(all(nc == 8))){
            stop("input must have 8 characters per element ala Y1234W12")
         }
         Y <- substring(x, 2, 5)
         week <- substring(x, 7)
      } else { '1234-12'
         Y <- substring(x, 1, 4)
         week <- substring(x, 6)
      }
   } else if (from == "matrix"){
      Y <- sprintf("%0.4i", as.numeric(x[,1]))
      week <- sprintf("%0.2i", as.numeric(x[,2]))
   } else if (from == "posixct" || from == "date"){
      Y <- format(x, "%Y")
      week <- sprintf("%0.2i", as.numeric(format(x, "%j")) %/% 8 + 1)
   } else {
      stop(paste("input format not known:", from))
   }
   d8 <- eight_days()
   j <- d8[as.numeric(week)]  # first day of the period
   # the value returned by the switch is the value of the function
   switch(to,
      "y1234w12" = sprintf("Y%0.4iW%0.2i", as.numeric(Y), as.numeric(week)),
      "matrix" = cbind(as.numeric(Y), as.numeric(week) ) ,
      "pretty" = sprintf("%0.4i-%0.2i", as.numeric(Y), as.numeric(week)),
      "posixct" = as.POSIXct(sprintf("%s %0.3i",Y,j), format = "%Y %j", tz = "UTC"),
      "y1234d123" = sprintf("Y%0.4iD%0.3i", as.numeric(Y), j),
      "year" = as.numeric(Y),
      "day" = j,
      'week' = as.numeric(week),
      as.Date(sprintf("%s %0.3i",Y,j), format = "%Y %j"))
} # convert_yrweek

#' Convert month-day timestamps in various formats to other formats.
#'
#' @export 
#' @param x the input date indicator - see \code{from}
#' @param from character indicating the input format
#'    \itemize{
#'       \item "Y1234M12" this is the default input format Y%YM%m
#'       \item "POSIXct" for POSIXct class
#'       \item "matrix" an nx2 numeric matrix of [year, mon, day]
#'       \item "Date" for Date class
#'       \item "pretty" for character in %Y-%m format
#'    }
#' @param to character indicating the desired output
#'    \describe{
#'       \item{matrix}{returns an nx3 numeric matrix of year, mon, day}
#'       \item{Date}{returns a vector of Date values, see day - default}
#'       \item{POSIXct}{returns a vector of POSIXct values, see day}
#'       \item{pretty}{returns a character vector of YYYY-mm}
#'       \item{Y1234M12}{returns a yrmon stamp}
#'       \item{year}{returns the year as numeric}
#'       \item{month}{return the month as numeric}
#'    }
#' @param day numeric, by default 1 but set this to the desired day when \code{to} is Date d
#' @return converted yearmonth string to desired
convert_yrmon <- function(x, from = "Y1234M12", to = "Date", day = 1){
   from <- tolower(from[1])
   to <- tolower(to[1])
   if (from == to) return(x)
   
   if (from == "y1234m12" || from == "pretty"){
      if (typeof(x) != "character"){
         stop("input must be character")
      }
      if (from == "y1234m12"){
         nc <- nchar(x)
         if (!(all(nc == 8))){
            stop("input must have 8 characters per element ala Y1234M12")
         }
         Y <- substring(x, 2, 5)
         M <- substring(x, 7)
      } else {
         Y <- substring(x, 1, 4)
         M <- substring(x, 6)
      }
   } else if (from == "matrix"){
      Y <- sprintf("%0.4i", as.numeric(x[,1]))
      M <- sprintf("%0.2i", as.numeric(x[,2]))
      if (ncol(x) == 3) day <- sprintf("%i", as.numeric(x[,3]))
   } else if (from == "posixct" || from == "date"){
      Y <- format(x, "%Y")
      M <- format(x, "%m")
      day <- format(x, "%d") 
   } else {
      stop(paste("input format not known:", from))
   }
   
   switch(to,
      "matrix" = cbind(as.numeric(Y), as.numeric(M), rep(as.numeric(day), length(Y)) ) ,
      "pretty" = sprintf("%0.4i-%0.2i", as.numeric(Y), as.numeric(M)),
      "posixct" = as.POSIXct(paste(Y, as.character(as.numeric(M)),
         as.character(day)), format = "%Y %m %d", tz = "UTC"),
      "y1234m12" = sprintf("Y%0.4iM%0.2i", as.numeric(Y), as.numeric(M)),
      "year" = as.numeric(Y),
      "month" = as.numeric(M),
      as.Date(paste(Y, as.character(as.numeric(M)), as.character(day)),format = "%Y %m %d")
      )
} # convert_yrmon

#' Convert a raster timestamp names to specified format.  The raster names 
#'  must be in the "Y1234M12" or "Y1234D123" format.
#'
#' @export
#' @param x the input raster with timestamp names or just a character vector
#' @param to the desired output format.  See \code{convert_yrmon} and 
#'        \code{convert_yrday} functions for details.
#' @param ... further arguments for \code{convert_yrmon} and \code{convert_yrday}
#' @return the raster names reformatted to the specified format
convert_timestamp <- function(x, to = "POSIXct", ...){
   if (inherits(x, 'BasicRaster')) {
      nm <- names(x)
   } else {
      nm <- x
   }
   if (all(grepl("Y[0-9]{4}M[0-9]{2}", nm)) ){
      r <- convert_yrmon(nm, to = to, ...)
   } else if (all(grepl("Y[0-9]{4}D[0-9]{3}", nm)) ){
      r <- convert_yrday(nm, to = to)
   } else if (all(grepl("Y[0-9]{4}W[0-9]{2}", nm)) ){
      r <- convert_yrweek(nm, to = to)
   } else {
      stop(paste("format is not known:", nm[1]))
   }
   return(r)
}

#' Convert POSIXct to 8-day time interval POSIXct or Y1234D123 character format
#' 
#' @export
#' @param x POSIXct timestamp
#' @param day8 numeric vector of eight daya intervals starts, see \code{eight_days}
#' @param to character specification for out put, choose "POSIXct" (the default) or
#'    "Y1234D123"
#' @return POSIXct timestamp mapped to 8-day intervals where day is 1, 9, 17, ...
POSIXct_to_eight <- function(x, day8 = eight_days(),
   to = c("POSIXct", "Y1234D123", "D123", "Y1234W12", "W12")[1] ){
   if (!inherits(x, "POSIXct")) stop("input must be POSIXct class")
   # we find the range of years to get an ordered vector of years
   # note that we don"t simply use unique as it won"t be ordered
   rY <- range(as.numeric(format(x, "%Y")))
   Y <- seq(from = rY[1], to = rY[2])
   # paste day8 to each year and convert to POSIXct
   d8 <- sprintf("%0.3i", day8)
   t8 <-lapply(Y, 
         function(x, d = NULL) {paste(x, d, "00:00:00")}, 
         d = d8 )   
   t8 <- do.call(c, t8)
   t8 <- as.POSIXct(t8, format = "%Y %j %H:%M:%S", tz = "UTC")
   
   # now, where does the original timestamp fall within the 8-day interval
   i8 <- findInterval(x, t8)
   # now use the indices as a look up table
   t8 <- t8[i8]
   
   switch(tolower(to),
      "y1234d123" = format(t8, "Y%YD%j"),
      "d123" = format(t8, "D%j"),
      "y1234w1" = paste0(format(t8, "Y%YW"), sprintf("%0.2i",i8)),
      "w12" = sprintf("%0.2i",i8),
      t8)
}


#' Retrieve the 8-day interval day-of-year numbers
#'
#' @export
#' @return an integer vector of the day-of-year on which the 8 day cycle falls.
eight_days <- function(){
   seq(from = 1, to = 365, by = 8)
} 

#' Convert [0,360] longitudes to [-180, 180]
#'
#' @export
#' @param x numeric vector, no check is done for being withing 0,360 range
#' @return numeric vector
to180 <- function(x) {
   ix <- x > 180
   x[ix] <- x[ix] - 360
   x
}

#' Convert [-180,180] longitudes to [0,360]
#'
#' @export
#' @param x numeric vector, no check is done for being within 0,360 range
#' @return numeric vector
to360 <- function(x) {
   ix <- x < 0
   x[ix] <- x[ix] + 360
   x
}