Merge pull request #508 from alberthkcheng/albert

[Fix #401 ext] Return localized labels in month

NEWS.md

@@ -2,6 +2,7 @@ Version 1.6.0.9000
 ==================
 
 ### NEW FEATURES
+* [#508](https://github.com/hadley/lubridate/pull/508) New parameter `locale` in `month`. Labels of the returned factors (when `label=TRUE`) now respect current locale.
 * [#485](https://github.com/hadley/lubridate/pull/485) `quarter` gained a new argument `fiscal_start` to address the issue of different fiscal conventions.
 * [#492](https://github.com/hadley/lubridate/issues/492) New functions `epiweek` and `epiyear`.
 * [#257](https://github.com/hadley/lubridate/issues/257) New `start` parameter in `wday` and `wday<-` to set week start.

R/accessors-month.r

@@ -13,6 +13,7 @@ NULL
 #'   label, such as "January". TRUE will display an abbreviated version of the
 #'  label, such as "Jan". abbr is disregarded if label = FALSE.
 #' @param value a numeric object
+#' @param locale for month, locale to use for month names. Default to current locale.
 #' @return the months element of x as a number (1-12) or character string. 1 =
 #'   January.
 #' @keywords utilities manip chron methods
@@ -28,36 +29,31 @@ NULL
 #' month(ymd(080101), label = TRUE, abbr = FALSE)
 #' month(ymd(080101) + months(0:11), label = TRUE)
 #' @export
-month <- function(x, label = FALSE, abbr = TRUE)
+month <- function(x, label = FALSE, abbr = TRUE, locale = Sys.getlocale("LC_TIME"))
   UseMethod("month")
 
 #' @export
-month.default <- function(x, label = FALSE, abbr = TRUE)
-  month(as.POSIXlt(x, tz = tz(x))$mon + 1, label, abbr)
+month.default <- function(x, label = FALSE, abbr = TRUE, locale = Sys.getlocale("LC_TIME"))
+  month(as.POSIXlt(x, tz = tz(x))$mon + 1, label, abbr, locale = locale)
 
 #' @export
-month.numeric <- function(x, label = FALSE, abbr = TRUE) {
+month.numeric <- function(x, label = FALSE, abbr = TRUE, locale = Sys.getlocale("LC_TIME")) {
   if (!label) return(x)
 
-  if (abbr) {
-    labels <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep",
-                "Oct", "Nov", "Dec")
-  } else {
-    labels <- c("January", "February", "March", "April", "May", "June",
-                "July", "August", "September", "October", "November",
-                "December")
-  }
+  names <- .get_locale_regs(locale)$month_names
+  labels <- if (abbr) names$abr else names$full
 
   ordered(x, levels = 1:12, labels = labels)
 }
 
 #' @export
-month.Period <- function(x, label = FALSE, abbr = TRUE)
+month.Period <- function(x, label = FALSE, abbr = TRUE, locale = Sys.getlocale("LC_TIME"))
   slot(x, "month")
 
 #' @rdname month
 #' @export
 "month<-" <- function(x, value) {
+  ## FIXME: how to make this localized and preserve backward compatibility? Guesser?
   if (!is.numeric(value)) {
       value <- pmatch(tolower(value), c("january", "february", "march",
       "june", "july", "august", "september", "october", "november", "december"))

tests/testthat/test-accessors.R

@@ -76,6 +76,9 @@ test_that("wday works with various start values", {
   expect_equal(as.character(wday(days, label = T, start = 1)),
                as.character(wday(days, label = T, start = 7)))
 
+  expect_equal(as.character(wday(days, label = T))[1], "Sat")
+  expect_equal(as.character(wday(days, label = T, abbr = FALSE))[1], "Saturday")
+
   expect_equal(wday(days, label = F, start = 1),
                c(6, 7, 6, 1, 7, 1, 2, 7, 1, 2, 3, 4, 4, 5, 6))
 
@@ -193,6 +196,10 @@ test_that("months accessor extracts correct month",{
   expect_that(month(posct), equals(2))
   expect_that(month(date), equals(2))
 
+  expect_that(as.character(month(date, label = TRUE)), equals("Feb"))
+  expect_that(as.character(month(date, label = TRUE, abbr = FALSE)),
+              equals("February"))
+
 })
 
 test_that("quarters accessor extracts correct quarter", {