ホーム - Project Euler

Problem 19¶

Counting Sundays¶

You are given the following information, but you may prefer to do some research for yourself.

• 1 Jan 1900 was a Monday.
• Thirty days has September, April, June and November.
  All the rest have thirty-one,
  Saving February alone,
  Which has twenty-eight, rain or shine.
  And on leap years, twenty-nine.
• A leap year occurs on any year evenly divisible by 4, but not on a century unless it is divisible by 400.

How many Sundays fell on the first of the month during the twentieth century (1 Jan 1901 to 31 Dec 2000)?

日曜日の数え上げ¶

次の情報が与えられている.

• 1900年1月1日は月曜日である.
• 9月, 4月, 6月, 11月は30日まであり, 2月を除く他の月は31日まである.
• 2月は28日まであるが, うるう年のときは29日である.
• うるう年は西暦が4で割り切れる年に起こる. しかし, 西暦が400で割り切れず100で割り切れる年はうるう年でない.

20世紀（1901年1月1日から2000年12月31日）中に月の初めが日曜日になるのは何回あるか?

#!r6rs
#!chezscheme

(import (chezscheme))

(define (leap-year? year)
  (cond
    [(and (not (zero? (mod year 400)))
          (zero? (mod year 100)))
     #f]
    [(zero? (mod year 4)) #t]
    [else #f]))

(define (days-count year month)
  (case month
    [(4 6 9 11) 30]
    [2
     (if (leap-year? year)
       29
       28)]
    [else 31]))

(define (month-calender year month start-dayweek)
  (let ([end (days-count year month)])
    (let loop ([day 1] [dayweek start-dayweek] [result '()])
      (if (< end day)
        (values result dayweek)
        (loop (add1 day) (mod (add1 dayweek) 7)
              (cons `((,year ,month ,day) . ,dayweek) result))))))

(define (year-calender year start-dayweek)
  (let loop ([month 1] [dayweek start-dayweek] [result '()])
    (if (< 12 month)
      (values result dayweek)
      (let-values ([(lis next-dayweek) (month-calender year month dayweek)])
        (loop (add1 month) next-dayweek `(,@lis ,@result))))))

(define (pickup-dayweek calender dayweek)
  (filter
    (lambda (cell)
      (= (cdr cell) dayweek))
    calender))

(define (pickup-start-month calender)
  (filter
    (lambda (cell)
      (= (list-ref (car cell) 2) 1))
    calender))

(define calender-1900-2000
  (let loop ([year 1900] [dayweek 1] [result '()])
    (if (< 2000 year)
      result
      (let-values ([(lis next-dayweek) (year-calender year dayweek)])
        (loop (add1 year) next-dayweek `(,@lis ,@result))))))

(define calender-1901-2000
  (filter
    (lambda (cell)
      (<= 1901 (caar cell)))
    calender-1900-2000))

(define answer-19
  (length
    (pickup-dayweek
      (pickup-start-month calender-1901-2000)
      0)))

(printf "19: ~D~%" answer-19)