home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 5 / DATAFILE_PDCD5.iso / utilities / b / binprolog / !BinPro330 / progs / cal < prev    next >
Encoding:
Text File  |  1993-11-03  |  2.8 KB  |  124 lines
  1. go:-go(10000).
  2.  
  3. go(N):-
  4.     day_of_week(1992,12,1,Day),
  5.     statistics,
  6.     write('dec 1, 1992 is: '),write(Day),nl,
  7.     time(_),
  8.     empty_loop(N),
  9.     time(T1),
  10.     full_loop(N),
  11.     time(T2),
  12.     T is T2-T1,
  13.     write([fools_days=N,time=T]),nl.
  14.  
  15. time(T):-statistics(runtime,[_,T]).
  16.  
  17. range(Min,Min,Max):-Min=<Max.
  18. range(I,Min,Max):-
  19.         Min<Max,
  20.         Min1 is Min+1,
  21.         range(I,Min1,Max).
  22.  
  23. empty_loop(Y):-range(_,1,Y),true,fail.
  24. empty_loop(_).
  25.  
  26. full_loop(Max):-
  27.     range(Year,1,Max),
  28.     day_of_week(Year,4,1,_FoolsDay),
  29.     fail.
  30. full_loop(_).
  31.  
  32. /*
  33. This algorithm was published in comp.programming and comes from
  34.     Andy Lowry, lowry@watson.ibm.com, (914) 784-7925
  35.     IBM Research, P.O. Box 704, Yorktown Heights, NY 10598
  36.  
  37. Original Prolog version by Peter Ludemann,
  38. Optimized for BinProlog by Paul Tarau
  39.  
  40. First, there is a special key value for each month and a
  41. correction factor for January and February in leap years.
  42. */
  43.  
  44. cal_key( 1, 6, 1).
  45. cal_key( 2, 2, 1).
  46. cal_key( 3, 2, 0).
  47. cal_key( 4, 5, 0).
  48. cal_key( 5, 0, 0).
  49. cal_key( 6, 3, 0).
  50. cal_key( 7, 5, 0).
  51. cal_key( 8, 1, 0).
  52. cal_key( 9, 4, 0).
  53. cal_key(10, 6, 0).
  54. cal_key(11, 2, 0).
  55. cal_key(12, 4, 0).
  56. cal_key(jan, 6, 1).
  57. cal_key(feb, 2, 1).
  58. cal_key(mar, 2, 0).
  59. cal_key(apr, 5, 0).
  60. cal_key(may, 0, 0).
  61. cal_key(jun, 3, 0).
  62. cal_key(jul, 5, 0).
  63. cal_key(aug, 1, 0).
  64. cal_key(sep, 4, 0).
  65. cal_key(oct, 6, 0).
  66. cal_key(nov, 2, 0).
  67. cal_key(dec, 4, 0).
  68. cal_key('January', 6, 1).
  69. cal_key('February', 2, 1).
  70. cal_key('March', 2, 0).
  71. cal_key('April', 5, 0).
  72. cal_key('May', 0, 0).
  73. cal_key('June', 3, 0).
  74. cal_key('July', 5, 0).
  75. cal_key('August', 1, 0).
  76. cal_key('September',4, 0).
  77. cal_key('October', 6, 0).
  78. cal_key('November',2, 0).
  79. cal_key('December', 4, 0).
  80.  
  81. % Next, we associate a number with each day of the week:
  82.  
  83. dow(0, sun).
  84. dow(1, mon).
  85. dow(2, tue).
  86. dow(3, wed).
  87. dow(4, thu).
  88. dow(5, fri).
  89. dow(6, sat).
  90.  
  91. % The day of week computation is rather arcane, but it works.
  92. % Note the correction for leap years.
  93.  
  94. day_of_week(Year,Month,Day, DayOfWeek) :-
  95.         cal_key(Month, Key, LeapC),
  96.     compute_it(Year,Day,Key,LeapC,DayOfWeek).
  97.  
  98. compute_it(Year,Day,Key,LeapC,DayOfWeek):-
  99.         Century is Year // 100,
  100.         YearInCentury is Year - Century * 100,
  101.         DOW0 is (Century * 5 + Century // 4 +
  102.                  YearInCentury + YearInCentury // 4 +
  103.                  Day + Key) 
  104.                 mod 7,
  105.         leap_year(Year,DOW0,LeapC,DayOfWeek).
  106.  
  107. % A leap year is any year which is divisible by 4; if it is also
  108. % divisible by 100 then it must also be divisible by 400 (thus,
  109. % 1600 and 2000 are leap years; 1700, 1800, and 1900 are not).
  110.  
  111. leap_year(Year,DOW0,_,DayOfWeek) :-
  112.     0 =\= Year mod 4,!,
  113.     dow(DOW0,DayOfWeek).
  114. leap_year(Year,DOW0,LeapC,DayOfWeek):-
  115.     0 =\= Year mod 100,!,
  116.     DOW is DOW0-LeapC,
  117.     dow(DOW,DayOfWeek).
  118. leap_year(Year,DOW0,_,DayOfWeek):-
  119.     0 =\= Year mod 400,!,
  120.     dow(DOW0,DayOfWeek).
  121. leap_year(_,DOW0,LeapC,DayOfWeek):-
  122.     DOW is DOW0-LeapC,
  123.     dow(DOW,DayOfWeek).
  124.