Problem 19 » 履歴 » リビジョン 2
リビジョン 1 (Noppi, 2024/01/01 14:26) → リビジョン 2/4 (Noppi, 2024/01/01 16:05)
[ホーム](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)
```