[Fix #227] Treat "days" and "years" units specially for pretty.point

R/pretty.r

@@ -22,13 +22,14 @@
 #' ## [9] "2010-04-01 GMT" "2010-05-01 GMT" "2010-06-01 GMT" "2010-07-01 GMT" 
 #' ## [13] "2010-08-01 GMT" "2010-09-01 GMT"
 pretty_dates <- function(x, n, ...){
-  remember <- Sys.getenv("TZ") 
-  if (Sys.getenv("TZ") == "")
-    remember <- "unset"
+  otz <- Sys.getenv("TZ") 
+  if (Sys.getenv("TZ") == "") otz <- "unset"
   Sys.setenv(TZ = tz(x[1]))
+  on.exit(if (otz == "unset") Sys.unsetenv("TZ")
+          else  Sys.setenv(TZ = otz))
+
   rng <- range(x)
-  diff <- as.duration(rng[2] - rng[1])
-  diff <- as.double(diff, "secs") 
+  diff <- difftime(rng[2], rng[1], units = "secs")
 
   binunits <- pretty.unit(diff/n)
 
@@ -40,10 +41,6 @@ pretty_dates <- function(x, n, ...){
 
 
   breaks <- seq.POSIXt(start, end, paste(binlength, binunits)) 
-  if (remember == "unset")
-    Sys.unsetenv("TZ")
-  else 
-    Sys.setenv(TZ = remember)
   breaks
 }
 
@@ -102,22 +99,28 @@ pretty.year <- function(x, n, ...){
 
 pretty.point <- function(x, units, length, start = TRUE, ...){
   x <- as.POSIXct(x)
-
-  floors <- c("sec", "min", "hour", "day", "d", "month", "year", "y")
-  floorto <- floors[which(floors == units) + 1]
-  lower <- floor_date(x, floorto)
-  upper <- ceiling_date(x, floorto)
-
-  points <- seq.POSIXt(lower, upper, paste(length, units))
-
-  if (start)
-    points <- points[points <= x]
 
-  else
-    points <- points[points >= x]
+  if(units %in% c("day", "year")){
 
-  fit <- as.duration(x - points)  
-  fit <- abs(as.double(fit, "secs"))
-  return(points[which.min(fit)])
-
+    if(start) return(floor_date(x, units))
+    else return(ceiling_date(x, units))
+
+  } else {
+
+    floors <- list("sec", "min", "hour", "day", "month", "year")
+    floorto <- match(units, floors) + 1L
+    lower <- floor_date(x, floorto)
+    upper <- ceiling_date(x, floorto)
+
+    points <- seq.POSIXt(lower, upper, paste(length, units))
+
+    if (start)
+      points <- points[points <= x]
+    else
+      points <- points[points >= x]
+
+    fit <- as.duration(x - points)  
+    fit <- abs(as.double(fit, "secs"))
+    points[which.min(fit)]
+  }
 }

tests/testthat/test-pretty.R

@@ -0,0 +1,10 @@
+context("Pretty formatting of dates")
+
+test_that("pretty_dates works for years",
+{
+  ## https://github.com/hadley/lubridate/issues/227
+  expect_equal(pretty_dates(c(as.Date("1993-12-05"), as.Date("2007-12-01")), 7),
+               ymd(c("1993-01-01 UTC", "1995-01-01 UTC", "1997-01-01 UTC",
+                     "1999-01-01 UTC", "2001-01-01 UTC", "2003-01-01 UTC",
+                     "2005-01-01 UTC", "2007-01-01 UTC")))  
+})