Untitled diff
10 removals
91 lines
26 additions
106 lines
function (side, x, at, format, labels = TRUE, ...)
function (side, x, at, format, labels = TRUE, n = 5, ...) {
{
mat <- missing(at) || is.null(at)
mat <- missing(at) || is.null(at)
if (!mat)
if (!mat)
x <- as.POSIXct(at)
x <- as.POSIXct(at)
else x <- as.POSIXct(x)
else x <- as.POSIXct(x)
range <- par("usr")[if (side%%2)
range <- par("usr")[if (side%%2)
1L:2L
1L:2L
else 3L:4L]
else 3L:4L]
d <- range[2L] - range[1L]
d <- range[2L] - range[1L]
z <- c(range, x[is.finite(x)])
z <- c(range, x[is.finite(x)])
attr(z, "tzone") <- attr(x, "tzone")
attr(z, "tzone") <- attr(x, "tzone")
if (d < 1.1 * 60) {
if (d < 1.1 ) {
sc <- 0.001
if (missing(format))
format <- "%H:%M:%OS6"
}
else if (d < 1.1 * 30) {
sc <- 1
sc <- 1
if (missing(format))
if (missing(format))
format <- "%S"
format <- "%H:%M:%OS3"
}
else if (d < 1.1 * 60) {
sc <- 1
if (missing(format))
format <- "%H:%M:%S"
}
else if (d < 1.1 * 30 * 60) {
sc <- 60
if (missing(format))
format <- "%H:%M:%S"
}
}
else if (d < 1.1 * 60 * 60) {
else if (d < 1.1 * 60 * 60) {
sc <- 60
sc <- 60
if (missing(format))
if (missing(format))
format <- "%M:%S"
format <- "%H:%M"
}
}
else if (d < 1.1 * 60 * 60 * 24) {
else if (d < 1.3 * 60 * 60 * 24) {
sc <- 60 * 60
sc <- 60 * 60
if (missing(format))
if (missing(format))
format <- "%H:%M"
format <- "%H:%M"
}
}
else if (d < 2 * 60 * 60 * 24) {
else if (d < 2 * 60 * 60 * 24) {
sc <- 60 * 60
sc <- 60 * 60
if (missing(format))
if (missing(format))
format <- "%a %H:%M"
format <- "%a %H:%M"
}
}
else if (d < 7 * 60 * 60 * 24) {
else if (d < 7 * 60 * 60 * 24) {
sc <- 60 * 60 * 24
sc <- 60 * 60 * 24
if (missing(format))
if (missing(format))
format <- "%a"
format <- "%a"
}
}
else {
else {
sc <- 60 * 60 * 24
sc <- 60 * 60 * 24
}
}
if (d < 60 * 60 * 24 * 50) {
if (d < 60 * 60 * 24 * 50) {
zz <- pretty(z/sc)
zz <- pretty(z/sc,n=n)
z <- zz * sc
z <- zz * sc
z <- .POSIXct(z, attr(x, "tzone"))
z <- .POSIXct(z, attr(x, "tzone"))
if (sc == 60 * 60 * 24)
if (sc == 60 * 60 * 24)
z <- as.POSIXct(round(z, "days"))
z <- as.POSIXct(round(z, "days"))
if (missing(format))
if (missing(format))
format <- "%b %d"
format <- "%b %d"
}
}
else if (d < 1.1 * 60 * 60 * 24 * 365) {
else if (d < 1.1 * 60 * 60 * 24 * 365) {
z <- .POSIXct(z, attr(x, "tzone"))
z <- .POSIXct(z, attr(x, "tzone"))
zz <- as.POSIXlt(z)
zz <- as.POSIXlt(z)
zz$mday <- zz$wday <- zz$yday <- 1
zz$mday <- zz$wday <- zz$yday <- 1
zz$isdst <- -1
zz$isdst <- -1
zz$hour <- zz$min <- zz$sec <- 0
zz$hour <- zz$min <- zz$sec <- 0
zz$mon <- pretty(zz$mon)
zz$mon <- pretty(zz$mon,n=n)
m <- length(zz$mon)
m <- length(zz$mon)
M <- 2 * m
M <- 2 * m
m <- rep.int(zz$year[1L], m)
m <- rep.int(zz$year[1L], m)
zz$year <- c(m, m + 1)
zz$year <- c(m, m + 1)
zz <- lapply(zz, function(x) rep(x, length.out = M))
zz <- lapply(zz, function(x) rep(x, length.out = M))
zz <- .POSIXlt(zz, attr(x, "tzone"))
zz <- .POSIXlt(zz, attr(x, "tzone"))
z <- as.POSIXct(zz)
z <- as.POSIXct(zz)
if (missing(format))
if (missing(format))
format <- "%b"
format <- "%b"
}
}
else {
else {
z <- .POSIXct(z, attr(x, "tzone"))
z <- .POSIXct(z, attr(x, "tzone"))
zz <- as.POSIXlt(z)
zz <- as.POSIXlt(z)
zz$mday <- zz$wday <- zz$yday <- 1
zz$mday <- zz$wday <- zz$yday <- 1
zz$isdst <- -1
zz$isdst <- -1
zz$mon <- zz$hour <- zz$min <- zz$sec <- 0
zz$mon <- zz$hour <- zz$min <- zz$sec <- 0
zz$year <- pretty(zz$year)
zz$year <- pretty(zz$year,n=n)
M <- length(zz$year)
M <- length(zz$year)
zz <- lapply(zz, function(x) rep(x, length.out = M))
zz <- lapply(zz, function(x) rep(x, length.out = M))
z <- as.POSIXct(.POSIXlt(zz))
z <- as.POSIXct(.POSIXlt(zz))
if (missing(format))
if (missing(format))
format <- "%Y"
format <- "%Y"
}
}
if (!mat)
if (!mat)
z <- x[is.finite(x)]
z <- x[is.finite(x)]
keep <- z >= range[1L] & z <= range[2L]
keep <- z >= range[1L] & z <= range[2L]
z <- z[keep]
z <- z[keep]
if (!is.logical(labels))
if (!is.logical(labels))
labels <- labels[keep]
labels <- labels[keep]
else if (identical(labels, TRUE))
else if (identical(labels, TRUE))
labels <- format(z, format = format)
labels <- format(z, format = format)
else if (identical(labels, FALSE))
else if (identical(labels, FALSE))
labels <- rep("", length(z))
labels <- rep("", length(z))
axis(side, at = z, labels = labels, ...)
axis(side, at = z, labels = labels, ...)
}
}