ProjectEuler #19のHaskell公式の解法の解読

問題

オリジナルはこちら
https://projecteuler.net/problem=19

日本語訳はこちら
http://odz.sakura.ne.jp/projecteuler/index.php?cmd=read&page=Problem%2019

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

1. 1900年1月1日は月曜日である.

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

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

Haskell.orgの回答例１

e19-1.hs

problem_19 =  length 
            . filter (== sunday) 
            . drop 12 
            . take 1212 
            $ since1900

since1900 = scanl nextMonth monday . concat $
              replicate 4 nonLeap ++ cycle (leap : replicate 3 nonLeap)

nonLeap = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]
leap    = 31 : 29 : drop 2 nonLeap

nextMonth x y = (x + y) `mod` 7
sunday = 0
monday = 1

解読

• nonLeapは見たところ、各月の日数を示している

• leapは1月・2月を入れ替えて、うるう年の各月日数のリストを作っている

• 設問では1900年の1月1日の曜日を指定して、各月の日数を示しているということは、これをもとに計算せよとの誘導していると考えるのが妥当

• ここまで考えると、topの関数は次になっていることが想定される

  • 1900年以降、毎月1日の曜日のリスト(since1900)から
  • 1212ヶ月分（1900年～2000年：12*101）を取り出し
  • （月初曜日算出のためには必要だがカウントする期間には含まれない）1900年分の12ヶ月を落とす
  • 日曜のみを残して
  • 数を数える

月別の日数算出

replicate 4 nonLeap ++ cycle (leap : replicate 3 nonLeap)は、

• うるう年を１年、平年を３年を無限に繰り返し
• 先頭のみ平年を４年

要するに

• 1900年はうるう年ではない
• 2000年はうるう年（4年に一度の法則のままで良い）

で、1900年から2000年までの各月の日数をリストのリストとして入れ子で生成している

nextMonth

• 第一引数に基準となる日の曜日を表す0~6の値
• 第二引数に第一引数からの経過日数を

与えることで経過日数後の曜日を表す値を取得

.hs

--日曜日から１日後
 (0 + 1) `mod` 7 = 1 -- 月曜日

scanl

scanl.hs

scanl :: (b -> a -> b) -> b -> [a] -> [b]
scanl f z [x1, x2, ...] == [z, 
                            f z x1, 
                            f (f z x1)  x2, ...]

last (scanl f z xs) == foldl f z xs.

つまり

• 1900年の１月１日が月曜日(1)
• そこから31日後の２月１日が (1 + 31 = 32) mod 7で4（木曜日）
• そこから28日後の３月１日が (4 + 28 = 32) mod 7で4（木曜日）
• そこから31日後の４月１日が (4 + 31 = 35) mod 7で0（日曜日）
• ・・・・・・

月初日の曜日と当該月の日数を使って翌月月初の曜日を求めることを繰り返す。

最終

理解のためにちょっとづつ変更してある

e19-1.hs

--平年
nonLeap = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]
--閏年
leap    = [31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]
--曜日の表現
type Youbi = Int
sunday :: Youbi
sunday = 0
monday :: Youbi
monday = 1
--基準日の曜日と経過日数から、経過日数後の曜日を求める
nextMonth :: Youbi -> Int -> Int
nextMonth w n = (w + n) `mod` 7
--期間中の各月の日数のリスト
days = concat $ replicate 4 nonLeap ++ cycle (leap : replicate 3 nonLeap)
--月初曜日のリストに変換
since1900 = scanl nextMonth monday days
--1900年を落としてカウント
problem_19 =  length 
             . filter (== sunday) 
             . drop 12 
             . take 1212 
             $ since1900

改良

うるう年を考慮した日数の生成が決め打ちなのが気に食わないので、ちょっと改良

.hs

isLeap :: Int -> Bool
isLeap n 
  | n `mod` 400 /= 0 && n `mod` 100 == 0 = False
  | n `mod` 4 == 0 = True
  | otherwise = False

conv :: Bool -> [Int]
conv True = leap
conv _    = nonLeap

days = concat . map (conv . isLeap) $ [1900..2000]

実際にはうるう年判定と変換を同時にすれば良いので冗長だが、わかりやすさのためにあえて別関数にしてある

#Haskell.orgの回答例２

.hs

import Data.Time.Calendar ( fromGregorian )
import Data.Time.Calendar.WeekDate ( toWeekDate )

problem_19_v2 = [() | y <- [1901..2000], 
                             m <- [1..12],
                             let (_, _, d) = toWeekDate $ fromGregorian y m 1,
                             d == 7]

おそらく現代の言語でプログラムを書く場合、回答例１みたいな解き方はしないだろう。
普通にカレンダー系のモジュール使うよね。
期間の各月初日を生成したうえで、その曜日を求めて日曜日の数を数える。
年・月はリストモナドというか、リスト内包表記使えば全パターンを簡単に作れる。ということは、
ポイントは

• 日付から曜日を求める

ところ。

.hs

fromGregorian :: Integer -> Int -> Int -> Day
toWeekDate :: Day -> (Integer, Int, Int) 

Data.Time.CalenderのDay型は修正ユリウス日。
修正ユリウス日は1858-11-17をゼロとした日数とのこと。

toWeekDateはDayをISO8601週の日付形式に変換する。
戻りの最初の要素は、年、2番目の週番号（1-53）、3番目の曜日（月曜日は1、日曜日は7）。
（年の最初の日は常に月曜日であるため、「週」の年はグレゴリオ暦の年とまったく同じではないことに注意）

改良

ISO8601週の日付形式に変換するのはわかりにくいうえに、別モジュールのimportが必要。
同じData.Time.CalendarのdayOfWeekを使うほうが圧倒的にわかりやすい。

.hs

import Data.Time.Calendar
    ( fromGregorian, dayOfWeek, DayOfWeek(Sunday) )

p = length [(y,m) | y <- [1901..2000], 
                    m <- [1..12],
                    dayOfWeek (fromGregorian  y m 1) == Sunday]