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