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