chron/0000755000175100001440000000000013052640663011406 5ustar hornikuserschron/TODO0000644000175100001440000000044211304021305012056 0ustar hornikusersApparently, 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/inst/0000755000175100001440000000000012643170351012360 5ustar hornikuserschron/inst/CITATION0000644000175100001440000000202313022332675013513 0ustar hornikuserscitHeader("To cite in publications use:") ## R >= 2.8.0 passes package metadata to citation(). if(!exists("meta") || is.null(meta)) meta <- packageDescription("chron") year <- sub("-.*", "", meta$Date) note <- sprintf("R package version %s.", meta$Version) citEntry(entry = "Manual", title = { paste("chron: Chronological Objects which Can Handle", "Dates and Times") }, author = c( person("David", "James", email = "dj@research.bell-labs.com"), person("Kurt", "Hornik", email = "Kurt.Hornik@R-project.org")), year = year, note = { paste(note, "S original by David James, R port by Kurt Hornik.") }, url = "https://CRAN.R-project.org/package=chron", textVersion = { paste("David James and Kurt Hornik", sprintf("(%s).", year), "chron: Chronological Objects which Can Handle", "Dates and Times.", note) }) chron/src/0000755000175100001440000000000012213262740012167 5ustar hornikuserschron/src/chron_strs.c0000644000175100001440000000230713052635021014517 0ustar hornikusers#include #include /* 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/src/unpaste.c0000644000175100001440000000265313052635021014016 0ustar hornikusers#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/Rchron.h0000644000175100001440000000045013052635021013570 0ustar hornikusers#ifndef R_CHRON_H #define R_CHRON_H #include #include #include 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/init.c0000644000175100001440000000100413052635021013267 0ustar hornikusers#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/NAMESPACE0000644000175100001440000000424113037370023012617 0ustar hornikusersuseDynLib("chron", .registration = TRUE) import("stats") importFrom("graphics", "Axis", "axis", "barplot", "hist", "par", "plot", "plot.default", "plot.new", "plot.window", "rect") export(".Holidays", "as.chron", "chron", "dates", "day.of.week", "days", "hours", "is.chron", "is.holiday", "is.weekend", "leap.year", "minutes", "month.day.year", "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", "ts") S3method("as.chron", "yearmon") S3method("as.chron", "yearqtr") 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.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("axis", "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("summary", "times") S3method("unique", "times") S3method("trunc", "times") S3method("xtfrm", "times") chron/PORTING0000644000175100001440000000465511304021305012445 0ustar hornikusers* 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/R/0000755000175100001440000000000012263232202011574 5ustar hornikuserschron/R/scale.R0000644000175100001440000000121512050654336013017 0ustar hornikuserschron_trans <- function(format = "%Y-%m-%d", n = 5) { breaks. <- function(x) chron(scales::pretty_breaks(n)(x)) format. <- function(x) format(as.POSIXct(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.R0000644000175100001440000003070213041162760013067 0ustar hornikusers".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.R0000644000175100001440000003002612272247031013037 0ustar hornikusers"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(as.character(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/dates.R0000644000175100001440000004707412210664272013043 0ustar hornikusers## ## 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$m, mdy$d, mdy$y) + as.numeric(start.on.monday)), months = chron(julian(mdy$m, 1, mdy$y, origin. = orig)), years = chron(julian(1, 1, mdy$y, 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")) } chron/R/y2k.R0000644000175100001440000000073711304021305012426 0ustar hornikusers"year.strict" <- function(...) stop("you must expand 2-digit year abbreviations") "year.expand" <- function(y, cut.off = 30, 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/zzz.R0000644000175100001440000000132711620026042012556 0ustar hornikusers.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/times.R0000644000175100001440000005040012466440744013060 0ustar hornikusers"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) } chron/MD50000644000175100001440000000265413052640663011725 0ustar hornikuserscb7376e9a42f3666afb47876e31b29fa *ChangeLog b7f2827deb459d7d8fe99f39e4ac0a28 *DESCRIPTION cbc899a0054a4286615159b2e9909107 *NAMESPACE 511477d4726a20de1217d4c1d04c2ba9 *PORTING 5aab81d06d80d3dc85bc1e6128218282 *R/chron.R 4cfe85f3a8966bc4ad75ac4c6d2941f6 *R/dates.R 4a7b2014cd423294adf54bf9bc3f644c *R/scale.R 23b838b6ec69eba4c097d83324d38ee0 *R/times.R f72b672b6f247cf5182b4b3adb570b1c *R/utils.R d23e620c5efef86d7786e213d653c19c *R/y2k.R 197aae00b4c1a6d10ae20e316278c109 *R/zzz.R c21bddb925efb5bf2f60312ee5633817 *README eb8e6e1933c473bfb701fa6fa5900962 *TODO fe8a4bada67008bd64bd6cb052719f92 *inst/CITATION 63341c059709b9b6011ac17a4da82fda *man/chron-internal.Rd d2dff041ed1b133b4064bababa41d51e *man/chron.Rd 04c67aba25f5decc6da3b03b1b72d319 *man/cut.dates.Rd 52f83aa2d54f74d294a9eac5b367bda6 *man/dates.Rd 1a9256fa7df2992c907e98ca63cf1db4 *man/day.of.week.Rd 0b8b3de1603f0ea048b86b415bc754ff *man/days.Rd 44a3d53c960f3ba2a592bde7530ae6cf *man/format.chron.Rd d399b53e909032c4b0f24b43ff27790b *man/hours.Rd 63720c9e7b8630b97500f0d6152cd4ad *man/is.holiday.Rd e605e7af69e9d629d9866d17fdac94a0 *man/scale.Rd 69af9d3b3955fea1e7b1013237c40df1 *man/seq.dates.Rd d6c49f63dc886eae91aa5fe3e625572f *man/trunc.times.Rd 26a923baa28b8d1f648d5de066eeec43 *man/yearmon.Rd 9730582ab7786af2f1d2a34ca9e9c909 *src/Rchron.h e65fd24b5aef2cfb96c60668c23a9900 *src/chron_strs.c 19489d0427b2a1dd5555d713470c8b31 *src/init.c b088bc9d159d1b2bfa4dea777e4f125d *src/unpaste.c chron/README0000644000175100001440000000501312210543001012244 0ustar hornikusersThis 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/DESCRIPTION0000644000175100001440000000156313052640663013121 0ustar hornikusersPackage: chron Version: 2.3-50 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"), person("Gabor", "Grothendieck", role = "ctb", email = "ggrothendieck@gmail.com")) Depends: R (>= 2.12.0) Imports: graphics, stats Suggests: scales, ggplot2 Enhances: zoo License: GPL-2 NeedsCompilation: yes Packaged: 2017-02-20 18:48:49 UTC; hornik Author: David James [aut] (S original), Kurt Hornik [aut, trl, cre], Gabor Grothendieck [ctb] Maintainer: Kurt Hornik Repository: CRAN Date/Publication: 2017-02-20 20:21:23 chron/ChangeLog0000644000175100001440000005561413052634221013164 0ustar hornikusers2017-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/man/0000755000175100001440000000000012466441204012157 5ustar hornikuserschron/man/format.chron.Rd0000644000175100001440000000235512272247650015057 0ustar hornikusers\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", enclose = c("", "")) format(chron(0, 0), "\%Y-\%m-\%dT\%H:\%M:\%S") # same } \keyword{misc} chron/man/scale.Rd0000644000175100001440000000154512050654135013540 0ustar hornikusers\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/hours.Rd0000644000175100001440000000140411304021305013567 0ustar hornikusers\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/trunc.times.Rd0000644000175100001440000000232612466644625014740 0ustar hornikusers\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/days.Rd0000644000175100001440000000331111304021305013366 0ustar hornikusers\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/seq.dates.Rd0000644000175100001440000000263112272247077014346 0ustar hornikusers\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/chron.Rd0000644000175100001440000001321412272247061013560 0ustar hornikusers\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.Rd0000644000175100001440000000336311304021305014327 0ustar hornikusers\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/yearmon.Rd0000644000175100001440000000432411304021305014105 0ustar hornikusers\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/chron-internal.Rd0000644000175100001440000000271211304021305015355 0ustar hornikusers\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{origin} %\alias{origin<-} %\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))) %origin(x) %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 = 30, century = c(1900, 2000), \dots) year.strict(\dots) } \details{ These are not to be called by the user. } \keyword{utilities} \keyword{internal} chron/man/is.holiday.Rd0000644000175100001440000000253111304021305014474 0ustar hornikusers\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/dates.Rd0000644000175100001440000000365511304021305013541 0ustar hornikusers\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{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{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/day.of.week.Rd0000644000175100001440000000360511304021305014546 0ustar hornikusers\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}