From noreply at r-forge.r-project.org Tue Jan 7 04:06:43 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 7 Jan 2014 04:06:43 +0100 (CET) Subject: [Xts-commits] r800 - pkg/xtsExtra/R Message-ID: <20140107030644.151CA186AD1@r-forge.r-project.org> Author: weylandt Date: 2014-01-07 04:06:39 +0100 (Tue, 07 Jan 2014) New Revision: 800 Added: pkg/xtsExtra/R/axTicksByTime.R Log: Temporary add axTicksByTime to xtsExtra to fix EZ's email of 2014-01-06 Added: pkg/xtsExtra/R/axTicksByTime.R =================================================================== --- pkg/xtsExtra/R/axTicksByTime.R (rev 0) +++ pkg/xtsExtra/R/axTicksByTime.R 2014-01-07 03:06:39 UTC (rev 800) @@ -0,0 +1,57 @@ +`axTicksByTime` <- +function (x, ticks.on = "auto", k = 1, labels = TRUE, format.labels = TRUE, + ends = TRUE, gt = 2, lt = 30) +{ + if (timeBased(x)) + x <- xts(rep(1, length(x)), x) + tick.opts <- c("years", "months", "weeks", "days", "hours", + "minutes", "seconds") + tick.k.opts <- c(10, 5, 2, 1, 6, 1, 1, 1, 4, 2, 1, 30, 15, + 1, 1) + if (ticks.on %in% tick.opts) { + cl <- ticks.on[1] + ck <- k + } + else { + tick.opts <- paste(rep(tick.opts, c(4, 2, 1, 1, 3, 3, + 1)), tick.k.opts) + is <- structure(rep(0, length(tick.opts)), .Names = tick.opts) + for (i in 1:length(tick.opts)) { + y <- strsplit(tick.opts[i], " ")[[1]] + ep <- endpoints(x, y[1], as.numeric(y[2])) + is[i] <- length(ep) - 1 + if (is[i] > lt) + break + } + nms <- rev(names(is)[which(is > gt & is < lt)])[1] + cl <- strsplit(nms, " ")[[1]][1] + ck <- as.numeric(strsplit(nms, " ")[[1]][2]) + } + if (is.null(cl)) { + ep <- NULL + } + else ep <- endpoints(x, cl, ck) + if (ends) + ep <- ep + c(rep(1, length(ep) - 1), 0) + if (labels) { + if (is.logical(format.labels) || is.character(format.labels)) { + unix <- ifelse(.Platform$OS.type == "unix", TRUE, + FALSE) + time.scale <- periodicity(x)$scale + fmt <- ifelse(unix, "%n%b%n%Y", "%b %Y") + if (time.scale == "quarterly") + fmt <- "%Y-Q%q" + if (time.scale == "weekly" | time.scale == "daily") + fmt <- ifelse(unix, "%b %d%n%Y", "%b %d %Y") + if (time.scale == "minute" | time.scale == "hourly") + fmt <- ifelse(unix, "%b %d%n%H:%M", "%b %d %H:%M") + if (time.scale == "seconds") + fmt <- ifelse(unix, "%b %d%n%H:%M:%S", "%b %d %H:%M:%S") + if (is.character(format.labels)) + fmt <- format.labels + names(ep) <- format(index(x)[ep], fmt) + } + else names(ep) <- as.character(index(x)[ep]) + } + ep +}