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