Project Euler

[ホーム](https://redmine.noppi.jp) - [[Wiki|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日）中に月の初めが日曜日になるのは何回あるか?

```scheme

#!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 ([i 1] [dayweek start-dayweek] [result '()])

      (if (< end i)

        (values (reverse result) (mod (add1 (cdr (car result))) 7))

        (loop (add1 i) (mod (add1 dayweek) 7)

              (cons `((,year ,month ,i) . ,(mod dayweek 7)) result))))))

(define (year-calender year start-dayweek)

  (let loop ([i 1] [dayweek start-dayweek] [result '()])

    (if (< 12 i)

      (values result dayweek)

      (let-values ([(lis next-dayweek) (month-calender year i dayweek)])

        (loop (add1 i) next-dayweek `(,@result ,@lis))))))

(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 `(,@result ,@lis))))))

(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)

```