« 2010年4月 | トップページ | 2010年6月 »

2010年5月

2010年5月24日 (月)

Project Euler : Problem 26 ~ 循環節の長さ

 問題はこちらをご覧ください。

 

 基本的な考え方は、以前の記事のとおりです。

 さらに、「フェルマーの小定理」を検討すると、分母を d とした場合、

mod (10 ^ (d - 1)) d == 1
となるので、「順関節の長さ」は最大で "d - 1" となります。
 したがって以前の記事の考えを基にすると、「2」や「5」を因子に持つ d を分母とした場合、「循環節の長さ」は明らかに "d - 1" より短くなるので、調べる候補から外しても問題ないと思われます。
 また、「循環節の長さ」は最大で "d - 1" ということから、 d の候補を大きい方から調べていって、「循環節の長さ」が "d - 1" になるものが見つかったら、それが求める d となります。
-- 1/n の循環節の長さを数える。 count :: Int -> Int count n = 1 + length (takeWhile (/= 1) $ iterate calc $ calc 1) where calc x = rem (10 * x) n problem026 :: Int problem026 = head [x | x <- xs, gcd x 10 == 1, count x == x - 1] where xs = [999, 997 .. 2] main = print problem026
 関数 "count" に関して少し解説をすると、 "iterate calc $ calc 1" は「余りを 10 倍して n で割った余り」を無限リストの形で返します。
 余りが 1 になった時点から再び循環節の繰り返しが始まります。ですからそこで "count" は終了となるのですが、 "takeWhile" が終了条件に合致する項目を含まないことになっているので、正確な「循環節の長さ」を出すために 1 を加えた結果を答えとしています。

 参考までに、「 1/n の小数点以下の数字を無限リストで返す関数」を作って見ました。

underPoint :: Int -> [Int] underPoint n = [a | (a, _) <- iterate calc (calc (0, 1))] where calc (_, m) = quotRem (10 * m) n
*Main> take 20 $ underPoint 7 [1,4,2,8,5,7,1,4,2,8,5,7,1,4,2,8,5,7,1,4]

2010年5月15日 (土)

Project Euler : Problem 25

 問題はこちらをご覧ください。

 

 この問題は、特にに工夫はしていません。フィボナッチ数列を作って条件を満たすまで数え上げただけです。

fibonacci :: Integral a => [a] fibonacci = 1 : 1 : zipWith (+) fibonacci (tail fibonacci) problem025 :: Int problem025 = count fibonacci where limit = 10 ^ (1000 - 1) count (x : xs) | x > limit = 1 | otherwise = 1 + count xs main = print problem025

 "takeWhile" を使ったバージョンも考えてみました。

fibonacci :: Integral a => [a] fibonacci = 1 : 1 : zipWith (+) fibonacci (tail fibonacci) problem025 :: Int problem025 = 1 + length fibonacci' where limit = 10 ^ (1000 - 1) fibonacci' = takeWhile (< limit) fibonacci main = print problem025
 実際の問題は「1000 桁になる最初の項」を探すのですが、律儀に各項の桁数を数えていくと結構時間がかかります。
 Haskell の Integer 型は桁数に制限がないので、コードでは "limit" に 1000 桁の数のうち一番小さい "10 ^ (1000 - 1)" を入れておいて、数字どうしの大小を直接比べるようにしました。

2010年5月10日 (月)

Project Euler : Problem 24 ~ 順列

 問題はこちらをご覧ください。

 

 以前書いたように、Haskell には与えられたリストの順列をすべて返す "permutations" という関数があるのですが、この関数はこの問題でいうところの「辞書順」には結果を返してくれません。
 そのため、この問題を "permutations" で解こうとすると、10! = 3628800 個のリストを求めた後、それをソートしてから 100 万番目の数を探さないといけません。
 実際にやってみたのですが、あまりに遅すぎて結果が出るまで待てませんでした。

 そういった経緯もあって、順列の結果を辞書順に返す "permutation" (非常に紛らわしい名前ですいません) を自作しました。

-- リスト ns から n 個を選ぶ順列 permutation :: [a] -> Int -> [[a]] permutation [] _ = [[]] permutation ns n = perm n (length ns - 1) [(ns, [])] where perm 0 _ xs = [a | (_, a) <- xs] perm c n xs = perm (c - 1) (n - 1) $ concatMap (f n) xs f n (xs, ys) = [(as ++ bs, ys ++ [b]) | i <- [0 .. n], let (as, b : bs) = splitAt i xs] problem024 :: [Int] problem024 = (permutation [0 .. 9] 10) !! (1000000 - 1) main = print problem024
 自作の "permutation" はもともと結構速く、並べ替える必要もないし、遅延評価のおかげで 100 万番目を計算した時点で "problem024" は計算を終了するので、自分のノートパソコンで実際に答えが出るまでに 0.25 秒しかかかりませんでした。

 実はこの問題、もっと簡単に速く解くことができます。
 例えば、 [0, 1, 2, 3] というリストの順列を辞書順に並べて、先頭から順に No.0, No.1, No.2 .. と番号をつけたとします。この時の No.15 を考えます。
 ちなみにここからの説明では、 Haskell のリストに合わせて、インデックスは 0 から数え始めることにして、「インデックス 0」を "i0" と表現します。また、n 個の要素をすべて使った順列の総数は n! = 1 × 2 × ... × (n - 1) × n となります。
 i0 に「0」が入る順列は 3! = 6 、 i0 に「1」が入る順列は同じく 3! = 6 となり、15 ÷ 6 = 2 あまり 3 となるので、 No.15 の i0 は「2」になることが分かります。
 i0 に「2」を使ったので、 i1 に入ることのできる数字は [0, 1, 3] ということになります。これを先ほどと同様に考えていくと 2! = 2 なので、 3 ÷ 2 = 1 あまり 1 となるので、 i1 は 1 になります。
 これを繰り返していくと、最終的に No.15 は [2, 1, 3, 0] となります (No.0 から始まっていることに注意!)。
 これらの考えを関数にまとめたのが、"permutationCount" です。

-- 順列の総数 permutationSize :: Int -> Int permutationSize n = product [2 .. n] -- xs の順列の n 番目の要素を返す。(0 番目から数え始める) permutationCount :: [a] -> Int -> [a] permutationCount xs 0 = xs permutationCount xs n = b : permutationCount (as ++ bs) r where (q, r) = quotRem n $ permutationSize (length xs - 1) (as, b : bs) = splitAt q xs problem24 :: [Int] problem24 = permutationCount [0 .. 9] (1000000 - 1) main = print problem24
 こちらの解き方は、直接 100 万番目を求めるので、約 0.005 秒で答えが出ました。

2010年5月 8日 (土)

Project Euler : Problem 23 ~ 過剰数

 問題はこちらをご覧ください。

 

 最初は、以前 Ruby でこの問題を解いた時と同じ方針でやってみたのですが、配列の更新に時間がかかるためか、答えが出るまでに 7 秒もかかってしまいました。

 そこで単純に、ある数から過剰数を小さい順に引いていって、過剰数にならないものだけを集めていくことにしました。
 ただし、何度も過剰数の判定を行う必要があるので、予め「インデックスが過剰数なら要素が "True"、そうでなければ要素が "False" になるような配列を準備しておきました。
 この方法だと、過剰数の判定に時間がかからないので、約 0.5 秒ほどで、答えが出ました。解法を変えるだけでここまで高速化したのには、びっくりしました。

import Data.Array -- 平方根の整数部分 isqrt :: Integral a => a -> a isqrt = truncate . sqrt . fromIntegral -- 真の約数の和 sumOfDivs :: Integral a => a -> a sumOfDivs 1 = 0 sumOfDivs n = sum ns1 + sum ns2' - n where ns1 = [x | x <- [1 .. isqrt n], rem n x == 0] ns2 = map (div n) ns1 ns2' = if last ns1 == last ns2 then init ns2 else ns2 -- 過剰数か ? isAbundant :: Integral a => a -> Bool isAbundant 1 = False isAbundant n = n < sumOfDivs n problem023 :: Int problem023 = sum $ filter notSum [1 .. limit] where limit = 28123 abuTest = listArray (1, limit) [isAbundant i | i <- [1 .. limit]] abuList = filter (abuTest !) [1 .. limit] notSum n = and [not $ abuTest ! (n - a) | a <- as] where as = takeWhile (<= div n 2) abuList main = print problem023
 「真の約数の和」は素因数分解の結果を利用して求める方法もあるのですが、今回は直接約数を求める方法にしました。

Project Euler : Problem 22

 問題はこちらをご覧ください。

 

 まずは、私の作ったコードから

import Data.List(sort) import Data.Char(ord) problem022 :: [String] -> Integer problem022 ns = sum $ zipWith (*) [1 ..] [nValue x | x <- sort ns] where nValue n = toInteger $ sum [ord x - ord 'A' + 1 | x <- n] main = do ss <- readFile "names.txt" print $ problem022 $ read ("[" ++ ss ++ "]")
 何のヒネリもないですね……。

 "nValue" は単純に名前のスコアを計算しているだけです。
 "main" アクションで "name.txt" を読み込んでいますが、結果は「文字列」として読み込まれるので、その結果の前後に "[" と "]" を付け加えて "read" 関数に与えてやると、「リスト」に変換してくれます。楽ちんですね。

« 2010年4月 | トップページ | 2010年6月 »

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            
フォト

最近のトラックバック

無料ブログはココログ