#' A class for generalized month index
#'
#' In the "\code{gmon}" class, a integer number is used to indicate the month.
#' The number from 1 to 12 is used to indicate Jan to Dec of the
#' reference year. The number from -11 to 0 is used to indicate
#' Jan to Dec of the previous year, and the number from
#' 13 to 24 corresponds to the next year, and so on.
#'
#' When print a "\code{gmon}" object, the suffix ".0" means the
#' current year, ".1" means the next year and ".-1" means
#' the previous year, and so on.
#' For example, Feb of the next year is printed as "Feb.1".
#' The methods \code{scale_x_gmon} and \code{scale_y_gmon} are
#' provided to show "\code{gmon}" objects properly based on \code{ggplot}.
#'
#' @export
#' @examples
#' mvec <- gmon(-20:25)
#' print(mvec)
#' x <- 1 : 46
#' names(x) <- mvec
#' print(x)
#'
#' @param x a vector of integers.
#' @rdname gmon
gmon <- function (x) {
ret <- round(x)
class(ret) <- 'gmon'
return(ret)
}
#' Coercion from and to \code{gmon} class
#' @export
#' @return a "\code{gmon}" object.
#' @param x an numeric vector.
#' @param ... unused.
as.gmon <- function (x, ...) {
UseMethod('as.gmon')
}
#' @export
as.gmon.default <- function (x, ...) {
gmon(as.numeric(x))
}
#' @export
print.gmon <- function (x, ...) {
print(as.character(x))
}
#' @export
as.character.gmon <- function (x, ...) {
abb <- month.abb[true_month(x)]
rela.yr <- rela_year(x)
str <- paste(abb, '.', rela.yr, sep = '')
return(str)
}
#' @export
as.data.frame.gmon <- function (x, row.names = NULL, optional = FALSE, ...) {
nrows <- length(x)
nm <- paste(deparse(substitute(x), width.cutoff = 500), collapse = " ")
if (is.null(row.names)) {
if (nrows == 0)
row.names <- character(0)
else if (length(row.names <- names(x)) == nrows && !any(duplicated(row.names))) {
}
else if (optional)
row.names <- character(nrows)
else row.names <- seq_len(nrows)
}
names(x) <- NULL
value <- list(x)
if (!optional)
names(value) <- nm
attr(value, "row.names") <- row.names
class(value) <- "data.frame"
value
}
#' @export
format.gmon <- function (x, ...) {
return(format(as.character(x), ...))
}
#' @export
unique.gmon <- function (x, ...) {
return(gmon(unique.default(x, ...)))
}
#' @export
"[.gmon" <- function (x, ..., drop = TRUE)
{
cl <- oldClass(x)
class(x) <- NULL
ret <- NextMethod("[")
class(ret) <- cl
return(ret)
}
#' @export
as.numeric.gmon <- function (x, ...) {
unclass(x)
}
#' Get the relative years for a \code{gmon} object
#'
#' Get the relative years for a "\code{gmon}" object.
#'
#' @export
#' @return a vector.
#' @examples
#' num.mon <- -12 : 3
#' gm <- gmon(num.mon)
#' ry <- rela_year(gm)
#' df <- data.frame(num.mon, ry, as.character(gm))
#' print(df)
#'
#' @param x a \code{gmon} object.
rela_year <- function (x) {
stopifnot(inherits(x, 'gmon'))
class(x) <- NULL
x <- x - 1
ret <- (x - (x %% 12)) / 12
return(ret)
}
#' Get the true month of a \code{gmon} object.
#' @export
#' @return a vector.
#' @param x a \code{gmon} object.
#' @examples
#' num.mon <- -25 : 15
#' gm <- gmon(num.mon)
#' tm <- true_month(gm)
#' cbind(gm, tm)
true_month <- function (x) {
stopifnot(inherits(x, 'gmon'))
y <- x %% 12
y[y == 0] <- 12
return(y)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.