「HaskellでProject Euler(Problem 34～36)」ブログ用

euler34.hs

import Data.Array (listArray, (!))
import Data.List (find)
import Zaneli.Euler (numToList)

main = print $ sum digitFactorials

digitFactorials :: [Int]
digitFactorials = [n | n <- [3..limit], let ns = map (facts !) $ numToList n, (sum ns) == n]
  where
    facts = let (minIdx, maxIdx) = (0, 9) in listArray (minIdx, maxIdx) $ map fact [minIdx..maxIdx] -- 一桁の値の階乗を予め作っておく
    limit = let (Just m) = find (\n -> (10^n-1) > n * (fact 9)) [1..] in 10^m-1

fact :: (Enum a, Num a) => a -> a
fact n = product [1..n]

euler35-1.hs

import Data.List (unfoldr)
import Zaneli.Euler (listToNum, numToList, primesLimitNum)

main = print $ circularPrimes 999999

circularPrimes :: Int -> Int
circularPrimes n = foldl circularPrimes' 0 primes
  where
    primes = primesLimitNum n
    circularPrimes' cps m | isCircularPrime = cps + 1 + (length cirs)
                          | otherwise       = cps
      where
        numList = numToList m
        cirs = circulars numList
        isCircularPrime = unprocessed m cirs && all (flip elem primes) cirs

-- 元の数より小さい巡回数があれば、すでに処理済みとみなしてFalseを返す
unprocessed :: Ord a => a -> [a] -> Bool
unprocessed m cirs = all (m <) cirs

circulars :: (Eq a, Num a) => [a] -> [a]
circulars ns = (unfoldr f ns)
  where
    f (m:ms) | ns == ms' = Nothing
             | otherwise = Just (listToNum ms', ms')
      where ms' = ms ++ [m]

euler35-2.hs

import Data.List (unfoldr)
import Zaneli.Euler (listToNum, numToList, primesLimitNum)

main = print $ circularPrimes 999999

circularPrimes :: Int -> Int
circularPrimes n = foldl circularPrimes' 0 primes
  where
    primes = primesLimitNum n
    circularPrimes' cps m | isCircularPrime = cps + 1 + (length cirs)
                          | otherwise       = cps
      where
        numList = numToList m
        cirs = circulars numList
        isCircularPrime | containEven numList = False
                        | processed m cirs    = False
                        | otherwise           = all (flip elem primes) cirs

-- 2桁以上で偶数を含む数の場合、その巡回数は必ず素数でないものを含むため、除外する
containEven :: Integral a => [a] -> Bool
containEven ns = lengthMoreThan 1 && any even ns
  where lengthMoreThan n = not . null . drop n $ ns

-- 元の数より小さい巡回数があれば、すでに処理済みとみなす
processed :: Ord a => a -> [a] -> Bool
processed m cirs = any (m >=) cirs

circulars :: (Eq a, Num a) => [a] -> [a]
circulars ns = (unfoldr f ns)
  where
    f (m:ms) | ns == ms' = Nothing
             | otherwise = Just (listToNum ms', ms')
      where ms' = ms ++ [m]

euler35-3.hs

import Data.List (partition, unfoldr)
import Zaneli.Euler (listToNum, numToList, primesLimitNum)

main = print $ circularPrimes 999999

circularPrimes :: Int -> Int
circularPrimes n = (length digitPrimes) + (sum $ map circularPrimes' digitsPrimes)
  where
    primes = primesLimitNum n
    (digitsPrimes, digitPrimes) = partition (>=10) $ primes
    circularPrimes' m | isCircularPrime = 1 + (length cirs)
                      | otherwise       = 0
      where
        numList = numToList m
        cirs = circulars numList
        isCircularPrime | any even numList = False
                        | any (m >=) cirs  = False
                        | otherwise        = all (flip elem primes) cirs

circulars :: (Eq a, Num a) => [a] -> [a]
circulars ns = (unfoldr f ns)
  where
    f (m:ms) | ns == ms' = Nothing
             | otherwise = Just (listToNum ms', ms')
      where ms' = ms ++ [m]

euler36.hs

import Data.List (unfoldr)
import Zaneli.Euler (numToList)

main = print $ sum $ doubleBasePalindromes 999999

doubleBasePalindromes :: Integer -> [Integer]
doubleBasePalindromes limit = filter (\n -> isPalindrome numToList n && isPalindrome toBinary n) [1..limit]

-- 10進数を2進数に変換する
toBinary :: Integral a => a -> [a]
toBinary n = reverse $ unfoldr f n
  where
    f n | n == 0    = Nothing
        | otherwise = Just(r, q)
      where
        (q, r) = n `divMod` 2

isPalindrome :: Eq a => (t -> [a]) -> t -> Bool
isPalindrome f ns = let ns' = f ns in ns' == reverse ns'