Project Euler Problem 19
問題19: 1900/1/1は月曜日である。では20世紀で月の初めが日曜日になるのは何回あるか。[=>問題文]
問題19の解答
;; Emacs Lisp (defun problem019 () (let* ((table [31 31 28 31 30 31 30 31 31 30 31 30]) (day (- (1+ 365) (aref table 0))) (count 0)) (do ((y 1901 (1+ y))) ((< 2000 y)) (let ((is-leap (zerop (% y 4)))) (do ((m 1 (1+ m))) ((< 12 m)) (incf day (aref table (1- m))) (if (and is-leap (= m 3)) (incf day)) (if (zerop (% day 7)) (incf count))))) count))
毎月の1日が基準日(1900/1/1)から何日目かを求め、7で割った余りで曜日を判定しています。「前月の日数を加算する」という処理の都合から、table の第一要素は12月の日数で、1月〜11月の日数がそのあとに続くようにしてあります。
1901年から1999年の間は 「100で割れる場合云々」「400で割れる場合云々」は無関係で、4年おきのうるう年さえ考えればよく、2000年も「例外の例外年」にあたり通常通りうるう年となります。
既存機能を利用する
カレンダーライブラリを持つ言語なら面倒な計算をすることなく日付から曜日を取得できます。Emacs Lisp も日時を計算するライブラリ関数 (current-time decode-time encode-time等)がありますが、これらは1970年以降しか扱うことができません。ただこれとは別に M-x calendar で起動する万年カレンダー(日記/スケジューラ)機能が Emacs Lisp には用意されています。これをうまく利用できないでしょうか?
(defun problem019-2 () (let ((buffer)) (labels (;; 準備 (start () (calendar) (setq buffer (current-buffer)) (buffer-disable-undo buffer)) ;; undo を記録しない ;; 後始末 (finish () (buffer-enable-undo buffer) (kill-buffer buffer)) ;; 指定日のバッファ内表示位置 (get-point (year month day) (calendar-other-month month year) (calendar-goto-date (list month day year)) (point))) (start) (let* ((count 0) (monday-point (get-point 1900 1 1))) (do ((y 1901 (1+ y))) ((< 2000 y)) (do ((m 1 (1+ m))) ((< 12 m)) (if (= monday-point (get-point y m 2)) (incf count)))) (finish) count))))
まず基準日(1900/1/1)から第一週の月曜日のバッファ内表示位置を得ます。そして対象期間のカレンダーを順に表示して「月の2日目が月曜日の位置に表示される」ことを判定します。
指定日を表示する calendar-goto-date の前に calendar-other-month を評価しているのは対象月をバッファの中央に表示するためです。カレンダーは3か月分並んで表示されるので、これをしないと位置が固定できません。
buffer-disable-undo はバッファ変更情報の記録を無効化する関数です。頻繁なバッファ表示更新で溜まった undo 記録が limit を越えてしまいワニングが表示されてしまうのでその回避策です。
バッファ内でカレンダーがパラパラと変わっていくのは見ていてちょっと面白いですが、処理には1分以上かかります。