"chron" <- function(dates. = NULL, times. = NULL,
                    format = c(dates = "m/d/y", times = "h:m:s"),
                    out.format = format, origin.) {
    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 - trunc(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. = trunc(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.))
        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, ...) {
    if (inherits(x, "chron"))
        return(x)
    if (is.character(x) || is.numeric(x))
        return(chron(x, ...))
    if (all(is.na(x)))
        return(x)
    stop("`x' cannot be coerced to a chron object")
}
as.chron.POSIXt <- function(x, offset = 0, ...) {
    ## offset is in hours relative to GMT
    if (!inherits(x, "POSIXt")) stop("wrong method")
    x <- unclass(as.POSIXct(x)) + 60*round(60*offset)
    tm <- x %% 86400
    if (any(tm != 0))
        chron(dates. = x %/% 86400, times. = tm/86400, ...)
    else
        chron(dates. = x %/% 86400, ...)
}

"is.chron" <-
function(x)
    inherits(x, "chron")

as.data.frame.chron <- .Alias(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(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 - trunc(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)
}
"dates"<-
function(x, ...)
    trunc(chron(dates. = x, ...))

"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 <- class(x)
    class(x) <- NULL
    out <- NextMethod(.Generic)
    class(out) <- cl
    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) <- c(.Class, class(val))
    }
    tms <- as.vector(val)
    tmp <- tms - trunc(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 <- class(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 <- .Alias(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(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 <- unpaste(dates., sep = fmt$sep, fnames = fmt$periods,
                   nfields = 3)
    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(as.character(dates.) != "NA"))
            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(trunc(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$mon)) <= 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$mon, sep = ""), 
                             first = nchar(paste(v$mon)))
        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$mon]
        else
            month.name[v$mon]
    }
    sep <- fmt$sep
    y <- character(length = length(x))
    if(!simplify)
        y[] <- paste(v[[perm[1]]], v[[perm[2]]], v[[perm[3]]], sep = sep)
    else {
        ## simplify (drop year/month when all equal)
        if(drop.mon) y[] <- v$day else if(drop.year) {
            perm <- perm[perm != "y"]	# drop years
            y[] <- paste(v[[perm[1]]], v[[perm[2]]], sep = sep)
        }
        else {
            perm <- perm[perm != "d"]	# drop days
            y[] <- paste(v[[perm[1]]], v[[perm[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(!is.null(to.org <- origin(to)) && any(to.org != org))
                origin(to) <- org
            to <- as.numeric(to)
        }
        x <- NextMethod("seq")	
	## 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.default(from = frm, to = t0)
    if(by == "days")
        return(chron(x, format = fmt, origin = org))
    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]
        return(chron(x, format = fmt, origin = org))
    }
    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
        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
            x <- sort(c(x1, x2))
        }
        ## simple case
        return(chron(x, format = fmt, origin = org))
    }
    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]
        return(chron(x, format = fmt, origin = org))
    }
}

"trunc.dates" <-
function(x) {
    cl <- class(x)
    class(x) <- NULL
    out <- NextMethod("trunc")
    class(out) <- cl[!as.logical(match(cl, "chron", 0))]
    out
}
"times"<-
function(x, ...)
    chron(times. = x, ...)

"Math.times" <-
function(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 <- .Alias(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 <- pretty(c(rng, as.numeric(x[!bad])))
    att <- attributes(x)
    at.x <- structure(tmp[tmp >= rng[1] & tmp <= rng[2]], format = att$
                      format, origin = att$origin, class = att$class)
    if(inherits(at.x, "chron")) class(at.x) <- class(at.x)[-1]	
    ## chrons put dates labels only
    ## force in data ends for times objects (the next block is a kludge!)
    ## if plotting times only, fake the time 1.0 to print as midnight
    if(missing(labels) || (is.logical(labels) && labels)) {
        if(!inherits(x, "dates")) {
            at.x[c(1, length(at.x))] <- range(x)
            if(max(at.x) == 1)
                labels <- format(at.x - trunc(at.x), simplify = simplify)
            else
                labels <- format(at.x, simplify = simplify)
        }
        else 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(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 <- out$h != "NA" & out$m != "NA" & out$s != "NA"
    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(times != "NA"))
            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] > 59)
    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]	
    ## times greater than 1 day  should format like numerics
    nas <- is.na(x)
    days <- abs(trunc(x))
    att$class <- att$format <- att$origin <- NULL
    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)
        out <- barplot(tt$counts, width = tt$breaks, histo = TRUE, ..., 
                       xlab = xlab, axes = FALSE)
        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, cex = cex, font = font, 
                         las = las, lab = lab, mgp = mgp, tcl = tcl)
            }
            else if(yaxt != "n")
                axis(2, adj = adj, 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))
        cex <- par("cex")
    if(is.null(col <- dots$col))
        col <- par("col")
    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")	
    ## 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
}

"summary.times"<-
function(x, digits = 12, ...) {
    if(!as.logical(length(x)))
        return(x)
    att <- attributes(x)
    class(x) <- NULL
    y <- as.numeric(x)
    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
}
".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"))
        if((is.character(x) || is.numeric(x)))
            x <- chron(x)
        else return(NULL)
    d <- month.day.year(trunc(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"))
        return(NULL)
    x <- as.numeric(x)
    h <- trunc(24 * (x - trunc(x)))
    h
}
"minutes"<-
function(x) {
    if(!inherits(x, "times"))
        return(NULL)
    x <- as.numeric(x)
    secs <- 24 * 60 * (x - trunc(x))
    m <- trunc(secs) %% 60
    m
}
"seconds"<-
function(x) {
    if(!inherits(x, "times"))
        return(NULL)
    x <- as.numeric(x)
    secs <- 24 * 3600 * (x - trunc(x))
    trunc(secs) %% 60
}

"quarters.default"<-
function(x, abb = TRUE) {
    if(!inherits(x, "dates"))
        if((is.character(x) || is.numeric(x)))
            x <- chron(x)
        else return(NULL)
    v <- month.day.year(trunc(as.numeric(x)))$month
    out <- (v - 1) %/% 3 + 1
    lbl <- if(abb)
        c("1Q", "2Q", "3Q", "4Q")
    else
        c("I", "II", "III", "IV")
    out <- lbl[out]
    ordered(out, levels = lbl, labels = lbl)
}
"months.default"<-
function(x, abb = 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(abb) month.abb else month.name
    out <- lbl[out]
    ordered(out, levels = lbl, labels = lbl)
}
"weekdays.default" <-
function(x, abb = 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(abb) day.abb else day.name
    out <- lbl[out]
    ordered(out, levels = lbl, labels = lbl)
}
"years" <-
function(x) {
    if(!inherits(x, "dates"))
        if((is.character(x) || is.numeric(x)))
            x <- chron(x)
        else return(NULL)
    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 == ""
    ## load.if.needed("chron_strs.o")
    .C(NAME = "cnt_flds_str",
       strings = as.character(str),
       nstrings = as.integer(n),
       sep = as.character(sep),
       white.space = as.integer(white.space),
       counts = integer(n),
       PACKAGE = "chron")$count
}

"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"))
        if(is.character(x) || is.numeric(x))
            x <- dates(x)
        else stop("x must inherit from dates")
    if(missing(holidays))
        if(exists(".Holidays"))
            holidays <- .Holidays
        else holidays <- NULL
    orig.x <- origin(x)
    if(!is.null(orig.h <- origin(holidays)) && any(orig.x != orig.h))
        origin(holidays) <- orig.x
    out <- match(trunc(x), trunc(holidays), 0)
    as.logical(out)
}

"is.weekend" <-
function(x) {
    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	
    ## recall out is between 1 (Sunday) and 7 (Saturday)
    out == 1 | out == 7
}

"julian.default" <-
function(m, d, y, origin.) {
    only.origin <- all(missing(m), missing(d), missing(y))
    if(only.origin) m <- 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)
    m <- c(origin.[1], m)               # prepend month of new origin
    d <- c(origin.[2], d)               # prepend day of new origin
    y <- c(origin.[3], 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 = "")
    m <- substring(month.name[v$month], 1, 3)
    y <- v$year - 1900
    out <- paste(d, m, y, sep = "")
    out
}

"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, 7)
    m <- match(m, substring(month.name, 1, 3), nomatch = NA)
    julian(m, as.numeric(d), as.numeric(y) + 1900)
}

"month.day.year" <-
function(jul, origin.) {
    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 <- jul + 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 <- " "
        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 <- str == "NA" | 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 <- .C(NAME = "unpaste",
                  strings = as.character(str),
                  nstrings = as.integer(n),
                  sep = as.character(sep),
                  white.space = as.integer(white.space),
                  nfields = as.integer(nfields),
                  output = vector("list", length = nfields),
                  PACKAGE = "chron")$output
    }
    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] <- "NA"
        }
    }
    names(out) <- fnames
    return(out)
}
"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
}
".First.lib" <-
function (lib, pkg) {
    library.dynam("chron", pkg, lib)

    ## 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")

    options(chron.year.abb = TRUE,
            chron.year.expand = "year.expand")
}

## The following are generic in R 1.3.0.
if(R.version$major <= 1 && R.version$minor < 3) {
    cat("I am here\n")
    julian <- function(x, ...) UseMethod("julian")
    months <- function(x, abbreviate) UseMethod("months")
    quarters <- function(x, abbreviate) UseMethod("quarters")
    weekdays <- function(x, abbreviate) UseMethod("weekdays")
}
