1 2# This R package is free software; you can redistribute it and/or 3# modify it under the terms of the GNU Library General Public 4# License as published by the Free Software Foundation; either 5# version 2 of the License, or (at your option) any later version. 6# 7# This R package is distributed in the hope that it will be useful, 8# but WITHOUT ANY WARRANTY; without even the implied warranty of 9# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 10# GNU Library General Public License for more details. 11# 12# You should have received a copy of the GNU Library General 13# Public License along with this R package; if not, write to the 14# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, 15# MA 02111-1307 USA 16 17 18################################################################################ 19# FUNCTION: DESCRIPTION: 20# align,timeDate Aligns a 'timeDate' object to regular time stamps 21# align,ANY 22################################################################################ 23 24# ---------------------------------------------------------------------------- # 25# Roxygen Tags 26#' @export 27# ---------------------------------------------------------------------------- # 28setMethod("align", "timeDate", 29 function(x, by = "1d", offset = "0s") 30{ 31 # A function implemented by Diethelm Wuertz and Yohan Chalabi 32 33 # Description: 34 # Aligns a 'timeDate' object to regular time stamps 35 36 # Example: 37 # align(timeCalendar(), "1w") # Weekly 38 # align(timeCalendar(), "2w", "3d") # Bi-Weekly with offset 39 40 # FUNCTION: 41 42 # Settings: 43 periods <- c(7*24*3600, 24*3600, 3600, 60, 1) 44 names(periods) <- c("w", "d", "h", "m", "s") 45 offset <- as.integer(gsub("[a-z]", "", offset, perl = TRUE)) * 46 periods[gsub("[ 0-9]", "", offset, perl = TRUE)] 47 offset <- as.vector(offset) 48 49 # Return Value: 50 seq(from = x[1] + offset, to = x[length(x)], by = by) 51 52}) 53 54 55# ---------------------------------------------------------------------------- # 56# Roxygen Tags 57#' @export 58# ---------------------------------------------------------------------------- # 59setMethod("align", "ANY", 60 function(x, y, xout, method = "linear", n = 50, rule = 1, f = 0, 61 ties = mean, ...) 62{ 63 # A function implemented by Diethelm Wuertz and Yohan Chalabi 64 65 # FUNCTION: 66 67 # Align by Approximation: 68 ans = approx(x = x, y = y, xout = xout, method = method, n = n, 69 rule = rule, f = f, ties = ties, ...) 70 71 # Return Value: 72 ans 73}) 74 75 76################################################################################ 77 78# ---------------------------------------------------------------------------- # 79# Roxygen Tags 80#' @export 81# ---------------------------------------------------------------------------- # 82alignDaily <- 83function(x, include.weekends=FALSE) 84{ 85 # A function implemented by Diethelm Wuertz 86 87 # Description: 88 # Aligns a 'timeDate' object to end-of-day dates 89 90 # Arguments: 91 # x - a 'timeDate' object 92 # include.weekends - a logical, should weekends be included? 93 94 # FUNCTION: 95 96 # Align: 97 if (include.weekends) { 98 tD <- align(x) 99 } else { 100 tD <- align(x) 101 tD <- tD[isWeekday(tD)] 102 } 103 104 # Return Value: 105 tD 106} 107 108 109# ---------------------------------------------------------------------------- 110 111# ---------------------------------------------------------------------------- # 112# Roxygen Tags 113#' @export 114# ---------------------------------------------------------------------------- # 115alignMonthly <- 116function(x, include.weekends=FALSE) 117{ 118 # A function implemented by Diethelm Wuertz 119 120 # Description: 121 # Aligns a 'timeDate' object to end of month dates 122 123 # Arguments: 124 # x - a 'timeDate' object 125 # include.weekends - a logical, should weekends be included? 126 127 # FUNCTION: 128 129 # Align: 130 if (include.weekends) { 131 tD <- timeLastDayInMonth(x) 132 } else { 133 tD <- timeLastDayInMonth(x) 134 tD[isWeekend(tD)] <- tD[isWeekend(tD)] - 24*3600 135 } 136 137 # Return Value: 138 tD 139} 140 141 142# ---------------------------------------------------------------------------- # 143# Roxygen Tags 144#' @export 145# ---------------------------------------------------------------------------- # 146alignQuarterly <- 147function(x, include.weekends=FALSE) 148{ 149 # A function implemented by Diethelm Wuertz 150 151 # Description: 152 # Aligns a 'timeDate' object to end-of-quarter dates 153 154 # Arguments: 155 # x - a 'timeDate' object 156 # include.weekends - a logical, should weekends be included? 157 158 # FUNCTION: 159 160 # Align: 161 if (include.weekends) { 162 tD <- timeLastDayInQuarter(x) 163 } else { 164 tD <- timeLastDayInQuarter(x) 165 tD[isWeekend(tD)] <- tD[isWeekend(tD)] - 24*3600 166 } 167 168 # Return Value: 169 tD 170} 171 172 173############################################################################### 174 175