HaskellでProjectEulerを - ここにタイトルを入力|

なんか人様のブログを見ていると結構やっている人が多いようなので挑戦してみた。
というか、挑戦していた。結構前からだらだらやってます。
とりあえず、今回は前にやったやつをば。

間違ってる/汚い/効率悪い、など訂正、助言、貶し、などいろいろお待ちしています。

ちなみに、Project Eulerの公式は
http://projecteuler.net/
あと翻訳してくださっている方がいらっしゃるようで、自分は日本語訳の
http://odz.sakura.ne.jp/projecteuler/index.php?Project%20Euler
の方を使っています。

えぇと、Project Eulerのライセンスって引用okですよね？
というか、引用はライセンス関係なしにok？あ、「一部」じゃないといけないのか？
ともかく、ProjectEulerの問題張るのはok...ですよね...？
間違ってたらごめんなさい。

まず。

ProjectEulerは同じような問題が多いので*1その辺を先にまとめておいた。
後々さらに書き加えていくかもしれんけど、とりあえず現段階*2のもの。

module Lib where

-- ソート済みリストの差
-- (\\)だとさすがに遅い。ソート済みという条件がついてるならこっちを使った方が速い。はず。
diff :: (Ord a, Eq a) => [a] -> [a] -> [a]
diff xxs@(x:xs) yys@(y:ys)
	| x > y		= diff xxs ys
	| x < y		= x:diff xs yys
	| otherwise	= diff xs ys
diff [] _		= []
diff xxs []		= xxs

-- ソート済みリストの和
-- 同様に。ハミング数とかによく効く。
merge :: (Ord a) => [a] -> [a] -> [a]
merge xxs@(x:xs) yys@(y:ys)
	| x < y		= x:merge xs yys
	| x > y		= y:merge xxs ys
	| otherwise	= x:merge xs ys
merge [] yys		= yys
merge xxs []		= xxs

-- フィボナッチ数列
-- ProjectEulerのフィボナッチは初項が1,1のと1,2のやつがあるので初項を取るようにした。
fib :: (Num a) => a -> a -> [a]
fib x1 x2 = x1:x2:zipWith (+) (fib x1 x2) (tail (fib x1 x2))
--fib@(_:tfib) = 1:2:zipWith (+) fib tfib

-- 約数
-- その数の約数。その数自身を含む。
-- 何度も呼ばれることがあるので高速化((そんなにできているかは不明だが))のためソート済みで出てこない。
-- 一時平方数の根が二個表示されるバグ付きだったw
divisors :: (Integral a) => a -> [a]
divisors num = divisors' num [1..num]
	where
		divisors' _ []			= []
		divisors' n (x:xs)
			| n < x * x		= []
			| n `mod` x == 0	= x:(n `div` x):divisors' n xs
			| otherwise		= divisors' n xs

-- 真の約数
-- その数自身を含まない約数のことをこう呼ぶらしい。こっちの方がよく使う。
properDivisors :: (Integral a) => a -> [a]
properDivisors num = 1:divisors' num [2..num]
	where
		divisors' _ []			= []
		divisors' n (x:xs)
			| n < x * x		= []
			| n == x * x		= [x]
			| n `mod` x == 0	= x:(n `div` x):divisors' n xs
			| otherwise		= divisors' n xs

-- 完全数かどうか？
-- 真の約数の和とその数自身が等しい数のこと。
isPerfectNumber :: (Integral a) => a -> Bool
isPerfectNumber n = (n ==) $ sum $ properDivisors n

-- 不足数かどうか？
-- 真の約数の和がその数自身より小さい数。
isDeficientNumber :: (Integral a) => a -> Bool
isDeficientNumber n = (n >) $ sum $ properDivisors n

-- 過剰数かどうか？
-- 真の約数の和がその数自身より大きい数。
isAbundantNumber :: (Integral a) => a -> Bool
isAbundantNumber n = (n <) $ sum $ properDivisors n

-- 素数列
-- 多分Haskellの例で一番目か二番目ぐらいに有名なやつ。もう一つはQuickSortかな？
primes :: (Integral a) => [a]
primes = primes' (2:[3,5..])
	where
		primes' (x:xs)	= x:(primes' $ filter ((/=0).(`mod`x)) xs)
		primes' _	= []

-- 素因数分解
-- そのまま。どうでもいいけどなんでfactors'の定義はこんなんなんだ？中置記法とか...。まぁいいや。
factors :: (Integral a) => a -> [a]
factors = (`factors'` (2:[3,5..]))
	where
		factors' n xxs@(x:xs)
			| n < x * x		= [n]
			| n `mod` x == 0	= x:factors' (n `div` x) xxs
			| otherwise		= factors' n xs
		factors' _ _			= []

-- foldl'
-- lazyじゃないfoldl。普通にfoldl使うとメモリ食いつぶされかねないので。
foldl' :: (a -> b -> a) -> a -> [b] -> a
foldl' _ a [] = a
foldl' f a (x:xs) = (foldl' f $! f a x) xs

-- foldl1'
-- foldl1のfoldl'を使ったVer.
foldl1' :: (a -> a -> a) -> [a] -> a
foldl1' f (x:xs) = foldl' f x xs
foldl1' _ _ = error "null list."

まぁ、あとはこの組み合わせですかねぇ。

Project Euler 1

10未満の自然数のうち、3 もしくは 5 の倍数になっているものは 3, 5, 6, 9 の4つがあり、これらの合計は 23 になる。
同じようにして、1,000 未満の 3 か 5 の倍数になっている数字の合計を求めよ。

1問目だけあってかなり易しめ。

今自分の書いた回答見てみたらなんだこりゃ、って感じ。

import Lib

multiples :: (Ord a, Num a) => a -> [a]
multiples x = iterate (+x) x

main :: IO ()
main = print $ sum $ takeWhile (<1000) $ foldl1 merge $ map multiples [3,(5::Integer)]

なんか、汎用的に数を増やせるようにしようとしてたみたいです。
::Integerはwarningのsuppress用。特に深い意味は無いっす。
まぁ、悩む所は無し。

Ans: 233168

Project Euler 2

フィボナッチ数列の項は前の2つの項の和である。最初の2項を 1, 2 とすれば、最初の10項は以下の通りである。
1, 2, 3, 5, 8, 13, 21, 34, 55, 89, ...
数列の項が400万を超えない範囲で、偶数の項の総和を求めよ。

フィボナッチ数列の問題。
関数型言語には優しすぎる問題。とか勝手に言ってみる。

import Lib

main :: IO ()
main = print $ sum $ filter even $ takeWhile (<(4000000::Integer)) $ fib 1 2

ん〜。まんまですにゃぁ。
ただ、遅い。
むぅ。

Ans: 4613732

Project Euler 3

13195 の素因数は 5、7、13、29 である。
600851475143 の素因数のうち最大のものを求めよ。

素因数分解のお話。

import Lib

main :: IO ()
main = print $ maximum $ factors (600851475143 :: Integer)

これもそのまま。factorsとか先に作っておくとかなり便利です。

Ans: 6857 (600851475143 = 71 * 839 * 1471 * 6857)

Project Euler 4

左右どちらから読んでも同じ値になる数を回文数という。 2桁の数の積で表される回文数のうち、最大のものは 9009 = 91 × 99 である。
では、3桁の数の積で表される回文数のうち最大のものはいくらになるか。

技巧が試されるような問題。
数学的に考えれば、まず、これは11の倍数、だと思うのだが...。などなどと考えつつ。

main :: IO ()
main = print $ maximum $ filter (isPalindrome . show) $ concat $ 
	(`map` [(999::Integer),998..100]) $ \x ->
	(`map` [x,x-1..100]) $ \y ->
	x * y

isPalindrome :: String -> Bool
isPalindrome str =
	let len = length str in
	let (str1,str2) = isPalindrome' (len `div` 2) str [] in
	let str2' = if odd len then tail str2 else str2 in
	str1 == str2'
	where
	isPalindrome' n xxs@(x:xs) yys
		| n == 0	= (xxs, yys)
		| otherwise	= isPalindrome' (n-1) xs (x:yys)
	isPalindrome' _ xxs yys	= (xxs,yys)

なんかやってますね。うん。
今思うとどうせStringにしてしまったんだし、(\x -> x == (reverse x))で十分な気がする。
isPalindromeは文字列を先頭から「折り曲げていって」比較する関数。
一応速度とか気にしていたみたいです。

Ans: 906609 (=993 * 913)

Project Euler 5

2520 は 1 から 10 の数字の全ての整数で割り切れる数字であり、そのような数字の中では最小の値である。
では、1 から 20 までの整数全てで割り切れる数字の中で最小の値はいくらになるか。

要は最小公倍数なので...。

main :: IO ()
main = print $ foldl1 lcm [1..(20::Integer)]

瞬殺。Prelude最高。

Ans: 232792560

Project Euler 6

最初の10個の自然数について、その和の二乗と、二乗数の和は以下の通り。
1² + 2² + ... + 10² = 385
(1 + 2 + ... + 10)² = 3025
これらの数の差は 3025 - 385 = 2640 となる。
同様にして、最初の100個の自然数について和の二乗と二乗の和の差を求めよ。

力押しで十分解ける問題。

main :: IO ()
main = print $ pow2 (sum [1..100]) - (sum $ map pow2 [1..(100::Integer)])
	where
	pow2 = (^(2::Integer))

そのまま。pow2は分けた意味は特にない。
強いて上げるならwarningのsuppressがめんどかったから。かな。

Ans: 25164150 (=25502500 - 338350)

Project Euler 7

素数を小さい方から6つ並べると 2, 3, 5, 7, 11, 13 であり、6番目の素数は 13 である。
10001 番目の素数を求めよ。

常日頃他人に関数型言語を勧める時に使う例だ。
「1000までの」は1000個領域allocして、ふるいを使えばいいだけなのだけど、「1000番目の」はいくつallocしていいか分からない*3ので難しいのだよね。
まぁ、単に「見つけた素数」用に1000個allocすれば十分なんだけどね。うん。

import Lib

main :: IO ()
main = print $ (primes :: [Integer]) !! (10001 - 1)

楽勝。インデックスあわせるために-1してる。
やはり遅いけど。

Ans: 104743

Project Euler 8

以下の1000桁の数字から5つの連続する数字を取り出してその積を計算する。そのような積の中で最大のものの値はいくらか
73167176531330624919225119674426574742355349194934
96983520312774506326239578318016984801869478851843
85861560789112949495459501737958331952853208805511
12540698747158523863050715693290963295227443043557
66896648950445244523161731856403098711121722383113
62229893423380308135336276614282806444486645238749
30358907296290491560440772390713810515859307960866
70172427121883998797908792274921901699720888093776
65727333001053367881220235421809751254540594752243
52584907711670556013604839586446706324415722155397
53697817977846174064955149290862569321978468622482
83972241375657056057490261407972968652414535100474
82166370484403199890008895243450658541227588666881
16427171479924442928230863465674813919123162824586
17866458359124566529476545682848912883142607690042
24219022671055626321111109370544217506941658960408
07198403850962455444362981230987879927244284909188
84580156166097919133875499200524063689912560717606
05886116467109405077541002256983155200055935729725
71636269561882670428252483600823257530420752963450

最初問題見たとき何をすればいいか分からなかった...。
例えば一番左上の"73167"の5つを選ぶと882(=7 * 3 * 1 * 6 * 7)になる。
こんな感じで最大な部分を探す。と。

import List
import Char

main :: IO ()
main = print $ maximum $ map (product . map (\c -> ord c - ord '0') . take 5) $ tails str

str :: String
str="7316717653133062491922511967442657474235534919493496983520312774506326239578318016984801869478851843858615607891129494954595017379583319528532088055111254069874715852386305071569329096329522744304355766896648950445244523161731856403098711121722383113622298934233803081353362766142828064444866452387493035890729629049156044077239071381051585930796086670172427121883998797908792274921901699720888093776657273330010533678812202354218097512545405947522435258490771167055601360483958644670632441572215539753697817977846174064955149290862569321978468622482839722413756570560574902614079729686524145351004748216637048440319989000889524345065854122758866688116427171479924442928230863465674813919123162824586178664583591245665294765456828489128831426076900422421902267105562632111110937054421750694165896040807198403850962455444362981230987879927244284909188845801561660979191338754992005240636899125607176060588611646710940507754100225698315520005593572972571636269561882670428252483600823257530420752963450"

まぁ、こんなのが妥当？
別にどこの5つかは答えなくていいんだよね？
ということでFA

Ans: 40824 (= 9 * 9 * 8 * 7 * 9)

Project Euler 9

ピタゴラスの三つ組(ピタゴラスの定理を満たす整数)とはa2 + b² = c²
を満たす数の組である.
例えば, 3² + 4² = 9 + 16 = 25 = 5²である.
a + b + c = 1000となるピタゴラスの三つ組が一つだけ存在する. このa,b,cの積を計算しなさい.

範囲が限られていて、数学的な条件がある。こんなときはやっぱり

main :: IO ()
main = print $ (\(a,b,c) -> a * b * c) $ head
		[ (a,b,cFromAB a b) | a <- [1..(1000::Integer)], b <- [1..a], pow2 a + pow2 b == pow2 (cFromAB a b)]
	where
	cFromAB a b = (1000::Integer) - a - b
	pow2 = (^(2::Integer))

内包表記の出番でしょ？
ちなみに、cFromABなんて書き方してるけど、内包表記でletが使えるようなので、"[ (a,b,c) | a <- [1..1000], b <- [1..a], let c = 1000 - a - b, a^2 + b^2 == c^2]"と書けるらしい。
便利便利♪

Ans: 31875000 (= 375 * 200 * 425)

Project Euler 10

10以下の素数の和は2 + 3 + 5 + 7 = 17である.
200万以下の全ての素数の和を計算しなさい.

シンプルながら、かなり凶悪な問題。
まぁ、でも愚直に。

import Lib

main :: IO ()
main = print $ sum $ takeWhile (<=(2000000::Integer)) primes

そのまんま。
だと、めっちゃ遅い。手元のMac *4で100分ぐらい。
むぅ。素数生成をもうちと見直してみるか...。

Ans: 142913828922

とか、ゼミの最中に考えてたら意外に簡単に高速化。

primes :: (Num a, Enum a, Ord a) => [a]
primes = 2:primes' [3,5..]
	where
		primes' (x:xs)	= x:(primes' $ xs `diff` (iterate (+x) x))
		primes' _	= []

filter使うよかdiff使った方が絶対速い。と思う。
あとdivよりは足し算の方が格段に速い。と思う。
ということで、Lib.hsを書き換え〜。
あわせて多少型が緩くなりましたとさ。
といってもあまり変わらないか。Realが抜けたぐらい？
変わらねー。"[3,5..]"使わずにiterate使えばEnumも消せるか？まぁいいや。

で、時間の方が同条件で80分。
んー。あまり変わらないか。
200000ぐらいまでだったら半分ぐらいになったんだけどなぁ。時間。
数が大きくなってくるとあまり効果がなくなってくるなぁ。むぅ。

そんなわけで

こんかいはProjectEulerのはじめの10。
多分続きます。
ただ、次回ないし次々回ぐらいからは多分もうちょっと細分化します。というのもストックがないので...。
ではでは。

*1:フィボナッチ数列とか真の約数の和とか

*2:26問目ぐらいまで解いた段階

*3:ちなみに分かったらフィールズ賞もの。だった気がする。というか、それが答えじゃん。

*4:CPU:2.4GHz Core 2 Duo / MEM:2GB