home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e032 / 3.ddi / FILES / MISCELLA.PAK / CALENDAR.M next >
Encoding:
Text File  |  1992-07-29  |  16.9 KB  |  482 lines
  1. (*:Name: `Miscellaneous`Calendar *)
  2.  
  3. (*:Title: Unifiying Calendar Computations by Considering a Calendar 
  4.           as a Mixed Radix Representation Generalized to Lists.
  5. *)
  6.  
  7. (*:Author: Ilan Vardi *)
  8.  
  9. (*:Mathematica Version: 2.0 *)
  10.  
  11. (*:Package Version: 1.01 *)
  12.  
  13. (*:History: V1.0, Ilan Vardi
  14.         V1.01, minor revisions, John M. Novak, Feb. 1992
  15. *)
  16.  
  17. (*:Keywords: Calendar, Julian, Gregorian, Islamic, Digits.
  18. *)
  19.  
  20. (*:Requirements: none. *)
  21.  
  22. (*:Warnings: A date is written as {y, m, d} where y is the year,
  23.              m is the month, and d is the day. 
  24.  
  25.              The computations can be done either in the Gregorian,
  26.              Julian, or Islamic calendars. The Gregorian calendar is 
  27.              the usual calendar in use today and this calendar is 
  28.              taken to be the default if no calendar is specified.
  29.  
  30.              Great Britain and its colonies switched from the Julian
  31.              calendar to the Gregorian calendar in September, 1752.
  32.              In these countries {1752, 9, 2} was followed by 
  33.              {1752, 9, 14}. The default calendar for dates on
  34.              or before {1752, 9, 2} is taken to be the Julian calendar.
  35.              This requires making some adjustements to DayOfWeek, 
  36.              DaysBetween, and DaysPlus. For example,
  37.              DaysBetween[{1752, 9, 2}, {1752, 9, 14}] will return 1.
  38.              
  39.              Catholic countries switched from the Julian to the Gregorian
  40.              calendar in October 1582, so that {1582, 10, 4} was followed
  41.              by {1582, 10, 15}. This change to the Package can be made
  42.              quite easily.
  43.  
  44.              The algorithm for the Julian calendar will fail for the year
  45.              4 and earlier since the leap years from 40 B.C. to the
  46.              year 4 did not follow a regular pattern (see Bickerman's book),
  47.              and also the year zero does not exist (it is taken to be 
  48.              1 B.C.). The first valid Julian date is therefore {4, 3, 1}.
  49.  
  50.              This only computes the Jewish New Year for the years 1900 
  51.              up to 2099.
  52.  
  53. *)
  54.  
  55. (*:Source:  Ilan Vardi, Computational Recreations in Mathematica,
  56.             Addison Wesley 1991, Chapter 3
  57.  
  58.             E.R. Berlekamp, J.H. Conway, and R.K. Guy, Winning Ways,
  59.             Volume 2, Academic Press 1982, pages 795-800
  60.  
  61.             W.A. Schocken, The Calculated Confusion of the Calendar,
  62.             Vantage Press, New York 1976
  63.  
  64.             E.J. Bickerman, The Chronology of the Ancient World,
  65.             Revised Edition, Thames and Hudson, London 1980
  66. *)
  67.  
  68. (*:Limitations: This package is meant to show how Mathematica can be
  69.                 used to give a unified treatment of a problem usually
  70.                 done using specialized hacks. This means that these 
  71.                 functions can be speeded up somewhat. For example, 
  72.                 DayOfWeek can be computed efficiently for the Gregorian
  73.                 calendar by using an algorithm of Reverend Zeller. See
  74.                 Computational Recreations in Mathematica, Problem 3.1.
  75.  
  76.                 I have not yet implemented the Jewish calendar. This
  77.                 calendar is the most nontrivial of all, since it is the
  78.                 only one that keeps track of both the lunar and solar 
  79.                 periods (see Schocken's book). A Lisp program implementing 
  80.                 the Jewish calendar is given by E.M. Reingold and N. Dershowitz,
  81.                 Calendrical Calculations, Technical Report 
  82.                 UIUCCDCS-R-89-1541 (1989), Dept. of Computer Science, 
  83.                 Univ.  of Ill. at Urbana-Champaign.
  84. *)
  85.  
  86. (*:Discussion: This package was written in order to give a unified
  87.                treatement of the basic calendar operations. This is
  88.                done by considering the calendar as a mixed radix 
  89.                positional number system where the radices are lists.
  90.                This requires a further generalization as the radix must
  91.                actually be a tree. This is necessary since, for example,
  92.                the numbers of days in a month depend on what year it is.
  93.                The calendars are quite regular, so they are most 
  94.                compactly represented as trees of functions. See 
  95.                Chapter 3 of Computational Recreations in Mathematica
  96.                for details.
  97.  
  98.                The Julian calendar is the simplest calendar consisting
  99.                of the usual western calendar with leap years every 
  100.                four years. This calendar gives a year that is slightly 
  101.                too long. It was replaced with the Gregorian calendar
  102.                in Catholic countries in 1582 and by Britain and its 
  103.                colonies in 1752. It is still used to compute Greek 
  104.                Orthodox holidays, such as Easter.
  105.  
  106.                The Gregorian calendar is the calendar presently in 
  107.                use in the western world. It differs from the Julian
  108.                calendar by eliminating leap years for centuries not
  109.                divisible by 400. In other words, 1900 was not a leap 
  110.                year, but the year 2000 will be a leap year.
  111.  
  112.                The Islamic calendar is a purely lunar calendar, and a year
  113.                has 354 or 355 days. The months do not correspond to the 
  114.                solar year, and migrate over the solar year following a 
  115.                30 year cycle. The names of the months are 
  116.  
  117.                Muharram, Safar, Rabia I, Rabia II, Jumada I, Jumada II, 
  118.                Rajab, Sha'ban, Ramadan, Shawwal, Dhu al-Qada, Dhu al-Hijah
  119.  
  120.                The functions computing Easter and the Jewish New Year
  121.                are taken directly from Winning Ways. 
  122. *)
  123.  
  124. BeginPackage["Miscellaneous`Calendar`"]
  125.  
  126. DayOfWeek::usage = "DayOfWeek[{y, m, d}, cal] gives the day of the
  127. week for year y, month m, and day d in calendar cal. The default 
  128. calendar is the usual American calendar."
  129.  
  130. DaysBetween::usage = "DaysBetween[{y1,m1, d1}, {y2,m2,d2}, cal] gives
  131. the number of days between the dates {y1, m1, d1} and {y2, m2, d2}
  132. in calendar cal. The default calendar is the usual American calendar."
  133.  
  134. DaysPlus::usage = "DaysPlus[{y, m, d}, n, cal] gives the date n days
  135. after {y, m, d} in calendar cal. The default calendar is the usual
  136. American calendar."
  137.  
  138. CalendarChange::usage = "CalendarChange[date, calendar1, calendar2]
  139. converts a date in calendar1 to a date in calendar2."
  140.  
  141. Calendar::usage = "Calendar indicates which calendar system is being
  142. used. Either the Gregorian, Julian, or Islamic calendars."
  143.  
  144. Gregorian::usage = "An option to DayOfWeek, DaysBetween, and DaysPlus,
  145. and argument to CalendarChange. It indicates that the Gregorian
  146. calendar is used. It is assumed that the date must be {1752, 9, 14} or
  147. later."
  148.  
  149. Julian::usage = "An option to DayOfWeek, DaysBetween, and DaysPlus,
  150. and argument to CalendarChange. It indicates that the Julian calendar
  151. is used. This calendar is only valid starting {4, 3, 1}."
  152.  
  153. Islamic::usage = "An option to DayOfWeek, DaysBetween, and DaysPlus,
  154. and argument to CalendarChange. It indicates that the Islamic calendar
  155. is used. This calendar began on {622, 7, 16} Julian, in other words,
  156. this is {1, 1, 1} in the Islamic calendar (the Hejira)."
  157.  
  158. EasterSunday::usage = "EasterSunday[year] computes the date of Easter
  159. Sunday in the Gregorian calendar according to the Gregorian
  160. calculation."
  161.  
  162. EasterSundayGreekOrthodox::usage = "EasterSunday[year] computes the
  163. date of Easter Sunday according to the Greek Orthodox church. The
  164. result is given as a Gregorian date."
  165.  
  166. JewishNewYear::usage = "JewishNewYear[y] gives the date of the Jewish
  167. New Year occurring in Christian year y, 1900 <= y < 2100. Add 3761 to
  168. Christian year y to get the corresponding new Jewish Year. "
  169.  
  170. Sunday::usage = "Day of Week."
  171.  
  172. Monday::usage = "Day of Week."
  173.  
  174. Tuesday::usage = "Day of Week."
  175.  
  176. Wednesday::usage = "Day of Week."
  177.  
  178. Thursday::usage = "Day of Week."
  179.  
  180. Friday::usage = "Day of Week."
  181.  
  182. Saturday::usage = "Day of Week."
  183.  
  184.  
  185. Begin["`Private`"]
  186.  
  187.  
  188. Options[DayOfWeek]:= {Calendar -> Gregorian}
  189.  
  190. Options[DaysBetween]:= {Calendar -> Gregorian}
  191.  
  192. Options[DayPlus]:= {Calendar -> Gregorian}
  193.  
  194. DayOfWeekNumber[date_List, opts___]:= 
  195. Block[{calendar = Calendar /. {opts}},
  196.        If[calendar === Calendar,
  197.           calendar = If[OrderedQ[{date, {1752, 9, 2}}],
  198.                         Julian, Gregorian]];
  199.            Mod[DateToNumber[date, calendar] + DayOfWeekInit[calendar], 7]
  200.        ]
  201.  
  202. DayOfWeek[date_List, opts___]:=
  203.  {
  204.   Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday
  205.   }[[
  206.       1 + DayOfWeekNumber[date, opts]
  207.     ]]
  208.           
  209.  
  210. DayOfWeekInit[Gregorian] = 0
  211.  
  212. DayOfWeekInit[calendar_]:= DayOfWeekInit[calendar] = 
  213.  Mod[3 - 
  214.      DateToNumber[
  215.      CalendarChange[{1990, 10, 31}, Gregorian, calendar], 
  216.      calendar], 
  217.      7]
  218.  
  219.  
  220. DaysBetween[date1_List, date2_List, opts___]:= 0 /; date1 == date2
  221.  
  222. DaysBetween[date1_List, date2_List, opts___]:=
  223.  DaysBetween[date2, date1, opts] /;  OrderedQ[{date2, date1}] 
  224.  
  225. DaysBetween[date1_List, date2_List, opts___]:=
  226.  Block[{calendar = Calendar /. {opts}},
  227.         If[calendar === Calendar, 
  228.            If[OrderedQ[{date1, {1752, 9, 2}}] && 
  229.               OrderedQ[{1752, 9, 14}, date2], 
  230.               1 + DaysBetween[date1, {1752, 9, 2}, Calendar -> Julian] +
  231.               DaysBetween[{1752, 9, 14}, date2, Calendar -> Gregorian],
  232.               DaysBetween[date1, date2, Calendar -> 
  233.                           If[OrderedQ[{date1, {1752, 9, 2}}], 
  234.                              Julian, Gregorian]]
  235.               ], 
  236.             DateToNumber[date2, calendar] - DateToNumber[date1, calendar]
  237.            ]
  238.          ]
  239.  
  240. DaysPlus[date_List, n_Integer, opts___]:= 
  241.  Block[{calendar = Calendar /. {opts}, d},
  242.         If[calendar === Calendar, 
  243.            If[OrderedQ[{date, {1752, 9, 2}}],
  244.               d = DaysPlus[date, n, Calendar -> Julian];
  245.               If[OrderedQ[{{1752, 9, 3}, d}],
  246.                  CalendarChange[d, Julian, Gregorian],
  247.                  d],
  248.               d = DaysPlus[date, n, Calendar -> Gregorian];
  249.               If[OrderedQ[{d, {1752, 9, 13}}],
  250.                  CalendarChange[d, Gregorian, Julian],
  251.                  d]
  252.               ],
  253.             NumberToDate[DateToNumber[date, calendar] + n, calendar]
  254.            ]
  255.         ]
  256.  
  257.  
  258. CalendarChange[date_, calendar1_, calendar2_]:= 
  259.  NumberToDate[DateToNumber[date, calendar1] + 
  260.        CalendarChangeInit[calendar1, calendar2], calendar2]
  261.  
  262.  
  263. EasterSunday[y_Integer]:= 
  264.       Block[{paschal, golden, c, h, t},
  265.             golden= Mod[y,19] +1;
  266.             h = Quotient[y,100];
  267.             c = - h + Quotient[h,4] + Quotient[8(h +11),25];
  268.             t = DaysPlus[{y, 4, 19}, - Mod[11 golden +c, 30],
  269.                          Calendar -> Gregorian];
  270.             paschal = If[(t[[3]] == 19) || (t[[3]] == 18 && golden >11), 
  271.                           t - {0,0,1} , t];
  272.             DaysPlus[paschal, 
  273.              7 - DayOfWeekNumber[paschal, Calendar -> Gregorian]]
  274.            ]
  275.  
  276. EasterSundayGreekOrthodox[y_Integer]:= 
  277.       Block[{paschal, golden, c, h, t},
  278.             golden= Mod[y,19] +1;
  279.             h = Quotient[y,100];
  280.             c = 3;
  281.             t = DaysPlus[{y, 4, 19}, - Mod[11 golden +c, 30],
  282.                          Calendar -> Gregorian];
  283.             paschal = If[(t[[3]] == 19) || (t[[3]] == 18 && golden >11), 
  284.                           t - {0,0,1} , t];
  285.             CalendarChange[DaysPlus[paschal, 
  286.                     7 - DayOfWeekNumber[paschal, Calendar -> Julian]],
  287.                     Julian, Gregorian]
  288.            ]
  289.  
  290. JewishNewYear[y_] := 
  291.             Block[{t,g,n,f,d},
  292.                   g= Mod[12 (Mod[y,19] +1) , 19];
  293.                   t= Quotient[y,100] -Quotient[y,400] -2  +
  294.                      765433/ 492480 g + Mod[y,4] / 4 -
  295.                      (313 y + 89091)/98496 ;
  296.                   n = Floor[t]; 
  297.                   f = t - n;
  298.                   d = Switch[Mod[ DateToNumber[y,9,n] [[1]],7], 
  299.                          0, n+1,
  300.                          1, If[ f >= 23269/25920 &&  g >11 , n+1,n],
  301.                          2, If[ f>= 1367/2160 && g > 6, n+2,n],
  302.                          3, n+1,
  303.                          4, n,
  304.                          5, n+1,
  305.                          6,n];
  306.                    If[d < 31,{y, 9, d},{y, 10, d - 30}]
  307.                    ] 
  308.  
  309.  
  310. (* Generalization of Digits to mixed list radices *)
  311.  
  312. MyDigits[n_, list_List, path_]:= 
  313.          Block[{md = MyDigitsInit[n, list, path]},
  314.                 If[Last[md] != 0, 
  315.                    md,
  316.                    MapAt[# + 1&,
  317.                          MyDigitsInit[n-1, list, path], 
  318.                          {-1}]
  319.                ]]
  320.  
  321. MyDigitsInit[n_, {}, _]:= {n}
  322.  
  323. MyDigitsInit[n_, list_List, path_]:= 
  324.    Block[{r = MyQuotient[n, First[list][path]]}, 
  325.    Prepend[MyDigits[MyMod[n, First[list] [path]], 
  326.                         Rest[list], Append[path, r]],
  327.            MyQuotient[n, First[list] [path]]]]
  328.  
  329.  
  330.  
  331. DigitsToNumber[date_, list_, path_]:= 
  332.  1 + date[[1]] list[[1]][path+1][[1]] + Last[date] + 
  333.  (Plus @@  
  334.   (Fold[Plus, 0, Take[list[[#]][path+1], date[[#]]]]& /@
  335.         Range[2, Length[list]]))
  336.  
  337. MyDigits[n_, b_List]:= {n} /; b == {} ||  0 < n < Last[b] 
  338.  
  339. MyDigits[n_, b_List]:= 
  340. Append[MyDigits[Quotient[n, Last[b]], Drop[b, -1]],
  341.        Mod[n, Last[b]]]
  342.  
  343. DigitsToNumber[{n_}, b_]:= n
  344.  
  345. DigitsToNumber[digits_List, b_]:=
  346. DigitsToNumber[Drop[digits, -1], 
  347.                Drop[b, -1]] Last[b] + Last[digits]
  348.  
  349. (* Quotient and Mod generalized to lists *)
  350.  
  351. MyQuotient[n_Integer, list_List]:= 
  352.   Quotient[n, First[list]] + 1 /; Length[list] == 1
  353.  
  354. MyQuotient[n_Integer, list_List]:= 
  355.    Block[{s = First[list], q = 1}, 
  356.           While[n > s, q++; s += list[[q]]]; q] /; Length[list] > 1
  357.  
  358. MyMod[n_Integer, list_List]:= 
  359.    Mod[n, First[list]] /; Length[list] == 1
  360.  
  361. MyMod[n_Integer, list_List]:= 
  362.    n - Fold[Plus, 0, Take[list, MyQuotient[n, list]-1]] /; Length[list] > 1
  363.  
  364.  
  365.  
  366. (* Julian calendar *)
  367.  
  368. JulianCalendar = {JulianFourYears, JulianYears, JulianMonths}
  369.  
  370. JulianFourYears[_]:= {1461}
  371.  
  372. JulianYears[_]:= {365, 365, 365, 366}
  373.  
  374. JulianMonths[path_List]:= 
  375. {31, 28 + Quotient[path[[2]], 4], 
  376.  31, 30, 31, 30, 31, 31, 30, 31, 30, 31}
  377.  
  378.  
  379. NumberToDate[n_, Julian]:=  
  380. Prepend[Drop[#, 2], DigitsToNumber[Take[# - 1, 2], {4}] + 1]& @
  381.         MyDigits[n, JulianCalendar, {}]
  382.  
  383. DateToNumber[date_, Julian]:= 
  384. Block[{d = Join[MyDigits[First[date]-1, {4}] , 
  385.                 Rest[date]-1]},
  386.        d = Join[Table[0, {4 - Length[d]}], d];
  387.        DigitsToNumber[d, JulianCalendar, d]]
  388.  
  389.  
  390. (* Gregorian calendar *)
  391.  
  392. GregorianCalendar = 
  393. {GregorianFourCenturies, GregorianCentury, 
  394.  GregorianFourYears, GregorianYears, GregorianMonths}
  395.  
  396. GregorianFourCenturies[_]:= {146097}
  397.  
  398. GregorianCentury[_]:= {36524, 36524, 36524, 36525}
  399.  
  400. GregorianFourYears[path_]:= 
  401.  Append[Table[1461, {24}], 1460 + Quotient[path[[2]], 4]]
  402.  
  403. GregorianYears[path_]:= 
  404.  {365, 365, 365, 366 - 
  405.  (1-Quotient[path[[2]], 4]) Quotient[path[[3]], 25]}
  406.  
  407. GregorianMonths[path_]:= 
  408. {31, 28 + Quotient[path[[4]], 4] * (1 - 
  409.    (1 - Quotient[path[[2]], 4]) Quotient[path[[3]], 25]),
  410.  31, 30, 31, 30, 31, 31, 30, 31, 30, 31}
  411.  
  412. NumberToDate[n_, Gregorian]:= 
  413. Prepend[Drop[#, 4], DigitsToNumber[Take[#-1, 4], {4,25,4}] + 1]& @
  414.  MyDigits[n, GregorianCalendar, {}]
  415.  
  416. DateToNumber[date_, Gregorian]:= 
  417. Block[{d = Join[MyDigits[First[date]-1, {4, 25, 4}] , Rest[date]-1]},
  418.        d = Join[Table[0, {6 - Length[d]}], d];
  419.        DigitsToNumber[d, GregorianCalendar, d]]
  420.  
  421.  
  422. CalendarChangeInit[Gregorian, Julian] = 2
  423.  
  424. CalendarChangeInit[Julian, Gregorian] = -2
  425.  
  426.  
  427. (* Islamic calendar *)
  428.  
  429.  
  430. IslamicCalendar = {IslamicThirtyYears, 
  431.                    IslamicYears, 
  432.                    IslamicMonths}
  433.  
  434. IslamicThirtyYears[_]:= {30 354 + 11}
  435.  
  436. IslamicYears[_]:= 354 +
  437.    {0,1,0,0,1,0,1,0,0,1,0,0,1,0,0,
  438.     1,0,1,0,0,1,0,0,1,0,1,0,0,1,0}
  439.  
  440. IslamicMonths[path_]:= 
  441.   {30, 29, 30, 29, 30, 29, 30, 29, 30, 29, 30, 29 + 
  442.    {0,1,0,0,1,0,1,0,0,1,0,0,1,0,0,
  443.     1,0,1,0,0,1,0,0,1,0,1,0,0,1,0}[[path[[2]]]]}
  444.  
  445.  
  446. NumberToDate[n_, Islamic]:= 
  447. Prepend[Drop[#, 2], DigitsToNumber[Take[#-1, 2], {30}] + 1]& @
  448.  MyDigits[n, IslamicCalendar, {}]
  449.  
  450. DateToNumber[date_, Islamic]:= 
  451. Block[{d = Join[MyDigits[First[date]-1, {30}], 
  452.                 Rest[date]-1]},
  453.        d = Join[Table[0, {4 - Length[d]}], d];
  454.        DigitsToNumber[d, IslamicCalendar, d]]
  455.  
  456. CalendarChangeInit[Islamic, Julian] = 
  457.   DateToNumber[{622, 7, 15}, Julian]
  458.  
  459. CalendarChangeInit[Julian, Islamic] = 
  460. -CalendarChangeInit[Islamic, Julian]
  461.  
  462. CalendarChangeInit[Gregorian, Islamic] = 
  463. -DateToNumber[CalendarChange[{622, 7, 15}, Julian, Gregorian], 
  464.               Gregorian]
  465.  
  466. CalendarChangeInit[Islamic, Gregorian] = 
  467. -CalendarChangeInit[Gregorian, Islamic] 
  468.  
  469.  
  470. End[]   (* Miscellaneous`Calendar`Private` *)
  471.  
  472. Protect[DayOfWeek, DaysBetween, DaysPlus, CalendarChange, Calendar, 
  473.         Julian, Gregorian, Islamic, EasterSunday, JewishNewYear,
  474.         EasterSundayGreekOrthodox]
  475.         
  476.        
  477.  
  478. EndPackage[]   (* Miscellaneous`Calendar` *)
  479.  
  480.  
  481.  
  482.