Project Euler : Problem 37

dailycoding37.hs

-- Project Euler : Problem 37

import Data.List
import Data.Char

-- [a]と[b]の全ての組み合わせをfで計算するzipWithみたいなもの
-- 例: zipWith' (*) [1,2,4,8] [1,3]
--       >> [1,3,2,6,4,12,8,24]
zipWith' :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWith' _ _ [] = []
zipWith' _ [] _ = []
zipWith' f (a:as) b = (map (f a) b) ++ (zipWith' f as b)

-- p-1法で1nの素因数を求める
pMinus1 :: Int -> Int -> Int -> Int
pMinus1 _ _ 1 = 1
pMinus1 a k n
    | even n      = 2
    | gcd a n > 1 = gcd a n
    -- p-1法によってnが素数とされたのとき，遅い方法で本当に素数なのか確認する
    | otherwise   = if or [(d == 1), (d == n)] then head $ tail $ divisors n else d
        where t = (a ^ k) `mod` n
              d = gcd (t - 1) n
-- p-1法を用いた素因数分解
factors :: Int -> [Int]
factors 1 = []
factors n = factor : factors (n `div` factor)
    where factor = pMinus1 2 2 n

-- 1からxまでで順番に割ってxの約数を求める(遅い)
divisors :: Int -> [Int]
divisors x = filter (\n -> x `mod` n == 0) [1..x]

-- p-1法を利用してxの約数を求める(ちょっと速い)
divisors' :: Int -> [Int]
divisors' x = sort $ foldr (\acc x' -> zipWith' (*) acc x') [1] partOfFact
    where partOfFact = map (\y -> map ((head y)^) [0..length(y)]) $ group $ factors x

-- 1からxまでで順番に割ってxの約数の数を求める(遅い)
numDivisors :: Int -> Int
numDivisors n = length $ divisors n

-- p-1法を用いた素因数分解によって約数の数を求める(ちょっと速い)
numDivisors' :: Int -> Int
numDivisors' n = product $ map (+1) $ map length $ group $ sort $ factors n

isPrime :: Int -> Bool
isPrime 0 = False
isPrime n = if (length $ divisors' n) == 2
                then True
                else False

cutPrimeLeft :: String -> Bool
cutPrimeLeft "" = True
cutPrimeLeft x
    | isPrime $ read x = cutPrimeLeft $ init x
    | otherwise        = False

cutPrimeRight :: String -> Bool
cutPrimeRight "" = True
cutPrimeRight x
    | isPrime $ read x = cutPrimeRight $ tail x
    | otherwise        = False

cutPrime :: String -> Bool
cutPrime x
    | (isPrime $ digitToInt $ head x) == False = False
    | (isPrime $ digitToInt $ last x) == False = False
    | otherwise = cutPrimeLeft x && cutPrimeRight x

main = print $ sum $ take 11 $ filter (cutPrime . show) [11..]

-- 748317
-- ./dailycoding37  389.65s user 1.65s system 99% cpu 6:32.60 total