From b439a9e397e711c9725a126349cea4b1e87a56f3 Mon Sep 17 00:00:00 2001
From: Vitalie Spinu <spinuvit@gmail.com>
Date: Thu, 1 Oct 2015 11:08:29 +0200
Subject: [PATCH] [Fix #227] Treat "days" and "years" units specially for
 pretty.point

---
 R/pretty.r                   | 53 +++++++++++++++++++-----------------
 tests/testthat/test-pretty.R | 10 +++++++
 2 files changed, 38 insertions(+), 25 deletions(-)
 create mode 100644 tests/testthat/test-pretty.R

diff --git a/R/pretty.r b/R/pretty.r
index f9589b50..d94a7982 100644
--- a/R/pretty.r
+++ b/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)]
+  }
 }
diff --git a/tests/testthat/test-pretty.R b/tests/testthat/test-pretty.R
new file mode 100644
index 00000000..9990ba96
--- /dev/null
+++ b/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")))  
+})