019.scm 4.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192
  1. ;;; Counting Sundays
  2. ;;; Problem 19
  3. ;;; You are given the following information, but you may prefer to do
  4. ;;; some research for yourself.
  5. ;;; - 1 Jan 1900 was a Monday.
  6. ;;; - Thirty days has September,
  7. ;;; April, June and November.
  8. ;;; All the rest have thirty-one,
  9. ;;; Saving February alone,
  10. ;;; Which has twenty-eight, rain or shine.
  11. ;;; And on leap years, twenty-nine.
  12. ;;; - A leap year occurs on any year evenly divisible by 4, but not
  13. ;;; on a century unless it is divisible by 400.
  14. ;;; How many Sundays fell on the first of the month during the
  15. ;;; twentieth century (1 Jan 1901 to 31 Dec 2000)?
  16. ;; IDEA: Using the given information, one could calculate ahead until
  17. ;; the end date in steps of 7 days, each time checking, whether it is
  18. ;; the first day of a month.
  19. ;; IDEA: Cheating: Using Guile's date functions, one could probably
  20. ;; query for each first of a month, whether or not it was a Sunday.
  21. ;; IDEA: Instead of going in days steps, one could go in variable
  22. ;; sized steps from first of a month to the first of the next
  23. ;; month. If the difference in days is divisable by 7, then it is the
  24. ;; same day as the previous first of a month.
  25. ;; IDEA: Calculate each first of the month and store it as a
  26. ;; days-from-start-date number, check how many of those modulo 7 are
  27. ;; congruent to 0.
  28. (import
  29. (except (rnrs base) let-values map)
  30. (only (guile)
  31. lambda* λ
  32. ;; printing
  33. display
  34. simple-format
  35. ;; command line arguments
  36. command-line
  37. current-input-port
  38. current-output-port)
  39. ;; hash tables
  40. (srfi srfi-69)
  41. ;; vectors
  42. (srfi srfi-43)
  43. (debug-utils))
  44. (define DAYS-IN-MONTH
  45. (list->vector
  46. '(31 ; January
  47. 28 ; February
  48. 31 ; March
  49. 30 ; April
  50. 31 ; May
  51. 30 ; June
  52. 31 ; July
  53. 31 ; August
  54. 30 ; September
  55. 31 ; October
  56. 30 ; November
  57. 31 ; December
  58. )))
  59. (define MONTH-NAMES
  60. (alist->hash-table
  61. '((0 . january)
  62. (1 . february)
  63. (2 . march)
  64. (3 . april)
  65. (4 . may)
  66. (5 . june)
  67. (6 . july)
  68. (7 . august)
  69. (8 . september)
  70. (9 . october)
  71. (10 . november)
  72. (11 . december))))
  73. (define WEEKDAY-NAMES
  74. (alist->hash-table
  75. '((0 . monday)
  76. (1 . tuesday)
  77. (2 . wednesday)
  78. (3 . thursday)
  79. (4 . friday)
  80. (5 . saturday)
  81. (6 . sunday))))
  82. (define start-date-day 0)
  83. (define leap-year?
  84. (λ (year)
  85. (cond
  86. ;; "A leap year occurs on any year evenly divisible by 4, but not
  87. ;; on a century unless it is divisible by 400."
  88. [(= (remainder year 4) 0)
  89. (or (= (remainder year 400) 0)
  90. (not (= (remainder year 100) 0)))]
  91. [else #f])))
  92. (define january?
  93. (λ (month)
  94. (= month 0)))
  95. (define february?
  96. (λ (month)
  97. (= month 1)))
  98. (define december?
  99. (λ (month)
  100. (= month 11)))
  101. (define sunday?
  102. (λ (days-count)
  103. ;; Weeks do not change at all and always have 7 days. -> When
  104. ;; day-count modulo 7 is 6, then the day is a Sunday.
  105. (= (remainder days-count 7) 6)))
  106. (define number-of-days-in-month
  107. (λ (year month)
  108. (cond
  109. [(and (february? month)
  110. (leap-year? year))
  111. 29]
  112. [else
  113. (vector-ref DAYS-IN-MONTH month)])))
  114. (define next-month
  115. (λ (month)
  116. (remainder (+ month 1)
  117. (vector-length DAYS-IN-MONTH))))
  118. (define end-date?
  119. (λ (year month)
  120. (and (= year 2001)
  121. (january? month))))
  122. (define count-first-of-month-sundays
  123. (λ ()
  124. (let iter ([year 1901]
  125. [month 0]
  126. ;; Start with a Tuesday.
  127. [days-count 1]
  128. [fom-sundays-count 0])
  129. (debug "days count:" days-count)
  130. ;; Move towards 31st of December 2000, by adding the number of
  131. ;; days in each month of a year, so that we always move from
  132. ;; first of one month to first of the next month. We do not need
  133. ;; to look at any other days. Each iteration we need to check,
  134. ;; if we are at a Sunday.
  135. (cond
  136. [(end-date? year month) fom-sundays-count]
  137. [else
  138. (cond
  139. [(sunday? days-count)
  140. (displayln year month "is a" (hash-table-ref WEEKDAY-NAMES (remainder days-count 7)))
  141. (iter (if (december? month) (+ year 1) year)
  142. (next-month month)
  143. ;; Add number of days in this month to get to the next
  144. ;; first of the month.
  145. (+ days-count (number-of-days-in-month year month))
  146. (+ fom-sundays-count 1))]
  147. [else
  148. (displayln year month "is a" (hash-table-ref WEEKDAY-NAMES (remainder days-count 7)))
  149. (iter (if (december? month) (+ year 1) year)
  150. (next-month month)
  151. ;; Add number of days in this month to get to the next
  152. ;; first of the month.
  153. (+ days-count (number-of-days-in-month year month))
  154. fom-sundays-count)])]))))
  155. (displayln "number of first of the month sundays:" (count-first-of-month-sundays))