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# periods Returns start and end dates for rolling periods 21# periodicallyRolling Returns start and end dates for periodically periods 22# monthlyRolling Returns start and end dates for monthly periods 23################################################################################ 24 25# ---------------------------------------------------------------------------- # 26# Roxygen Tags 27#' @export 28# ---------------------------------------------------------------------------- # 29periods <- 30 function (x, period = "12m", by = "1m", offset = "0d") 31{ 32 # A function implemented by Diethelm Wuertz and Yohan Chalabi 33 34 # Description: 35 # Returns start and end dates for a rolling periods 36 37 # Arguments: 38 # x - an object of class timeDate 39 # period - a span string, consisting of a length integer 40 # and a unit value, e.g. "52w" for 52 weeks. 41 # by - a span string, consisting of a length integer 42 # and a unit value, e.g. "4w" for 4 weeks. 43 # offset - a span string, consisting of a length integer 44 # and a unit value, e.g. "0d" for no offset. 45 46 # Details: 47 # Periodically Rolling - Allowed unit values are "m" for 48 # 4 weeks, "w" for weeks, "d" for days, "H" for hours, "M" 49 # for minutes, and "S" for seconds. 50 # Monthly Calendar Rolling - The only allowed allowed unit 51 # value is "m" for monthly periods. Express a quarterly 52 # period by "3m", a semester by "6m", a year by "12m" etc. 53 54 # Example: 55 # x = time(as.timeSeries(data(smallcap.ts))) 56 # periods(x, "12m", "1m") 57 # periods(x, "52w", "4w") 58 59 # FUNCTION: 60 61 # Check x: 62 stopifnot(is(x, "timeDate")) 63 64 # Check Periods: 65 Names = c("m", "w", "d", "H", "M", "S") 66 periodUnit = gsub("[ 0-9]", "", period, perl = TRUE) 67 stopifnot(periodUnit %in% Names) 68 offsetUnit = gsub("[ 0-9]", "", offset, perl = TRUE) 69 stopifnot(offsetUnit %in% Names) 70 byUnit = gsub("[ 0-9]", "", by, perl = TRUE) 71 stopifnot(byUnit %in% Names) 72 73 # Rolling Periods: 74 if (periodUnit == "m" & byUnit == "m") { 75 ans = monthlyRolling(x, period, by) 76 } else { 77 ans = periodicallyRolling(x, period, by) 78 } 79 80 # Return Value: 81 ans 82} 83 84 85# ---------------------------------------------------------------------------- # 86# Roxygen Tags 87#' @export 88# ---------------------------------------------------------------------------- # 89periodicallyRolling <- 90 function(x, period = "52w", by = "4w", offset = "0d") 91{ 92 # A function implemented by Diethelm Wuertz and Yohan Chalabi 93 94 # Description: 95 # Returns start and end dates for a rolling periods 96 97 # Arguments: 98 # x - an object of class timeDate 99 # period - a span string, consisting of a length integer 100 # and a unit value, e.g. "52w" for 52 weeks. 101 # by - a span string, consisting of a length integer 102 # and a unit value, e.g. "4w" for 4 weeks. 103 # offset - a span string, consisting of a length integer 104 # and a unit value, e.g. "0d" for no offset. 105 106 # Details: 107 # Allowed unit values are "m" for 4 weeks, "w" for weeks, 108 # "d" for days, "H" for hours, "M" for minutes, and "S" 109 # for seconds. 110 111 # Example: 112 # periodicallyRolling((time(as.timeSeries(data(smallcap.ts))))) 113 114 # FUNCTION: 115 116 # Check: 117 stopifnot(is(x, "timeDate")) 118 119 # Settings: 120 periods = c(4*7*24*3600, 7*24*3600, 24*3600, 3600, 60, 1) 121 names(periods) = Names = c("m", "w", "d", "H", "M", "S") 122 periodUnit = gsub("[ 0-9]", "", period, perl = TRUE) 123 stopifnot(periodUnit %in% Names) 124 offsetUnit = gsub("[ 0-9]", "", offset, perl = TRUE) 125 stopifnot(offsetUnit %in% Names) 126 byUnit = gsub("[ 0-9]", "", by, perl = TRUE) 127 stopifnot(byUnit %in% Names) 128 129 # Extract Periods: 130 period = as.integer(gsub("[mwdHMS]", "", period, perl = TRUE)) * 131 periods[periodUnit] 132 offset = as.integer(gsub("[mwdHMS]", "", offset, perl = TRUE)) * 133 periods[offsetUnit] 134 by = as.integer(gsub("[mwdHMS]", "", by, perl = TRUE)) * 135 periods[byUnit] 136 137 # Convert timeDate to GMT-POSIX 138 posixGMT = as.POSIXct( 139 timeDate(x, zone = x@FinCenter, FinCenter = "GMT"), tz = "GMT") 140 141 # Compute Julian counts (x) and series values (y) 142 Origin = as.POSIXct("1970-01-01", tz = "GMT") 143 u <- as.integer(difftime(posixGMT, Origin, tz = "GMT", units = "secs")) 144 xout = seq(u[1] + offset, u[length(u)], by = by) 145 toGMT = Origin + as.integer(xout) 146 fromGMT = toGMT - period 147 toGMT = toGMT[fromGMT >= posixGMT[1]] 148 fromGMT = fromGMT[fromGMT >= posixGMT[1]] 149 to = timeDate(toGMT, zone = "GMT", FinCenter = x@FinCenter) 150 from = timeDate(fromGMT, zone = "GMT", FinCenter = x@FinCenter) 151 152 # Windows: 153 windows = list(from = from, to = to) 154 attr(windows, "control") = c(start = start(x), end = end(x)) 155 156 # Return Value: 157 windows 158} 159 160 161# ---------------------------------------------------------------------------- # 162# Roxygen Tags 163#' @export 164# ---------------------------------------------------------------------------- # 165monthlyRolling <- 166 function(x, period = "12m", by = "1m") 167{ 168 # A function implemented by Diethelm Wuertz and Yohan Chalabi 169 170 # Description: 171 # Returns start and end dates for monthly periods 172 173 # Arguments: 174 # x - an object of class timeDate 175 # period - a span string, consisting of a length integer 176 # and a unit value, e.g. "12m" for 1 calendar year. 177 # by - a span string, consisting of a length integer 178 # and a unit value, e.g. "1m" for 1 calendar month. 179 180 # Details: 181 # The only allowed allowed unit value is "m" for monthly 182 # periods. Express a quarterly period by "3m", a semester 183 # by "6m", a year by "12m" etc. 184 185 # Example: 186 # monthlyRolling((time(as.timeSeries(data(smallcap.ts))))) 187 188 # FUNCTION: 189 190 # Check: 191 stopifnot(is(x, "timeDate")) 192 193 # Get Window Parameter: 194 periodLength = as.numeric(substr(period, 1, nchar(period)-1)) 195 periodUnit = substr(period, nchar(period), nchar(period)) 196 byLength = as.numeric(substr(by, 1, nchar(by)-1)) 197 byUnit = substr(by, nchar(by), nchar(by)) 198 stopifnot(periodUnit == "m") 199 stopifnot(byUnit == "m") 200 201 # Make Windows - expand series x to a monthly series 202 positions = x 203 startPositions = unique(timeFirstDayInMonth(positions)) 204 205 # for non monthly data 206 # startPositions@Data[1] <- start(x)@Data 207 endPositions = unique(timeLastDayInMonth(positions)) 208 209 # for non monthly data 210 # endPositions@Data[length(endPositions)] <- end(x)@Data 211 numberOfPositions = length(startPositions) 212 startSeq <- seq(from = 1, 213 to = (numberOfPositions-periodLength + 1), 214 by = byLength) 215 startDates = startPositions[startSeq] 216 endSeq <- seq(from = periodLength, 217 to = numberOfPositions, 218 by = byLength) 219 endDates = endPositions[endSeq] 220 221 # Windows: 222 windows = list(from = startDates, to = endDates) 223 attr(windows, "control") = c(start = start(positions), end = end(positions)) 224 225 # Return Value: 226 windows 227} 228 229 230################################################################################ 231 232