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