# 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
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.