[R] Strange behavior with time-series x-axis
Felix Andrews
felix at nfrac.org
Fri Nov 2 04:23:04 CET 2007
Allen,
I can reproduce the problems you described, but I can't find where the
problem is (in axis.POSIXct). Anyway, here is an alternative I wrote a
while ago:
# for base graphics
timeAxis <- function(side, at=NULL, labels=TRUE, ..., tz="GMT") {
range <- par("usr")[if (side%%2) 1:2 else 3:4]
axisStuff <- timeAxisComponents(range, label=labels, tz=tz)
labels <- axisStuff$label
labels[labels == ""] <- NA
axis(side, at=axisStuff$at, labels=labels, ...)
}
# for grid graphics
grid.xaxis.POSIXt <- function(lim=convertX(unit(0:1,"npc"), "native",
valueOnly=T),
label=T, draw=T, name=NULL, ...)
{
axisStuff <- timeAxisComponents(lim, label=label)
if (label==F) axisStuff$label <- F
tmp <- xaxisGrob(at=axisStuff$at, label=axisStuff$label, name=name, ...)
if (label) tmp <- editGrob(tmp, gPath=gPath("labels"), check.overlap=F)
if (draw) grid.draw(tmp)
tmp
}
# lim should be POSIXct or numeric equivalent (i.e. secs since 1970)
timeAxisComponents <- function(lim, label=TRUE, tz="GMT") {
stopifnot(length(lim) == 2)
if (is.numeric(lim)) {
class(lim) <- c("POSIXt", "POSIXct")
attr(lim, "tzone") <- tz
}
timelim <- as.POSIXct(lim)
lim <- as.numeric(timelim)
startTime <- min(timelim)
# utility functions for making pretty times
truncMonth <- function(thisPOSIXt) {
zz <- as.POSIXlt(thisPOSIXt)
zz$mday <- 1
zz$hour <- zz$min <- zz$sec <- 0
zz$isdst <- -1
zz
}
truncYear <- function(thisPOSIXt) {
zz <- as.POSIXlt(thisPOSIXt)
zz$mday <- 1
zz$mon <- zz$hour <- zz$min <- zz$sec <- 0
zz$isdst <- -1
zz
}
truncDecade <- function(thisPOSIXt) {
zz <- as.POSIXlt(truncYear(thisPOSIXt))
zz$year <- (zz$year %/% 10) * 10
zz
}
trunc.century <- function(thisPOSIXt) {
zz <- as.POSIXlt(truncYear(thisPOSIXt))
zz$year <- (zz$year %/% 100) * 100
zz
}
# work out time sequence and formatting, depending on the time scale
# each of tickSpec and labelSpec defines a time sequence and formatting
tickSpec <- list(by="1 hour", format="%m-%d %H:%M",
from=trunc(startTime, units="hours"))
labelSpec <- tickSpec
if (diff(range(lim)) > 8 * 60*60) { # 8 hours
labelSpec$by <- "3 hours"
labelSpec$from <- trunc(startTime, units="days")
}
if (diff(range(lim)) > 24 * 60*60) { # 24 hours
tickSpec <- labelSpec
labelSpec$by <- "12 hours"
}
if (diff(range(lim)) > 2 * 24*60*60) { # 2 days
tickSpec <- labelSpec
labelSpec$by <- "1 DSTday"
labelSpec$format <- "%Y-%m-%d"
}
if (diff(range(lim)) > 3 * 24*60*60) { # 3 days
# only put ticks at day labels (no sub-ticks)
tickSpec <- labelSpec
}
if (diff(range(lim)) > 7 * 24*60*60) { # 7 days
tickSpec <- labelSpec
labelSpec$by <- "3 DSTdays"
# ignore up to 3 days of previous month to find start date
labelSpec$from <- truncMonth(startTime + 4*24*60*60)
}
if (diff(range(lim)) > 18 * 24*60*60) { # 18 days
labelSpec$by <- "7 DSTdays"
# ignore up to 7 days of previous month to find start date
labelSpec$from <- truncMonth(startTime + 7*24*60*60)
# leave ticks going by 1 day
}
if (diff(range(lim)) > 1.1 * 30*24*60*60) { # 1 month
labelSpec$by <- "1 month"
# leave ticks going by 1 day
}
if (diff(range(lim)) > 1.85 * 30*24*60*60) { # 2 months
labelSpec$format <- "%Y-%m"
# only put ticks at month labels (no sub-ticks)
tickSpec <- labelSpec
}
if (diff(range(lim)) > 6 * 30*24*60*60) { # 6 months
tickSpec <- labelSpec
labelSpec$by <- "3 months"
labelSpec$format <- "%Y-%b"
labelSpec$from <- truncYear(startTime)
}
if (diff(range(lim)) > 2 * 365.25*24*60*60) { # 2 years
tickSpec <- labelSpec
labelSpec$by <- "1 year"
labelSpec$format <- "%Y"
}
if (diff(range(lim)) > 3.5 * 365.25*24*60*60) { # 3.5 years
# only put ticks at year labels (no sub-ticks)
tickSpec <- labelSpec
}
if (diff(range(lim)) > 8 * 365.25*24*60*60) { # 8 years
tickSpec <- labelSpec
labelSpec$by <- "2 years"
labelSpec$from <- truncDecade(startTime)
}
if (diff(range(lim)) > 12 * 365.25*24*60*60) { # 12 years
labelSpec$by <- "5 years"
# leave ticks going by 1 year
}
if (diff(range(lim)) > 30 * 365.25*24*60*60) { # 30 years
tickSpec <- labelSpec
labelSpec$by <- "10 years"
}
if (diff(range(lim)) > 60 * 365.25*24*60*60) { # 60 years
# drop 5-year ticks
tickSpec <- labelSpec
}
if (diff(range(lim)) > 100 * 365.25*24*60*60) { # 100 years
labelSpec$by <- "20 years"
labelSpec$from <- trunc.century(startTime)
}
# make sequence of axis ticks
at <- seq(tickSpec$from, max(timelim), by=tickSpec$by)
at <- at[(min(timelim) <= at) & (at <= max(timelim))]
# blank labels
atLabels <- rep("", length(at))
if (label) {
labelAt <- seq(labelSpec$from, max(timelim), by=labelSpec$by)
labelIdx <- c(na.omit(match(as.numeric(labelAt), as.numeric(at))))
atLabels[labelIdx] <- format(at[labelIdx], labelSpec$format)
}
return(list(at=at, label=atLabels))
}
On 10/26/07, Allen McIntosh <mcintosh at research.telcordia.com> wrote:
> I recently called plot(x,y) where x was an array of POSIXct timestamps,
> and was pleasantly surprised that it produced a nice plot right out of
> the box:
>
> z <- as.POSIXct(c("2006-10-26 08:00:00 EDT","2007-10-25 12:00:00 EDT"))
> x <- seq(z[1],z[2],len=100)
> y <- 1:100
> plot(x,y,type="l")
>
> The X axis had nice labels, one tick mark every other month. (Plotting
> on a 1024x768 X11 display, Fedora Core 5, R version 2.5.1.)
>
> What I really wanted to do was a little more elaborate, involving
> multiple Y variables, so I did the following to draw the axes and frame
> the plot:
>
> plot(range(x),range(y),type="n")
>
> and suddenly the nice X axis labels were not so nice anymore. There
> were three tickmarks labeled "Nov", "Oct" and "Nov", and that's all.
>
> (range(x) strips the tzone attribute from x, but replacing range(x) with
> c(x[1],x[100]) doesn't change anything).
>
> If x covers a slightly larger span of time, e.g.
>
> z <- as.POSIXct(c("2006-10-1 08:00:00 EDT","2007-10-25 12:00:00 EDT"))
> x <- seq(z[1],z[2],len=100)
> plot(x,y,type="l")
>
> then the x axis labeling is also problematic, consisting of a single
> tick at "2007".
>
> Is there anything I can do about this, short of turning off automatic X
> labels and doing things myself?
>
> ______________________________________________
> R-help at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>
--
Felix Andrews / 安福立
PhD candidate
Integrated Catchment Assessment and Management Centre
The Fenner School of Environment and Society
The Australian National University (Building 48A), ACT 0200
Beijing Bag, Locked Bag 40, Kingston ACT 2604
http://www.neurofractal.org/felix/
3358 543D AAC6 22C2 D336 80D9 360B 72DD 3E4C F5D8
More information about the R-help
mailing list