Project Euler: Problem 19

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

http://projecteuler.net/index.php?section=problems&id=19

与えられたいくつかの情報を元に、1901年1月1日から2000年12月31日までの間に月の最初の日(=>1日)が日曜日であった数を求めよとのこと。

このところ勉強している Haskell で解いてみようかと思ったが…30 分くらいで挫折して、例のごとく Gauche で書いてみた。

#!/usr/bin/env gosh

(define (leap? year)
  (and (zero? (remainder year 4))
       (or (zero? (remainder year 400))
           (not (zero? (remainder year 100))))))

(define-class <date> ()
              [(year :init-keyword :year :init-value 0)
               (mon  :init-keyword :mon  :init-value 1)
               (day  :init-keyword :day  :init-value 1)])

;; return a date which is n days after from self
(define-method + ((self <date>) (n <integer>))
               (if (<= 0 n)
                   (let loop ((n n)
                              (y (slot-ref self 'year))
                              (m (slot-ref self 'mon))
                              (d (slot-ref self 'day)))
                     (if (< n 1)
                       (make <date> :year y :mon m :day d)
                       (if (< d 28)
                         (loop (- n 1) y m (+ d 1))
                         (case m
                           [(1 3 5 7 8 10 12)
                            (cond [(< d 31)
                                   (loop (- n 1) y m (+ d 1))]
                                  [(= d 31)
                                   (if (= m 12)
                                     (loop (- n 1) (+ y 1) 1       1)
                                     (loop (- n 1) y       (+ m 1) 1))]
                                  [else (error "invalid date")])]
                           [(4 6 9 11)
                            (cond [(< d 30)
                                   (loop (- n 1) y m (+ d 1))]
                                  [(= d 30)
                                   (loop (- n 1) y (+ m 1) 1)]
                                  [else (error "invalid date")])]
                           [(2)
                            (if (leap? y)
                              (case d
                                [(28)
                                 (loop (- n 1) y m 29)]
                                [(29)
                                 (loop (- n 1) y 3 1)]
                                [else (error "invalid date")])
                              (case d
                                [(28)
                                 (loop (- n 1) y 3 1)]
                                [else (error "invalid date")]))]
                           [else (error "invalid date")]))))
                   (- self (abs n))))

;; return a date which is n days before from self
(define-method - ((self <date>) (n <integer>))
               (if (<= 0 n)
                   (let loop ((n n)
                              (y (slot-ref self 'year))
                              (m (slot-ref self 'mon))
                              (d (slot-ref self 'day)))
                     (if (< n 1)
                       (make <date> :year y :mon m :day d)
                       (cond [(< 1 d)
                              (loop (- n 1) y m (- d 1))]
                             [(= 1 d)
                              (case m
                                [(2 4 6 8 9 11)
                                 (loop (- n 1) y (- m 1) 31)]
                                [(5 7 10 12)
                                 (loop (- n 1) y (- m 1) 30)]
                                [(3)
                                 (if (leap? y)
                                   (loop (- n 1) y 2 29)
                                   (loop (- n 1) y 2 28))]
                                [(1)
                                 (loop (- n 1) (- y 1) 12 31)])]
                              [else (error "invalid date")])))
                   (+ self (abs n))))

(define-method equal? ((self <date>) (other <date>))
               (and (= (slot-ref self 'year) (slot-ref other 'year))
                    (= (slot-ref self 'mon)  (slot-ref other 'mon))
                    (= (slot-ref self 'day)  (slot-ref other 'day))))

(define-method < ((self <date>) (other <date>))
               (or (< (slot-ref self 'year) (slot-ref other 'year))
                   (and (= (slot-ref self 'year) (slot-ref other 'year))
                        (or (< (slot-ref self 'mon) (slot-ref other 'mon))
                            (and (= (slot-ref self 'mon) (slot-ref other 'mon))
                                 (< (slot-ref self 'day) (slot-ref other 'day)))))))

(define-method <= ((self <date>) (other <date>))
               (or (equal? self other)
                   (< self other)))

(define-method > ((self <date>) (other <date>))
               (and (not (equal? self other))
                    (< self other)))

(define-method >= ((self <date>) (other <date>))
               (or (equal? self other)
                   (< self other)))

;; *epoc-date* should be a Monday, and *enough* old.
(define *epoc-date*
  (let1 date (make <date> :year 1900 :mon 1 :day 1) ; 1900/1/1 is Monday
        date))

;; 0 is Monday
(define-method wday ((self <date>))
               (remainder (x->number self) 7))

(define-method x->string ((self <date>))
               (format #f "~a/~a/~a(~a)"
                          (slot-ref self 'year)
                          (slot-ref self 'mon)
                          (slot-ref self 'day)
                          (list-ref '(Mon Tue Wed Thu Fri Sat Sun) (wday self))))

;; convert a date into a number of days count from *epoc-date*
(define-method x->number ((self <date>))
               (if (< self *epoc-date*)
                 (error "given date too old")
                 (let loop ((num 0)
                            (prv #f)
                            (stp 1024))
                   (if (< (+ *epoc-date* num) self)
                     (loop (+ num stp) num stp)
                     (if (< 1 stp)
                       (loop prv #f (ash stp -1))
                       num)))))

(define (main args)
  (let ((min-date (make <date> :year 1901 :mon  1 :day  1))
        (max-date (make <date> :year 2000 :mon 12 :day 31)))
    (let loop ((y (slot-ref min-date 'year))
               (m (slot-ref min-date 'mon))
               (n 0))
      (let1 date (make <date> :year y :mon m :day 1) ; first day of the month
            (display ".") (flush) ; display the progress
            (if (<= date max-date)
              (if (< m 12)
                (loop y
                      (+ m 1) ; increment month
                      (if (= (wday date) 6) (+ 1 n) n))  ; 6 is Sun
                (loop (+ y 1) ; increment year
                      1
                      (if (= (wday date) 6) (+ 1 n) n))) ; 6 is Sun
              (begin
                (newline)
                (print n))))))
  0)

よく考えるとこれまで日付計算を真面目にやったことがなかったような気がするので、効率的な計算方法がいまいち思いつかない。とりあえず、1901年から計算しないといけないので、Unix 時間を普通に使うのは無理なことくらいは分かる。

ひとまず、問題文から与えられた情報のみから曜日を求めるため、1900年1月1日をエポック日として定義したうえ、エポック日との差を元に特定の日の曜日を計算できるようにしてみた。

効率は死ぬ程悪いもののひとまず動くようにはなった。解き終わってから他の人がどんな風に解いてるのかと思って調べてみたら、曜日計算を行なうための公式なんてものがあったことを知る。(=> ツェラーの公式 - Wikipedia) …もっと精進しなきゃいかんですね。