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#  Easter                    Returns date of easter or related feasts
21# DEPRECATED:               DESCRIPTION:
22#  .easterSunday             Easter Algorithm
23#  .easter                   Returns date of easter or related feasts
24################################################################################
25
26# ---------------------------------------------------------------------------- #
27# Roxygen Tags
28#' @export
29# ---------------------------------------------------------------------------- #
30Easter <-
31    function(year = getRmetricsOptions("currentYear"), shift = 0)
32{
33    # A function implemented by Diethelm Wuertz
34
35    # Description:
36    #   Returns dates of easter or related feasts
37
38    # Arguments:
39    #   year - an integer variable or vector for the year(s)
40    #       ISO-8601 formatted as "CCYY" where easter or
41    #       easter related feasts should be computed.
42    #   shift - the number of days shifted from the easter
43    #       date. Negative integers are allowed.
44
45    # Value:
46    #   Returns the date of Easter shifted by 'shift' days,
47    #   ".sdate" formatted, an integer of the form CCYYMMDD.
48
49    # Details:
50    #   By default the date of Easter is calculated and returned
51    #   in ISO format CCYYMMDD as an integer. Changing shift you
52    #   can calculate easter related feasts, e.g. "shift=1" returns
53    #   the date of Easter Monday, or "shift=-2" returns the date
54    #   of Good Friday.
55
56    # Note:
57    #   This algorithm holds for any year in the Gregorian Calendar,
58    #   which (of course) means years including and after 1583
59
60    # Examples:
61    #   currentYear         # prints current year as integer
62    #   .easter()            # date of easter this year
63    #   .easter(2000:2009))  # easter for the 2k decade
64    #   timeDate(.easter())  # Convert to timeDate
65    #   class(.easter())     # what class?
66
67    # Notes:
68    #   The variable currentYear is set in ".FirstLib"
69    #   Calls ".month.day.year" and ".sjulian"
70
71    # Changes:
72    #
73
74    # FUNCTION:
75
76    # Shift and Compute Easter:
77    a = year%%19
78    b = year%/%100
79    c = year%%100
80    d = b%/%4
81    e = b%%4
82    f = (b+8)%/%25
83    g = (b-f+1)%/%3
84    h = (19*a+b-d-g+15)%%30
85    i = c%/%4
86    k = c%%4
87    l = (32+2*e+2*i-h-k)%%7
88    m = (a+11*h+22*l)%/%451
89    easter.month = (h+l-7*m+114)%/%31
90    p = (h+l-7*m+114)%%31
91    easter.day = p+1
92    easterSunday = year*10000 + easter.month*100 + easter.day
93
94    # Compose:
95    mdy = .month.day.year(.sjulian(easterSunday)+shift)
96    ans = as.integer(mdy$year*10000 + mdy$month*100 + mdy$day)
97
98    # Classify as simple integer ISO date format CCYYMMDD
99    ans = timeDate(as.character(ans))
100
101    # Return Value:
102    ans
103}
104
105
106# ---------------------------------------------------------------------------- #
107# Roxygen Tags
108#' @export
109# ---------------------------------------------------------------------------- #
110.easterSunday <-
111    function(year)
112{
113    # A function implemented by Diethelm Wuertz
114
115    # Description:
116    #   Computes the 'timeDate' of Easter Sunday
117
118    # FUNCTION:
119
120    # This algorithm holds for any year in the Gregorian Calendar,
121    # which (of course) means years including and after 1583
122    a = year%%19
123    b = year%/%100
124    c = year%%100
125    d = b%/%4
126    e = b%%4
127    f = (b+8)%/%25
128    g = (b-f+1)%/%3
129    h = (19*a+b-d-g+15)%%30
130    i = c%/%4
131    k = c%%4
132    l = (32+2*e+2*i-h-k)%%7
133    m = (a+11*h+22*l)%/%451
134    easter.month = (h+l-7*m+114)%/%31
135    p = (h+l-7*m+114)%%31
136    easter.day = p+1
137
138    # Return Value:
139    year*10000 + easter.month*100 + easter.day
140}
141
142
143# ---------------------------------------------------------------------------- #
144# Roxygen Tags
145#' @export
146# ---------------------------------------------------------------------------- #
147.easter <-
148function (year = getRmetricsOptions("currentYear"), shift = 0)
149{
150    mdy = .month.day.year(.sjulian(.easterSunday(year)) + shift)
151    ans = as.integer(mdy$year * 10000 + mdy$month * 100 + mdy$day)
152    ans = timeDate(as.character(ans))
153    ans
154}
155
156
157################################################################################
158
159