Nothing
#' Label date axis
#'
#' Labels date axes at sensible intervals in the time domain of weeks to decades.
#'
#' @return The dates that were labeled
#' @author Berry Boessenkool, \email{berry-b@@gmx.de}, Feb 2015, update labels and midyear Dec 2015
#' @seealso \code{\link{monthLabs}} for the numbercrunching itself, \code{\link{axis.Date}} with defaults that are less nice.
#' @keywords chron aplot dplot
#' @importFrom graphics axis par
#' @importFrom utils str
#' @export
#' @examples
#'
#' set.seed(007) # for reproducibility
#' Date1 <- as.Date("2013-09-25")+sort(sample(0:150, 30))
#' plot(Date1, cumsum(rnorm(30)), type="l", xaxt="n", ann=FALSE)
#' timeAxis(side=1)
#' timeAxis(1, npm=2, cex.axis=0.5, col.axis="red") # fix number of labels per month
#'
#' DateYM <- as.Date("2013-04-25")+0:500
#' plot(DateYM, cumsum(rnorm(501)), type="l", xaxt="n", ann=FALSE)
#'
#' monthAxis() # see more examples there - it largely replaces timeAxis!!!
#'
#' plot(Date1, cumsum(rnorm(30)), type="l", xaxt="n", ann=FALSE)
#' timeAxis(labels=FALSE, col.ticks=2)
#' timeAxis(1, format=" ") # equivalent to axis(labels=FALSE)
#' timeAxis(1)
#' d <- timeAxis(1, labels=letters[1:24], mgp=c(3,2.5,0))
#' d # d covers the full year, thus is longer than n=5
#'
#' Date2 <- as.Date("2011-07-13")+sort(sample(0:1400, 50))
#' plot(Date2, cumsum(rnorm(50)), type="l", xaxt="n", ann=FALSE)
#' timeAxis(npy=12, format=" ") # fix number of labels per year
#' timeAxis(tcl=-0.8, lwd.ticks=2, format="%Y/%m", mgp=c(3,1,0))
#' timeAxis(format="", mgp=c(3,2,0)) # International Date format YYYY-mm-dd
#'
#' plot(Date2, cumsum(rnorm(50)), type="l", xaxt="n", ann=FALSE)
#' timeAxis(midyear=TRUE)
#' abline(v=monthLabs(npm=1), col=8)
#'
#' Date3 <- as.Date("2011-07-13")+sort(sample(0:1200, 50))
#' plot(Date3, cumsum(rnorm(50)), type="l", xaxt="n", ann=FALSE)
#' timeAxis(1, n=4, font=2)
#' timeAxis(1, col.axis=3) # too many labels with default n=5
#'
#' monthAxis(side=3) # again: use monthAxis, it is usually nicer!
#'
#' # mid-year labels:
#' plot(Date3, cumsum(rnorm(50)), type="l", xaxt="n", ann=FALSE)
#' timeAxis(midyear=TRUE, midargs=list(tcl=-1.2))
#'
#' # mid-month labels:
#' plot(Date1, cumsum(rnorm(30)), type="l", xaxt="n", ann=FALSE)
#' timeAxis(midmonth=TRUE)
#'
#' # Time axis instead of date axis:
#' plot(as.POSIXct(Sys.time()+c(0,10)*24*3600), 1:2, xaxt="n")
#' timeAxis(n=3)
#' timeAxis()
#'
#' @param side Which \code{\link{axis}} are to be labeled? (can be several). DEFAULT: 1
#' @param timeAxis Logical indicating whether the axis is \code{\link{POSIXct}}, not date.
#' DEFAULT: NA, meaning axis value >1e5
#' @param origin Origin for\code{\link{as.Date}} and \code{\link{as.POSIXct}}. DEFAULT: "1970-01-01"
#' @param startyear Integer. starting year. DEFAULT: NULL = internally computed from \code{\link{par}("usr")}
#' @param stopyear Ditto for ending year. DEFAULT: NULL
#' @param n Approximate number of labels that should be printed (as in \code{\link{pretty}}). DEFAULT: 5
#' @param npm Number of labels per month, overrides n. DEFAULT: NULL = internally computed.
#' @param npy Number of labels per year, overrides npm and n. DEFAULT: NA
#' @param format Format of date, see details in \code{\link{strptime}}. DEFAULT: "\%d.\%m.\\n\%Y"
#' @param yformat Format of year if \code{ym=TRUE}.
#' Use \code{yformat=" "} (with space) to suppress year labeling.
#' DEFAULT: "\%Y"
#' @param labels labels. DEFAULT: format.Date(d, format)
#' @param ym Label months with first letter at the center of the month and year at center below.
#' Sets midyear and midmonth to TRUE. Uses \code{labels} and \code{format}
#' for the years, but ignores them for the months. DEFAULT: FALSE
#' @param mcex \code{cex.axis} for month labels if ym=TRUE. DEFAULT: 0.6
#' @param mmgp \code{mgp} for month labels if ym=TRUE. DEFAULT: 3,0,0
#' @param midyear Place labels in the middle of the year? if TRUE, format default is "\%Y". DEFAULT: FALSE
#' @param midmonth Place labels in the middle of the month? if TRUE, format default is "\%m\\n\%Y". DEFAULT: FALSE
#' @param midargs List of arguments passed to \code{\link{axis}} for the year-start lines without labels. DEFAULT: NULL
#' @param mgp MarGinPlacement, see \code{\link{par}}. The second value is for label distance to axis. DEFAULT: c(3,1.5,0)
#' @param cex.axis Character EXpansion (letter size). DEFAULT: 1
#' @param tick Draw tick lines? DEFAULT: TRUE
#' @param tcl Tick length (negative to go below axis) in text line height units like mgp[2]
#' Changed to -2.5 for year borders if ym=TRUE. DEFAULT: par("tcl")
#' @param las LabelAxisStyle for orientation of labels. DEFAULT: 1 (upright)
#' @param \dots Further arguments passed to \code{\link{axis}}, like \code{lwd, col.ticks, hadj, lty}, ...
#'
timeAxis <- function(
side=1,
timeAxis=NA,
origin="1970-01-01",
startyear=NULL,
stopyear=NULL,
n=5,
npm=NULL,
npy=NA,
format="%d.%m.\n%Y",
yformat="%Y",
labels=format.Date(d, format),
ym=FALSE,
mcex=0.6,
mmgp=c(3,0,0),
midyear=FALSE,
midmonth=FALSE,
midargs=NULL,
mgp=c(3,1.5,0),
cex.axis=1,
tick=TRUE,
tcl=par("tcl"),
las=1,
...)
{
if(ym)
{
midyear <- TRUE
midmonth <- TRUE
}
# internally needed functions to get Date range from graphic:
getDate <- function(s)
{
usr <- par("usr")[if(s%%2) 1:2 else 3:4]
if(is.na(timeAxis)) timeAxis <- usr[1]>1e5
if(timeAxis) usr <- as.POSIXct(usr, origin=origin)
as.Date(usr, origin=origin)
}
getYear <- function(x) as.numeric(format(x, "%Y"))
# possible combinations of npm, npy:
pos_npm <- c(31, 6, 3, 2, 1, NA, NA, NA, NA, NA)
pos_npy <- c(NA, NA, NA, NA, 12, 6, 4, 3, 2, 1)
pos_dif <- c( 1, 5, 10, 15, 30, 61, 91, 122, 183, 365) # number of days between labels
#
# loop around each side:
for(side_i in side)
{
# set from and to:
dateRange <- getDate(side_i)
startyear_i <- if(missing(startyear)) getYear(dateRange[1]) else startyear
stopyear_i <- if(missing(stopyear )) getYear(dateRange[2]) else stopyear
#
# determine npm and npy - desired number of days between labels:
wish_dif <- as.numeric(diff(dateRange)) / n
# closest value:
sel <- which.min(abs(pos_dif - wish_dif))
# select npm and npy from list
npm_i <- if(is.null(npm) ) pos_npm[sel] else npm
npy_i <- if(is.null(npm) & is.na(npy)) pos_npy[sel] else npy
# calculate dates
d <- monthLabs(startyear_i, stopyear_i, npm=npm_i, npy=npy_i)
# TimeAxis default (TRUE if values at axis are very large):
if(is.na(timeAxis)) timeAxis <- par("usr")[if(side_i%%2) 1 else 3] > 1e5
if(timeAxis) d <- as.POSIXct(d)
# Label axis
if(!midyear & ! midmonth) axis(side=side_i, at=d, labels=labels, las=las, mgp=mgp,
cex.axis=cex.axis, tcl=tcl, tick=tick, ...)
#
# midmonth option:
if(midmonth)
{
d <- monthLabs(startyear_i, stopyear_i, npm=2)
dbor <- d[seq(1,length(d), by=2)] # border dates (=month starting points)
dmid <- d[seq(2,length(d), by=2)] # mid-month points
if(timeAxis) {dbor <- as.POSIXct(dbor) ; dmid <- as.POSIXct(dmid) }
cex2 <- if(ym) mcex else cex.axis
mgp2 <- if(ym) mmgp else mgp
do.call(axis, owa(list(side=side_i, at=dbor, labels=FALSE, las=las, mgp=mgp2,
cex.axis=cex2, tcl=tcl, tick=tick), midargs))
if(missing(format)) format <- "%m\n%Y"
labels <- labels[seq(2,length(d), by=2)]
if(ym) labels <- substr(format(dmid, "%B"),1,1)
axis(side=side_i, at=dmid, labels=labels, las=las, mgp=mgp2,
cex.axis=cex2, tick=FALSE, ...)
}
# midyear option:
if(midyear)
{
d <- monthLabs(startyear_i, stopyear_i, npy=2)
dbor <- d[seq(1,length(d), by=2)] # border dates (=year starting points)
dmid <- d[seq(2,length(d), by=2)] # mid-year points
if(timeAxis) {dbor <- as.POSIXct(dbor) ; dmid <- as.POSIXct(dmid) }
if(ym) tcl <- -2.5
if(!ym & missing(mgp)) mgp <- c(3,0.5,0) # if(ym) mgp[2] <- mgp[2] + 1.5
do.call(axis, owa(list(side=side_i, at=dbor, labels=FALSE, las=las, mgp=mgp,
cex.axis=cex.axis, tcl=tcl, tick=tick), midargs))
if(missing(format)) format <- "%Y"
labels <- labels[seq(2,length(d), by=2)]
if(ym) labels <- format(dmid, yformat)
axis(side=side_i, at=dmid, labels=labels, las=las, mgp=mgp,
cex.axis=cex.axis, tick=FALSE, ...)
}
} # End of loop along graph sides
# output:
return(invisible(d))
} # End of function
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.