Gauss'scher Osteralgorithmus und ein paar Datumsfunktionen

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

das wurgel

Betreff: Gauss'scher Osteralgorithmus und ein paar Datumsfunktionen

BeitragDo, Feb 18, 2010 22:24
Antworten mit Zitat
Benutzer-Profile anzeigen
Eine Funktion, die bei Angabe der Jahreszahl ausrechnet, wann Ostern in diesem Jahr ist. Basierend auf Ostern lassen sich dann die anderen Feiertage ausrechnen.

Code: [AUSKLAPPEN]
Dim HolidayName$(24)
Dim HolidayDate(24)

Function Easter(myYear)

   Local myDay
   Local myMonth
   Local a, b, c, d, e, g, h, i, k, l, m
   
    ;The following calculation of the Date For Easter follows the algorithm
    ;given in the New Scientist magazine, issue No. 228 (Vol. 9) page 828 (30 March 1961).
   a = myYear Mod 19       ; Find position of year in 19-year Lunar Cycle, called the Golden Number.
   b = myYear / 100:         c = myYear Mod 100  ; b is century number, c is year number within century
   d = b / 4:                e = b Mod 4         ; These are used in leap year adjustments.
   i = c / 4:                k = c Mod 4         ; Also related To leap year.

    ;The Next Step computes a correction factor used in the following Step
    ;which computes the number of days between the spring equinox
    ;And the First full moon thereafter.  The correction factor is needed
    ;To keep the approximation in Line with the observed behavior of the moon.
    ;It moves the full moon date back by one day eight times in every 2500 years,
    ;in century years three apart, with four years at the End of the cycle.
    ;The constant 13 corrects the correction For the fact that this
    ;cycle was decreed To start in the year 1800.
   g = (8 * b + 13) / 25

    ;Now the number of days After the equinox (21 March, by definition) that
    ;we find the Next full moon.  This is a number between 0 And 29.
    ;The term 19*a advances the full moon 19 days For Each year of the
    ;Lunar Cycle, For a total of 361 days in the 19 years.  The other 4.24 days
    ;are made up when a returns To zero on the Next cycle.  Thus, the
    ;full moon dates Repeat every 19 years.  The term b-d advances the
    ;date by one day For three out of every four century years, the
    ;years which are Not leap years although divisible by 4.
    ;The term g is the correction factor calculated above, And 15
    ;adjusts this whole calculation To the actual conditions at that
    ;date on which the scheme began, probably in Oct of 1582.
    h = ((19 * a + b - d - g + 15) Mod 30 + 30) Mod 30
   
    ;Now we are interested in how many days we have To wait After the
    ;full moon Until we get a Sunday (which has To be definitely After
    ;the full moon).  The following Step calculates a number l which is
    ;one less than the number of days.  Every ordinary year ends on the
    ;same day of the week on which it started;  a leap year ends on the
    ;day of the week following the one on which it started.  Thus, If
    ;it is known on what day of the week a date occurred in any year
    ;it is possible To calculate its day of the week in another year
    ;by marching through the week one day For Each regular year And
    ;two For Each leap year.
    ;     The term k is the number of ordinary years
    ;since the Last leap year;  each such year brings the date of the
    ;full moon one day closer To Sunday, And so reduces the number of
    ;days To be waited (unless it goes negative, but modular arithmetic
    ;theory makes -1 = 6 where the modulus is 7).
    ;     The term i is the number of leap years so far in the current century.
    ;Each leap year has with it three ordinary years, And Each such group
    ;advances the day of the week by 5 days.  But in modulo 7 arithmetic
    ;subtracting 5 days is equivalent To adding 2 days.  So we add
    ;two days For Each group of four years in the current century.
    ;     Since a century consists of 25 groups of four years, it advances
    ;the day of the week by 124 Or 125 days depending on whether the
    ;century year is an ordinary Or leap year.  The remainders when
    ;these numbers are divided by seven are 5 And 6 respectively.
    ;The term e is the number of ordinary century years since the
    ;Last leap century year.  As with the groups of four years, we
    ;add two days For Each rather than subtract 5 For Each.
    ;     Every fourth century year is a leap year;  therefore,
    ;Each group of four centuries advances the day of the week by
    ;3*5+6 = 21 days, Or 0 in modulo 7 arithmetic, And no
    ;term is necessary For time Before the Last leap century year.
    ;The constant term 32 adjusts the calculation For the day of the
    ;week of the equinox when the scheme was put into effect.  It also
    ;is larger than necessary by 28 in order To assure that the
    ;subtractions of k And h never reduce the dividend below 0.
    ;     Thus, (2*e + 2*i - k + 32) Mod 7 gives one less than the number
    ;of days between the equinox And its following Sunday.  But we need To
    ;calculate the number of days After the full moon.  The term h,
    ;calculated in the previous Step, gives the number of days After
    ;the equinox that the full moon occurs.  Each of those days brings
    ;the full moon closer To the actual Sunday of Easter,
    ;so it reduces the number of days After the full moon Until Easter.
    ;(Again, If h > 6, modular arithmetic theory readjusts the result To
    ;another cycle of 0 To 6, And here the constant 32 keeps the dividend > 0.)
    l = ((2 * e + 2 * i - k + 32 - h) Mod 7 + 7) Mod 7

    ;The calendar set up by Pope Gregory XIII And his advisor, the astronomer
    ;Clavius, provided For official full moon dates as well as matching
    ;the equinoxes And solstices with their nominal dates.  But, since
    ;the period of the moon is Not an exact number of days, some fudging
    ;was needed here as elsewhere in the calendar system.  Some of the
    ;periods between successive full moons in the Lunar Cycle are 30 days,
    ;some 29 days.  Clavius Then arranged the periods carefully so
    ;that If a full moon fell on 20 March (the day Before the equinox),
    ;the period following it would be of 29 days.  The effect of this
    ;arrangement is that Easter can never occur later than 25 April.
    ;The above calculations assume uniform 30-day lunar periods.  In rare
    ;cases (e.g., 1954 And 1981) one of these 29-day lunar periods causes
    ;the full moon To fall on a Saturday where a 30-day period would put
    ;it on a Sunday.  The following Step calculates the fudge factor For
    ;this situation.  The result m is 0 If no fudging is necessary, Or
    ;1 If fudging is required.
    m = (a + 11 * h + 19 * l) / 433

    ;Now we have calculated the number of days which will elapse between
    ;21 march And Easter: h + (l + 1) - 7*m.  The Next two steps
    ;turn this into a month And day.  In the First expression, the constant
    ;90 assures that the the quotient will be at least 3 (= March).
    ;If the elapsed days exceed 9, Then the quotient will be 4 (= April).
    ;In the second expression, If month = 3 Then 33*month + 19 = 118 And the
    ;remainder of that part of the expression is 22;  when month = 3,
    ;l + h - 7*m < 10, so 22 < day <= 31.
    ;If month = 4, 33*month = 132, And since h + l - 7*m > 9, the whole
    ;expression satisfies 5*32 = 160 < expr.  The remainder is greater
    ;than 0 And less than 26.
    myMonth = (h + l - 7 * m + 90) / 25
    myDay = ((h + l - 7 * m + 33 * myMonth + 19) Mod 32 + 32) Mod 32
   
   Return DateToInt(myDay,myMonth,myYear)
End Function ;Easter

Function InitHolidays(Year)

   Local myEaster
   Local myLeapDay
   
   HolidayName(0) = "Neujahr":             HolidayDate(0) = DateToInt(1, 1, Year)
   HolidayName(22) = "1. Weihnachtstag":   HolidayDate(22) = HolidayDate(0) + myLeapDay + 358
   
   myEaster = Easter(GetYear(HolidayDate(0)))
   myLeapDay = LeapYear(GetYear(HolidayDate(0)))
   
   HolidayName(1) = "Hl. 3 Könige":        HolidayDate(1) = HolidayDate(0) + 5
   HolidayName(2) = "Karfreitag":          HolidayDate(2) = myEaster - 2
   HolidayName(3) = "Ostersonntag":        HolidayDate(3) = myEaster
   HolidayName(4) = "Ostermontag":         HolidayDate(4) = myEaster + 1
   HolidayName(5) = "Maifeiertag":         HolidayDate(5) = HolidayDate(0) + myLeapDay + 120
   HolidayName(6) = "Himmelfahrt":         HolidayDate(6) = myEaster + 39
   HolidayName(7) = "Pfingstsonntag":      HolidayDate(7) = myEaster + 49
   HolidayName(8) = "Pfingstmontag":       HolidayDate(8) = myEaster + 50
   HolidayName(9) = "Fronleichnam":        HolidayDate(9) = myEaster + 60
   HolidayName(10) = "Mariä Himmelfahrt":  HolidayDate(10) = HolidayDate(0) + myLeapDay + 226
   HolidayName(11) = "Tag der dt. Einheit":HolidayDate(11) = HolidayDate(0) + myLeapDay + 275
   HolidayName(12) = "Reformationstag":    HolidayDate(12) = HolidayDate(0) + myLeapDay + 303
   HolidayName(13) = "Allerheiligen":      HolidayDate(13) = HolidayDate(0) + myLeapDay + 304
   HolidayName(22) = "1. Weihnachtstag":   HolidayDate(22) = HolidayDate(0) + myLeapDay + 358
   HolidayName(14) = "Volkstrauertag":     HolidayDate(14) = SundayBefore(HolidayDate(22)) - 35
   HolidayName(15) = "Buß- und Bettag":    HolidayDate(15) = SundayBefore(HolidayDate(22)) - 32
   HolidayName(16) = "Totensonntag":       HolidayDate(16) = SundayBefore(HolidayDate(22)) - 28
   HolidayName(17) = "1. Advent":          HolidayDate(17) = SundayBefore(HolidayDate(22)) - 21
   HolidayName(18) = "2. Advent":          HolidayDate(18) = SundayBefore(HolidayDate(22)) - 14
   HolidayName(19) = "3. Advent":          HolidayDate(19) = SundayBefore(HolidayDate(22)) - 7
   HolidayName(20) = "4. Advent":          HolidayDate(20) = SundayBefore(HolidayDate(22))
   HolidayName(21) = "Heiligabend":        HolidayDate(21) = HolidayDate(0) + myLeapDay + 357
   HolidayName(23) = "2. Weihnachtstag":   HolidayDate(23) = HolidayDate(0) + myLeapDay + 359
   HolidayName(24) = "Silvester":          HolidayDate(24) = HolidayDate(0) + myLeapDay + 364

End Function

Function SundayBefore(iDate)
   Return iDate - Weekday(iDate)
End Function

Function Weekday(iDate)
   Return (iDate-1) Mod 7
End Function

Function LeapYear(yyyy)
   If yyyy Mod 4 Then Return 0
   If yyyy Mod 100 Then Return 1
   If yyyy Mod 400 Then Return 1
   Return 0
End Function

Function MonthDays(mm, yyyy)
   Return 30+((mm+(mm>7)) Mod 2=1)-(mm=2)*(2-LeapYear(yyyy))
End Function

Function DateToInt(dd, mm, yyyy)
   Local iDate=yyyy*365+((yyyy-1)/4+1)-((yyyy-1)/100+1)+((yyyy-1)/400+1)
   iDate=iDate+(mm-1)*31-((mm-1)-(mm>8))/2-(mm>2)*(2-LeapYear(yyyy))
   iDate=iDate+dd-1
   Return iDate
End Function

Function GetYear(iDate)
   Local years
   Local sign=Sgn(iDate)
   iDate=Abs(iDate)
   Repeat
      iDate=iDate-365-LeapYear(years)
      years=years+1
   Until iDate<0
   Return (years-1)*sign-(sign=-1)
End Function

Function GetMonth(iDate)
   Local year=GetYear(iDate)
   Local months=0
   iDate=iDate-DateToInt(1,1,year)
   Repeat
      months=months+1
      iDate=iDate-MonthDays(months, year)
   Until iDate<0 Or months=12
   Return months
End Function

Function GetDay(iDate)
   Local year=GetYear(iDate)
   Local months
   iDate=iDate-DateToInt(1,1,year)
   For months=1 To 12
      Local days=MonthDays(months, year)
      If iDate>=days Then
         iDate=iDate-days
      Else
         Exit
      EndIf
   Next
   Return iDate+1
End Function

Function Today()
   Local cdate$=CurrentDate$()
   Local month$=Mid(cdate, 4, 3)
   Local mm
   Select month
      Case "Jan" : mm=1
      Case "Feb" : mm=2
      Case "Mar" : mm=3
      Case "Apr" : mm=4   
      Case "May" : mm=5   
      Case "Jun" : mm=6   
      Case "Jul" : mm=7
      Case "Aug" : mm=8   
      Case "Sep" : mm=9   
      Case "Oct" : mm=10   
      Case "Nov" : mm=11
      Case "Dec" : mm=12
   End Select
   Return DateToInt(Left(cdate, 2), mm, Right(cdate, 4))
End Function

Function MonthName$(mm)
   Select mm
      Case 1 : Return "Januar"
      Case 2 : Return "Februar"
      Case 3 : Return "März"
      Case 4 : Return "April"
      Case 5 : Return "Mai"
      Case 6 : Return "Juni"
      Case 7 : Return "Juli"
      Case 8 : Return "August"
      Case 9 : Return "September"
      Case 10 : Return "Oktober"
      Case 11 : Return "November"
      Case 12 : Return "Dezember"
   End Select
End Function

Function DayName$(day)
   Select day Mod 7
      Case 0 : Return "Sonntag"
      Case 1 : Return "Montag"
      Case 2 : Return "Dienstag"
      Case 3 : Return "Mittwoch"
      Case 4 : Return "Donnerstag"
      Case 5 : Return "Freitag"
      Case 6 : Return "Samstag"
   End Select
End Function


Restliche Funktionen:

iDate = DateToInt(dd, mm, yyyy) - Gibt die Anzahl der Tage seit dem 01.01.0000 zurück (wird in anderen Funktionen benötigt)
GetYear(iDate), GetMonth(iDate), GetDay(iDate) - Umkehrfunktionen von DateToInt
InitHolidays(yyyy) - Füllt die Arrays HolidayName$ und HolidayDate mit Feiertagen
iDate = SundayBefore(iDate) - Gibt das Datum des letzen Sonntags zurück
Weekday(iDate) - Gibt den Wochentag eines Datums zurück (0=Sonntag)
LeapYear(yyyy) - Ist das Jahr ein Schaltjahr?
MonthDays(mm, yyyy) - Anzahl der Tage eines bestimmten Monats
iDate = Today() - Heu7tiges Datum als Integer
Month-/DayName(mm/dd) - Deutsche Tage und Monatsnamen


Beispielprogrammen:
Code: [AUSKLAPPEN]

Graphics 640, 480, 16, 2

Local heute=DateToInt(18, 02, 2010);Today()

Print "Heute ist "+DayName(Weekday(heute))+", der "+GetDay(heute)+". "+MonthName(GetMonth(heute))+", "+GetYear(heute)+" ."
Print "Es sind "+heute+" Tage vergangen seit dem 01.01.0000 ."
Print "Es sind "+(heute-DateToInt(16, 12, 1992))+" Tage seit dem 16. 12. 1992 vergangen"
Print "Überübermorgen ist "+DayName(Weekday(heute+3))+"."
Print ""

Print "Feiertage: "

InitHolidays(GetYear(heute))

Local i
For i=0 To 24
   Print HolidayName$(i) + String(" ", 21-Len(HolidayName$(i))) + GetDay(HolidayDate(i))+". "+MonthName(GetMonth(HolidayDate(i)))+", "+GetYear(HolidayDate(i))
Next

WaitKey()
1 ist ungefähr 3

ozzi789

BeitragFr, Feb 19, 2010 20:19
Antworten mit Zitat
Benutzer-Profile anzeigen
Immer zu gebrauchen Wink

thnx
0x2B || ! 0x2B
C# | C++13 | Java 7 | PHP 5

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group