[Fix #401] Return localized labels in wday

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

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