[Fix #355] Add as_date generic and methods

 Closes #389

NAMESPACE

@@ -97,6 +97,7 @@ export(as.difftime)
 export(as.duration)
 export(as.interval)
 export(as.period)
+export(as_date)
 export(ceiling_date)
 export(date)
 export(date_decimal)
@@ -267,6 +268,7 @@ exportMethods(as.character)
 exportMethods(as.difftime)
 exportMethods(as.interval)
 exportMethods(as.numeric)
+exportMethods(as_date)
 exportMethods(c)
 exportMethods(intersect)
 exportMethods(reclass_timespan)

NEWS.md

@@ -9,7 +9,8 @@ Version 1.5.0.9000 (development)
 * `parse_date_time2` and `fast_strptime` gain new `lt` argument to control type of output.
 * [#373](https://github.com/hadley/lubridate/issues/373) New `date` and `date<-` additions to the `year`, `month` etc family of accessors.
 * [#365](https://github.com/hadley/lubridate/issues/365) New very fast datetime constructor `make_datetime` (dropin replacement of `ISOdatetime`).
-* [#344](https://github.com/hadley/lubridate/issues/344) `force_tz` and `with_tz` can handle data.frames component-wise.
+* [#344](https://github.com/hadley/lubridate/issues/344) `force_tz` and `with_tz` can handle data.frames component-wise
+* [#355](https://github.com/hadley/lubridate/issues/355) New `as_date` replacement of `as.Date` with more intuitive behavior with non-UTC timezones
 
 ### CHANGES
 

R/coercion.r

@@ -608,3 +608,51 @@ setMethod("as.character", signature(x = "Duration"), function(x, ...){
 setMethod("as.character", signature(x = "Interval"), function(x, ...){
   format(x)
 })
+
+
+#' Change an object to a Date
+#'
+#' as_date changes \code{\link{POSIXt}}, numeric and character objects to
+#' \code{\link{Date}} objects.
+#'
+#' @param x a vector of \code{\link{POSIXt}}, numeric or character objects
+#' @param tz a time zone name (default: time zone of the POSIXt object
+#'   \code{x}). See \code{\link{olson_time_zones}}.
+#' @param origin a Date object, or something which can be coerced by
+#'   \code{as.Date(origin, ...)} to such an object (default: the Unix epoch of
+#'   "1970-01-01"). Note that in this instance, \code{x} is
+#'   assumed to reflect the number of days since \code{origin} at \code{"UTC"}.
+#' @param format a character string (default: \code{\%Y-\%m-\%d}). See
+#'   \code{\link{strptime}} for alternative format specifications.
+#' @param ... further arguments to be passed to specific methods (see above).
+#' @return a vector of \code{\link{Date}} objects corresponding to \code{x}.
+#' @export
+setGeneric(name = "as_date", function(x, ...) standardGeneric("as_date"))
+
+#' @rdname as_date
+#' @export
+setMethod(f = "as_date", signature = "POSIXt", function (x, tz = NULL) {
+  tz <- if (is.null(tz)) tz(x) else tz
+  as.Date(x, tz = tz)
+})
+
+#' @rdname as_date
+#' @export
+setMethod(f = "as_date", signature = "numeric", function (x, origin = NULL) {
+  origin <- if (is.null(origin)) "1970-01-01" else origin
+  as.Date(x, origin = origin)
+})
+
+#' @rdname as_date
+#' @export
+setMethod(f = "as_date", signature = "character", function (x, format = NULL) {
+  format <- if (is.null(format)) "%Y-%m-%d" else format
+  as.Date(x, format = format)
+})
+
+#' @rdname as_date
+#' @export
+setMethod(f = "as_date", signature = "ANY", function (x, ...) {
+  as.Date(x, ...)
+})
+

tests/testthat/test-Dates.R

@@ -4,17 +4,28 @@ test_that("is.Date works as expected",{
   expect_that(is.Date(234), is_false())
   expect_that(is.Date(as.POSIXct("2008-08-03 13:01:59", tz = "UTC")),
     is_false())
-  expect_that(is.Date(as.POSIXlt("2008-08-03 13:01:59", tz = "UTC")), 
+  expect_that(is.Date(as.POSIXlt("2008-08-03 13:01:59", tz = "UTC")),
     is_false())
   expect_that(is.Date(Sys.Date()), is_true())
   expect_that(is.Date(minutes(1)), is_false())
   expect_that(is.Date(dminutes(1)), is_false())
   expect_that(is.Date(interval(
-    as.POSIXct("2008-08-03 13:01:59", tz = "UTC"), 
+    as.POSIXct("2008-08-03 13:01:59", tz = "UTC"),
     as.POSIXct("2009-08-03 13:01:59", tz = "UTC") )), is_false())
 })
 
 test_that("is.Date handles vectors",{
   expect_that(is.Date(c(Sys.Date(), as.Date("2009-10-31"))),
     is_true())
 })
+
+test_that("as_date works", {
+  dt1 <- as.POSIXct("2010-08-03 00:59:59.23")
+  dt2 <- as.POSIXct("2010-08-03 00:59:59.23", tz="Europe/London")
+  dt3 <- as.POSIXct("2010-11-03 00:59:59.23")
+  dt4 <- as.POSIXct("2010-11-03 00:59:59.23", tz="Europe/London")
+  expect_equal(as_date(dt1), as.Date("2010-08-03"))
+  expect_equal(as_date(dt2), as.Date("2010-08-03"))
+  expect_equal(as_date(dt3), as.Date("2010-11-03"))
+  expect_equal(as_date(dt4), as.Date("2010-11-03"))
+})