1yearDays <- function(time) {
2  time <- as.POSIXlt(time)
3
4  time$mon[] <- time$mday[] <- time$sec[] <- time$min <- time$hour <- 0
5  time$year <- time$year + 1
6
7  return(as.POSIXlt(as.POSIXct(time))$yday)
8}
9
10monthDays <- function(time) {
11  time <- as.POSIXlt(time)
12  time$mday[] <- time$sec[] <- time$min <- time$hour <- 0
13  time$mon <- time$mon + 1
14
15  return(as.POSIXlt(as.POSIXct(time))$mday)
16}
17
18round.POSIXt <- function(x, digits=c("secs", "mins", "hours", "days", "months", "years"))
19  {
20    ## this gets the default from the generic, as that has two args.
21    if(is.numeric(digits) && digits == 0.0) digits <-"secs"
22    units <- match.arg(digits)
23
24    month.length <- monthDays(x)
25    x <- as.POSIXlt(x)
26
27    if(length(x$sec) > 0)
28      switch(units,
29             "secs"   = {x$sec <- x$sec + 0.5},
30             "mins"   = {x$sec <- x$sec + 30},
31             "hours"  = {x$sec <- 0; x$min <- x$min + 30},
32             "days"   = {x$sec <- 0; x$min <- 0; x$hour <- x$hour + 12
33                         isdst <- x$isdst <- -1},
34             "months" = {x$sec <- 0; x$min <- 0; x$hour <- 0;
35                         x$mday <- x$mday + trunc(monthDays(x)/2);
36                         isdst <- x$isdst <- -1},
37             "years"  = {x$sec <- 0; x$min <- 0; x$hour <- 0;
38                         x$mday <- 0; x$mon <- x$mon + 6;
39                         isdst <- x$isdst <- -1}
40             )
41
42    return(trunc(as.POSIXct(x), units=units))
43  }
44
45trunc.POSIXt <- function(x, units=c("secs", "mins", "hours", "days", "months", "years"), ...) {
46    units <- match.arg(units)
47
48    x <- as.POSIXlt(x)
49
50    isdst <- x$isdst
51    if(length(x$sec) > 0)
52      switch(units,
53             "secs" = {x$sec <- trunc(x$sec)},
54             "mins" = {x$sec <- 0},
55             "hours"= {x$sec <- 0; x$min <- 0},
56             "days" = {x$sec <- 0; x$min <- 0; x$hour <- 0; isdst <- x$isdst <- -1},
57             "months" = {
58               x$sec <- 0
59               x$min <- 0
60               x$hour <- 0
61               x$mday <- 1
62               isdst <- x$isdst <- -1
63             },
64             "years" = {
65               x$sec <- 0
66               x$min <- 0
67               x$hour <- 0
68               x$mday <- 1
69               x$mon <- 0
70               isdst <- x$isdst <- -1
71             }
72             )
73
74    x <- as.POSIXlt(as.POSIXct(x))
75    if(isdst == -1) {
76      x$isdst <- -1
77    }
78    return(x)
79  }
80
81ceil <- function(x, units, ...) {
82  UseMethod('ceil', x)
83}
84
85ceil.default <- function(x, units, ...) {
86  ceiling(x)
87}
88
89ceil.POSIXt <- function(x, units=c("secs", "mins", "hours", "days", "months", "years"), ...) {
90  units <- match.arg(units)
91
92  x <- as.POSIXlt(x)
93
94  isdst <- x$isdst
95  if(length(x$sec) > 0 && x != trunc.POSIXt(x, units=units)) {
96    switch(units,
97           "secs" = {
98             x$sec <- ceiling(x$sec)
99           },
100           "mins" = {
101             x$sec <- 0
102             x$min <- x$min + 1
103           },
104           "hours"= {x$sec <- 0; x$min <- 0; x$hour <- x$hour + 1},
105           "days" = {
106             x$sec <- 0
107             x$min <- 0
108             x$hour <- 0
109             x$mday <- x$mday + 1
110             isdst <- x$isdst <- -1
111           },
112           "months" = {
113             x$sec <- 0
114             x$min <- 0
115             x$hour <- 0
116             x$mday <- 1
117             x$mon <- x$mon + 1
118             isdst <- x$isdst <- -1
119           },
120           "years" = {
121             x$sec <- 0
122             x$min <- 0
123             x$hour <- 0
124             x$mday <- 1
125             x$mon <- 0
126             x$year <- x$year + 1
127             isdst <- x$isdst <- -1
128           }
129           )
130
131    x <- as.POSIXlt(as.POSIXct(x))
132    if(isdst == -1) {
133      x$isdst <- -1
134    }
135  }
136  return(x)
137}
138