#' Get the common portion of a range of dates.
#'
#' For a sequence of POSIXct or POSIXt date/times, return a string
#' summarizing the constant portion of the range; ie. that shared
#' among all dates. The main purpose of this is to provide additional
#' information for xyplot()s that don't have enough detail on the time
#' axis to let you know what period of time you're looking at. For
#' this reason, one extra component is included when dates cross a
#' unit boundary, but span less than a unit; e.g. if the date range
#' goes overnight, but isn't a full day in size.
#'
#' @param dates vector of POSIXct or POSIXt date/times
#'
#' @param formats character vector; formatting strings compatible with
#' \code{strftime} and \code{lubridate}; the n-th element is the
#' format string to use if the first date/time component which
#' varies among \code{dates} is \code{n}. The last element of
#' this vector is used if the range of dates agrees among more
#' leading components than formats. Defaults to: c("", "%Y",
#' "%Y %b", "%Y %b %d", "%Y %b %d, %I %p", "%Y %b %d, %I%M %p",
#' "%Y %b %d, %I:%M:%S %p") which might only make sense for
#' locales that use a 12-hour clock.
#'
#' @return character scalar; this is earliest element of \code{dates},
#' formatted with the \code{n}-th element of \code{formats}, where
#' $code{n} is the index of the first date/time component that
#' varies among \code{dates}; i.e.:
#'
#' \enumerate{
#' \item \code{n=1} if the year varies among \code{dates}
#' \item \code{n=2} if the year is constant but the month varies
#' \item \code{n=3} if the year and month are constant but the day varies
#' \item etc.
#' }
#' If \code{length(formats) < n}, the last element of \code{formats} is used.
#'
#' This function is intended for use in labelling time axes in plots
#' generated by \code{lattice::xyplot()} when the latter does not
#' display enough information to fully determine the displayed
#' date/time.
#'
#' @note It probably makes more sense to just add
#' \code{paste(format(range(..$ts)), collapse=" to ")} to the time
#' axis label...
#'
#' @author John Brzustowski \email{jbrzusto@@REMOVE_THIS_PART_fastmail.fm}
#'
#' @examples
#' library(lubridate)
#' dateStem(ymd("2013-05-01", "2014-06-15")) ## returns ""
#' dateStem(ymd("2014-05-01", "2014-06-15")) ## returns "2014"
#' dateStem(ymd("2014-05-01", "2014-05-10")) ## returns "2014 May"
#' dateStem(ymd_hms("2014-05-01 03:20:17", "2014-05-01 21:09:32")) ## returns "2014 May 1"
#' dateStem(ymd_hms("2014-05-01 03:20:17", "2014-05-01 03:09:32")) ## returns "2014 May 1, 03 AM"
#' dateStem(ymd_hms("2014-05-01 03:20:17", "2014-05-01 03:20:32")) ## returns "2014 May 1, 03:20 AM"
#' dateStem(ymd_hms("2014-05-01 03:20:17", "2014-05-01 03:20:17")) ## returns "2014 May 1, 03:20:17 AM"
dateStem = function(dates, formats=c("", "%Y", "%Y %b", "%Y %b %d", "%Y %b %d, %I %p", "%Y %b %d, %I:%M %p", "%Y %b %d, %I:%M:%S %p")) {
## beginning and ending dates
b = min(dates)
e = max(dates)
parts = as.POSIXlt(c(b, e))
## difference in date components
diffs = lapply(unclass(parts)[c("year", "mon", "mday", "hour", "min", "sec")], diff)
n = which(diffs != 0)[1]
if (is.na(n) || n > length(formats)) {
n = length(formats)
} else if (n < length(formats) & diffs[n] == 1) {
n = n + 1
}
## work around annoying behaviour of format(DATE, FMT), when FMT is ""
return(if (nchar(formats[n]) > 0) format(b, formats[n]) else "")
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.