Project Euler

2011年3月 3日 (木)

Project Euler 用のモジュールを改訂しました。

 以前、Project Euler 用のモジュールとして、"ForEuler.hs" を発表しました。
 今でも暇な時にチョコチョコいじっているのですが、最新版を以前の記事のコードと差し替えました。
 実際のコードはこちらを御覧ください。

2011年2月27日 (日)

Project Euler : Problem 59 ~ 暗号解読

 問題はこちらをご覧ください。
 また、自作の "ForEuler module" に関してはこちらをご覧ください。

 

 今回の問題の解法は、以前 Ruby で解いた時と同じです。考え方についてはこちらをご覧下さい。

{- * キーワードを探す : problem059_find_key.hs -} import Data.Bits (xor) import Data.List (transpose, sort, group, sortBy) import Data.Ord (comparing) import Data.Char (chr, ord) main :: IO () main = do ss <- readFile "cipher1.txt" print $ map f $ map top5 $ divide 3 $ read ("[" ++ ss ++ "]") where f ns = deemChar 'e' ns -- cs を n 個おきにグループに分る -- ex : divide 3 [1..10] => [[1,4,7,10],[2,5,8],[3,6,9]] divide :: Int -> [Int] -> [[Int]] divide n cs = (transpose . f) cs where f [] = [] f xs = as : f bs where (as, bs) = splitAt n xs -- ns の要素のうち出現頻度の高い順に 5 個をリストにして返す top5 :: [Int] -> [Int] top5 ns = map fst $ take 5 $ reverse $ sortBy (comparing snd) lst where lst = [(head xs, length xs) | xs <- (group . sort) ns] -- 鍵文字を c と仮定して、ns を復元する(結果は String として返す) deemChar :: Char -> [Int] -> [String] deemChar c ns = map f ns where f n = [chr $ xor n $ ord c]
{- * 暗号文を復元する : problem059_decode.hs * コンパイル後のファイル名を "decode"、キーワードを "***" と仮定すると、 > decode *** で、暗合文を復元する。 -} import Data.Bits (xor) import Data.Char (ord, chr) import System (getArgs) main :: IO () main = do args <- getArgs ss <- readFile "cipher1.txt" print $ decode (read ("[" ++ ss ++ "]")) (head args) {- -- *** をキーワードに置き換える main :: IO () main = do ss <- readFile "cipher1.txt" print $ decode (read ("[" ++ ss ++ "]")) "***" -} decode :: [Int] -> String -> String decode ns pw = map chr $ zipWith (xor) ns ms where ms = map ord $ concat $ repeat pw

2011年2月 6日 (日)

Project Euler : Problem 58

 問題はこちらをご覧ください。
 また、自作の "ForEuler module" に関してはこちらをご覧ください。

 

 辺の長さと四隅の数の関係を調べてみると、次のようなことが分ります。

辺の長さ : 四隅の数 : 交差 1 : 1 : 0 3 : 9, 7, 5, 3 : -2 5 : 25, 21, 17, 13 : -4 7 : 49, 43, 37, 31 : -6
 つまり四隅の数は、辺の長さを L とすると「初項 L^2, 公差 1-L の等差数列」と見ることができます。
 ということで次のようなコードを書いてみました。
import ForEuler (isPrime) problem058 :: Integer problem058 = head [s | (s, _, _) <- dropWhile check $ tail ts] where ts = scanl f (1, 0, 1) [3, 5 ..] check (_, p, t) = 10 * p >= t f (_, p, t) s = (s, p + length (pNums s), t + 4) pNums x = filter isPrime [x ^ 2 + (1 - x) * y | y <- [0 .. 3]] main :: IO () main = print problem058
 対角線上の数の個数の合計を t 、そのうちの素数の個数の合計を p とした時、dropWhile に与える条件を「p / t >= 0.1」とすると、計算の度に数値の型を Int から Float に変換しなければいけません。
 そこで条件式を変形して「10 * p >= t」とすることで Int だけで計算できるようにしてみました。

2010年12月 9日 (木)

Project Euler : Problem 57 ~ 漸化式

 問題はこちらをご覧ください。
 また、自作の "ForEuler module" に関してはこちらをご覧ください。

 

 考え方に関してはこちらをご覧ください。

 今回は、漸化式の分子と分母をタプルにした無限リスト "root2" を定義してみました。

import ForEuler (dexToList) root2 :: [(Integer, Integer)] root2 = iterate func (3, 2) where func (a, b) = (a + 2 * b, a + b) problem057 :: Int problem057 = length $ filter check $ take 1000 root2 where check (a, b) = size a > size b size x = length $ dexToList x main :: IO () main = print problem057

2010年11月29日 (月)

Project Euler : Problem 56

 問題はこちらをご覧ください。
 また、自作の "ForEuler module" に関してはこちらをご覧ください。

 

 自然数 ab の桁の和を計算する関数を f(a, b) とすると、

f(a, b) = f(a * 10, b) = f(a * 100, b)
ということが分かります。すなわち、"a" が 10 の倍数の時には計算する必要が無いということです。
 そこで今回は次のようなコードを書いてみました。
import ForEuler problem056 :: Integer problem056 = maximum nums where nums = [f (a ^ b) | a <- [2 .. 99], rem a 10 /= 0, b <- [2 .. 99]] f n = sum $ dexToList n main :: IO () main = print problem056

Project Euler : Problem 55

 問題はこちらをご覧ください。
 また、自作の "ForEuler module" に関してはこちらをご覧ください。

 

 今回は、問題文を素直にコードにしてみました。

import ForEuler isLychrel :: Integer -> Bool isLychrel n | null ans = True | otherwise = False where ans = [x | x <- take 50 $ tail $ iterate reversePlus n, isPalindromic x] reversePlus n = n + (listToDex . reverse . dexToList) n problem055 :: Int problem055 = length $ filter isLychrel [1 .. 10000] main :: IO () main = print problem055
 数を反転するのに (listToDex . reverse . dexToList) という合成関数を使ってみました。

2010年11月 4日 (木)

Project Euler : Problem 53 その2

 問題はこちらをご覧ください。
 また、自作の "ForEuler module" に関してはこちらをご覧ください。

 

 前回 "Problem 53" の記事を投稿した後、同じ問題を解いていらっしゃる他の方々のブログを眺めていたら、なぜか「パスカルの三角形」の単語がちょくちょく出てきました。
 最初は「??」だったのですが、「『組み合わせ』といえば『パスカルの三角形』」ということをやっと思いだしました。(分らない人は "Wikipedia" などで調べて見てください)
 それで、急いで自分なりの「パスカルの三角形バージョン」を作ってみました。

pascal'sTriangle :: [[Integer]] pascal'sTriangle = iterate func [1] where func ns = zipWith (+) (0:ns) ns ++ [1] -- nCr > m となる r の数 count :: [Integer] -> Integer -> Int count ns m = if r == length ns then 0 else length ns - 2 * r where r = length $ takeWhile (<= m) ns problem053 :: Int problem053 = sum $ map (`count` 1000000) $ take 101 pascal'sTriangle main :: IO () main = print problem053

 「パスカルの三角形」を使ってこの問題を解くと、階乗の計算が不要になるのでかなり速く解けますね。

2010年10月29日 (金)

Project Euler : Problem 53

 問題はこちらをご覧ください。
 また、自作の "ForEuler module" に関してはこちらをご覧ください。

 

 まずは、brute force 版。何も考えず、問題を素直に解きました。

import ForEuler problem053 :: Int problem053 = length $ filter (> 1000000) combs where combs = [combinationSize n r | n <- [1 .. 100], r <- [1 .. n]] main :: IO () main = print problem053
 これでも、最適化オプションを付けてコンパイルすれば、うちの非力なノートパソコンでも約 0.1 秒ほどで答えが出ます。

 ここで一工夫。
 先ほどのコードでは、"combinationSizse 関数" の内部で階乗の計算が繰り返し行われています。そこで階乗の計算結果をメモ化してみました。

import Data.Array factorial :: Integer -> Integer factorial n = facts ! n where facts = listArray (0, 100) (1 : [factorial' x | x <- [1 .. 100]]) factorial' x = x * factorial (x - 1) combSize :: Integer -> Integer -> Integer combSize n r = div (factorial n) (factorial r * factorial (n - r)) problem053 :: Int problem053 = length $ filter (> 1000000) combs where combs = [combSize n r | n <- [1 .. 100], r <- [1 .. n]] main :: IO () main = print problem053
 これだと計算の無駄な繰り返しが無くなるので、うちのパソコンで約 0.03 秒で答えが出ます。かなり高速化されました。

 今度はちょっと考え方を変えてみます。
 次の結果を見てください。

> map (combinationSize 10) [0..10] > [1,10,45,120,210,252,210,120,45,10,1]
 組み合わせの式の定義からも分かることですが、nCr = nC(n-r) が成り立ちます。
 また、r が n/2 に達するまでは nCr は大きくなっていき、r が n/2 を越えると対照的に小さくなっていきます。
 このことから、r を 0 から小さい順に調べていって、nCr0 が初めて 1000000 を越えた場合、r0 ≦ r ≦ (n - r0) の範囲にある r では、必ず nCr > 1000000 が成立します。
 ということは、特定の n に対する r0 さえ見つけてしまえば、nCr > 1000000 が成立する場合の数が分かることになります。
import ForEuler -- nCr > m となる r の数 count :: Integer -> Integer -> Integer count n m = if null rs then 0 else n - 2 * (head rs) + 1 where -- rs : nCr > m となる r の集合の前半 rs = filter (\x -> combinationSize n x > m) [0 .. (div n 2)] problem053 :: Integer problem053 = sum $ map (`count` 1000000) [1 .. 100] main :: IO () main = print problem053
 今回は計算量が少ないので、階乗の計算をメモ化しなくても十分速いです。うちのパソコンで約 0.01 秒で答えが出ました。

 Project Euler って、コーディングの知識も要求されるけど、うまい解法を見つけることがもっと重要かも……。

2010年10月25日 (月)

Project Euler : Problem 52

 問題はこちらをご覧ください。
 また、自作の "ForEuler module" に関してはこちらをご覧ください。

 

 これまた解法は "Ruby 版" と一緒なので、詳しくはこちらをご覧ください。

import ForEuler import Data.List check :: Integer -> Bool check n = and [ns == conv x | x <- map (* n) [2..6]] where conv = sort . dexToList ns = conv n problem052 :: Integer problem052 = head $ filter check [123456 ..] main :: IO () main = print problem052

2010年10月18日 (月)

Project Euler : Problem 51 ~ 8個の素数

 問題はこちらをご覧ください。
 また、自作の "ForEuler module" に関してはこちらをご覧ください。

 

 アルゴリズムは「Ruby 版」とほぼ同じなので、考え方に関してはこちらをご覧ください。

import ForEuler -- findPos xs es -- * xs 内での es の各要素の位置を xs の index のリストで返す -- * ex: findPos [0,1,0,2,3] [0,1,2] => [[0,2], [1], [3]] findPos :: Eq a => [a] -> [a] -> [[Int]] findPos xs es = [i | i <- map (findPos' xs) es, i /= []] where findPos' xs e = [i | (x, i) <- zip xs [0 ..], x == e] -- setElems e xs is -- * xs 内の is で示される位置の要素を e に置き換える -- * ex: setElems 0 [1,2,3,4] [1,2] => [1,0,0,4] setElem :: a -> [a] -> [Int] -> [a] setElem e xs is = foldl (setElem' e) xs is where setElem' e xs i = as ++ (e : bs) where (as, _ : bs) = splitAt i xs -- makeNewPrimes n is -- * n の is で示される位置の数字を 0 〜 9 で置き換えたもののうち、素数 -- だけをリストにして返す -- * ex: makeNewPrimes 56003 [2,3] -- => [56003,56113,56333,56443,56663,56773,56993] makeNewPrimes :: Int -> [Int] -> [Int] makeNewPrimes n is = filter isPrime ns where ns = [listToDex xs | xs <- map func [0 .. 9], head xs /= 0] func e = setElem e (dexToList n) is problem051 :: [Int] problem051 = head $ filter ((== 8) . length) $ concatMap check primes where check p = map (makeNewPrimes p) $ findPos (dexToList p) [0,1,2] main :: IO () main = print problem051

 Haskell で「初めて〜になるものを探す」といった問題を解く場合、今回のコードのように、「無限リストを特定の条件で filter して、その先頭要素だけを取り出す」というパターンが使えるので、非常に重宝しています。

より以前の記事一覧

2016年7月
          1 2
3 4 5 6 7 8 9
10 11 12 13 14 15 16
17 18 19 20 21 22 23
24 25 26 27 28 29 30
31            
フォト

最近のトラックバック

無料ブログはココログ