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

2010年7月

2010年7月28日 (水)

Project Euler : Problem 40

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

 

 今回も「Ruby 版」と同じように、数字を文字列に変換して繋げていきました。

import Data.Char problem040 :: Int problem040 = product [digitToInt $ str !! x | x <- xs] where str = concatMap show [0 ..] xs = take 7 $ iterate (* 10) 1 main :: IO () main = print problem040

Project Euler : Problem 39 ~ ピタゴラス数 その2

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

 

 この問題は、「Problem 9」でも使用した「pythagoreanNums 関数」を使っています(ただし、ForEuler.hs に書いた pythagoreanNums のコードは「Problem 9」に書いたコードをちょっと改良してあります)。
 pythagoreanNums の考え方についてはこちらをご覧ください。

import Data.Ord (comparing) import Data.List (maximumBy) import ForEuler (pythagoreanNums) problem039 :: Int problem039 = fst $ maximumBy (comparing snd) xs where xs = [(x, length $ pythagoreanNums x) | x <- [1 .. 1000]] main :: IO () main = print problem039

2010年7月23日 (金)

Project Euler : Problem 38 ~ Pandigital な連結積

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

 

 今回も「Ruby 版」と同じ方法なので、解説はこちらをご覧ください。

import ForEuler (dexToList, listToDex, permutation, isPandigitalList) -- n の連結積を文字列の形で返す。 concatList :: [Int] -> [Int] concatList ns = iter ns $ map (dexToList . (* listToDex ns)) [2 ..] where iter prd (s : ss) | length prd < 9 = iter (prd ++ s) ss | otherwise = prd -- d 桁の数の連結積の中で最大の Pandigital 数を求める。 maxPNum :: Int -> Int maxPNum d = head $ pNums ++ [0] where pNums = [listToDex x | x <- [concatList y | y <- ys], isPandigitalList x] ys = permutation [9, 8 .. 1] d problem038 :: Int problem038 = maximum $ map maxPNum [1 .. 4] main :: IO () main = print problem038
 Haskell は遅延評価をしてくれるので、pNums の先頭の要素(つまり最大値)が見つかった時点で勝手に処理を終わらせてくれるので、それ以上無駄な計算をしません。
 ちなみに 13 行目の "++ [0]" は "pNums" が空リストだった時にエラーが出ないようにするためのものです。

2010年7月22日 (木)

Project Euler : Problem 37 ~ 左右から切り詰め可能な素数

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

 

 まずは brute force 版から……。

import ForEuler -- 左右どちらからも切り詰め可能か? -- ex : n = 3797 の時、xs は [(379,7),(37,97),(3,797)] となる。 isTruncatable :: Int -> Bool isTruncatable n = and [isPrime q && isPrime r | (q, r) <- xs] where xs = map (quotRem n) $ takeWhile (< n) $ iterate (* 10) 10 -- 左右どちらからも切り詰め可能な素数 (一桁の素数を除く) truncatablePrimes :: [Int] truncatablePrimes = take 11 [x | x <- dropWhile (< 10) primes, isTruncatable x] problem037 :: Int problem037 = sum truncatablePrimes main :: IO () main = print problem037
 工夫したのは、左から切り詰める場合の判定と右から切り詰める場合の判定をひとつの関数で行った所でしょうか?
 例えば、問題に出てくる 3797 という素数が左右から切り詰め可能であるためには、797, 97, 7, 379, 37, 3 の全てが素数である必要があります。
 isTruncatable 関数はコメントに書いてあるように、3797 が与えられると一度に [(379,7),(37,97),(3,797)] というリストを作って、全てが素数かどうかを調べます。

 さらに別の方法でも解いてみました。
 Scheme 版にも書いた方法で、素数の右に数字をつけて新しい素数を作っていくものです。(詳しくは Scheme 版の解説をご覧ください)

import ForEuler -- 整数 n の右に数字をつけて新しい素数を作る。 -- ex : makeNewPrimes 3 => [31, 37] makeNewPrimes :: Int -> [Int] makeNewPrimes n = filter isPrime [10 * n + x | x <- [1,3,7,9]] -- 左から切り詰められるか? -- ex : n = 3797 の時、xs は [7, 97, 797] となる。 isTruncatable :: Int -> Bool isTruncatable n = and [isPrime x | x <- xs] where xs = [rem n x | x <- takeWhile (< n) $ iterate (* 10) 10] -- 左右どちらからも切り詰め可能な素数 (一桁の素数を除く) truncatablePrimes :: [Int] truncatablePrimes = filter isTruncatable xs where xs = dropWhile (< 10) $ concat $ takeWhile (not . null) xss xss = iterate (concatMap makeNewPrimes) [2, 3, 5, 7] problem037 :: Int problem037 = sum truncatablePrimes main :: IO () main = print problem037
 こちらは調べる数がかなり少ないので、最適化してコンパイルした場合、0.02 秒ほどで答えが出ました。ひとつめの方法が同じ条件で 0.36 秒ほどかかっているので、アルゴリズムを変えただけでかなり高速化されたと言えます。

2010年7月12日 (月)

Project Euler 用関数 (Haskell)

 「Project Euler」を解くために作った関数が結構たまってきたので、まとめて公開してみます。
 とはいっても、まだまだ初心者の作ったものですからツッコミ所が満載でないかと思いますので、間違いに気付いた方やもっといい方法を知っている方はぜひ教えてください。

{- ForEuler.hs :: Module of Functions for "Project Euler" coding by Tsumuji -} module ForEuler where import Data.List (group, sort, delete, tails) {- 素数関連 -} -- 素数列 -- http://d.hatena.ne.jp/notogawa/20110114/1295006865 を参考に -- gcd の使い方が秀逸 primes :: Integral a => [a] primes = map fromIntegral primes' where primes' = [2, 3, 5] ++ f 5 7 (drop 2 primes') f m s (p : ps) = [n | n <- ns, gcd m n == 1] ++ f (m * p) (p * p) ps where ns = [x + y | x <- [s, s + 6 .. p * p - 2], y <- [0, 4]] -- 素数判定 -- isPrime :: Integral a => a -> Bool isPrime n = (n > 1) && isPrime' primes where isPrime' (x : xs) | x * x > n = True | rem n x == 0 = False | otherwise = isPrime' xs {- 素因数分解関連 -} -- 素因数分解 factorize :: Integral a => a -> [(a, Int)] factorize 1 = [(1, 0)] factorize n = format $ factorize' n primes where format ps = [(x, length xs) | xs@(x : _) <- group ps] factorize' n ps@(p : ps') | p * p > n = [n] | rem n p == 0 = p : factorize' (div n p) ps | otherwise = factorize' n ps' -- 約数 divisor :: Integral a => a -> [a] divisor n = sort $ foldr distribute [1] ns where ns = [map (f^) [0 .. i] | (f, i) <- factorize n] distribute ns1 ns2 = [x * y | x <- ns1, y <- ns2] -- 約数の個数 countOfDivs :: Integral a => a -> Int countOfDivs n = product [b + 1 | (_, b) <- factorize n] -- 真の約数の和 -- * 『数学ガール』を参照のこと。 sumOfDivs :: Integral a => a -> a sumOfDivs 1 = 0 sumOfDivs n = product [f p i | (p, i) <- factorize n] - n where f p i = div (p ^ (i + 1) - 1) (p - 1) -- 完全数か ? isPerfect :: Integral a => a -> Bool isPerfect 1 = False isPerfect n = n == sumOfDivs n -- 過剰数か ? isAbundant :: Integral a => a -> Bool isAbundant 1 = False isAbundant n = n < sumOfDivs n -- 不足数か ? isDeficient :: Integral a => a -> Bool isDeficient 1 = True isDeficient n = n > sumOfDivs n -- 友愛数のペアのうち、小さい値が引数の範囲内にあるものを返す。 -- ex : amicablePairs 2 1200 => [(220,284),(1184,1210)] amicablePairs :: Integral a => a -> a -> [(a, a)] amicablePairs from to = [(x, y) | x <- [from .. to], let y = sumOfDivs x, x < y, x == sumOfDivs y] {- 数列関連 -} -- Fibonacci 数 -- "seq" を使うと速くなる fibonacci :: Integral a => [a] fibonacci = fibs 1 1 where fibs a b = seq a $ a : fibs b (a + b) -- 多角数のリスト -- ex : polyNumList 3 => [1,3,6,10,15,21,28,36,45,55 ..] polyNumList :: Integral a => a -> [a] polyNumList n = poly 1 (n - 1) where poly v add = v : poly (v + add) (add + n - 2) -- 多角数の一般項 from 『Wikipedia』 -- ex : map (polyNum 3) [1 .. 5] => [1,3,6,10,15] polyNum :: Integral a => a -> a -> a polyNum p n = div (x * n) 2 where x = (p - 2) * n - (p - 4) -- 多角数か? isPolyNum :: Integral a => a -> a -> Bool isPolyNum p n = isIntRoot (p - 2) (4 - p) (-2 * n) {- 回文数関連 -} -- 回文リストか? isPalindromicList :: Eq a => [a] -> Bool isPalindromicList ns = ns == reverse ns -- 回文数または回文文字列か? isPalindromic :: Show a => a -> Bool isPalindromic n = isPalindromicList $ show n -- 奇数桁の回文数を作る oddPalNum :: Integral a => a -> a oddPalNum n = fromIntegral $ read $ ns ++ tail (reverse ns) where ns = show n -- 偶数桁の回文数を作る evenPalNum :: Integral a => a -> a evenPalNum n = fromIntegral $ read $ ns ++ reverse ns where ns = show n {- 整数とリストの変換 -} -- 整数をリストに変換 -- ex : integralToList 10 123 => [1,2,3] -- ex : integralToList 2 123 => [1,1,1,1,0,1,1] integralToList :: Integral a => a -> a -> [a] integralToList radix n = iter n [] where iter n prd | n < radix = n : prd | otherwise = iter (div n radix) (rem n radix : prd) -- 整数をリストに変換 (十進法限定) dexToList :: Integral a => a -> [a] dexToList = integralToList 10 -- リストを整数に変換 -- ex : listToIntegral 10 [1,2,3] => 123 -- ex : listToIntegral 2 [1,1,1,1,0,1,1] => 123 listToIntegral :: Integral a => a -> [a] -> a listToIntegral radix ns = foldl calc 0 ns where calc x y = x * radix + y -- リストを整数に変換 (十進法限定) listToDex :: Integral a => [a] -> a listToDex = listToIntegral 10 {- ピタゴラス数 -} -- ピタゴラス数 -- a + b + c = n, a^2 + b^2 = c^2, a < b < c の組を探す。 {- * 上記条件より 1. a + a + a < n よって a <= div n 3 2. a^2 + b^2 = (n - a - b)^2 変形すると、 b = n / 2 - (a * n) / (2 * (n - a)) 3. a, b ともに整数なら、n は必ず偶数になるので (既約ピタゴラス数の場合、a と b はどちらかは偶数でもう一方は奇数、 さらに c は奇数になることが判っている) i ) n/2 は整数。 ii) 従って、(a * n) / (2 * (n - a)) も整数。 -} pythagoreanNums :: Integral a => a -> [(a, a, a)] pythagoreanNums n | odd n = [] | otherwise = [(a, b, n - a - b) | a <- as, let b = calc a, a < b] where as = [a | a <- [1 .. div n 3], rem (a * n) (2 * (n - a)) == 0] calc a = div (n * (n - 2 * a)) (2 * (n - a)) -- 既約ピタゴラス数 primitivePythagoreanNums :: Integral a => a -> [(a, a, a)] primitivePythagoreanNums n = [(a, b, c) | (a, b, c) <- pythagoreanNums n, gcd a b == 1] {- 順列と組み合わせ -} -- 順列 ( 辞書順 ) -- ( Data.List に "permutations" が存在するが返り値が辞書順ではない ) -- ex : permutation [1..3] 2 => [[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]] permutation :: [a] -> Int -> [[a]] 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] -- 重複順列 ( 辞書順 ) -- ex : repPermutation [1..3] 2 -- => [[1,1],[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]] repPermutation :: [a] -> Int -> [[a]] repPermutation ns n = perm n [[]] where perm 0 xs = xs perm c xs = perm (c - 1) $ concatMap f xs f xs = [xs ++ [x] | x <- ns] -- 組み合わせ ( 辞書順 ) -- ex : combination [1 .. 4] 2 => [[1,2],[1,3],[1,4],[2,3],[2,4],[3,4]] combination :: [a] -> Int -> [[a]] combination ns n = comb n [(ns, [])] where comb 0 xs = [a | (_, a) <- xs] comb c xs = comb (c - 1) $ concatMap f xs f (xs, ys) = [(as, ys ++ [a]) | (a : as) <- tails xs] -- 重複組み合わせ (repeated combination) -- ex : repComb [0..2] 2 => [[0,0],[0,1],[0,2],[1,1],[1,2],[2,2]] repCombination :: [a] -> Int -> [[a]] repCombination ns n = comb n [(ns, [])] where comb 0 xs = [a | (_, a) <- xs] comb c xs = comb (c - 1) $ concatMap f xs f (xs, ys) = [(as, ys ++ [a]) | as@(a : _) <- tails xs] -- 順列の数 -- ex : permutationSize 5 3 => 60 permutationSize :: Integral a => a -> a -> a permutationSize m n = fallingFactorial m n -- 組み合わせの数 -- ex : combinationSize 5 3 => 10 combinationSize :: Integral a => a -> a -> a combinationSize m n = div (fallingFactorial m n) (factorial n) {- Pandigital 数関連 -} -- Pandigital な数か? isPandigital :: Integral a => a -> Bool isPandigital n = isPandigitalStr (show n) -- Pandigital な List か? isPandigitalList :: Integral a => [a] -> Bool isPandigitalList ns = and $ zipWith (==) (sort ns) [1,2,3,4,5,6,7,8,9,0] -- Pandigital な String か? isPandigitalStr :: String -> Bool isPandigitalStr str = and $ zipWith (==) (sort str) "1234567890" {- その他 -} -- リストの先頭から n 個目ごとに f を適用 -- ex : step 3 (\x -> 0) [1 .. 10] => [0,2,3,0,5,6,0,8,9,0] step :: Int -> (a -> a) -> [a] -> [a] step _ _ [] = [] step n f xs = f a : as ++ step n f bs where (a : as, bs) = splitAt n xs -- Zeller の公式(の変形 ?) -- 0 : Sun, 1 : Mon, 2 : Tue .. -- ネットで見つけた中で、一番シンプルそうなものから…… zeller :: Int -> Int -> Int -> Int zeller y m d | m < 3 = zeller (y - 1) (m + 12) d | otherwise = rem (y + a - b + c + d + e) 7 where [a, b, c] = map (div y) [4, 100, 400] e = div (13 * m + 8) 5 zellerToStr :: Int -> Int -> Int -> String zellerToStr y m d = ws !! (zeller y m d) where ws = ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"] -- オイラーのφ関数 -- * 正の整数 n に対して、1 から n までの自然数のうち n と互いに -- 素なものの個数(1 と n は互いに素と考える) phi :: Integral a => a -> a phi 1 = 1 phi n = product [p^(i - 1) * (p - 1) | (p, i) <- factorize n] -- リストから特定の要素だけを取り除く -- ex : remove 3 [1,2,3,1,2,3] => [1,2,1,2] remove :: Eq a => a -> [a] -> [a] remove x ys = [y | y <- ys, y /= x] -- すべての要素が異なっているか? isAllDifferent :: Eq a => [a] -> Bool isAllDifferent [] = True isAllDifferent (x : xs) | elem x xs = False | otherwise = isAllDifferent xs -- 平方根の整数部分 isqrt :: Integral a => a -> a isqrt = truncate . sqrt . fromIntegral -- 整数か?(小数点以下は 0 か?) isInteger :: RealFrac a => a -> Bool isInteger n = truncate n == ceiling n -- 二次方程式 a * x ^ 2 + b x + c = 0 の大きい方の根は整数か? isIntRoot :: Integral a => a -> a -> a -> Bool isIntRoot a b c = x == y * y && rem (y - b) (2 * a) == 0 where x = b * b - 4 * a * c y = round $ sqrt $ fromIntegral x -- 下降階乗冪 fallingFactorial :: Integral a => a -> a -> a fallingFactorial m n = product [m - n + 1 .. m] -- 階乗 factorial :: Integral a => a -> a factorial m = product [2 .. m] -- 整数の桁数を求める digits :: Integral a => a -> Int digits = length . show

※ 2011/03/03 : "ForEuler.hs" は日々ちょこちょこ改良(書き換え?)がされています。現在、私が使用しているものに差し替えました。

2010年7月 3日 (土)

Project Euler : Problem 36 ~ 十進法と二進法

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

 

 まずは愚直に……偶数は二進法にしたときに一の位が必ず「0」になるので、最初から除外してあります。

-- 回文リストか? isPalindromicList :: Eq a => [a] -> Bool isPalindromicList ns = ns == reverse ns -- 整数をリストに変換 -- ex : integralToList 10 123 => [1,2,3] -- ex : integralToList 2 123 => [1,1,1,1,0,1,1] integralToList :: Integral a => a -> a -> [a] integralToList radix n = iter n [] where iter n prd | n < radix = n : prd | otherwise = iter (div n radix) (rem n radix : prd) problem036 :: Int problem036 = sum $ filter (\x -> check 10 x && check 2 x) [1, 3 .. 1000000] where check m n = isPalindromicList $ integralToList m n main :: IO () main = print problem036

 次に、十進法の回文数を作って、それが二進法の回文数になるかを調べる方法。

-- 奇数桁の回文数を作る oddPalNum :: Integral a => a -> a oddPalNum n = fromIntegral $ read $ ns ++ tail (reverse ns) where ns = show n -- 偶数桁の回文数を作る evenPalNum :: Integral a => a -> a evenPalNum n = fromIntegral $ read $ ns ++ reverse ns where ns = show n -- 回文リストか? isPalindromicList :: Eq a => [a] -> Bool isPalindromicList ns = ns == reverse ns -- 整数をリストに変換 -- ex : integralToList 10 123 => [1,2,3] -- ex : integralToList 2 123 => [1,1,1,1,0,1,1] integralToList :: Integral a => a -> a -> [a] integralToList radix n = iter n [] where iter n prd | n < radix = n : prd | otherwise = iter (div n radix) (rem n radix : prd) palNums :: [Int] palNums = filter odd $ map oddPalNum ns ++ map evenPalNum ns where ns = [1 .. 999] problem036 :: Int problem036 = sum $ filter check palNums where check n = isPalindromicList $ integralToList 2 n main :: IO () main = print problem036

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

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

最近のトラックバック

無料ブログはココログ