chron/ 0000755 0001751 0000144 00000000000 14734745731 011420 5 ustar hornik users chron/README 0000644 0001751 0000144 00000005013 12210543001 012244 0 ustar hornik users This directory contains code and help for an R port of CHRON, an S-PLUS
package for working with chronological objects (times and dates).
The original was downloaded from
http://netlib.bell-labs.com/cm/ms/departments/sia/project/misc/chron.html
See the file `PORTING' for the changes made for the R version.
The original `README' is appended below.
*** Original README **************************************************
This directory contains S functions to work with chron objects. These
objects handle dates and times. For the time being issues relating to
time-zones, daylight savings time, etc. are being put aside.
NOTE: To use chron objects you need library(statistics) in S.
In S-PLUS you need library(chron, first = T)
For source and details, see
http://cm.bell-labs.com/ms/departments/sia/dj/chron.html
The following methods and functions are available for chron objects:
function description
---------- -----------------------------------------------------
chron createas a chron object; it takes either julian dates
or character dates. See help(chron).
dates creates a dates object (simply invokes chron)
times creates a times object (simply inoveks chron)
as.numeric returns a vector of julian dates + fraction of day (times)
as.character returns a character representation of dates/times
is.na
print print dates and times nicely
plot plot with time axis
hist histogram with time axis
identify identify points in scatterplot
lines, points add lines/points
axis.times add time axis to plot
cut make ordered factors from dates (e.g., by month, week)
seq generate a sequence of dates
min, max, numeric summaries
range, summary
sort, order
trunc, ceiling,
round, signif,
diff
[.times selects, e.g., dates[ dates > "02/20/92" ], or
lathe.date[ start.date > min(scan.date) ]
[<-.times replacement
c combines chrons
days, months, extact day, month, year, quarter number, etc.
years, quarters
weekdays,
hours, minutes,
seconds
is.holiday
is.weekend
month.day.year date conversion (modified from the S "blue" book)
julian,
day.of.week
UNDOCUMENTED FEATURES:
----------------------
1. Chron matrices can be created from chron objects by using dim()
(can't use matrix() nor array())
> dim(x) <- c(20,3)
> x[2,3] <- "03/28/90" # replaces a cell
2. The c() method takes anything that can be coerced to chrons:
y <- c(x, "03/21/92", 8123)
but a bug(?) in the S evaluator makes it necessary to
specify the chron object first, i.e., c("03/28/90", x) does not
dispath the c.dates() method.
chron/MD5 0000644 0001751 0000144 00000002654 14734745731 011737 0 ustar hornik users 1b2f335f480cd5599d41d3f0b3fa1a6d *ChangeLog
cbff52898a579f7d4fcd2c7aec8a5046 *DESCRIPTION
fe0a98033866c71fe88fff19a3490d11 *NAMESPACE
511477d4726a20de1217d4c1d04c2ba9 *PORTING
4450c7915f2c9ed3acfdc26e3449284f *R/chron.R
62730feb3ebc1f1ce3974e7785774daa *R/dates.R
43ef5c27a002daa914c8a64b4db3e8b5 *R/scale.R
de7e005592ea960d74be869309566639 *R/times.R
f72b672b6f247cf5182b4b3adb570b1c *R/utils.R
f402e63e9ffa0ab4b5b1daaace06515f *R/y2k.R
197aae00b4c1a6d10ae20e316278c109 *R/zzz.R
c21bddb925efb5bf2f60312ee5633817 *README
eb8e6e1933c473bfb701fa6fa5900962 *TODO
fb530644fa0e6bce4e323e8b05ee8ef3 *man/chron-internal.Rd
b72ec1625f60b3827114c8cf05d2eefe *man/chron.Rd
04c67aba25f5decc6da3b03b1b72d319 *man/cut.dates.Rd
dc0b24ea3c49ee187d15d4665830f1f5 *man/dates.Rd
1a9256fa7df2992c907e98ca63cf1db4 *man/day.of.week.Rd
0b8b3de1603f0ea048b86b415bc754ff *man/days.Rd
b0926cb5ec613e22bcc808094ccfc3b3 *man/format.chron.Rd
3e5a05f6159d3fc4e9d6ad85461ea2a8 *man/hours.Rd
63720c9e7b8630b97500f0d6152cd4ad *man/is.holiday.Rd
ca943161be619a9f943ed1b73cafeac0 *man/origin.Rd
e605e7af69e9d629d9866d17fdac94a0 *man/scale.Rd
13b82052ded7323ff5d562184a9b0ef0 *man/seq.dates.Rd
d6c49f63dc886eae91aa5fe3e625572f *man/trunc.times.Rd
26a923baa28b8d1f648d5de066eeec43 *man/yearmon.Rd
db9820dd2f6dd9114e0dd22be8914c2a *src/Rchron.h
a13a2f69e1ea21411debd3778e9592d7 *src/chron_strs.c
19489d0427b2a1dd5555d713470c8b31 *src/init.c
b088bc9d159d1b2bfa4dea777e4f125d *src/unpaste.c
chron/R/ 0000755 0001751 0000144 00000000000 14734514716 011616 5 ustar hornik users chron/R/y2k.R 0000644 0001751 0000144 00000000737 13716720142 012444 0 ustar hornik users "year.strict" <- function(...)
stop("you must expand 2-digit year abbreviations")
"year.expand" <-
function(y, cut.off = 69, century = c(1900, 2000), ...)
{
## cut.off specifies year for rounding up/down
if(!is.numeric(y))
stop("must be a numeric year specification")
i <- (!is.na(y) & (y >= 0) & (y <= 99))
if(any(i))
y[i] <- ifelse(y[i] < cut.off,
y[i] + century[2],
y[i] + century[1])
y
}
chron/R/dates.R 0000644 0001751 0000144 00000051055 14424156711 013040 0 ustar hornik users ##
## Need to improve consistency for preserving format and origin
## attributes ...
##
"dates"<-
function(x, ...)
{
fmt <- attr(x, "format")
## Why?
x <- chron(dates. = x, ...)
##
## This used to be floor.chron() ...
##
cl <- oldClass(x)
out <- floor(unclass(x))
class(out) <- cl[!as.logical(match(cl, "chron", 0))]
cl <- oldClass(x)
attr(out, "format") <- fmt
out
}
"Math.dates" <-
function(x, ...)
{
ok <- switch(.Generic,
trunc = ,
round = ,
signif = ,
ceiling = ,
floor = TRUE,
FALSE)
if(!ok)
stop(paste(.Generic, "not defined for dates objects"))
cl <- oldClass(x)
class(x) <- NULL
out <- NextMethod(.Generic)
class(out) <- cl
attr(out, "format") <- attr(x, "format")
out
}
"Ops.dates" <-
function(e1, e2)
{
ok <- switch(.Generic,
"+" = ,
"-" = ,
"<" = ,
">" = ,
"==" = ,
"!=" = ,
"<=" = ,
">=" = TRUE,
FALSE)
if(nargs() == 1) {
## unary operators (only + is valid)
if(.Generic == "+")
return(e1)
else
stop(paste("unary", .Generic, "not defined for chron objects"))
}
if(!ok)
stop(paste(.Generic, "not defined for chron objects"))
dates.flg <- nchar(.Method)
if(is.character(e1)) {
e1 <- chron(e1, format = attr(e2, "format"), origin. = origin(e2))
dates.flg[1] <- TRUE
}
if(is.character(e2)) {
e2 <- chron(e2, format = attr(e1, "format"), origin. = origin(e1))
dates.flg[2] <- TRUE
}
scalar <- !all(dates.flg) # scalar operand?
o1 <- origin(e1)
o2 <- origin(e2)
if(!scalar) {
if(.Generic == "+")
stop("chron objects may not be added together")
if(any(o1 != o2)) {
warning("different origin in dates arithmetic")
origin(e2) <- o2 <- o1
}
}
val <- NextMethod(.Generic)
boolean <- match(.Generic, c("==", "!=", ">", ">=", "<", "<="),
nomatch = 0)
if(boolean)
return(val) # make sure origin wasn't dropped
if(!inherits(val, "dates")) {
attr(val, "origin") <- if(dates.flg[1]) o1 else o2
class(val) <- unique(c(.Class, class(val)))
}
tms <- as.vector(val)
tmp <- tms - floor(tms)
## If a fractional scalar operand, then dates become chrons
if(scalar && length(tmp <- tmp[!is.na(tmp)]) && any(tmp != 0)) {
if(length(fmt.val <- attr(val, "format")) < 2)
attr(val, "format") <- c(fmt.val, "h:m:s")
class(val) <- c("chron", "dates", "times")
}
## dates - dates is days
if(!scalar && inherits(val, "dates")) {
if(length(fmt.val <- attr(val, "format")) < 2)
attr(val, "format") <- "h:m:s"
else attr(val, "format") <- rev(attr(val, "format"))[[1]]
attr(val, "origin") <- NULL
val <- times(val)
}
val
}
"Summary.dates" <-
function(x, ...)
{
ok <- switch(.Generic,
max = ,
min = ,
range = TRUE,
FALSE)
if(!ok)
stop(paste(.Generic,
"not defined for objects that inherit from dates"))
val <- NextMethod(.Generic)
attr(val, "origin") <- origin(x)
class(val) <- class(x)
val
}
"[<-.dates" <-
function(x, ..., value)
{
if(!as.logical(length(value)))
return(x) # as per p.104 in the blue book
if(!is.numeric(value) && !is.character(value) && !all(is.na(value)))
stop("replacement of/with chron objects must be with times objects")
ox <- origin(x)
fmt <- attr(x, "format")
if(!inherits(value, "dates"))
value <- chron(value, format = fmt, origin. = ox)
else if(any(ox != origin(value)))
origin(value) <- ox
cl <- oldClass(x)
class(x) <- class(value) <- NULL
x <- NextMethod(.Generic)
attr(x, "format") <- fmt
attr(x, "origin") <- ox
class(x) <- cl
x
}
"all.equal.dates" <-
function(..., tolerance = 1/(10 * 24 * 60 * 60))
NextMethod("all.equal", ..., tolerance = tolerance)
as.data.frame.dates <- as.data.frame.vector
"c.dates" <-
function(..., recursive = FALSE)
{
## output will have the format and origin corresponding to the
## argument with earliest origin
dots <- list(...)
is.dts <- unlist(lapply(dots, inherits, "dates"))
o <- matrix(unlist(lapply(dots, origin)), nrow = 3)
all.orig <- julian(o[1, ], o[2, ], o[3, ], origin. = c(0, 0, 0))
earliest <- min(all.orig)
mdy <- month.day.year(earliest, origin. = c(0, 0, 0))
orig <- c(mdy$month, mdy$day, mdy$year)
n <- length(dots)
fmt <- attr(dots[[(1:n)[is.dts][match(earliest, all.orig)]]], "format")
out <- vector("list", length = n)
for(i in 1:n) {
x <- dots[[i]]
## note that NA's don't need any further processing
if(!all(is.na(x))) {
if(is.dts[i]) {
if(any(origin(x) != orig))
origin(x) <- orig
}
else x <- chron(x, format = fmt, origin. = orig)
}
out[i] <- list(x)
}
out <- chron(unlist(out, use.names = FALSE),
origin. = orig, format = fmt)
out
}
"convert.dates" <-
function(dates. = NULL, format = "m/d/y", origin., length. = 0, ...)
{
## returns a julian vector given various types of input
if(is.null(dates.) || !length(dates.))
return(numeric(length = length.))
if(is.numeric(dates.))
return(dates.) # assume julian format
if(!is.character(dates.) && all(!is.na(dates.)))
stop(paste("object", deparse(substitute(dates.)),
"must be numeric or character"))
if(!is.character(format)) {
## format may be a function or fun name
FUN <- switch(mode(format),
name = get(as.character(format), mode = "function"),
"function" = format,
stop(paste("unrecognized date format",
as.character(format))))
return(FUN(dates., ...))
}
if(missing(origin.)
&& is.null(origin. <- getOption("chron.origin")))
origin. <- c(month = 1, day = 1, year = 1970)
## determine sep, order of month, day, year, etc.
fmt <- parse.format(format)
out <- if(nzchar(fmt$sep))
unpaste(dates., sep = fmt$sep, fnames = fmt$periods,
nfields = 3)
else
.str_to_ymd_list(dates., fmt)
if(fmt$abb)
mo <- as.numeric(out$m)
else mo <- match(tolower(substring(out$m, 1, 3)),
tolower(month.abb), nomatch = NA)
yy <- as.numeric(out$y)
dy <- as.numeric(out$d)
if(all(is.na(yy) | is.na(dy) | is.na(mo)))
if(any(!is.na(as.character(dates.))))
stop(paste("format", format, "may be incorrect"))
else
return(rep(NA, length(dates.)))
if(any(!is.na(yy)) && fmt$year.abb){
fun <- getOption("chron.year.expand")
fun <- switch(mode(fun),
"character" = get(fun, mode = "function"),
"name" = eval(fun),
"function" = fun,
stop(paste("cannot expand 2-digit year abbreviation",
"--you must specify \"chron.year.expand\"",
"through options()")))
yy <- fun(yy, ...)
}
non.na <- !is.na(mo) # all months between 1 and 12?
bad <- seq_along(mo)[non.na][mo[non.na] < 1 | mo[non.na] > 12]
if(n.bad <- length(bad)) {
if(n.bad > 10)
msg <- paste(n.bad, "months out of range set to NA")
else msg <- paste("month(s) out of range in positions",
paste(bad, collapse = ","), "set to NA")
warning(msg)
mo[bad] <- NA
non.na[bad] <- FALSE
}
non.na <- non.na & !is.na(dy)
mon.len <- month.length[mo[non.na]]
mon.len[leap.year(yy[non.na]) & mo[non.na] == 2] <- 29# leap years!
## all days in the proper range (including leap years)?
bad <- seq_along(dy)[non.na][dy[non.na] < 1 | dy[non.na] > mon.len]
if(n.bad <- length(bad)) {
if(n.bad > 10)
msg <- paste(n.bad, "days out of range set to NA")
else msg <- paste("days(s) out of range in positions",
paste(bad, collapse = ","), "set to NA")
warning(msg)
dy[bad] <- NA
non.na[bad] <- FALSE
}
return(julian(mo, dy, yy, origin. = origin.))
}
"cut.dates"<-
function(x, breaks, labels, start.on.monday = TRUE, ...)
{
if(!inherits(x, "dates"))
x <- chron(x)
n <- length(breaks) # dates breaks may be either
# numeric of character
if(n > 1) {
if(!inherits(breaks, "dates"))
breaks <- sort(chron(dates. = breaks))
## make sure x and breaks have same origin
org <- origin(x)
if(!is.null(o <- origin(breaks)) && any(o != org))
origin(breaks) <- org
breaks <- as.numeric(breaks)
if(missing(labels))
labels <- paste("Range", seq_along(breaks[-1]))
out <- cut.default(x, breaks = breaks, labels = labels)
out <- ordered(as.character(out), levels = levels(out),
labels = labels)
return(out)
}
if(n < 1) stop(paste(deparse(substitute(breaks)),
"must have length > 0"))
## breaks is either number or a string
if(is.numeric(breaks)) {
x <- as.numeric(x)
if(inherits(breaks, "times"))
breaks <- unclass(breaks)
out <- NextMethod("cut")
return(ordered(out))
}
## we have a character string
valid <- c("days", "weeks", "months", "years")
if(!as.logical(i <- pmatch(breaks[1], valid, 0)))
stop(paste("unrecognized time period (", breaks,
"), must be one of", paste(valid, collapse = ","),
collapse = " "))
by <- valid[i]
bump <- c(1, 7, 31, 365)[i] # force a full period for last obs.
from <- min(x)
orig <- origin(x)
mdy <- month.day.year(as.numeric(from), origin. = orig)
from <- switch(by,
days = from,
weeks = (from - day.of.week(mdy$month, mdy$day, mdy$year)
+ as.numeric(start.on.monday)),
months = chron(julian(mdy$month, 1, mdy$year, origin. = orig)),
years = chron(julian(1, 1, mdy$year, origin. = orig)))
if(from == min(x))
from <- from - .Machine$double.eps
breaks <- brk <- seq(from = from, to = max(x) + bump, by = by)
breaks <- as.numeric(breaks)
n <- length(breaks)
x <- as.numeric(x)
if(missing(labels)) {
labels <-
switch(by,
days = paste("day", seq_along(breaks[ - n] + 1)),
weeks = paste("week", seq_along(breaks[ - n] + 1)),
months = paste(as.character(months(brk[ - n] + 1)),
substring(as.character(years(brk[ - n] + 1)), 3, 4)),
years = substring(as.character(years(brk[ - n] + 1)), 3, 4))
}
out <- cut.default(x, breaks = breaks, labels = labels, right = FALSE)
ordered(as.character(out), levels = levels(out), labels = labels)
}
"format.dates" <-
function(x, format = "m/d/y", origin., simplify = FALSE, ...)
{
if(!all(is.na(x)) && !is.numeric(x))
stop(paste("couldn't extract julian dates from object",
deparse(substitute(x))))
if(is.null(default.orig <- getOption("chron.origin")))
default.orig <- c(month = 1, day = 1, year = 1970)
att <- attributes(x)
if(inherits(x, "dates")) {
if(missing(format))
format <- switch(mode(att$format),
character = ,
list = att$format[[1]],
name = ,
"function" = att$format,
NULL = format,
stop("invalid output format for dates"))
if(missing(origin.))
origin. <- att$origin
}
else if(missing(origin.))
origin. <- default.orig
if(!is.character(format)) {
## format may be a function
FUN <- switch(mode(format),
"function" = format,
name = eval(format),
stop(paste("unknown date format",
as.character(format))))
return(FUN(unclass(x), ...))
}
v <- month.day.year(floor(unclass(x)), origin. = origin.)
v$day <- substring(paste("0", v$day, sep = ""),
first = nchar(paste(v$day)))
if(simplify) {
drop.year <- length(unique(v$year[!is.na(v$year)])) <= 1
drop.mon <- (simplify > 1 && drop.year
&& length(unique(v$month)) <= 1)
if(!drop.mon && !drop.year)
drop.day <- TRUE
}
fmt <- parse.format(format[1])
perm <- fmt$periods
if(fmt$abb) {
v$month <- substring(paste("0", v$month, sep = ""),
first = nchar(paste(v$month)))
if(fmt$year.abb){
v$year <- v$year %% 100
v$year <- substring(paste("0", v$year, sep=""),
first = nchar(paste(v$year)))
}
}
else {
v$month <- if(fmt$mon.abb)
month.abb[v$month]
else
month.name[v$month]
}
sep <- fmt$sep
y <- character(length = length(x))
if(!simplify) {
## Perform partial matching by hand:
ind <- pmatch(perm, names(v))
y[] <- paste(v[[ind[1]]], v[[ind[2]]], v[[ind[3]]], sep = sep)
## "Simpler" than
## do.call("paste",
## c(v[pmatch(perm, names(v))], list(sep = sep))
## Could also use [[ with exact = FALSE, of course (R >= 2.6.0).
} else {
## simplify (drop year/month when all equal)
if(drop.mon) y[] <- v$day else if(drop.year) {
perm <- perm[perm != "y"] # drop years
ind <- pmatch(perm, names(v))
y[] <- paste(v[[ind[1]]], v[[ind[2]]], sep = sep)
}
else {
perm <- perm[perm != "d"] # drop days
ind <- pmatch(perm, names(v))
y[] <- paste(v[[ind[1]]], v[[ind[2]]], sep = sep)
}
}
y[is.na(x)] <- NA
y[x == Inf] <- "Inf"
y[x == - Inf] <- "-Inf"
att$format <- att$origin <- att$class <- NULL
attributes(y) <- att
y
}
print.dates <-
function(x, digits = NULL, quote = FALSE, prefix = "", simplify, ...)
{
if(!as.logical(length(x))) {
cat("dates(0)\n")
return(invisible(x))
}
if(missing(simplify) &&
is.null(simplify <- getOption("chron.simplify")))
simplify <- FALSE
print.default(format.dates(x, simplify = simplify), quote = quote)
invisible(x)
}
seq.dates <- function(from, to, by = "days", length., ...)
{
if(missing(from))
stop("argument \"from\" must be specified")
if(!inherits(from, "dates")) from <- chron(from[1])
## the output will have same format and origin as "from"
fmt <- attr(from, "format") # dates format
org <- origin(from) # dates origin
if(is.numeric(by)) {
cl <- class(from)
from <- as.numeric(from)
if(!missing(to)) {
if(!inherits(to, "dates")) to <- chron(to[1])
if(!is.null(to.org <- origin(to)) && any(to.org != org))
origin(to) <- org
to <- as.numeric(to)
}
x <- seq.int(from, to, by)
## preserve full chrons (i.e., don't round x)
if(all(cl != "chron"))
x <- round(x, 0)
return(chron(x, format = fmt, origin. = org))
}
if(!is.character(by) || length(by) != 1)
stop("\"by\" must be a number or string (days, weeks, months, or years)"
)
valid <- c("days", "weeks", "months", "years")
if(!as.logical(i <- pmatch(by, valid, 0)))
stop("\"by\" must be one of days, weeks, months, or years")
by <- valid[i] # coerced "to" to a dates object
if(missing(to)) {
if(missing(length.))
stop("must specify \"length\" when \"to\" is missing")
to <- from + (length. - 1) * c(1, 7, 31, 366)[i]
## possibly BUGGY!!!
}
else {
if(!missing(by) && !missing(length.))
stop("Too many arguments")
if(!inherits(to, "dates"))
to <- chron(to)
if(!missing(length.))
by <- if(from < to) as.numeric(to - from)/(length. - 1) else 0
}
## make sure "from" and "to" have the same origin
if(!is.null(to.org <- origin(to)) && any(to.org != org))
origin(to) <- org
if(from > to)
stop("\"from\" must be a date before \"to\"")
frm <- as.numeric(from)
t0 <- as.numeric(to)
frm.mdy <- month.day.year(frm, origin. = org)
## the idea is to generate all days between "form" and "to", subset
## out the dates we need, and finally chron them.
x <- seq.int(from = frm, to = t0)
if(by == "weeks") {
mdy <- month.day.year(x, origin. = org)
mdy.dow <- day.of.week(mdy$month, mdy$day, mdy$year)
frm.dow <- day.of.week(frm.mdy$month, frm.mdy$day, frm.mdy$year)
x <- x[mdy.dow == frm.dow]
}
else if(by == "months") {
## be careful when "from" is in the tail of the month!
nxt.day <- month.day.year(as.numeric(from + 1))$month
end.of.the.month <- frm.mdy$month != nxt.day
if(end.of.the.month) x <- c(x, x[length(x)] + 1)
mdy <- month.day.year(x, origin. = org)
dys <- mdy$day
if(frm.mdy$day <= 28)
x <- x[dys == frm.mdy$day]
else if(end.of.the.month)
x <- x[dys == 1] - 1
else {
## 29th or 30th of one of the 31-day months
x1 <- x[dys == frm.mdy$day] # all but Feb!
x2 <- x[mdy$month == 3 & dys == 1] - 1 # Feb
##
## Of course, leap years can have Feb 29, in which case we
## get common entries in x1 and x2 ... hence, unique().
x <- sort(unique(c(x1, x2)))
##
}
## simple case
if(!missing(length.)) x <- x[seq_len(length.)]
}
else if(by == "years") {
## be careful when "from" is Feb 29 of a leap year
mdy <- month.day.year(x, org)
if(leap.year(frm.mdy$year) && frm.mdy$day == 29)
x <- x[mdy$day == 1 & mdy$month == 3] - 1
else
x <- x[mdy$day == frm.mdy$day & mdy$month == frm.mdy$month]
if(!missing(length.)) x <- x[seq_len(length.)]
}
## The original code had just
## return(chron(x, format = fmt, origin = org))
## As pointed out by Sebastian Luque , this causes
## trouble in case we have 00:00:00 time components, as in this case
## chron() returns a dates-only object. Hence:
if(inherits(from, "chron")) # a full chron ...
chron(floor(x), x - floor(x), format = fmt, origin. = org)
else
return(chron(x, format = fmt, origin. = org))
}
unique.dates <-
function(x, incomparables = FALSE, ...)
x[!duplicated(x, incomparables, ...)]
xtfrm.dates <-
function(x)
as.numeric(x)
## chron 'dates' objects: only dates
## (no times here because caught by 'chron' method)
pretty.dates <-
function(x, ...)
{
if(!inherits(x, "times"))
x <- chron(x)
x <- as.Date(x)
ans <- pretty(x, ...)
structure(as.chron(ans), labels = attr(ans, "labels"))
}
as.Date.dates <-
function(x, ...)
{
if(inherits(x, "dates")) {
z <- attr(x, "origin")
x <- trunc(as.numeric(x))
if(length(z) == 3L && is.numeric(z))
x <- x + as.numeric(as.Date(paste(z[3L], z[1L], z[2L], sep="/")))
return(structure(x, class = "Date"))
} else stop(gettextf("'%s' is not a \"dates\" object",
deparse(substitute(x)) ))
}
as.POSIXct.dates <-
function(x, ...)
{
if(inherits(x, "dates")) {
z <- attr(x, "origin")
x <- as.numeric(x) * 86400
if(length(z) == 3L && is.numeric(z))
x <- x + as.numeric(ISOdate(z[3L], z[1L], z[2L], 0))
return(structure(x, class = c("POSIXct", "POSIXt")))
} else stop(gettextf("'%s' is not a \"dates\" object",
deparse(substitute(x)) ))
}
as.POSIXlt.dates <-
function(x, ...)
as.POSIXlt(as.POSIXct(x), ...)
as.dates <-
function(x, ...)
UseMethod("as.dates")
as.dates.default <- dates
chron/R/zzz.R 0000644 0001751 0000144 00000001327 13716720330 012567 0 ustar hornik users .onLoad <-
function(libname, pkgname) {
## The following controls the behavior when faced w. 2-digit years.
##
## To have 2-digit years actually refer to the first century
## options(chron.year.abb = FALSE)
##
## To flag all 2-digit years as error:
## options(chron.year.abb = TRUE,
## chron.year.expand = "year.strict")
##
## To allow 2-digit year abbreviations and guess(?) actual year:
## options(chron.year.abb = TRUE,
## chron.year.expand = "year.expand")
if(is.null(getOption("chron.year.abb")))
options(chron.year.abb = TRUE)
if(is.null(getOption("chron.year.expand")))
options(chron.year.expand = "year.expand")
}
chron/R/scale.R 0000644 0001751 0000144 00000001215 14734514716 013027 0 ustar hornik users chron_trans <-
function(format = "%Y-%m-%d", n = 5)
{
breaks. <- function(x)
chron(scales::pretty_breaks(n)(x))
format. <- function(x)
format(as.POSIXlt(x, tz = "GMT"), format = format)
scales::trans_new("chron",
transform = as.numeric, inverse = chron,
breaks = breaks., format = format.)
}
scale_x_chron <-
function(..., format = "%Y-%m-%d", n = 5)
{
ggplot2::scale_x_continuous(..., trans = chron_trans(format, n))
}
scale_y_chron <-
function(..., format = "%Y-%m-%d", n = 5)
{
ggplot2::scale_y_continuous(..., trans = chron_trans(format, n))
}
chron/R/utils.R 0000644 0001751 0000144 00000030702 13041162760 013067 0 ustar hornik users ".Holidays" <-
structure(.Data = c(8035, 8180, 8220, 8285, 8365, 8394),
format = structure(.Data = "m/d/y", .Names = "dates"),
origin = structure(.Data = c(1, 1, 1970),
.Names = c("month", "day", "year")),
class = c("dates", "times"),
.Names = c("New Year's Day", "Memorial Day",
"Independence Day", "Labor Day", "Thanksgiving",
"Christmas"))
"day.abb" <-
c("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat")
"day.name" <-
c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday",
"Saturday")
"month.length"<-
c(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
"days"<-
function(x)
{
if(!inherits(x, "dates"))
x <- as.chron(x)
d <- month.day.year(floor(as.numeric(x)), origin. = origin(x))$day
## use paste to avoid bug in ordered() as in beta release 8/92
d <- ordered(paste(d), paste(1:31))
d
}
"hours"<-
function(x)
{
if(!inherits(x, "times"))
x <- as.chron(x)
x <- as.numeric(x)
sec <- round(24 * 3600 * abs(x - floor(x)))
hh <- sec %/% 3600
hh
}
"minutes"<-
function(x)
{
if(!inherits(x, "times"))
x <- as.chron(x)
x <- as.numeric(x)
sec <- round(24 * 3600 * abs(x - floor(x)))
hh <- sec %/% 3600
mm <- (sec - hh * 3600) %/% 60
mm
}
"seconds"<-
function(x)
{
if(!inherits(x, "times"))
x <- as.chron(x)
x <- as.numeric(x)
sec <- round(24 * 3600 * abs(x - floor(x)))
hh <- sec %/% 3600
mm <- (sec - hh * 3600) %/% 60
ss <- trunc(sec - hh * 3600 - 60 * mm)
ss
}
"quarters.default"<-
function(x, abbreviate = TRUE)
{
if(!inherits(x, "dates"))
if((is.character(x) || is.numeric(x)))
x <- chron(x)
else return(NULL)
v <- month.day.year(floor(as.numeric(x)))$month
out <- (v - 1) %/% 3 + 1
lbl <- if(abbreviate)
c("1Q", "2Q", "3Q", "4Q")
else
c("I", "II", "III", "IV")
out <- lbl[out]
ordered(out, levels = lbl, labels = lbl)
}
"months.default"<-
function(x, abbreviate = TRUE)
{
if(!inherits(x, "dates"))
if((is.character(x) || is.numeric(x)))
x <- chron(x)
else return(NULL)
out <- month.day.year(as.numeric(x), origin. = origin(x))$month
lbl <- if(abbreviate) month.abb else month.name
out <- lbl[out]
ordered(out, levels = lbl, labels = lbl)
}
"weekdays.default" <-
function(x, abbreviate = TRUE)
{
if(!inherits(x, "dates"))
if((is.character(x) || is.numeric(x)))
x <- chron(x)
else stop("x must inherit from dates")
v <- month.day.year(as.numeric(x), origin. = origin(x))
out <- day.of.week(v$month, v$day, v$year) + 1
lbl <- if(abbreviate) day.abb else day.name
out <- lbl[out]
ordered(out, levels = lbl, labels = lbl)
}
"years" <-
function(x)
{
if(!inherits(x, "dates"))
x <- as.chron(x)
y <- month.day.year(as.numeric(x), origin. = origin(x))$year
y <- ordered(y)
y
}
"clock2frac" <-
function(str)
{
h <- as.numeric(substring(str, 1, 2))
m <- as.numeric(substring(str, 4, 5))
w <- substring(str, 6, 7)
if(any(h < 0, h > 12, m < 0, m > 59))
stop("misspecified time")
pm <- w == "pm" | w == "PM"
h[pm] <- h[pm] + 12
f <- (h * 3600 + m * 60)/(24 * 3600)
f
}
"count.events" <-
function(x, by)
table(cut(x, breaks = by))
"count.fields.str" <-
function(str, sep = "")
{
n <- length(str)
white.space <- missing(sep) || sep == ""
.C(C_cnt_flds_str,
strings = as.character(str),
nstrings = as.integer(n),
sep = as.character(sep),
white.space = as.integer(white.space),
counts = integer(n))$counts
}
"day.of.week" <-
function(month, day, year)
{
ix <- year + trunc((month - 14)/12)
jx <- (trunc((13 * (month + 10 - (month + 10) %/% 13 * 12) - 1)/5)
+ day + 77 + (5 * (ix - (ix %/% 100) * 100)) %/% 4
+ ix %/% 400 - (ix %/% 100) * 2)
jx %% 7
}
"format<-" <-
function(x, ..., value)
UseMethod("format<-")
"frac2clock" <-
function(f)
{
sec.per.day <- 24 * 3600
secs <- f * sec.per.day
h <- secs %/% 3600
m <- round((secs - h * 3600)/60, 0)
i <- h >= 13
h[i] <- h[i] - 12
pm <- rep("am", length(f))
i <- f > 0.5
pm[i] <- "pm"
m <- paste(m)
i <- nchar(m) == 1
m[i] <- paste("0", m[i], sep = "")
h <- paste(h)
i <- nchar(h) == 1
h[i] <- paste("0", h[i], sep = "")
paste(h, ":", m, pm, sep = "")
}
"is.holiday" <-
function(x, holidays)
{
if(!inherits(x, "dates")) x <- as.chron(x)
if(missing(holidays)) {
if(exists(".Holidays"))
holidays <- .Holidays
else holidays <- NULL
} else if (length(holidays) == 0) holidays <- NULL
if (is.null(holidays)) return(rep(FALSE, length(x)))
orig.x <- origin(x)
if(!is.null(orig.h <- origin(holidays)) && any(orig.x != orig.h))
origin(holidays) <- orig.x
out <- match(floor(x), floor(holidays), 0)
as.logical(out)
}
"is.weekend" <-
function(x)
{
if(!inherits(x, "dates")) x <- as.chron(x)
v <- month.day.year(as.numeric(x), origin. = origin(x))
out <- day.of.week(v$month, v$day, v$year) + 1
## recall out is between 1 (Sunday) and 7 (Saturday)
out == 1 | out == 7
}
"julian.default" <-
function(x, d, y, origin., ...)
{
only.origin <- all(missing(x), missing(d), missing(y))
if(only.origin) x <- d <- y <- NULL # return days since origin
if(missing(origin.) || is.null(origin.))
if(is.null(origin. <- getOption("chron.origin")))
origin. <- c(month = 1, day = 1, year = 1970)
nms <- names(d)
xdy <- cbind(x, d, y)
m <- c(origin.[1], xdy[, "x"]) # prepend month of new origin
d <- c(origin.[2], xdy[, "d"]) # prepend day of new origin
y <- c(origin.[3], xdy[, "y"]) # prepend year of new origin
##
## code from julian date in the S book (p.269)
##
y <- y + ifelse(m > 2, 0, -1)
m <- m + ifelse(m > 2, -3, 9)
c <- y %/% 100
ya <- y - 100 * c
out <- ((146097 * c) %/% 4 + (1461 * ya) %/% 4
+ (153 * m + 2) %/% 5 + d + 1721119)
## now subtract the new origin from all dates
if(!only.origin) {
if(all(origin. == 0))
out <- out[-1]
else
out <- out[-1] - out[1]
## orig according to S algorithm
}
names(out) <- nms
out
}
"julian2mine" <-
function(x)
{
v <- month.day.year(x)
d <- as.character(v$day)
i <- nchar(d) == 1
d[i] <- paste("0", d[i], sep = "")
paste(d, month.abb[v$month], v$year, sep = "")
}
"leap.year" <-
function(y)
{
if(inherits(y, "dates"))
y <- month.day.year(as.numeric(y), origin. = origin(y))$year
y %% 4 == 0 & (y %% 100 != 0 | y %% 400 == 0)
}
"mine2julian" <-
function(str)
{
d <- substring(str, 1, 2)
m <- substring(str, 3, 5)
y <- substring(str, 6, 9)
m <- match(m, month.abb, nomatch = NA)
julian(m, as.numeric(d), as.numeric(y))
}
"month.day.year" <-
function(jul, origin.)
{
if (!inherits(jul, "dates")) jul <- as.chron(jul)
if(missing(origin.) || is.null(origin.))
if(is.null(origin. <- getOption("chron.origin")))
origin. <- c(month = 1, day = 1, year = 1970)
if(all(origin. == 0)) shift <- 0 else shift <- julian(origin. = origin.)
## relative origin
## "absolute" origin
j <- as.integer(floor(jul)) + as.integer(shift)
j <- j - 1721119
y <- (4 * j - 1) %/% 146097
j <- 4 * j - 1 - 146097 * y
d <- j %/% 4
j <- (4 * d + 3) %/% 1461
d <- 4 * d + 3 - 1461 * j
d <- (d + 4) %/% 4
m <- (5 * d - 3) %/% 153
d <- 5 * d - 3 - 153 * m
d <- (d + 5) %/% 5
y <- 100 * y + j
y <- y + ifelse(m < 10, 0, 1)
m <- m + ifelse(m < 10, 3, -9)
list(month = m, day = d, year = y)
}
"my.axis" <-
function(x, simplify = TRUE, ...)
{
## put date labels in one line plus time lables on second line
px <- pretty(x)
xx <- chron(px, format = attr(x, "format"), origin. = origin(x))
lbls <- format(xx, enclose = c("", ""), sep = "\n", simplify = simplify)
axis(1, at = px, labels = lbls, ...)
invisible(list(at = px, labels = lbls))
}
"origin" <-
function(x)
attr(x, "origin")
"origin<-" <-
function(x, value)
{
if (length(value) != 3 || any(is.na(value)))
stop("origin must be a month, day, year vector")
if (value[1] < 1 || value[1] > 12)
stop("month out of range in origin")
n <- month.length[value[1]] +
as.numeric(value[1] == 2 && leap.year(value[3]))
if (value[2] < 1 || value[2] > n)
stop("day out of range in origin")
cl <- class(x)
class(x) <- NULL
jval <- julian(value[1], value[2], value[3], origin. = c(0, 0, 0))
## adjust days for new origin (new.x + new.o == old.x + old.o)
if (!is.null(ox <- attr(x, "origin")))
x <- x - jval + julian(ox[1], ox[2], ox[3], origin. = c(0, 0, 0))
new.origin <- unlist(month.day.year(jval, origin. = c(0, 0, 0)))
attr(x, "origin") <-
structure(new.origin, names = c("month", "day", "year"))
class(x) <- cl
x
}
"parse.format" <-
function(format, year.abb = getOption("chron.year.abb"), ...)
{
## determine order of month, day, year or hour, min, secs
abb <- TRUE # short notation?
mon.abb <- FALSE # should month names be abbreviated?
if(is.null(year.abb))
year.abb <- TRUE
if((nf <- nchar(format)) == 5) {
## abbreviated dates/times
sep <- substring(format, 2, 2)
fmt <- substring(format, first = c(1, 3, 5), last = c(1, 3, 5))
}
else if(nf == 3) {
sep <- "" # no sep
fmt <- substring(format, first = 1:3, last = 1:3)
}
else {
## full format (month names)
abb <- FALSE
sep <- gsub("^[[:alpha:]]+([^[:alpha:]]).*", "\\1", format)
if(sep == format)
stop(paste("unrecognized format", format))
fmt <- unlist(unpaste(format, sep = sep))
mon.abb <- if(any(fmt == "month")) FALSE else TRUE
}
periods <- substring(tolower(fmt), 1, 1) # m, d, & y in right order
return(list(abb = abb, sep = sep, periods = periods,
mon.abb = mon.abb, year.abb = year.abb))
}
"unpaste" <-
function(str, sep = "/", fnames = NULL, nfields = NULL,
first = c(1, 3, 5), width = 2)
{
## split str into fields separated by sep or by fiels specified by
## start positions and field widths; output a list
str <- as.character(str)
nas <- is.na(str) | str == ""
if(sep != "") {
if(is.null(nfields)) {
## use a simple heuristic
nf <- count.fields.str(str[!nas], sep = sep)
cnt <- table(nf)
nfields <- sort(unique(nf))[cnt == max(cnt)]
}
str[nas] <- paste(rep(NA, nfields), collapse = sep)
nf <- count.fields.str(str, sep = sep)
bad <- seq_along(str)[nf != nfields]
if(n.bad <- length(bad)) {
if(n.bad > 10)
msg <- paste(n.bad,
"entries set to NA",
"due to wrong number of fields")
else msg <- paste(
"wrong number of fields in entry(ies)",
paste(bad, collapse = ", "))
warning(msg)
nas[bad] <- TRUE
str[nas] <- paste(rep(NA, nfields), collapse = sep)
}
n <- length(str)
white.space <- FALSE
out <- .Call(C_unpaste,
as.character(str),
as.character(sep),
as.logical(white.space),
as.integer(nfields))
for(i in seq_along(out))
out[[i]][nas] <- as.character(NA)
}
else {
last <- first + width - 1
out <- vector("list", length = length(first))
for(i in seq_along(first)) {
out[[i]] <- substring(str, first[i], last[i])
out[[i]][nas] <- as.character(NA)
}
}
names(out) <- fnames
return(out)
}
.str_to_ymd_list <-
function(str, fmt)
{
str <- as.character(str)
nas <- is.na(str) | str == ""
periods <- fmt$periods
widths <- cbind(y = nchar(str) - 4, m = 2, d = 2)
last <- apply(widths[, fmt$periods, drop = FALSE], 1, cumsum)
first <- rbind(0, last[-3, , drop = FALSE]) + 1
out <- vector("list", length = 3)
for(i in seq_along(periods)) {
out[[i]] <- substring(str, first[i, ], last[i, ])
out[[i]][nas] <- as.character(NA)
}
names(out) <- periods
out
}
chron/R/chron.R 0000644 0001751 0000144 00000030020 14317064224 013034 0 ustar hornik users "chron" <-
function(dates. = NULL, times. = NULL,
format = c(dates = "m/d/y", times = "h:m:s"),
out.format, origin.)
{
if(is.null(format))
format <- c(dates = "m/d/y", times = "h:m:s")
if(missing(out.format)){
if(is.character(format))
out.format <- format
else
stop('must specify the "out.format" argument')
}
given <- c(dates = !missing(dates.), times = !missing(times.))
if(is.null(default.origin <- getOption("chron.origin")))
default.origin <- c(month = 1, day = 1, year = 1970)
if(all(!given))
## dates and times missing
return(structure(numeric(0),
format = format, origin = default.origin,
class = c("chron", "dates", "times")))
if(inherits(dates., "dates")) {
if(missing(origin.))
origin. <- origin(dates.)
else origin(dates.) <- origin.
}
else if(missing(origin.))
origin. <- default.origin
if(given["dates"] && !given["times"]) {
## presumably only dates
if(missing(format) && inherits(dates., "dates"))
format <- attr(dates., "format")
fmt <- switch(mode(format),
character = ,
list = format[[1]],
name = ,
"function" = format,
NULL = c(dates = "m/d/y"),
stop("unrecognized format"))
dts <- convert.dates(dates., format = fmt, origin. = origin.)
tms <- dts - floor(dts)
## if dates include fractions of days create a full chron
if(!all(is.na(tms)) && any(tms[!is.na(tms)] != 0))
return(chron(dates. = floor(dts), times. = tms, format
= format, out.format = out.format, origin. =
origin.))
ofmt <- switch(mode(out.format),
character = ,
list = out.format[[1]],
name = ,
"function" = out.format,
NULL = c(dates = "m/d/y"),
stop("invalid output format"))
attr(dts, "format") <- ofmt
attr(dts, "origin") <- origin.
class(dts) <- c("dates", "times")
names(dts) <- names(dates.)
return(dts)
}
if(given["times"] && !given["dates"]) {
## only times
if(missing(format) && inherits(times., "times")) {
format <- attr(times., "format")
if(!is.name(format))
format <- rev(format)[[1]]
}
fmt <- switch(mode(format),
character = ,
list = rev(format)[[1]],
name = ,
"function" = format,
NULL = c(times = "h:m:s"),
stop("invalid times input format"))
tms <- convert.times(times., fmt)
ofmt <- switch(mode(out.format),
character = ,
list = rev(out.format)[[1]],
name = ,
"function" = out.format,
NULL = c(dates = "m/d/y"),
stop("invalid times output format"))
attr(tms, "format") <- ofmt
class(tms) <- "times"
names(tms) <- names(times.)
return(tms)
}
## both dates and times
if(length(times.) != length(dates.)) {
if(length(times.) == 1)
times. <- rep.int(times., length(dates.))
else if(length(dates.) == 1)
dates. <- rep.int(dates., length(times.))
else
stop(paste(deparse(substitute(dates.)), "and",
deparse(substitute(times.)), "must have equal lengths"))
}
if(missing(format)) {
if(is.null(fmt.d <- attr(dates., "format")))
fmt.d <- format[1]
if(is.null(fmt.t <- attr(times., "format")))
fmt.t <- format[2]
if(mode(fmt.d) == "character" && mode(fmt.t) == "character")
format <- structure(c(fmt.d, fmt.t),
names = c("dates", "times"))
else {
fmt.d <- if(is.name(fmt.d)) fmt.d else fmt.d[[1]]
fmt.t <- if(is.name(fmt.t)) fmt.t else rev(fmt.t)[[1]]
format <- list(dates = fmt.d, times = fmt.t)
}
}
if(any(length(format) != 2, length(out.format) != 2))
stop("misspecified chron format(s) length")
if(all(mode(format) != c("character", "list")))
stop("misspecified input format(s)")
if(all(mode(out.format) != c("list", "character")))
stop("misspecified output format(s)")
dts <- convert.dates(dates., format = format[[1]], origin. = origin.)
tms <- convert.times(times., format = format[[2]])
x <- unclass(dts) + unclass(tms)
attr(x, "format") <- out.format
attr(x, "origin") <- origin.
class(x) <- c("chron", "dates", "times")
nms <- paste(names(dates.), names(times.))
if(length(nms) && any(nms != ""))
names(x) <- nms
return(x)
}
as.chron <- function(x, ...) UseMethod("as.chron")
as.chron.default <- function (x, format, ...)
{
if(inherits(x, "chron"))
return(x)
if(is.numeric(x)) {
if (missing(format) || is.null(format)) return(chron(x, ...))
else return(as.chron(as.POSIXct(format(x, scientific = FALSE),
tz = "GMT", format = format),
...))
}
if (is.character(x)) {
if (missing(format) || is.null(format)) {
out <- suppressWarnings(try(chron(x, ...), silent = TRUE))
## If this fails, try Date or datetime.
if(inherits(out, "try-error")) {
xx <- sub("T", " ", x)
out <- if(!any(grepl(" ", x, fixed = TRUE)))
as.chron(as.Date(xx), ...)
else
as.chron(as.POSIXct(xx, tz = "GMT"), ...)
}
} else {
out <- as.chron(as.POSIXct(x, format = format, tz = "GMT"),
...)
}
return(out)
}
stop("'x' cannot be coerced to a chron object")
}
as.chron.POSIXt <- function(x, offset = 0, tz = "GMT", ...)
{
## offset is in hours relative to GMT
if(!inherits(x, "POSIXt")) stop("wrong method")
x <- as.numeric(as.POSIXct(format(x, tz = tz), tz = "GMT")) +
60 * round(60 * offset)
tm <- x %% 86400
# if(any(tm != 0))
chron(dates. = x %/% 86400, times. = tm / 86400, ...)
# else
# chron(dates. = x %/% 86400, ...)
}
as.chron.Date <- function(x, ...)
{
chron(unclass(x), ...)
}
asChronYearFreq <-
function(x, frac = 0, holidays = FALSE, frequency, ...)
{
stopifnot(isTRUE((12 / frequency) %% 1 == 0))
x <- unclass(x)
year <- floor(x + 0.001)
month <- floor(12 * (x - year) + 1 + 0.5 + 0.001)
dd.start <- as.Date(paste(year, month, 1, sep = "-"))
nd <- 32 * 12 / frequency
dd.end <- dd.start + nd - as.numeric(format(dd.start + nd, "%d"))
if(identical(holidays, FALSE))
chron(((1 - frac) * as.numeric(dd.start) +
frac * as.numeric(dd.end)),
...)
else
chron(sapply(seq_along(x), function(i) {
s <- unclass(seq(dd.start[i], dd.end[i], by = "days"))
h <- if(isTRUE(holidays)) is.holiday(s) else is.holiday(s, holidays)
ss <- s[!is.weekend(s) & !h]
quantile(ss, probs = frac, names = FALSE)
}), ...)
}
as.chron.yearmon <-
function(x, frac = 0, holidays = FALSE, ...)
{
asChronYearFreq(x, frac = frac, holidays = holidays,
frequency = 12, ...)
}
as.chron.yearqtr <-
function(x, frac = 0, holidays = FALSE, ...)
{
asChronYearFreq(x, frac = frac, holidays = holidays,
frequency = 4, ...)
}
as.chron.ts <-
function(x, frac = 0, holidays = FALSE, ...)
{
asChronYearFreq(time(x), frac = frac, holidays = holidays,
frequency = frequency(x), ...)
}
as.chron.factor <- function(x, ...)
{
as.chron(as.character(x), ...)
}
"is.chron" <-
function(x)
inherits(x, "chron")
as.data.frame.chron <- as.data.frame.vector
"convert.chron" <-
function(x, format = c(dates = "m/d/y", times = "h:m:s"), origin.,
sep = " ", enclose = c("(", ")"), ...)
{
if(is.null(x) || !as.logical(length(x)))
return(numeric(length = 0))
if(is.numeric(x))
return(x)
if(!is.character(x) && all(!is.na(x)))
stop(paste("objects", deparse(substitute(x)),
"must be numeric or character"))
if(length(format) != 2)
stop("format must have length==2")
if(missing(origin.)
&& is.null(origin. <- getOption("chron.origin")))
origin. <- c(month = 1, day = 1, year = 1970)
if(any(enclose != ""))
x <- substring(x, first = 2, last = nchar(x) - 1)
str <- unpaste(x, sep = sep)
dts <- convert.dates(str[[1]], format = format[[1]],
origin. = origin., ...)
tms <- convert.times(str[[2]], format = format[[2]], ...)
dts + tms
}
"format.chron" <-
function(x, format = att$format, origin. = att$origin, sep = " ",
simplify, enclosed = c("(", ")"), ...)
{
att <- attributes(x)
if(length(format) == 1L) {
if(!nzchar(format))
format <- "%Y-%m-%d %H:%M:%S"
return(format(as.POSIXct(x), format = format, tz = "GMT"))
}
if(missing(simplify))
if(is.null(simplify <- getOption("chron.simplify")))
simplify <- FALSE
dts <- format.dates(x, format[[1]], origin. = origin., simplify =
simplify)
tms <- format.times(x - floor(x), format[[2]], simplify = simplify)
x <- paste(enclosed[1], dts, sep, tms, enclosed[2], sep = "")
## output is a character object w.o class
att$class <- att$format <- att$origin <- NULL
attributes(x) <- att
x
}
"new.chron" <-
function(x, new.origin = c(1, 1, 1970),
shift = julian(new.origin[1], new.origin[2], new.origin[3],
c(0, 0, 0)))
{
cl <- class(x)
class(x) <- NULL # get rid of "delim" attribute
del <- attr(x, "delim")
attr(x, "delim") <- NULL # map formats
format <- attr(x, "format")
format[1] <- switch(format[1],
abb.usa = paste("m", "d", "y", sep = del[1]),
abb.world = paste("d", "m", "y", sep = del[1]),
abb.ansi = "ymd",
full.usa = "month day year",
full.world = "day month year",
full.ansi = "year month year",
format[1])
if(length(format) == 2)
format[2] <- switch(format[2],
military = "h:m:s",
format[2])
attr(x, "format") <- format
orig <- attr(x, "origin")
if(is.null(orig)) {
x <- x - shift
attr(x, "origin") <- new.origin
}
## (update origin after we assign the proper class!)
## deal with times as attributes
tms <- attr(x, "times")
if(!is.null(tms)) {
if(all(tms[!is.na(tms)] >= 1))
tms <- tms/(24 * 3600)
x <- x + tms
class(x) <- c("chron", "dates", "times")
}
else class(x) <- c("dates", "times")
x
}
print.chron <-
function(x, digits = NULL, quote = FALSE, prefix = "", sep = " ",
enclosed = c("(", ")"), simplify, ...)
{
if(!as.logical(length(x))) {
cat("chron(0)\n")
return(invisible(x))
}
if(missing(simplify) &&
is.null(simplify <- getOption("chron.simplify")))
simplify <- FALSE
xo <- x
x <- format.chron(x, sep = sep, enclosed = enclosed, simplify =
simplify)
print.default(x, quote = quote)
invisible(xo)
}
unique.chron <-
function(x, incomparables = FALSE, ...)
x[!duplicated(x, incomparables, ...)]
xtfrm.chron <-
function(x)
as.numeric(x)
pretty.chron <-
function(x, ...)
{
if(!inherits(x, "times"))
x <- chron(x)
x <- as.POSIXct(x)
attr(x, "tzone") <- "GMT"
ans <- pretty(x, ...)
structure(as.chron(ans), labels = attr(ans, "labels"))
}
chron/R/times.R 0000644 0001751 0000144 00000051066 13524223434 013060 0 ustar hornik users "times"<-
function(x, ...)
chron(times. = x, ...)
"Axis.times" <-
function(x = NULL, at = NULL, ..., side, labels = NULL)
axis.times(n = side, x = x, labels = labels, ...)
"Math.times" <-
function(x, ...)
{
if(.Generic == "round")
return(round_times(x, ...))
cl <- class(x)
class(x) <- NULL
out <- NextMethod(.Generic)
class(out) <- cl
out
}
"Ops.times" <-
function(e1, e2)
{
if(nargs() == 1) {
## unary operators
val <- switch(.Generic,
"-" = -1 * e1,
"+" = e1,
"!" = !as.logical(e1))
return(val)
}
if(is.character(e1))
e1 <- chron(times. = e1, format = attr(e2, "format"))
if(is.character(e2))
e2 <- chron(times. = e2, format = attr(e1, "format"))
val <- NextMethod(.Generic)
boolean <- match(.Generic, c("==", "!=", ">", ">=", "<", "<="),
nomatch = 0)
if(boolean) return(as.logical(val))
## make sure the format attribute wasn't dropped by NextMethod
## (p.144 blue book)
if(is.null(attr(val, "format"))) {
if(is.null(fmt <- attr(e1, "format")))
fmt <- attr(e2, "format")
attr(val, "format") <- fmt
}
if(!inherits(val, .Class))
class(val) <- c(.Class, class(val))
val
}
"Summary.times" <-
function(x, ...)
{
val <- NextMethod(.Generic)
if(.Generic == "all" || .Generic == "any")
return(as.logical(val))
attr(val, "format") <- attr(x, "format")
class(val) <- class(x)
val
}
"[.times" <-
function(x, ..., drop = TRUE)
{
cl <- class(x)
class(x) <- NULL
val <- NextMethod("[")
attr(val, "format") <- attr(x, "format")
attr(val, "origin") <- attr(x, "origin")
class(val) <- cl
val
}
"[<-.times" <-
function(x, ..., value)
{
if(!as.logical(length(value)))
return(x) # as per p.104 in the blue book
if(!is.numeric(value) && !is.character(value) && !all(is.na(value)))
stop("replacement of/with times objects must be with times objects")
fmt <- attr(x, "format")
if(!inherits(value, "times"))
value <- chron(times. = value, format = rev(fmt)[[1]])
cl <- class(x) # ensure that dates objects have
# equal origins
class(x) <- class(value) <- NULL
x <- NextMethod(.Generic)
attr(x, "format") <- fmt
class(x) <- cl
x
}
"[[.times" <-
function(x, ..., drop = TRUE)
{
cl <- class(x)
class(x) <- NULL
val <- NextMethod("[[")
attr(val, "format") <- attr(x, "format")
attr(val, "origin") <- attr(x, "origin")
class(val) <- cl
val
}
"as.character.times" <-
function(x, ...)
format(x, ...)
as.data.frame.times <- as.data.frame.vector
"axis.times"<-
function(n, x, add = TRUE, labels, simplify = TRUE, ...)
{
if(!inherits(x, "times"))
x <- chron(x)
bad <- is.na(x) | abs(as.vector(x)) == Inf
rng <- if(n == 1 || n == 3) par("usr")[1:2] else par("usr")[3:4]
tmp <- c(rng, as.numeric(x[!bad]))
rng1 <- diff(range(tmp))
if (rng1 > 1) fctr <- 1
else if (rng1 > 1/24) fctr <- 24
else if (rng1 > 1/1440) fctr <- 1440
else fctr <- 86400
tmp <- pretty(fctr*tmp)/fctr
if (simplify) {
step <- diff(tmp[1:2])
simplify <- step >= 1/1440
if (inherits(x, "chron") && step >= 1) class(x) <- class(x)[-1]
}
att <- attributes(x)
at.x <- structure(tmp[tmp >= rng[1] & tmp <= rng[2]], format = att$
format, origin = att$origin, class = att$class)
if(missing(labels) || (is.logical(labels) && labels))
labels <- format(at.x, simplify = simplify)
if(add)
axis(n, at = at.x, labels = labels, ...)
invisible(list(n = n, at = at.x, labels = labels))
}
"c.times" <-
function(..., recursive = FALSE)
{
dots <- list(...)
is.tms <- unlist(lapply(dots, inherits, "times"))
n <- length(dots)
fmt <- attr(dots[[(1:n)[is.tms][1]]], "format")
if(is.null(fmt))
fmt <- "h:m:s"
out <- vector("list", length = n)
for(i in 1:n) {
x <- dots[[i]]
if(!all(is.na(x)))
x <- convert.times(x)
out[i] <- list(x)
}
out <- times(unlist(out, use.names = FALSE), format = fmt)
out
}
"convert.times"<-
function(times = NULL, format = "h:m:s", length. = 0, ...)
{
## convert time in hours, min and secs into fraction of days
if(is.null(times) || !as.logical(length(times)))
return(numeric(length = length.))
if(is.numeric(times))
return(times)
if(!is.character(format)) {
## format may be a function
FUN <- switch(mode(format),
name = get(as.character(format), mode = "function"),
functions = format,
stop(paste("unrecognized format mode",
as.character(format))))
return(FUN(times, ...))
}
fmt <- parse.format(format)
out <- unpaste(times, sep = fmt$sep, fnames = fmt$periods, nfields = 3)
hh <- mm <- ss <- as.numeric(rep(NA, length(out$h)))
ok <- !is.na(out$h) & !is.na(out$m) & !is.na(out$s)
hh[ok] <- as.numeric(out$h[ok])
mm[ok] <- as.numeric(out$m[ok])
ss[ok] <- as.numeric(out$s[ok])
if(all(is.na(hh) | is.na(mm) | is.na(ss)))
if(any(!is.na(times)))
stop(paste("format", format, "may be incorrect"))
else return(rep(NA, length(times)))
i <- (hh[ok] < 0 | hh[ok] > 23 | mm[ok] < 0 | mm[ok] > 59 |
ss[ok] < 0 | ss[ok] >= 60)
bad <- seq_along(hh)[ok][i]
if(n.bad <- length(bad)) {
if(n.bad > 10)
msg <- paste(n.bad,
"time-of-day entries out of range set to NA")
else msg <- paste("time-of-day entries out of range in positions",
paste(bad, collapse = ","), "set to NA")
warning(msg)
hh[bad] <- mm[bad] <- ss[bad] <- NA
ok[bad] <- FALSE
}
out <- 3600 * hh + 60 * mm + ss
out/(24 * 3600) # return days and fraction of days
}
"diff.times"<-
function(x, lag = 1, differences = 1, ...)
{
## delete references to time-series
if(lag < 1 | differences < 1)
stop("Bad value for lag or differences")
if(lag * differences >= length(x))
return(x[0])
r <- x
s <- 1:lag
for(i in 1:differences)
r <- r[ - s] - r[ - (length(r) + 1 - s)]
r
}
"format.times"<-
function(x, format. = "h:m:s", simplify = FALSE, ...)
{
if(!as.logical(length(x)))
return("")
if(all(is.na(x)))
return(rep("NA", length = length(x)))
if(!is.numeric(x))
stop(paste(deparse(substitute(x)), "must be numeric"))
att <- attributes(x)
if(inherits(x, "times")) {
if(missing(format.))
format. <- switch(mode(att$format),
character = ,
list = rev(att$format)[[1]],
name = ,
"function" = att$format,
NULL = format.,
stop("invalid output times format"))
class(x) <- NULL
}
if(!is.character(format.)) {
## format may be a function or name
FUN <- switch(mode(format.),
"function" = format.,
name = eval(format.),
stop(paste("unrecognized time format",
deparse(substitute(format.)))))
return(FUN(unclass(x), ...))
}
else format. <- rev(format.)[1]
nas <- is.na(x)
att$class <- att$format <- att$origin <- NULL
##
## DJ's design is that
## times greater than 1 day should format like numerics
## To change this (e.g., have times(1.5) format as 36:00:00), simply
## comment the code below, and make the corresponding change in
## print.times().
days <- abs(floor(x))
if(any(days[!nas] > 0)) {
attributes(x) <- att
return(format(x))
}
##
sec <- round(24 * 3600 * abs(x))
hh <- sec %/% 3600
mm <- (sec - hh * 3600) %/% 60
ss <- trunc(sec - hh * 3600 - 60 * mm)
out <- list(h = substring(paste("0", hh, sep = ""), nchar(paste(hh))),
m = substring(paste("0", mm, sep = ""), nchar(paste(mm))),
s = substring(paste("0", ss, sep = ""), nchar(paste(ss))))
style <- parse.format(format.)
o <- style$periods
if(!simplify)
out <- paste(out[[o[1]]], out[[o[2]]], out[[o[3]]],
sep = style$sep)
else {
if(simplify == 1) {
## no secs
o <- o[o != "s"]
out <- paste(out[[o[1]]], out[[o[2]]], sep = style$sep)
}
else out <- out$h
}
if(any(x[!nas] < 0))
out <- paste(ifelse(x < 0, "-", " "), out, sep = "")
out[nas] <- NA
out[x == Inf] <- "Inf"
out[x == - Inf] <- "-Inf"
attributes(out) <- att
out
}
"format<-.times" <-
function(x, ..., value)
{
ok <- switch(mode(value),
character = ,
name = ,
"function" = ,
list = TRUE,
FALSE)
if(!ok)
stop(paste("invalid format \"", as.character(value),
"\" in format replacement", sep = ""))
attr(x, "format") <- value
x
}
"hist.times" <-
function(x, nclass, breaks, plot = TRUE, probability = FALSE, ...,
xlab = deparse(substitute(x)), simplify = TRUE)
{
if(!inherits(x, "times"))
stop(paste(deparse(substitute(x)), "must be of class chron"))
cl <- class(x)
x <- as.numeric(x)
tt <- NextMethod("hist", plot = FALSE)
dots <- list(...)
if(plot) {
old <- par("xaxt", "yaxt")
on.exit(old)
x <- tt$breaks
y <- if(probability) tt$density else tt$counts
plot.new()
plot.window(xlim = range(x), ylim = range(y, 0))
rect(x[-length(x)], 0, x[-1L], y)
if(any(cl == "dates"))
lbl <- format(chron(dates. = tt$breaks), simplify = simplify)
else
lbl <- format(chron(times. = tt$breaks), simplify = simplify)
if(is.null(adj <- dots$adj))
adj <- par("adj")
if(is.null(cex <- dots$cex))
cex <- par("cex")
if(is.null(font <- dots$font))
font <- par("font")
if(is.null(las <- dots$las))
las <- par("las")
if(is.null(lab <- dots$lab))
lab <- par("lab")
if(is.null(mgp <- dots$mgp))
mgp <- par("mgp")
if(is.null(tcl <- dots$tcl))
tcl <- par("tcl")
## do we plot x axis
if(is.null(axes <- dots$axes))
axes <- TRUE
if(is.null(xaxt <- dots$xaxt))
xaxt <- par("xaxt")
if(is.null(yaxt <- dots$yaxt))
yaxt <- par("yaxt")
if(is.null(horiz <- dots$horiz))
horiz <- FALSE
if(axes) {
if(horiz) {
if(xaxt != "n")
axis(1, adj = adj, labels = TRUE,
cex = cex, font = font, las = las, lab = lab,
mgp = mgp, tcl = tcl)
}
else if(yaxt != "n")
axis(2, adj = adj, labels = TRUE,
cex = cex, font = font, las = las, lab = lab,
mgp = mgp, tcl = tcl)
axis(horiz + 1, at = tt$breaks, labels = lbl, adj = adj,
cex = cex, font = font, las = las, lab = lab,
mgp = mgp, tcl = tcl)
}
}
invisible(tt)
}
"identify.times" <-
function(x, y, ...)
{
if(inherits(x, "times"))
x <- as.numeric(x)
if(!missing(y) && inherits(y, "times"))
y <- as.numeric(y)
NextMethod("identify", ...)
}
"is.na.times" <-
function(x, ...)
{
x <- as.numeric(x)
NextMethod("is.na")
}
"lines.times" <-
function(x, y, ...)
{
nas <- is.na(x)
xtmp <- x <- x[!nas]
ytmp <- y <- y[!nas]
o <- order(x)
x <- as.numeric(x[o]) # as.numeric ensures times are
# computed
y <- as.numeric(y[o])
NextMethod("lines", ...)
invisible(list(x = xtmp, y = ytmp))
}
"mean.times"<-
function(x, trim = 0, weight = rep(1, length(x)), na.ok = TRUE, ...)
{
if(!missing(weight) && length(weight) != length(x))
stop(paste("weights must have same length as",
deparse(substitute(x))))
att <- attributes(x)[c("format", "origin", "class")]
nas <- is.na(x)
if(!na.ok && any(nas, is.na(weight)))
return(structure(NA, format = att$format, origin = att$origin,
class = att$class))
if(na.ok) {
x <- x[!nas]
if(!missing(weight))
weight <- weight[!nas]
}
if(trim > 0) {
if(trim >= 0.5)
return(median(x))
n <- length(x)
i1 <- floor(trim * n) + 1
i2 <- n - i1 + 1
i <- sort.list(x, unique(c(i1, i2)))[i1:i2]
weight <- weight[i] # lazy eval makes order of
# assignment important!
x <- x[i]
}
if(any(weight < 0))
stop("weights must be non-negative")
if(sm <- sum(weight))
out <- sum(unclass(x) * (weight/sm))
else out <- rep(0, length(x))
structure(out, format = att$format, origin = att$origin,
class = att$class)
}
"plot.times" <-
function(x, y, ...,
xlab = deparse(substitute(x)), ylab = deparse(substitute(y)),
simplify)
{
if(missing(simplify))
if(is.null(simplify <- getOption("chron.simplify")))
simplify <- TRUE
x.times <- inherits(x, "times") # is x a times?
if(missing(y)) {
x <- sort(x) # NA's will be ignored
y <- seq_along(as.vector(x))
if(missing(ylab))
ylab <- "Counts"
}
y.times <- inherits(y, "times") # is y a times?
dots <- list(...)
if(is.null(axes <- dots$axes)) axes <- TRUE # do we draw axes?
## only xaxt="n" or yaxt="n" requests in ... are honored!
if(is.null(req.xaxt <- dots$xaxt) || req.xaxt != "n")
req.xaxt <- "s"
if(is.null(req.yaxt <- dots$yaxt) || req.yaxt != "n")
req.yaxt <- "s"
old <- par("xaxt", "yaxt")
on.exit(par(old))
## trap graphical pars in ... that affect axis() in addition to plot()
if(is.null(adj <- dots$adj))
adj <- par("adj")
if(is.null(cex <- dots$cex.axis))
cex <- par("cex")
if(is.null(col <- dots$col.axis))
col <- par("col")
if(is.null(font <- dots$font.axis))
font <- par("font")
if(is.null(las <- dots$las))
las <- par("las")
if(is.null(lab <- dots$lab))
lab <- par("lab")
if(is.null(mgp <- dots$mgp))
mgp <- par("mgp")
if(is.null(tcl <- dots$tcl)) tcl <- par("tcl")
## for some plot types we need to sort according to x
if(!is.null(type <- dots$type))
if(any(type == c("l", "b", "o"))) {
xlab; ylab # force promises
nas <- is.na(x)
o <- order(x[!nas])
x <- x[!nas][o]
y <- y[!nas][o]
}
xx <- unclass(x)
yy <- unclass(y)
if(x.times)
xaxt <- "n"
else xaxt <- req.xaxt
if(y.times)
yaxt <- "n"
else yaxt <- req.yaxt
if(!is.null(l <- dots$log)) {
if(inherits(x, "dates") && any(l == c("x", "xy", "yx")))
stop("cannot do logarithmic plot of a dates object")
if(inherits(y, "dates") && any(l == c("y", "xy", "yx")))
stop("cannot do logarithmic plot of a chron object")
}
## unfortunately we can't use (easily) NextMethod when y is missing!
plot.default(xx, yy, xlab = xlab, ylab = ylab, ...,
xaxt = xaxt, yaxt = yaxt)
if(axes) {
if(req.xaxt == "n")
par(xaxt = "n")
else if(x.times)
axis.times(1, x, simplify = simplify, labels = TRUE,
adj = adj, col = col, cex = cex, font = font,
las = las, lab = lab, mgp = mgp, tcl = tcl)
if(req.yaxt == "n")
par(yaxt = "n")
else if(y.times)
axis.times(2, y, simplify = simplify, srt = 90, labels
= TRUE, adj = adj, col = col, cex = cex,
font = font, las = las, lab = lab, mgp = mgp,
tcl = tcl)
}
invisible(list(x = x, y = y))
}
points.times <- function(x, y, ...)
{
xtmp <- x
ytmp <- y
x <- as.numeric(x)
y <- as.numeric(y)
NextMethod("points", ...)
invisible(list(x = xtmp, y = ytmp))
}
print.times <-
function(x, digits, quote = FALSE, prefix = "", simplify, ...)
{
if(!as.logical(length(x))) {
cat("times(0)\n")
return(invisible(x))
}
if(missing(simplify) &&
is.null(simplify <- getOption("chron.simplify")))
simplify <- FALSE
xo <- x
## print whole days (no fraction) as regular integers
if(all(is.na(x)) || any(x[!is.na(x)] >= 1))
cat("Time in days:\n")
x <- format.times(x, simplify = simplify)
NextMethod("print", quote = quote)
invisible(xo)
}
quantile.times <- function(x, ...)
{
fmt <- attr(x, "format")
orig <- attr(x, "origin")
cl <- class(x)
x <- unclass(x)
out <- structure(NextMethod("quantile"), format = fmt, origin = orig,
class = cl)
out
}
round_times <-
function(x, units = "days", eps = 1e-10, ...)
{
att <- attributes(x)[c("format", "origin", "class")]
if(is.character(units)) {
idx <- pmatch(units, c("days", "hours", "minutes", "seconds"))
if(!is.na(idx)) {
values <- c(1, as.numeric(times(c("01:00:00","00:01:00","00:00:01"))))
units <- values[idx]
}
}
if(!inherits(units, "times")) {
units <- try(times(units))
if(inherits(units, "try-error"))
stop("cannot coerce units to class: times")
}
units <- as.numeric(units)
out <- units * trunc((as.numeric(x) + units / 2 + eps) / units)
structure(out, format = att$format, origin = att$origin,
class = att$class)
}
"summary.times"<-
function(object, digits = 12, ...)
{
if(!as.logical(length(object)))
return(object)
att <- attributes(object)
class(object) <- NULL
y <- as.numeric(object)
z <- unclass(summary.default(y, digits = digits, ...))
tmp <- structure(z[1:6], format = att$format, origin = att$origin,
class = att$class)
z[1:6] <- format(tmp)
class(z) <- "table"
z
}
## units can be "days", "hours", "minutes", "seconds" or they can
## be of times class or they can be of a class that can be coerced
## to "times" class
## e.g. trunc(times("12:13:14"), "minutes") # same
## e.g. trunc(times("12:13:14"), "min") # same
## e.g. trunc(times("12:13:14"), times("00:01:00")) # same
## e.g. trunc(times("12:13:14"), "00:01:00") # same
## e.g. trunc(times("12:13:14"), 1/(24*60)) # same
## e.g. trunc(times("12:13:14"), "00:01:30") # truncate to 90 seconds
trunc.times <-
function (x, units = "days", eps = 1e-10, ...)
{
att <- attributes(x)[c("format", "origin", "class")]
if(is.character(units)) {
idx <- pmatch(units, c("days", "hours", "minutes", "seconds"))
if(!is.na(idx)) {
values <- c(1, as.numeric(times(c("01:00:00","00:01:00","00:00:01"))))
units <- values[idx]
}
}
if(!inherits(units, "times")) {
units <- try(times(units))
if(inherits(units, "try-error"))
stop("cannot coerce units to class: times")
}
units <- as.numeric(units)
out <- units * trunc((as.numeric(x) + eps) / units)
structure(out, format = att$format, origin = att$origin,
class = att$class)
}
unique.times <-
function(x, incomparables = FALSE, ...)
x[!duplicated(x, incomparables, ...)]
xtfrm.times <-
function(x)
as.numeric(x)
## chron 'times' objects: only times
## (no dates here because caught by 'dates' method)
pretty.times <-
function(x, ..., simplify = TRUE)
{
## call 'chron' method to get absolute times
ans <- pretty(chron(dates. = x), ...)
at <- chron(times. = as.vector(ans))
## format.times will revert to numeric format if any > 1
labels <- if(max(abs(at)) <= 1) # 'x' might exceed 1
format(at - floor(at), simplify = simplify)
else
format(at, simplify = simplify)
structure(at, labels = labels)
}
rep.times <-
function(x, ...)
{
att <- attributes(x)[c("format", "origin", "class")]
structure(NextMethod("rep"),
format = att$format,
origin = att$origin,
class = att$class)
}
as.times <-
function(x, ...)
UseMethod("as.times")
as.times.default <- times
chron/PORTING 0000644 0001751 0000144 00000004655 11304021305 012445 0 ustar hornik users * Put the unpaste part of chron_strs.c in a separate file, and rewrite
for R internal object handling. Code for unpaste() from strings.inUX
is no longer needed.
* Copy ALL.FUNCTIONS -> chron.R.
* In chron.R, replace all occurrences of
!length(something)
by
!as.logical(length(something))
In Emacs, you can do
(query-replace-regexp
"!length(\\([a-z\.]*\\))" "!as.logical(length(\\1))" nil)
* The same problem (`!' only defined for logical arguments) occurs in
cut.dates():
if(!(i <- pmatch(breaks[1], valid, 0)))
seq.dates():
if(!(i <- pmatch(by, valid, 0)))
=> add `as.logical' after the `!'.
* In Ops.dates,
if(any(o1 != o2))
does not work in R if one of the origins is NULL. Change to
if(any(o1 - o2))
* Change .Machine$single.eps to .Machine$double.eps
* Change .Options to options()
* In julian(), replace
if(missing(origin.))
by
if(missing(origin.) || is.null(origin.))
* Change occurences of
UseMethod(generic, object, ...)
to
UseMethod(generic)
* Make the following functions generic in the R distribution:
cut diff hist mean quantile seq trunc
Comment the corresponding definitions for the generic funs and their
default methods.
* In cut.dates(), it seems that R's cut.default() which uses intervals
closed on the right by default produces results which are one off.
Adding `right = FALSE' to the call to cut.default() seems to fix this.
* character(n=0) in R is character(length=0) in S; fix chron.R
accordingly
* In c.dates() and c.times(), add `recursive = FALSE' argument.
* In leap.year(), fix typo.
* In format<-(), format<-.times() and origin<-(), replace `val' by
`value'.
* Y2K update: comment convert.dates(), format.dates(), parse.format(),
and replace by updated functions by David James.
* DOCUMENTATION FIXES (after conversion via Sd2Rd):
chron.Rd:
Add alias.
cut.dates.Rd:
Add alias.
dates.Rd:
Fix \name.
Add aliases (dates, times).
Delete 1st \seealso.
day.of.week.Rd:
Add aliases (day.of.week, julian, leap.year, month.day.year).
REMOVE julian.Rd, leap.year.Rd, month.day.year.Rd.
days.Rd:
Fix \name.
Add aliases (days, months, quarters, weekdays, years).
Merge in all \seealso{}'s (dates chron is.holiday is.weekend cut.dates
seq.dates).
REMOVE months.Rd quarters.Rd weekdays.Rd years.Rd.
hours.Rd:
Fix \name.
Add aliases (hours minutes seconds).
is.holiday.Rd:
Add aliases (is.holiday is.weekend).
REMOVE is.weekend.Rd.
seq.dates.Rd:
Add alias.
Fix examples everywhere!
chron/src/ 0000755 0001751 0000144 00000000000 14245106266 012176 5 ustar hornik users chron/src/Rchron.h 0000644 0001751 0000144 00000000473 14245105522 013600 0 ustar hornik users #ifndef R_CHRON_H
#define R_CHRON_H
#include
#include
#include
typedef int Sint;
SEXP C_unpaste(SEXP s_strings, SEXP s_sep, SEXP s_whitespace,
SEXP s_nfields);
void C_cnt_flds_str(char **strings, Sint *nstrings, char **sep,
Sint *white_space, Sint *counts);
#endif
chron/src/unpaste.c 0000644 0001751 0000144 00000002653 13041162774 014026 0 ustar hornik users #include "Rchron.h"
#include
#define BUF_SIZ 4096
SEXP
C_unpaste(SEXP s_strings, SEXP s_sep, SEXP s_whitespace,
SEXP s_nfields)
{
Sint i, j, k;
char buffer[BUF_SIZ];
const char *s;
int c;
SEXP *output, ans;
int nstrings = Rf_length(s_strings);
const char *sep = CHAR(STRING_ELT(s_sep, 0));
int nfields = INTEGER(s_nfields)[0];
Rboolean whitespace = asLogical(s_whitespace);
if(whitespace == NA_LOGICAL)
whitespace = FALSE;
/* allocate character vectors for each field */
PROTECT(ans = allocVector(VECSXP, nfields));
output = (SEXP *) S_alloc(nfields, sizeof(SEXP));
for(k = 0; k < nfields; ++k)
SET_VECTOR_ELT(ans, k, output[k] = allocVector(STRSXP, nstrings));
for(i = 0; i < nstrings; ++i) {
s = CHAR(STRING_ELT(s_strings, i));
if(whitespace) /* skip initial whitespace */
while(isspace(*s)) ++s;
j = k = 0;
while(1) {
if(j >= 4095) {
warning("Problems coming ...");
}
c = *s;
if((c == '\0')
|| (whitespace && isspace(c))
|| (!whitespace && c == *sep)) {
buffer[j++] = '\0';
SET_STRING_ELT(output[k], i, COPY_TO_USER_STRING(buffer));
if(c=='\0')
break;
k++;
j = 0;
if(whitespace) {
/* skip trailing space in current item */
while(isspace(*(s+1)))
++s;
if(*(s+1) == '\0')
break;
}
}
else
buffer[j++] = c;
++s;
}
}
UNPROTECT(1);
return(ans);
}
chron/src/init.c 0000644 0001751 0000144 00000001004 13041163016 013265 0 ustar hornik users #include "Rchron.h"
#include
R_NativePrimitiveArgType cnt_flds_t[] =
{STRSXP, INTSXP, STRSXP, INTSXP, INTSXP};
static const R_CMethodDef CEntries[] = {
{"C_cnt_flds_str", (DL_FUNC) &C_cnt_flds_str, 5, cnt_flds_t},
{NULL, NULL, 0}
};
static const R_CallMethodDef CallEntries[] = {
{"C_unpaste", (DL_FUNC) &C_unpaste, 4},
{NULL, NULL, 0}
};
void
R_init_chron(DllInfo *dll)
{
R_registerRoutines(dll, CEntries, CallEntries, NULL, NULL);
R_useDynamicSymbols(dll, FALSE);
}
chron/src/chron_strs.c 0000644 0001751 0000144 00000002271 14245106266 014530 0 ustar hornik users #include "Rchron.h"
/* count fields in vector of strings */
void
C_cnt_flds_str(char **strings, Sint *nstrings, char **sep,
Sint *white_space, Sint *counts)
{
Sint n = *nstrings, whitespace = *white_space;
Sint i, nsep;
char *s, c_sep = **sep;
int c, in_white_space;
if(!whitespace) {
/* sep is a one-char delimiter */
for(i = 0; i < n; ++i) {
s = strings[i];
if(*s == '\0')
continue; /* empty string */
nsep = 0;
while((c = *s++) != '\0')
if(c == c_sep)
++nsep;
counts[i] = nsep + 1;
}
return;
}
/* items are delimited by white space (new lines, tabs, spaces) */
for(i = 0; i < n; ++i) {
s = strings[i];
if(*s == '\0')
continue; /* empty string */
while((c = *s++) != '\0')
/* skip initial white space */
if(!isspace(c))
break;
if(c == '\0')
continue; /* only whitespace in string */
in_white_space = nsep = 0;
while(c != '\0') {
/* look for transitions into/out of white space */
if(in_white_space && !isspace(c)){
++nsep;
in_white_space = 0;
}
else if(!in_white_space && isspace(c))
in_white_space = 1;
c = *s++;
}
counts[i] = nsep + 1;
}
return;
}
chron/ChangeLog 0000644 0001751 0000144 00000062505 14734515040 013166 0 ustar hornik users 2024-12-30 Kurt Hornik
* DESCRIPTION: New versino is 2.3-62.
* R/scale.R:
Tweak.
Suggestion by Mao Kobayashi .
2023-05-02 Kurt Hornik
* DESCRIPTION: New version is 2.3-61.
* R/dates.R:
Avoid partial argument matches.
2023-03-02 Kurt Hornik
* DESCRIPTION: New version is 2.3-60.
* NAMESPACE: Drop axis.times(), add as.chron.factor().
2023-01-31 Kurt Hornik
* DESCRIPTION: New version is 2.3-59.
* inst/CITATION: Drop.
2022-10-04 Kurt Hornik
* DESCRIPTION: New version is 2.3-58.
* R/chron.R (as.chron.POSIXt): Update for recent
as.character.POSIXt() changes in base R.
2022-05-30 Kurt Hornik
* DESCRIPTION: New version is 2.3-57.
* src/Rchron.h: Add typedef for legacy 'Sint' type.
2021-03-08 Kurt Hornik
* man/chron.Rd:
* man/dates.Rd:
* man/format.chron.Rd:
* man/hours.Rd:
* man/seq.dates.Rd:
Avoid partial matching.
2020-08-18 Kurt Hornik
* DESCRIPTION: New version is 2.3-56.
* R/zzz.R: Drop .onAttach().
* R/y2k.R:
* man/chron-internal.Rd:
Changed the default cutoff when expanding a 2-digit year to a
4-digit year from 30 to 69 (as for Date and POSIXct in base R.)
2020-02-02 Kurt Hornik
* DESCRIPTION: New version is 2.3-55.
* R/zzz.R (.onAttach): Add.
2019-08-13 Kurt Hornik
* DESCRIPTION: New version is 2.3-54.
* R/dates.R:
Add as.dates().
Suggestion by Gabor Grothendieck .
2019-08-12 Kurt Hornik
* NAMESPACE:
* R/times.R:
Add as.times().
Suggestion by Gabor Grothendieck .
2018-09-09 Kurt Hornik
* DESCRIPTION: New version is 2.3-53.
* NAMESPACE:
* R/times.R:
Add rep.times().
Suggestion by Gabor Grothendieck .
2018-01-06 Kurt Hornik
* DESCRIPTION: New version is 2.3-52.
* R/dates.R:
* NAMESPACE:
Add and register as.Date(), as.POSIXct() and as.POSIXlt() methods
for class 'dates' previously provided in base.
2017-10-07 Kurt Hornik
* DESCRIPTION: New version is 2.3-51.
* NAMESPACE:
* man/chron-internal.Rd:
* man/origin.Rd:
Document and export origin getter and setter.
Contributed by Gabor Grothendieck .
2017-02-20 Kurt Hornik
* DESCRIPTION: New version is 2.3-50.
2017-01-22 Kurt Hornik
* R/utils.R:
* src/init.c:
Improve registration of native routines.
2017-01-17 Kurt Hornik
* DESCRIPTION: New version is 2.3-49.
* NAMESPACE:
* R/utils.R:
* src/init.c:
Improve registration of native routines.
2016-12-08 Kurt Hornik
* DESCRIPTION: New version is 2.3-48.
* inst/CITATION: Canonicalize CRAN URLs.
2016-01-06 Kurt Hornik
* inst/CITATION: Avoid personList().
2015-06-24 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-47.
* NAMESPACE: Add missing imports.
2015-02-11 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-46.
* R/times.R:
* man/trunc.times.Rd:
Add round method for times objects via Math.times (to
be able to use the same arguments as the trunc methods,
differently from the generic).
Suggestion by Gabor Grothendieck .
2014-02-11 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-45.
2014-01-29 Kurt Hornik
* man/format.chron.Rd: Added.
2014-01-08 Kurt Hornik
* R/chron.R ("format.chron"): Allow formatting chron objects using
percent codes. Suggestion by Gabor Grothendieck
.
2013-09-01 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-44.
* R/utils.R (unpaste):
Have unpaste() consistently return NA_character_ and not the
string "NA" for missing pieces.
Spotted by Kodi Arfer .
* README:
* Y2K:
Remove 'Y2K' and no longer refer to it.
2012-11-14 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-43.
* NAMESPACE:
* R/scale.R:
* man/scale.Rd:
Add scale/ggplot2 functionality contributed by Gabor Grothendieck
.
2011-08-21 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-42.
* src/unpaste.c (unpaste): Do not write to stderr directly.
2011-08-08 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-41.
* R/zzz.R (.onLoad): Name formals correctly.
* R/chron.R (as.chron.default): Prefer dates to chron when
coercing from character.
2011-07-24 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-40.
* README:
* COPYING:
Remove 'COPYING'.
2010-12-07 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-39.
* R/times.R ("hist.times"): Make work to some extent.
2010-10-03 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-38.
* R/dates.R (convert.dates): Don't use seq.int() incorrectly.
Spotted by BDR.
2010-09-14 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-37.
* NAMESPACE:
* R/chron.R (pretty.chron):
* R/times.R (pretty.times):
* R/dates.R (pretty.dates):
Add pretty() methods contributed by Felix Andrews
, and use for R >= 2.12.0.
2010-08-31 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-36.
* R/chron.R (as.chron.POSIXt): Do not convert to dates if the time
component is 0. By Gabor Grothendieck .
2010-04-05 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-35.
* R/zzz.R (.onLoad): Do not overwrite global chron options.
Suggested by Gabor Grothendieck .
2010-03-17 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-34.
* R/utils.R (count.fields.str): Call .C() correctly.
2009-11-08 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-33.
* NAMESPACE:
* R/chron.R (unique.chron):
* R/dates.R (unique.dates):
* R/times.R (unique.times):
Add unique() methods to make factor() work on chron objects for R
2.10.0 or later.
2009-10-04 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-32.
* R/times.R (trunc.times): Preserve class, format and origin.
2009-09-10 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-31.
* inst/CITATION: Improve.
2009-02-18 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-30.
* R/chron.R (chron): Recycle dates/times if one is length one.
Suggested by Gabor Grothendieck .
2009-02-05 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-29.
* inst/CITATION: Improve.
2009-01-05 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-28.
* man/chron.Rd: Rd fixes.
2008-12-17 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-27.
* NAMESPACE: Registration of xtfrm() methods only works for R
2.8.0 or later (spotted by Alex Kleeman ).
2008-12-14 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-26.
* NAMESPACE
* R/chron.R (xtfrm.chron):
* R/dates.R (xtfrm.dates):
* R/times.R (xtfrm.times):
Add xtfrm methods.
2008-11-12 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-25.
* R/dates.R ("convert.dates"): Try making format 'ymd' work for
non-abbreviated year specs.
2008-07-18 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-24.
* R/chron.R (as.chron.default):
* man/chron.Rd:
Add a 'format' argument to the as.chron() default method.
Thanks to Gabor Grothendieck .
2008-05-20 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-23.
2008-05-19 Kurt Hornik
* R/dates.R (seq.dates):
Fix bug spotted by Andreas Eckner .
2008-03-04 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-22.
* R/chron.R (as.chron.default):
Make as.chron() work on format(Sys.time()).
Thanks to Gabor Grothendieck .
2008-02-14 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-21.
* R/chron.R (as.chron.POSIXt):
More tz improvements.
2008-02-07 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-20.
* R/utils.R ("julian.default"):
Make recycling of x/d/y work.
Thanks to Gabor Grothendieck .
2008-02-04 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-19.
(Depends): Need 2.4.0 or better, as seq_len() et al are used.
* R/dates.R (format.dates):
R >= 2.7.0 no longer performs partial matching in [[ by default.
2008-02-01 Kurt Hornik
* R/chron.R (as.chron.POSIXt):
Make 'tz' work as intended.
2008-01-31 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-18.
* R/utils.R (years, days, hours, minutes, seconds):
* man/days.Rd:
* man/hours.Rd:
Coerce to chron if necessary.
* R/chron.R
(as.chron.default): Consistenly return a chron object, or fail.
(as.chron.POSIXt): Add 'tz' argument (defaulting to "GMT").
2008-01-30 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-17.
* NAMESPACE:
* R/chron.R:
* man/yearmon.Rd:
Added as.chron.ts(), as.chron.yearmon(), and as.chron.yearqtr().
Thanks to Gabor Grothendieck .
* R/utils.R ("is.holiday"): Fixed bug for zero length holiday
vector.
Thanks to Gabor Grothendieck .
* man/days.Rd:
Document how to use the chron/default methods for Date objects.
2007-12-21 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-16.
* NAMESPACE:
* R/chron.R:
* R/chron.Rd:
Added as.chron.Date().
Thanks to Gabor Grothendieck .
2007-07-12 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-14.
(License): Clarify.
2007-07-10 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-13.
* R/times.R (print.times): Keep handling of "times greater than
one day" in sync with format.times().
2007-06-18 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-12.
* R/dates.R:
* NAMESPACE:
Remove explicit trunc.dates() and floor.dates() so that in
particular the former can dispatch to trunc.times().
Rewrite dates() based on the former floor.dates().
2007-05-03 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-11.
* man/trunc.times.Rd:
* R/dates.R (trunc.dates):
* R/times.R (trunc.times):
Add '...' argument to trunc() methods.
2007-02-01 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-10.
* inst/CITATION: Get date/year and version from the package
metadata.
2006-10-16 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-9.
* R/chron.R:
* man/chron.Rd:
Add as.chron.factor().
Thanks to Gabor Grothendieck .
2006-09-23 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-8.
* R/utils.R (hours, minutes, seconds): Sync code with what is used
in format.times() and more appropriate. Thanks to Glen A Sargeant
and Gabor Grothendieck
for raising the issue.
2006-09-09 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-7.
(Imports): Add stats.
* NAMESPACE: More missing imports.
2006-08-12 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-6.
* NAMESPACE: Add missing imports.
2006-07-14 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-5.
* src/unpaste.c (unpaste):
* R/utils.R (unpaste):
Improvements for strict type checking in ff calls, thanks BDR.
2006-06-23 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-4.
* inst/CITATION: New file.
* R/dates.R (seq.dates): Do not get rid of all-zero time
components. Spotted by Sebastian Luque .
2006-06-09 Duncan Murdoch
* DESCRIPTION (Version): New version is 2.3-3.
* R/times.R: Change axis.times to try harder to give unique
labels at round number locations.
2006-02-04 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-2.
* R/times.R (trunc.times):
* man/trunc.times.Rd:
Add a comparison tolerance argument to address problems with
floating point representations, donated by Gabor Grothendieck
.
2006-01-13 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-1.
* R/times.R (trunc.times):
* man/trunc.times.Rd:
New trunc() methods for times objects, donated by Gabor
Grothendieck .
2005-10-25 Kurt Hornik
* DESCRIPTION (Version): New version is 2.3-0.
* R/times.R ("Axis.times"): New Axis() method for R 2.3.0 or
better, suggested by G Grothendieck .
("plot.times"): Use 'col.axis' rather than 'col' etc for catching
graphical parameters in ... that affect (and are passed to)
axis(). Spotted by Parlamis Franklin and
relayed by Marc Schwartz .
2005-10-24 Kurt Hornik
* NAMESPACE: Added.
2005-07-11 Kurt Hornik
* man/cut.dates.Rd:
* man/seq.dates.Rd:
Rd format.
2005-04-28 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-35.
* R/chron.R:
* R/dates.R:
* R/times.R:
* R/utils.R:
As spotted by David Harte , there is a
problem with dates before the origin:
R> chron(dates.="12/31/1969", times.="18:00:00")
[1] (01/01/70 -06:00:00)
(Most likely not as intended.) Fix by changing trunc() to floor()
when extracting dates and times parts.
2005-02-26 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-34.
* R/dates.R (seq.dates): Two patches suggested by Steve Su
and relayed by Martyn Plummer
.
2004-11-06 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-33.
* R/dates.R (seq.dates): seq.dates(by = "months") was wrong for
end of month dates. Spotted by Ciprian_Marin@ssga.com, fix by
Gabor Grothendieck . See also message
2004-November/058829.html in the r-help mail archive at
https://www.stat.math.ethz.ch/pipermail/r-help/.
2004-09-15 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-32.
* R/dates.R (seq.dates): seq.dates() gave too many months/years if
a given length was too large. Trim back to the specified length
(spotted by , fix suggested by Gabor
Grothendieck ).
2004-05-28 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-31.
* R/utils.R ("is.holiday", "is.weekend"): If the argument does not
inherit from dates, try coercing to chron. The is.numeric() test
does not do the right thing for POSIXct objects (e.g., obtained by
Sys.time(), spotted by Matthew Dowle ).
* man/is.holiday.Rd: Document the above change.
* R/dates.R ("Ops.dates"): At least avoid duplicated class
entries.
2004-05-19 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-30.
* R/times.R (convert.times): Fix problem with times with 59 <
seconds < 60 (PR#6878 by Dennis Wolf ).
2004-01-31 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-29.
* INDEX: Removed.
2003-11-06 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-28.
* man/chron.Rd:
* man/day.of.week.Rd:
Fix codoc default value mismatch problems.
2003-07-16 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-27.
(Depends): Need R 1.6.0 or better, as src/init.c uses
R_NativePrimitiveArgType.
2003-06-28 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-26.
* man/chron.Rd: Explicitly say that for day/month/year format
specifications, the separator must be non-null. Thanks to Jerome
Asselin for the suggestion and the PRs for
the previous release.
2003-06-25 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-25.
* R/utils.R (parse.format): Be more defensive about 'arbitrary'
separators in format specs.
2003-04-23 Kurt Hornik
* DESCRIPTION (Version) New version is 2.2-24.
(Author, Maintainer): Update KH email address.
2003-01-16 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-23.
* R/utils.R (parse.format): Allow for arbitrary (non-alpha)
separators in format specs (PR#2458).
2002-12-15 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-22.
* TITLE: Removed.
* R/utils.R:
* src/unpaste.c:
Move unpaste C code from .C() to .Call() (courtesy DTL).
2002-05-02 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-21.
(Depends): Need R 1.2.0 or better.
* src/unpaste.c (unpaste): Remove pre-1.2.0 compatibility code.
2002-03-31 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-20.
* R/utils.R (unpaste):
* R/dates.R (convert.dates):
* R/times.R (c.times):
Adjust for R 1.5.0 character NAs.
2001-11-27 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-19.
* R/chron.R:
* R/dates.R:
* R/times.R:
.Alias() is gone in R 1.4.0, hence remove.
2001-09-18 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-18.
* R/chron.R (chron): the default for the argument 'out.format' was
wrong if the argument 'format' was a function or R symbol (in
these cases 'out.format' now is not set and we stop). As the
current code does not always preserve format slots, we need to
make a NULL format correspond to the default.
* R/dates.R (convert.dates): now correctly handles formats given
as R symbols.
* R/times.R (convert.times): now correctly handles formats given
as R symbols.
* R/utils.R (month.day.year): now coerces its argument to be
integer since the algorithm requires integer arithmetic.
All fixes by David James.
2001-08-20 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-17.
* R/chron.R:
* R/dates.R:
* R/times.R:
* R/utils.R:
* man/cut.dates.Rd:
* man/day.of.week.Rd:
* man/days.Rd:
* man/seq.dates.Rd:
Fix generic/method inconsistencies.
2001-08-19 Kurt Hornik
* man/day.of.week.Rd: Document arguments of day.of.week().
* man/chron-internal.Rd: Add keyword 'internal'.
2001-07-14 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-16.
* man/cut.dates.Rd: Fix unbalanced braces.
2001-06-20 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-15.
* R/times.R: In plot.times(), force eval of xlab/ylab before
subscripting x/y (PR#930).
2001-06-15 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-14.
* R/y2k.R: In year.expand(), do not try to expand NAs (problem
reported by B.Rowlingson@lancaster.ac.uk.
2001-06-02 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-13.
* man/chron.Rd:
* man/day.of.week.Rd:
Codoc fixes.
2001-05-12 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-12.
* man/chron-internal.Rd: New file.
2001-05-10 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-11.
* R/zzz.R:
* R/utils.R:
* man/day.of.week.Rd:
* man/days.Rd:
julian(), weekdays(), months() and quarters() are generic in R
1.3.0. Functions in chron are now default methods for these.
* R/times.R: format.times() needs to round its calculation of
sec (suggested by BDR).
* R/chron.R: as.chron() is now generic, with a method for class
"POSIXt" and a default one.
2001-04-06 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-10.
* R/dates.R: Eliminate Y2K problems in cut.dates() pointed out by
"Dirk F. Raetzel" .
2001-03-24 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-9.
* R/utils.R: Add 'PACKAGE' arg to FF calls.
2000-12-24 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-8.
(Maintainer): New entry.
Wed Aug 9 10:53:36 2000 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-7.
* src/unpaste.c (unpaste): Adjust for R 1.2.0 GenGC changes.
Sat Jul 22 11:41:45 2000 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-6.
* R/chron.R (print.chron): Return argument 'x'.
* R/dates.R (print.dates): Return argument 'x'.
* R/times.R (print.times): Return argument 'x'.
Changes suggested by M Maechler .
Sun Jul 16 21:54:53 2000 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-5.
* R/times.R: Use graphics parameter 'tcl' instead of 'tck'.
Sun Jul 2 10:47:12 2000 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-4.
(License): Under GPL now.
* src/chron_strs.c: Use R.h API (use Sint where appropriate).
* src/unpaste.c: Use R.h API.
* man/*.Rd: Provide \description{} entries. Use \code where
language elements are referred.
Wed Jun 28 16:14:43 2000 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-3.
* R/chron.R: Get options via getOption().
Replace T/F by TRUE/FALSE.
Split into 4 files.
Sun Jun 25 17:06:07 2000 Kurt Hornik
* src/chron_strs.c (to_lower): Remove.
* R/chron.R: Comment lower.case().
Add as.data.frame() methods for classes 'chron', 'dates' and
'times'.
* R/y2k.R: Get options via getOption().
Replace lower.case() by tolower().
(year.expand): Only expand the 2-digit specifications, leaving
everything else intact.
* man/*.Rd: Add '\keyword{chron}'.
* man/chron.Rd: Add aliases for methods for objects of class
'chron'.
* man/dates.Rd: Add aliases for methods for objects of class
'dates' or 'times'.
Sun Jan 23 15:35:51 2000 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-2.
* Rename 'year.abb' and 'year.expand' to 'chron.year.abb' and
'chron.year.expand', respectively.
Tue Jan 4 21:42:01 2000 Kurt Hornik
* DESCRIPTION (Version): New version is 2.2-1.
* Y2K: New file.
* PORTING: Document Y2K improvements.
* R/zzz.R: Set new options 'year.abb' and 'year.expand' to allos
2-digit abbreviations and (kind of) guess the actual year.
* R/y2k.R: New file with replacements for the commented funs and
new functions year.expand() and year.strict().
* R/chron.R: Comment convert.dates(), format.dates(), and
parse.format().
Thu Jul 29 10:48:16 1999 Kurt Hornik
* DESCRIPTION (Version): New version is 2.1-7.
* TODO: unpaste() now uses C version.
* R/chron_strs.R: Remove.
* src/Makefile: Remove.
* src/unpaste.c: Rewrite for R style list handling.
* PORTING: Document the change from R to C unpaste.
Sat Apr 10 13:08:59 1999 Kurt Hornik
* DESCRIPTION (Version): New version is 2.1-6.
* R/chron.R (leap.year): Fix typo.
(format<-, format<-.times, origin<-): Replace 'val' by 'value'.
* PORTING: Document this.
Sun Mar 28 10:53:43 1999 Kurt Hornik
* DESCRIPTION (Version): New version is 2.1-5.
* R/chron.R (c.dates): Add 'recursive = FALSE' argument.
* R/chron.R (c.times): Add 'recursive = FALSE' argument.
* PORTING: Document this.
Sun Dec 6 11:43:51 1998 Kurt Hornik
* DESCRIPTION (Version): New version is 2.1-4.
* TODO: New file.
Fri Nov 27 23:23:30 1998 Kurt Hornik
* DESCRIPTION (Version): New version is 2.1-3.
* R/chron.R: Comment load.if.needed().
* man/load.if.needed.Rd: Removed.
* src/chron_strs.c: Add '#include '.
* src-c: Removed.
Fri Mar 13 08:02:50 1998 Kurt Hornik
* DESCRIPTION (Version): New version is 2.1-2.
* README: Changed to new (?) URL for chron.
Wed Feb 18 23:43:24 1998 Kurt Hornik
* R/zzz.R: Use .First.lib() for dynloading.
* DESCRIPTION: New file.
* ChangeLog: Finally started, current version is 2.1-1.
chron/NAMESPACE 0000644 0001751 0000144 00000004621 14401635434 012627 0 ustar hornik users useDynLib("chron", .registration = TRUE)
import("stats")
importFrom("graphics", "Axis", "axis", "barplot", "hist", "par",
"plot", "plot.default", "plot.new", "plot.window", "rect")
export(".Holidays",
"as.chron", "as.dates", "as.times",
"chron",
"dates", "day.of.week", "days",
"hours",
"is.chron", "is.holiday", "is.weekend",
"leap.year",
"minutes", "month.day.year",
"origin", "origin<-",
"seconds", "seq.dates",
"times",
"years")
## Grr ...
export("year.expand", "year.strict")
export("chron_trans", "scale_x_chron", "scale_y_chron")
S3method("as.chron", "POSIXt")
S3method("as.chron", "Date")
S3method("as.chron", "default")
S3method("as.chron", "factor")
S3method("as.chron", "ts")
S3method("as.chron", "yearmon")
S3method("as.chron", "yearqtr")
S3method("as.dates", "default")
S3method("as.times", "default")
S3method("julian", "default")
S3method("months", "default")
S3method("quarters", "default")
S3method("weekdays", "default")
S3method("as.data.frame", "chron")
S3method("format", "chron")
S3method("pretty", "chron")
S3method("print", "chron")
S3method("unique", "chron")
S3method("xtfrm", "chron")
S3method("Math", "dates")
S3method("Ops", "dates")
S3method("Summary", "dates")
S3method("[<-", "dates")
S3method("all.equal", "dates")
S3method("as.Date", "dates")
S3method("as.POSIXct", "dates")
S3method("as.POSIXlt", "dates")
S3method("as.data.frame", "dates")
S3method("c", "dates")
S3method("cut", "dates")
S3method("format", "dates")
S3method("print", "dates")
S3method("pretty", "dates")
S3method("seq", "dates")
S3method("unique", "dates")
S3method("xtfrm", "dates")
S3method("Axis", "times")
S3method("Math", "times")
S3method("Ops", "times")
S3method("Summary", "times")
S3method("[", "times")
S3method("[<-", "times")
S3method("[[", "times")
S3method("as.character", "times")
S3method("as.data.frame", "times")
S3method("c", "times")
S3method("diff", "times")
S3method("format", "times")
S3method("format<-", "times")
S3method("hist", "times")
S3method("identify", "times")
S3method("is.na", "times")
S3method("lines", "times")
S3method("mean", "times")
S3method("plot", "times")
S3method("points", "times")
S3method("print", "times")
S3method("pretty", "times")
S3method("quantile", "times")
S3method("rep", "times")
S3method("summary", "times")
S3method("unique", "times")
S3method("trunc", "times")
S3method("xtfrm", "times")
chron/TODO 0000644 0001751 0000144 00000000442 11304021305 012056 0 ustar hornik users Apparently, the components of origin are used as positional rather than
as named! I.e.,
options(chron.origin = c(month = 1, day = 1, year = 1960))
is ok but
options(chron.origin = c(year = 1960, month = 1, day = 1))
is not. DEBUG etc etc
How can we improve the handling of holidays?
chron/man/ 0000755 0001751 0000144 00000000000 13166144207 012160 5 ustar hornik users chron/man/scale.Rd 0000644 0001751 0000144 00000001545 12050654135 013540 0 ustar hornik users \name{scale}
\alias{chron_trans}
\alias{scale_x_chron}
\alias{scale_y_chron}
\title{Coordinates and Positions for Chronological Objects}
\usage{
chron_trans(format = "\%Y-\%m-\%d", n = 5)
scale_x_chron(..., format = "\%Y-\%m-\%d", n = 5)
scale_y_chron(..., format = "\%Y-\%m-\%d", n = 5)
}
\arguments{
\item{format}{format string as described in \code{\link[base]{strptime}}.}
\item{n}{Approximate number of axis ticks.}
\item{...}{Passed to \code{\link[ggplot2]{scale_x_continuous}}.}
}
\description{
\code{chron_trans} is a \pkg{ggplot2} transformer for \code{chron}.
\code{scale_x_chron} and \code{scale_y_chron} are \pkg{ggplot2} scales.
}
\examples{
if(require("ggplot2")) {
dd <- data.frame(tt = chron(1:10), value = 101:110)
p <- ggplot(dd, aes(tt, value)) +
geom_point() + scale_x_chron(format = "\%m-\%d")
print(p)
}
}
chron/man/day.of.week.Rd 0000644 0001751 0000144 00000003605 11304021305 014546 0 ustar hornik users \name{day.of.week}
\alias{day.of.week}
\alias{julian.default}
\alias{leap.year}
\alias{month.day.year}
\title{
Convert between Julian and Calendar Dates
}
\description{
Utility functions to convert between Julian dates (numbers of days
since an origin, by default 1970-01-01) and calendar dates given by
year, month, and day within the month.
}
\usage{
\method{julian}{default}(x, d, y, origin., \dots)
month.day.year(jul, origin.)
leap.year(y)
day.of.week(month, day, year)
}
\arguments{
\item{x, month}{vector of month numbers.}
\item{d, day}{vector of day numbers.}
\item{y, year}{vector of years.}
\item{jul}{vector of Julian Dates, i.e., number of days since
\code{origin.}.}
\item{origin.}{vector specifying the origin as month, day, and year.
If missing, it defaults to \code{getOption("chron.origin")} if this
is non-null, otherwise
\code{c(month = 1, day = 1, year = 1970)}.}
\item{\dots}{further arguments to be passed to or from methods.}
}
\value{
A vector of Julian dates (number of days since \code{origin.}) when
\code{julian()} is called, or a list with members \code{month},
\code{day}, \code{year} corresponding to the input Julian dates if
\code{month.day.year()} is called. \code{leap.year()} returns a
logical vector indicating whether the corresponding year is a leap
year.
\code{day.of.week()} returns a number between 0 and 6 to specify day
of the week--0 refers to Sunday.
These functions were taken from Becker, Chambers, and Wilks (1988),
and were slightly modified to take \code{chron} and \code{dates}
objects; some also take the extra argument \code{origin.}.
%The original functions are stored in the \code{library(example)}.
}
\seealso{
\code{\link{chron}},
\code{\link{dates}},
\code{\link{times}}
}
\examples{
julian(1, 1, 1970)
# [1] 0
unlist(month.day.year(0))
# month day year
# 1 1 1970
}
\keyword{chron}
chron/man/yearmon.Rd 0000644 0001751 0000144 00000004324 11304021305 014105 0 ustar hornik users \name{yearmon}
\alias{as.chron.yearmon}
\alias{as.chron.yearqtr}
\alias{as.chron.ts}
\title{Convert monthly or quarterly data to chron}
\description{
These functions can be used to convert the times of \code{"ts"} series
with \code{frequency} of 12 or 4 or objects of \code{"yearmon"} and
\code{"yearqtr"} class, as defined in the \pkg{"zoo"} package, to
\code{chron} dates.
}
\usage{
\method{as.chron}{yearmon}(x, frac = 0, holidays = FALSE, ...)
\method{as.chron}{yearqtr}(x, frac = 0, holidays = FALSE, ...)
\method{as.chron}{ts}(x, frac = 0, holidays = FALSE, ...)
}
\arguments{
\item{x}{an object of class \code{"\link[zoo]{yearmon}"} or
\code{"\link[zoo]{yearqtr}"} or \code{"\link[stats]{ts}"} objects,
or a numeric vector interpreted \dQuote{in years} and fractions of
years.}
\item{frac}{Number between zero and one inclusive representing
the fraction of the way through the month or quarter.}
\item{holidays}{If \code{TRUE} or a vector of chron dates, indicated
holidays and weekends are excluded so the return value will be a
non-holiday weekday.}
\item{\dots}{Other arguments passed to \code{\link{chron}}.}
}
\details{
The \code{"yearmon"} and \code{"yearqtr"} classes are defined in
package \pkg{zoo}. If \code{holidays} is \code{TRUE} or a vector of
dates then the \code{is.holiday} function is used to determine whether
days are holidays.
The method for ts objects converts the times corresponding to
\code{time(x)} to chron. The ts series must have a frequency that is
a divisor of 12.
}
\value{
Returns a \code{chron} object.
}
\seealso{
\code{\link{is.holiday}},
\code{\link{ts}}
}
\examples{
## Monthly time series data.
as.chron(AirPassengers)
as.chron(time(AirPassengers))
## convert to first day of the month that is not a weekend or holiday
as.chron(AirPassengers, frac = 0, holidays = TRUE)
## convert to last day of the month
as.chron(AirPassengers, frac = 1)
## convert to last day of the month that is not a weekend or holiday
as.chron(AirPassengers, frac = 1, holidays = TRUE)
## convert to last weekday of the month
as.chron(AirPassengers, frac = 1, holidays = c())
## Quarterly time series data.
as.chron(presidents)
as.chron(time(presidents))
}
\keyword{ts}
chron/man/trunc.times.Rd 0000644 0001751 0000144 00000002326 12466644625 014740 0 ustar hornik users \name{trunc.times}
\alias{round.times}
\alias{trunc.times}
\title{Truncate times Objects}
\description{
Truncate times objects.
}
\usage{
\method{trunc}{times}(x, units = "days", eps = 1e-10, \dots)
}
\arguments{
\item{x}{a \code{"times"} object.}
\item{units}{Can be one of \code{"days"}, \code{"hours"},
\code{"minutes"}, \code{"seconds"} or an unambiguous abbreviated
version of any of those.}
\item{eps}{Comparison tolerance. Times are considered equal if their
absolute difference is less than \code{eps}.}
\item{\dots}{further arguments to be passed to or from methods.}
}
\details{
The time is truncated to the second, minute, hour or day or to the
value specified.
There is also a \code{round} method which has the same arguments as
the \code{trunc} method, and performs rounding instead of truncation.
}
\value{
An object of class \code{"times"}.
}
\seealso{
\code{\link{trunc}} for the generic function and default methods.
}
\examples{
tt <- times(c("12:13:14", "15:46:17"))
trunc(tt, "minutes")
trunc(tt, "min")
trunc(tt, times("00:01:00"))
trunc(tt, "00:01:00")
trunc(tt, 1/(24*60))
tt2 <- structure(c(3.0, 3.1, 3.5, 3.9), class = "times")
trunc(tt2, "day")
trunc(tt2)
}
\keyword{chron}
chron/man/seq.dates.Rd 0000644 0001751 0000144 00000002632 14021343656 014341 0 ustar hornik users \name{seq.dates}
\alias{seq.dates}
\title{
Generate Chron or Dates Sequences
}
\description{
Generate a regular sequence of dates.
}
\usage{
\method{seq}{dates}(from, to, by = "days", length., \dots)
}
\arguments{
\item{from}{starting date; it can be a chron or dates object, a
character string, e.g., \code{"05/23/91"}, or a Julian date.}
\item{to}{ending date, like \code{from}.}
\item{by}{either a numeric value or one of the valid strings
\code{"days"}, \code{"weeks"}, \code{"months"}, or \code{"years"}.}
\item{length.}{optional number of elements in the sequence.}
\item{\dots}{further arguments to be passed to or from methods.}
}
\value{a sequence with values (\code{from}, \code{from + by},
\code{from + 2*by}, \dots, \code{to}) of class
\code{class(from)} and origin \code{origin(from)}.
Note that \code{from} must be less than or equal to the argument
\code{to}.
}
\examples{
seq.dates("01/01/92", "12/31/92", by = "months")
# [1] 01/01/92 02/01/92 03/01/92 04/01/92 05/01/92 06/01/92
# [7] 07/01/92 08/01/92 09/01/92 10/01/92 11/01/92 12/01/92
end.of.the.month <- seq.dates("02/29/92", by = "month", length. = 15)
end.of.the.month
# [1] 02/29/92 03/31/92 04/30/92 05/31/92 06/30/92 07/31/92
# [7] 08/31/92 09/30/92 10/31/92 11/30/92 12/31/92 01/31/93
# [13] 02/28/93 03/31/93 04/30/93
}
\seealso{
\code{\link{chron}},
\code{\link{dates}},
\code{\link{cut.dates}}
}
\keyword{chron}
chron/man/is.holiday.Rd 0000644 0001751 0000144 00000002531 11304021305 014474 0 ustar hornik users \name{is.holiday}
\alias{is.holiday}
\alias{is.weekend}
\alias{.Holidays}
\title{
Find Weekends and Holidays in a Chron or Dates Object
}
\description{
Determine the date represented by a chron or dates object is a weekend
or a holiday.
}
\usage{
is.weekend(x)
is.holiday(x, holidays)
.Holidays
}
\arguments{
\item{x}{an object inheriting from \code{"dates"}, or coercible to
\code{"chron"}.}
\item{holidays}{optional \code{"chron"} or \code{"dates"} object
listing holidays. If argument \code{holidays} is missing, either
the value of the object \code{.Holidays} (if it exists) or
\code{NULL} will be used.}
}
\value{
a logical object indicating whether the corresponding date is a
weekend in the case of \code{is.weekend()} or a holiday in the case of
\code{is.holiday()}.
}
\seealso{
\code{\link{days}},
\code{\link{weekdays.default}},
\code{\link{months.default}},
\code{\link{quarters.default}},
\code{\link{years}};
\code{\link{chron}},
\code{\link{dates}},
\code{\link{cut.dates}},
\code{\link{seq.dates}}
}
\examples{
dts <- dates("01/01/98") + trunc(365 * runif(50))
table(is.weekend(dts))
.Holidays
# New Year Memorial Indepen. Labor day Thanksgiving Christmas
# 01/01/92 05/25/92 07/04/92 09/07/92 11/26/92 12/25/92
# NOTE: Only these 6 holidays from 1992 are defined by default!
}
\keyword{chron}
chron/man/days.Rd 0000644 0001751 0000144 00000003311 11304021305 013366 0 ustar hornik users \name{days}
\alias{days}
\alias{months.default}
\alias{quarters.default}
\alias{weekdays.default}
\alias{years}
\title{
Return Various Periods from a Chron or Dates Object
}
\description{
Given a chron or dates object, extract the year, quarter, month, day
(within the month) or weekday (days within the week) of the date it
represents.
}
\usage{
days(x)
\method{weekdays}{default}(x, abbreviate = TRUE)
\method{months}{default}(x, abbreviate = TRUE)
\method{quarters}{default}(x, abbreviate = TRUE)
years(x)
}
\arguments{
\item{x}{an object inheriting from class \code{"\link{dates}"}, or
coercible to such via \code{\link{as.chron}}.}
\item{abbreviate}{
should abbreviated names be returned? Default is \code{TRUE}.
}
}
\value{
an ordered factor corresponding to days, weekdays, months, quarters,
or years of \code{x} for the respective function.
}
\details{
Note that \code{months}, \code{quarters} and \code{weekdays} are
generics defined in package \pkg{base} which also provides methods for
objects of class \code{"\link{Date}"} as generated, e.g., by
\code{\link{Sys.Date}}. These methods return \link{character} rather
than \link{factor} variables as the default methods in \pkg{chron} do.
To take advantage of the latter, Date objects can be converted to
dates objects using \code{\link{as.chron}}, see the examples.
}
\seealso{
\code{\link{is.weekend}},
\code{\link{is.holiday}}
}
\examples{
dts <- dates("07/01/78") + trunc(50 * rnorm(30))
plot(weekdays(dts))
plot(months(dts))
## The day in the current timezone as a Date object.
Dt <- Sys.Date()
## Using the months method for Date objects.
months(Dt)
## Using the months default method.
months(as.chron(Dt))
}
\keyword{chron}
chron/man/dates.Rd 0000644 0001751 0000144 00000003721 14021343552 013545 0 ustar hornik users \name{dates}
\alias{dates}
\alias{times}
\alias{Math.dates}
\alias{Ops.dates}
\alias{Summary.dates}
\alias{[<-.dates}
\alias{all.equal.dates}
\alias{as.data.frame.dates}
\alias{as.dates}
\alias{c.dates}
\alias{floor.dates}
\alias{format.dates}
\alias{print.dates}
\alias{trunc.dates}
\alias{Math.times}
\alias{Ops.times}
\alias{Summary.times}
\alias{[.times}
\alias{[<-.times}
\alias{[[.times}
\alias{as.character.times}
\alias{as.data.frame.times}
\alias{as.times}
\alias{axis.times}
\alias{c.times}
\alias{diff.times}
\alias{format.times}
\alias{format<-.times}
\alias{hist.times}
\alias{identify.times}
\alias{is.na.times}
\alias{lines.times}
\alias{mean.times}
\alias{plot.times}
\alias{points.times}
\alias{print.times}
\alias{quantile.times}
\alias{summary.times}
\title{
Generate Dates and Times Components from Input
}
\description{
Create objects which represent dates or times.
}
\usage{
dates(x, \dots)
times(x, \dots)
}
\arguments{
\item{x}{a chron object, a character vector, or a numeric vector
specifying time. If character, it must be in a format recognized by
\code{chron()}. If numeric, it specifies Julian dates, i.e., number
of days since an origin.}
\item{...}{parameters for \code{chron()}.}
}
\value{
An object of class \code{dates} or \code{times}, depending of the
function called.
These functions return objects inheriting from dates and times,
respectively. They call \code{chron()} if \code{x} does not belong to
any of the chronological classes.
}
\examples{
dts <- dates(c("02/27/92", "02/27/92", "01/14/92",
"02/28/92", "02/01/92"))
dts
# [1] 02/27/92 02/27/92 01/14/92 02/28/92 02/01/92
class(dts)
x <- chron(dates. = c("02/27/92", "02/27/92", "01/14/92", "02/28/92"),
times. = c("23:03:20", "22:29:56", "01:03:30", "18:21:03"))
dates(x)
# [1] 02/27/92 02/27/92 01/14/92 02/28/92
}
\seealso{
\code{\link{chron}},
\code{\link{times}},
\code{\link{seq.dates}},
\code{\link{cut.dates}}
}
\keyword{chron}
chron/man/chron.Rd 0000644 0001751 0000144 00000013216 14021343477 013564 0 ustar hornik users \name{chron}
\alias{chron}
\alias{as.chron}
\alias{as.chron.default}
\alias{as.chron.POSIXt}
\alias{as.chron.Date}
\alias{as.chron.factor}
\alias{is.chron}
\alias{as.data.frame.chron}
\alias{print.chron}
\title{
Create a Chronological Object
}
\description{
Create chronological objects which represent dates and times of day.
}
\usage{
chron(dates., times., format = c(dates = "m/d/y", times = "h:m:s"),
out.format, origin.)
}
\arguments{
\item{dates.}{character or numeric vector specifying dates. If
character, \code{dates.} are assumed to be in one of the date
formats below; if numeric, \code{dates.} are assumed to be Julian
dates, i.e., number of days since \code{origin.}.}
\item{times.}{optional character or numeric vector specifying times of
day. If character, \code{times.} are assumed to be in one of the
time formats below; if numeric, \code{times.} are assumed to be
fractions of a day.}
\item{format}{vector or list specifying the input format of the input.
The format can be either strings specifying one of the recognized
formats below or a list of user-supplied functions to convert dates
from character into Julian dates and vice versa.
The dates format can be any permutation of the characters
\code{"d"}, \code{"m"}, or \code{"y"} delimited by a separator
(possibly null), e.g., \code{"m/d/y"}, \code{"d-m-y"}, \code{"ymd"},
are all valid; the format can also be permutations of the words
\code{"day"}, \code{"month"} and \code{"year"} (with non-null
separator), which produces the month name, e.g., \code{"month day
year"} produces \code{"April 20 1992"}, \code{"day mon year"}
produces \code{"20 Apr 1992"}.
The times format can be any permutation of \code{"h"}, \code{"m"},
and \code{"s"} separated by any one non-special character. The
default is \code{"h:m:s"}.}
\item{out.format}{vector or list specifying date and time format for
printing and output. Default is same as \code{format}.}
\item{origin.}{a vector specifying the date with respect to which
Julian dates are computed. Default is
\code{c(month = 1, day = 1, year = 1970)};
you may set the option \code{chron.origin} to specify your own
default, e.g.,
\code{options(chron.origin = c(month=1, day=1, year=1990))}.}
}
\value{
An object of class \code{"times"} if only \code{times.} were
specified, \code{"dates"} if only \code{dates.}, or \code{"chron"} if
both \code{dates.} and \code{times.} were supplied. All these inherit
from class \code{"times"}.
These objects represent dates and times of day, and allow the
following arithmetic and summaries: subtraction \code{d1-d2},
constant addition \code{d1+constants}, all logical comparisons,
summaries \code{min()}, \code{max()}, and \code{range()} (which drop
NAs by default); constants specify days (fractions are converted to
time-of-day, e.g., 2.5 represents 2 days and 12 hours). Operations
such as sorting, differencing, etc., are automatically handled.
There are methods for \code{as.character()}, \code{as.numeric()},
\code{cut()}, \code{is.na()}, \code{print()}, \code{summary()},
\code{plot()}, \code{lines()}, \code{lag()}, and the usual subsetting
functions \code{[}, \code{[<-}.
The functions \code{days()}, \code{months()}, \code{quarters()},
\code{years()}, \code{weeks()}, \code{weekdays()}, \code{hours()},
\code{minutes()}, and \code{seconds()} take any \code{chron} object as
input and extract the corresponding time interval.
\code{cut()} is used to create ordered factors from \code{chron}
objects. Chronological objects may be used with the modeling software.
If \code{x} is \code{character} then it will be converted using
\code{as.POSIXct} (with the \code{format} argument, if any, passed to
\code{as.POSIXct}) and \code{tz = "GMT"} and then converted
to \code{chron}. If \code{x} is \code{numeric} and \code{format}
is not specified then it will be converted to \code{chron}
using \code{chron(x)}. If \code{x} is \code{numeric} and \code{format}
is \code{specified} then \code{x} will be converted to character and
then processed using \code{as.POSIXct} as discussed above. If the
format is specified as \code{NULL} it will be treated the same as if
it were \code{missing}.
The current implementation of \code{chron} objects does not handle
time zones nor daylight savings time.
}
\seealso{
\code{\link{dates}},
\code{\link{times}},
\code{\link{julian.default}},
\code{\link{cut.dates}},
\code{\link{seq.dates}}.
}
\examples{
dts <- dates(c("02/27/92", "02/27/92", "01/14/92",
"02/28/92", "02/01/92"))
dts
# [1] 02/27/92 02/27/92 01/14/92 02/28/92 02/01/92
tms <- times(c("23:03:20", "22:29:56", "01:03:30",
"18:21:03", "16:56:26"))
tms
# [1] 23:03:20 22:29:56 01:03:30 18:21:03 16:56:26
x <- chron(dates. = dts, times. = tms)
x
# [1] (02/27/92 23:03:19) (02/27/92 22:29:56) (01/14/92 01:03:30)
# [4] (02/28/92 18:21:03) (02/01/92 16:56:26)
# We can add or subtract scalars (representing days) to dates or
# chron objects:
c(dts[1], dts[1] + 10)
# [1] 02/27/92 03/08/92
dts[1] - 31
# [1] 01/27/92
# We can substract dates which results in a times object that
# represents days between the operands:
dts[1] - dts[3]
# Time in days:
# [1] 44
# Logical comparisons work as expected:
dts[dts > "01/25/92"]
# [1] 02/27/92 02/27/92 02/28/92 02/01/92
dts > dts[3]
# [1] TRUE TRUE FALSE TRUE TRUE
# Summary operations which are sensible are permitted and work as
# expected:
range(dts)
# [1] 01/14/92 02/28/92
diff(x)
# Time in days:
# [1] -0.02319444 -44.89335648 45.72052083 -27.05876157
sort(dts)[1:3]
# [1] 01/14/92 02/01/92 02/27/92
}
\keyword{chron}
chron/man/cut.dates.Rd 0000644 0001751 0000144 00000003363 11304021305 014327 0 ustar hornik users \name{cut.dates}
\alias{cut.dates}
\title{
Create a Factor from a Chron or Dates Object
}
\description{
Divide the range of a chron or dates object \code{x} into intervals
and code the values in \code{x} according to which interval they fall.
}
\usage{
\method{cut}{dates}(x, breaks, labels, start.on.monday = TRUE, \dots)
}
\arguments{
\item{x}{chron or dates object (see \code{chron}), character dates
such as \code{"10/04/91"} or Julian dates).}
\item{breaks}{either a vector of break points (a \code{dates} vector,
character dates such as \code{"10/04/91"} or Julian dates), a
constant specifying number of equally spaced intervals extending
from \code{min(x)-1} to \code{max(x)+1}, or one of the strings in
\code{c("days", "weeks", "months", "year")} specifying a time
period.}
\item{labels}{character labels for intervals.}
\item{start.on.monday}{should weeks be assumed to start on Mondays?
Default is \code{TRUE}. Set to \code{FALSE} if weeks start on
Sundays; for other days of the week specify the corresponding
number: Sunday == 0, Monday == 1, Tuesday == 2, \dots, Saturday ==
6.}
\item{\dots}{further arguments to be passed to or from methods.}
}
\value{an ordered factor whose levels represent the various time
intervals.}
\seealso{
\code{\link{seq.dates}}}
\examples{
# days from 07/01/92 thru 07/15/92 fell into 3 Monday-started weeks
cut(dates("07/01/92") + 0:14, "weeks")
# [1] week 1 week 1 week 1 week 1 week 1 week 2 week 2 week 2
# [9] week 2 week 2 week 2 week 2 week 3 week 3 week 3
dts <- dates(c("02/27/92", "02/27/92", "01/14/92",
"02/28/92", "02/01/92"))
cut(dts, "months")
# [1] Feb 92 Feb 92 Jan 92 Feb 92 Feb 92
boxplot(runif(5) ~ cut(dts, "months"))
}
\keyword{chron}
chron/man/hours.Rd 0000644 0001751 0000144 00000001406 14021343627 013606 0 ustar hornik users \name{hours}
\alias{hours}
\alias{minutes}
\alias{seconds}
\title{
Return Hours, Minutes, or Seconds from a Times Object
}
\description{
Given a chron or times object, extract the hours, minutes or seconds
of the time it represents.
}
\usage{
hours(x)
minutes(x)
seconds(x)
}
\arguments{
\item{x}{an object inheriting from class \code{"\link{times}"}, or
coercible to such via \code{\link{as.chron}}.}
}
\value{
the corresponding time period as an ordered factor.
}
\examples{
x <- chron(dates. = c("02/27/92", "02/27/92", "01/14/92", "02/28/92"),
times. = c("23:03:20", "22:29:56", "01:03:30", "18:21:03"))
h <- hours(x)
y <- runif(4)
boxplot(y ~ h)
}
\seealso{
\code{\link{chron}},
\code{\link{dates}},
\code{\link{times}}
}
\keyword{chron}
chron/man/origin.Rd 0000644 0001751 0000144 00000001460 13166144745 013746 0 ustar hornik users \name{origin}
\alias{origin}
\alias{origin<-}
\title{
Chron Origin
}
\description{
Get and set chron origin.
}
\usage{
origin(x)
origin(x) <- value
}
%- maybe also 'usage' for other objects documented here.
\arguments{
\item{x}{
a chron object
}
\item{value}{
month, day, year vector
}
}
\details{
\code{origin} extracts the origin of its argument. \code{origin<-} sets the
origin of its argument.
}
\value{
The \code{origin} function returns a month, day, year vector.
}
\note{
The default origin for chron objects is January 1, 1970 and it is recommended
that that origin be used. Some chron functions may not perform properly
with a non-default origin.
}
\seealso{\code{\link{chron}}}
\examples{
ch <- as.chron(Sys.Date())
origin(ch)
}
\keyword{chron}
chron/man/chron-internal.Rd 0000644 0001751 0000144 00000002635 13716726335 015411 0 ustar hornik users \name{chron-internal}
\title{Internal chron objects}
%\alias{clock2frac}
%\alias{convert.chron}
%\alias{convert.dates}
%\alias{convert.times}
%\alias{count.events}
%\alias{count.fields.str}
%\alias{day.abb}
%\alias{day.name}
%\alias{format<-}
%\alias{frac2clock}
%\alias{julian2mine}
%\alias{mine2julian}
%\alias{month.length}
%\alias{my.axis}
%\alias{new.chron}
%\alias{parse.format}
%\alias{unpaste}
\alias{year.expand}
\alias{year.strict}
\description{
Internal chron objects.
}
\usage{
%clock2frac(str)
%convert.chron(x, format = c(dates = "m/d/y", times = "h:m:s"), origin.,
% sep = " ", enclose = c("(", ")"), \dots)
%convert.dates(dates. = NULL, format = "m/d/y", origin., length. = 0,
% \dots)
%convert.times(times = NULL, format = "h:m:s", length. = 0, \dots)
%count.events(x, by)
%count.fields.str(str, sep = "")
%day.abb
%day.name
%frac2clock(f)
%julian2mine(x)
%mine2julian(str)
%month.length
%my.axis(x, simplify = TRUE, \dots)
%new.chron(x, new.origin = c(1, 1, 1970), shift = julian(new.origin[1],
% new.origin[2], new.origin[3], c(0, 0, 0)))
%parse.format(format, year.abb = getOption("chron.year.abb"), \dots)
%unpaste(str, sep = "/", fnames = NULL, nfields = NULL,
% first = c(1, 3, 5), width = 2)
year.expand(y, cut.off = 69, century = c(1900, 2000), \dots)
year.strict(\dots)
}
\details{
These are not to be called by the user.
}
\keyword{utilities}
\keyword{internal}
chron/man/format.chron.Rd 0000644 0001751 0000144 00000002356 14021343600 015042 0 ustar hornik users \name{format.chron}
\alias{format.chron}
\title{Format a chron object}
\description{
Format a chron object.
}
\usage{
\method{format}{chron}(x, format = att$format, origin. = att$origin,
sep = " ", simplify, enclosed = c("(", ")"), ...)
}
\arguments{
\item{x}{
A chron object.
}
\item{format}{
As in \code{\link{chron}} or a single character string with percent codes as
detailed in \code{\link[base]{strptime}}.
}
\item{origin.}{
As in \code{\link{chron}}.
}
\item{sep}{
A character string that separates the dates and times in the output. Ignored
if percent codes are used in \code{format}.
}
\item{simplify}{
As in \code{\link{format.dates}}. Ignored
if percent codes are used in \code{format}.
}
\item{enclosed}{
A character vector of length 2 containing the strings that begin and end
each output date/time.
Ignored if percent codes are used in \code{format}.
}
\item{\dots}{
Not currently used.
}
}
\value{
A character vector.
}
\seealso{
\code{\link{chron}}.
\code{\link{format.dates}}.
\code{\link[base]{strptime}}.
}
\examples{
format(chron(0, 0), c("yy/m/d", "h:m:s"), sep = "T", enclosed = c("", ""))
format(chron(0, 0), "\%Y-\%m-\%dT\%H:\%M:\%S") # same
}
\keyword{misc}
chron/DESCRIPTION 0000644 0001751 0000144 00000002076 14734745731 013133 0 ustar hornik users Package: chron
Version: 2.3-62
Title: Chronological Objects which Can Handle Dates and Times
Description: Provides chronological objects which can handle dates and times.
Authors@R: c(person("David", "James", role = "aut",
comment = "S original"),
person("Kurt", "Hornik", role = c("aut", "trl", "cre"),
email = "Kurt.Hornik@R-project.org",
comment = c(ORCID = "0000-0003-4198-9911", "R port")),
person("Gabor", "Grothendieck", role = "ctb",
email = "ggrothendieck@gmail.com"),
person("R Core Team", role = "ctb"))
Depends: R (>= 2.12.0)
Imports: graphics, stats
Suggests: scales, ggplot2
Enhances: zoo
License: GPL-2
NeedsCompilation: yes
Packaged: 2024-12-30 13:17:12 UTC; hornik
Author: David James [aut] (S original),
Kurt Hornik [aut, trl, cre] (, R
port),
Gabor Grothendieck [ctb],
R Core Team [ctb]
Maintainer: Kurt Hornik
Repository: CRAN
Date/Publication: 2024-12-31 10:47:53 UTC