Created
October 25, 2016 17:15
-
-
Save AndreMikulec/aceb20a0b6c170027b035519ca7a3adb to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ## meant to be an R Package zoo S3 object | |
| # | |
| seq.yearqtr <- function(from, to, by, length.out = NULL, along.with = NULL, ...) { | |
| # R version 3.3.1 (2016-06-21) -- "Bug in Your Hair" | |
| # | |
| require(zoo) # zoo_1.7-13 | |
| # exactly two of 'to', 'by' and 'length.out' / 'along.with' must be specified | |
| # seq.Date - missing | |
| if (missing(from)) | |
| stop("'from' must be specified") | |
| if (!inherits(from, "yearqtr")) | |
| stop("'from' must be a \"yearqtr\" object") | |
| if (length(as.yearqtr(from)) != 1L) | |
| stop("'from' must be of length 1") | |
| if (!missing(to)) { | |
| if (!inherits(to, "yearqtr")) | |
| stop("'to' must be a \"yearqtr\" object") | |
| if (length(as.yearqtr(to)) != 1L) | |
| stop("'to' must be of length 1") | |
| } | |
| if (!missing(along.with)) { | |
| length.out <- length(along.with) | |
| } | |
| else if (!is.null(length.out)) { | |
| if (length(length.out) != 1L) | |
| stop("'length.out' must be of length 1") | |
| length.out <- ceiling(length.out) | |
| } | |
| status <- c(!missing(to), !missing(by), !is.null(length.out)) | |
| if (sum(status) != 2L) | |
| stop("exactly two of 'to', 'by' and 'length.out' / 'along.with' must be specified") | |
| # seq.Date - by management | |
| if (missing(by)) { | |
| from <- unclass(as.yearqtr(from)) | |
| to <- unclass(as.yearqtr(to)) | |
| res <- seq.int(from, to, length.out = length.out) | |
| return(structure(res, class = "yearqtr")) | |
| } | |
| if (length(by) != 1L) | |
| stop("'by' must be of length 1") | |
| # meant for inherited from "difftime" or was a "character" test and manipulation | |
| # does not apply to this code | |
| valid <- 0L | |
| if (!is.numeric(by)) | |
| stop("invalid mode for 'by'") | |
| if (is.na(by)) | |
| stop("'by' is NA") | |
| # always TRUE because 'by' never inherited from "difftime" nor was a "character" and | |
| # never did the inherited from "difftime" or was a "character" test and manipulation | |
| if (valid <= 2L) { | |
| from <- unclass(as.yearqtr(from)) | |
| if (!is.null(length.out)) | |
| res <- seq.int(from, by = by, length.out = length.out) | |
| else { | |
| to0 <- unclass(as.yearqtr(to)) | |
| res <- seq.int(0, to0 - from, by) + from | |
| } | |
| res <- structure(res, class = "yearqtr") | |
| } | |
| # do not try to convert to POSIX__ | |
| # so skip | |
| if (!missing(to)) { | |
| to <- as.yearqtr(to) | |
| res <- if (by > 0) | |
| res[res <= to] | |
| else res[res >= to] | |
| } | |
| res | |
| } | |
| # seq.yearqtr(as.yearqtr("2000 Q1"),as.yearqtr("2002 Q1")) | |
| # Error in seq.yearqtr(as.yearqtr("2000 Q1"), as.yearqtr("2002 Q1")) : | |
| # exactly two of 'to', 'by' and 'length.out' / 'along.with' must be specified | |
| # seq.yearqtr(as.yearqtr("2000 Q1"),as.yearqtr("2002 Q1"), length.out = 2) | |
| # [1] "2000 Q1" "2002 Q1" | |
| # seq.yearqtr(as.yearqtr("2000 Q1"),as.yearqtr("2002 Q1"), length.out = 3) | |
| # [1] "2000 Q1" "2001 Q1" "2002 Q1" | |
| # seq.yearqtr(as.yearqtr("2000 Q1"),as.yearqtr("2002 Q1"), length.out = 4) | |
| # [1] "2000 Q1" "2000 Q4" "2001 Q2" "2002 Q1" | |
| # seq.yearqtr(as.yearqtr("2000 Q1"),as.yearqtr("2002 Q1"), by = 0.25) | |
| # [1] "2000 Q1" "2000 Q2" "2000 Q3" "2000 Q4" "2001 Q1" "2001 Q2" "2001 Q3" | |
| # [8] "2001 Q4" "2002 Q1" | |
| # seq.yearqtr(as.yearqtr("2002 Q1"),as.yearqtr("2000 Q1"), by = -0.25) | |
| # [1] "2002 Q1" "2001 Q4" "2001 Q3" "2001 Q2" "2001 Q1" "2000 Q4" "2000 Q3" | |
| # [8] "2000 Q2" "2000 Q1" | |
| # copy and paste yearqtr with yearmon | |
| # | |
| # example/test run data has been adjusted | |
| ## meant to be an R Package zoo S3 object | |
| # | |
| seq.yearmon <- function(from, to, by, length.out = NULL, along.with = NULL, ...) { | |
| # R version 3.3.1 (2016-06-21) -- "Bug in Your Hair" | |
| # | |
| require(zoo) # zoo_1.7-13 | |
| # exactly two of 'to', 'by' and 'length.out' / 'along.with' must be specified | |
| # seq.Date - missing | |
| if (missing(from)) | |
| stop("'from' must be specified") | |
| if (!inherits(from, "yearmon")) | |
| stop("'from' must be a \"yearmon\" object") | |
| if (length(as.yearmon(from)) != 1L) | |
| stop("'from' must be of length 1") | |
| if (!missing(to)) { | |
| if (!inherits(to, "yearmon")) | |
| stop("'to' must be a \"yearmon\" object") | |
| if (length(as.yearmon(to)) != 1L) | |
| stop("'to' must be of length 1") | |
| } | |
| if (!missing(along.with)) { | |
| length.out <- length(along.with) | |
| } | |
| else if (!is.null(length.out)) { | |
| if (length(length.out) != 1L) | |
| stop("'length.out' must be of length 1") | |
| length.out <- ceiling(length.out) | |
| } | |
| status <- c(!missing(to), !missing(by), !is.null(length.out)) | |
| if (sum(status) != 2L) | |
| stop("exactly two of 'to', 'by' and 'length.out' / 'along.with' must be specified") | |
| # seq.Date - by management | |
| if (missing(by)) { | |
| from <- unclass(as.yearmon(from)) | |
| to <- unclass(as.yearmon(to)) | |
| res <- seq.int(from, to, length.out = length.out) | |
| return(structure(res, class = "yearmon")) | |
| } | |
| if (length(by) != 1L) | |
| stop("'by' must be of length 1") | |
| # meant for inherited from "difftime" or was a "character" test and manipulation | |
| # does not apply to this code | |
| valid <- 0L | |
| if (!is.numeric(by)) | |
| stop("invalid mode for 'by'") | |
| if (is.na(by)) | |
| stop("'by' is NA") | |
| # always TRUE because 'by' never inherited from "difftime" nor was a "character" and | |
| # never did the inherited from "difftime" or was a "character" test and manipulation | |
| if (valid <= 2L) { | |
| from <- unclass(as.yearmon(from)) | |
| if (!is.null(length.out)) | |
| res <- seq.int(from, by = by, length.out = length.out) | |
| else { | |
| to0 <- unclass(as.yearmon(to)) | |
| res <- seq.int(0, to0 - from, by) + from | |
| } | |
| res <- structure(res, class = "yearmon") | |
| } | |
| # do not try to convert to POSIX__ | |
| # so skip | |
| if (!missing(to)) { | |
| to <- as.yearmon(to) | |
| res <- if (by > 0) | |
| res[res <= to] | |
| else res[res >= to] | |
| } | |
| res | |
| } | |
| # seq.yearmon(as.yearmon("2000-01"),as.yearmon("2000-07")) | |
| # Error in seq.yearmon(as.yearmon("2000-01"), as.yearmon("2000-07")) : | |
| # exactly two of 'to', 'by' and 'length.out' / 'along.with' must be specified | |
| # seq.yearmon(as.yearmon("2000-01"),as.yearmon("2000-07"), length.out = 2) | |
| # [1] "Jan 2000" "Jul 2000" | |
| # seq.yearmon(as.yearmon("2000-01"),as.yearmon("2000-07"), length.out = 3) | |
| # [1] "Jan 2000" "Apr 2000" "Jul 2000" | |
| # seq.yearmon(as.yearmon("2000-01"),as.yearmon("2000-07"), length.out = 4) | |
| # [1] "Jan 2000" "Mar 2000" "May 2000" "Jul 2000" | |
| # seq.yearmon(as.yearmon("2000-01"),as.yearmon("2000-07"), by = 1/12) | |
| # [1] "Jan 2000" "Feb 2000" "Mar 2000" "Apr 2000" "May 2000" "Jun 2000" "Jul 2000" | |
| # seq.yearmon(as.yearmon("2000-07"),as.yearmon("2000-01"), by = -1/12) | |
| # [1] "Jul 2000" "Jun 2000" "May 2000" "Apr 2000" "Mar 2000" "Feb 2000" "Jan 2000" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment