--- floor_date_frac_orig.R	2017-01-13 21:31:29.415630181 -0800
+++ floor_date_frac.R	2017-01-13 21:34:37.822945428 -0800
@@ -1,3 +1,27 @@
+# FHE 13 Jan 2017
+
+# Modified from Hadley Wickham's "lubridate" library
+
+# Extends "floor_date" with fractional units, e.g. "0.1 seconds", or
+# "2 milliseconds" (=="2ms")
+
+# Note that we can't get exact rounding due to floating point
+# resolution limitations:
+
+## sprintf("%.09f",as.numeric(floor_date(Sys.time(), "ms")))
+## [1] "1484369763.108000040"
+
+# However, multiple nearby values should "floor" to the same result:
+
+## > t=Sys.time(); table(sprintf("%.09f",as.numeric(floor_date(c(t,t+1e-4,t+2e-4), "ms"))))
+## 1484369576.492000103
+## 3
+
+# Currently only works for "seconds", modify trunc_multi_unit if you
+# want to be able to specify "0.25 hour" etc.
+
+# TODO: add round_date, ceiling_date
+
 floor_date <- function(x, unit = "seconds") {
   if(!length(x)) return(x)
 
@@ -5,6 +29,14 @@
   n <- parsed_unit$n
   unit <- standardise_period_names(parsed_unit$unit)
 
+  if(unit %in% c("microsecond", "millisecond")){
+    switch(unit,
+           microsecond = n <- n/1e6,
+           millisecond = n <- n/1e3,
+           )
+    unit <- "second"
+  }
+
   if(unit %in% c("second", "minute", "hour", "day")){
 
     out <- trunc_multi_unit(x, unit, n)
@@ -53,7 +85,10 @@
     unit <- unit[[1]]
   }
 
-  p <- .Call("c_parse_period", as.character(unit))
+  # FHE 13 Jan 2017
+  # Elide the C code since we also have an R implementation
+#  p <- .Call("c_parse_period", as.character(unit))
+  p=list(NA);
 
   if (!is.na(p[[1]])) {
 
@@ -77,7 +112,7 @@
       start <- attr(m, "capture.start")
       end <- start + attr(m, "capture.length") - 1L
       n <- if(end[[1]] >= start[[1]]){
-             as.integer(str_sub(unit, start[[1]], end[[1]]))
+             as.numeric(str_sub(unit, start[[1]], end[[1]]))
            } else {
              1
            }
@@ -128,9 +163,11 @@
   dates <- c("second", "minute", "hour", "day", "week", "month", "year",
              ## these ones are used for rounding only
              "bimonth", "quarter", "halfyear")
-  y <- gsub("(.)s$", "\\1", x)
-  y <- substr(y, 1, 3)
-  res <- dates[pmatch(y, dates)]
+  res <- dates[pmatch(substr(x, 1, 3), dates)]
+  # could speed this up by only grepping on NA elements of res
+  # (but when is this function called with >1 element?)
+  res[grep("^(ms|mil)",x)] = "millisecond"
+  res[grep("^(us|micro)",x)] = "microsecond"
   if (any(is.na(res))) {
     stop("Invalid period name: ", paste(x[is.na(res)], collapse = ", "),
       call. = FALSE)