[Xts-commits] r800 - pkg/xtsExtra/R

[noreply at 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
+}