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