diff --git a/R/accessors-day.r b/R/accessors-day.r index 5941fd79..bd62c312 100644 --- a/R/accessors-day.r +++ b/R/accessors-day.r @@ -12,6 +12,7 @@ NULL #' ordered factor of character strings, such as "Sunday." TRUE will display an abbreviated version of the #' label, such as "Sun". abbr is disregarded if label = FALSE. #' @param value a numeric object +#' @param locale for wday, locale to use for day names. Default to current locale. #' @return wday returns the day of the week as a decimal number #' (01-07, Sunday is 1) or an ordered factor (Sunday is first). #' @seealso \code{\link{yday}}, \code{\link{mday}} @@ -22,11 +23,8 @@ NULL #' #' wday(ymd(080101)) #' wday(ymd(080101), label = TRUE, abbr = FALSE) -#' # Levels: Sunday < Monday < Tuesday < Wednesday < Thursday < Friday < Saturday #' wday(ymd(080101), label = TRUE, abbr = TRUE) -#' # Levels: Sunday < Monday < Tuesday < Wednesday < Thursday < Friday < Saturday #' wday(ymd(080101) + days(-2:4), label = TRUE, abbr = TRUE) -#' # Levels: Sunday < Monday < Tuesday < Wednesday < Thursday < Friday < Saturday #' #' x <- as.Date("2009-09-02") #' yday(x) #245 @@ -44,24 +42,21 @@ mday <- day #' @rdname day #' @export -wday <- function(x, label = FALSE, abbr = TRUE) +wday <- function(x, label = FALSE, abbr = TRUE, locale = Sys.getlocale("LC_TIME")) UseMethod("wday") #' @export -wday.default <- function(x, label = FALSE, abbr = TRUE){ - wday(as.POSIXlt(x, tz = tz(x))$wday + 1, label, abbr) +wday.default <- function(x, label = FALSE, abbr = TRUE, locale = Sys.getlocale("LC_TIME")){ + wday(as.POSIXlt(x, tz = tz(x))$wday + 1, label, abbr, locale = locale) } #' @export -wday.numeric <- function(x, label = FALSE, abbr = TRUE) { +wday.numeric <- function(x, label = FALSE, abbr = TRUE, locale = Sys.getlocale("LC_TIME")) { if (!label) return(x) - if (abbr) { - labels <- c("Sun", "Mon", "Tues", "Wed", "Thurs", "Fri", "Sat") - } else { - labels <- c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", - "Friday", "Saturday") - } + names <- .get_locale_regs(locale)$wday_names + labels <- if (abbr) names$abr else names$full + ordered(x, levels = 1:7, labels = labels) } @@ -125,6 +120,7 @@ setMethod("day<-", signature("Period"), function(x, value){ #' @export "wday<-" <- function(x, value){ if (!is.numeric(value)) { + ## FIXME: how to make this localized and preserve backward compatibility? Guesser? value <- pmatch(tolower(value), c("sunday", "monday", "tuesday", "wednesday", "thursday", "friday", "saturday")) } diff --git a/R/guess.r b/R/guess.r index 2c64ad0f..259d2077 100644 --- a/R/guess.r +++ b/R/guess.r @@ -404,8 +404,17 @@ guess_formats <- function(x, orders, locale = Sys.getlocale("LC_TIME"), num_flex["z"] <- sprintf("(%s|%s|%s|%s)", alpha_flex[["Ou"]], num_flex[["Oz"]], num_flex[["OO"]], num_flex[["Oo"]]) num_exact["z"] <- sprintf("(%s|%s|%s|%s)", alpha_exact[["Ou"]], num_exact[["Oz"]], num_exact[["OO"]], num_exact[["Oo"]]) + wday_order <- order(wday(.date_template)) + wday_names <- list(abr = unique(mat[, "a"][wday_order]), + full = unique(mat[, "A"][wday_order])) + + month_order <- order(month(.date_template)) + month_names <- list(abr = unique(mat[, "b"][month_order]), + full = unique(mat[, "B"][month_order])) + out <- list(alpha_flex = alpha_flex, num_flex = num_flex, - alpha_exact = alpha_exact, num_exact = num_exact) + alpha_exact = alpha_exact, num_exact = num_exact, + wday_names = wday_names, month_names = month_names) assign(locale, out, envir = .locale_reg_cache) out diff --git a/man/day.Rd b/man/day.Rd index 33c549d1..f5627958 100644 --- a/man/day.Rd +++ b/man/day.Rd @@ -17,7 +17,7 @@ day(x) mday(x) -wday(x, label = FALSE, abbr = TRUE) +wday(x, label = FALSE, abbr = TRUE, locale = Sys.getlocale("LC_TIME")) qday(x) @@ -44,6 +44,8 @@ ordered factor of character strings, such as "Sunday." FALSE will display the da ordered factor of character strings, such as "Sunday." TRUE will display an abbreviated version of the label, such as "Sun". abbr is disregarded if label = FALSE.} +\item{locale}{for wday, locale to use for day names. Default to current locale.} + \item{value}{a numeric object} } \value{ @@ -62,11 +64,8 @@ wday(x) #4 wday(ymd(080101)) wday(ymd(080101), label = TRUE, abbr = FALSE) -# Levels: Sunday < Monday < Tuesday < Wednesday < Thursday < Friday < Saturday wday(ymd(080101), label = TRUE, abbr = TRUE) -# Levels: Sunday < Monday < Tuesday < Wednesday < Thursday < Friday < Saturday wday(ymd(080101) + days(-2:4), label = TRUE, abbr = TRUE) -# Levels: Sunday < Monday < Tuesday < Wednesday < Thursday < Friday < Saturday x <- as.Date("2009-09-02") yday(x) #245