« Project Euler : Problem 36 ~ 十進法と二進法 | トップページ | Project Euler : Problem 37 ~ 左右から切り詰め可能な素数 »

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" は日々ちょこちょこ改良(書き換え?)がされています。現在、私が使用しているものに差し替えました。

« Project Euler : Problem 36 ~ 十進法と二進法 | トップページ | Project Euler : Problem 37 ~ 左右から切り詰め可能な素数 »

Haskell」カテゴリの記事

Project Euler」カテゴリの記事

コメント

Github には公開されないんですか?

Github に関しては詳しくないんですよね…。

コメントを書く

コメントは記事投稿者が公開するまで表示されません。

(ウェブ上には掲載しません)

トラックバック

この記事のトラックバックURL:
http://app.cocolog-nifty.com/t/trackback/112020/48859081

この記事へのトラックバック一覧です: Project Euler 用関数 (Haskell):

« Project Euler : Problem 36 ~ 十進法と二進法 | トップページ | Project Euler : Problem 37 ~ 左右から切り詰め可能な素数 »

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

最近のトラックバック

無料ブログはココログ