「HaskellでProject Euler(Problem 49～51)」ブログ用

euler49-1.hs

import Data.Maybe (fromJust)
import Data.List (find, sort)
import Zaneli.Euler (primesLimitNum)

main = print $ show' $ head $ fromJust primePermutations
  where show' (n1, n2, n3) = (show n1) ++ (show n2) ++ (show n3)

primes :: [Integer]
primes = reverse $ takeWhile (>= 1000) $ primesLimitNum 9999

primePermutations :: Maybe [(Integer, Integer, Integer)]
primePermutations = find (not . null) $ map primePermutations' primes
  where
    primePermutations' 1487 = []
    primePermutations' n = [(n, n2, n3) | m <- [1..(9999-n) `div` 2], let n2 = n + m, valid n2, let n3 = n2 + m, valid n3]
      where
        valid m = isPermutation m && elem m primes
        isPermutation m = (sort $ show n) == (sort $ show m)

euler49-2.hs

import Data.List (sort)
import Zaneli.Euler (primesLimitNum)

main = print $ show' $ head $ primes >>= primePermutations
  where show' (n1, n2, n3) = (show n1) ++ (show n2) ++ (show n3)

primes :: [Integer]
primes = reverse $ takeWhile (>= 1000) $ primesLimitNum 9999

primePermutations :: Integer -> [(Integer, Integer, Integer)]
primePermutations 1487 = []
primePermutations n = [(n, n2, n3) | m <- [2,4..(9999-n) `div` 2], let n2 = n + m, valid n2, let n3 = n2 + m, valid n3]
  where
    valid m = isPermutation m && elem m primes
    isPermutation m = n' == (sort $ show m)
    n' = sort $ show n

euler50-1.hs

import Data.List (find, tails)
import Zaneli.Euler (primesLimitNum)

main = let (n, _) = foldl f (0, 0) $ tails primes in
       print n

limit = 999999

primes :: [Integer]
primes = primesLimitNum limit

f :: (Integer, Int) -> [Integer] -> (Integer, Int)
f r@(_, c) ps | c >= length ps = r
f r ps                         =
  let (_, _, r') = foldl (\(n, c, r) p -> f' n c r p) (0, 0, r) ps in r'

f' :: (Num t, Ord t) => Integer -> t -> (Integer, t) -> Integer -> (Integer, t, (Integer, t))
f' n c r _ | n > limit = (n, c + 1, r)
f' n c r@(_, cnt) p    = (n', c', r')
  where
    n' = n + p
    c' = c + 1
    r' | cnt > c         = r
       | n' `mod` 2 == 0 = r
       | isPrime n'      = (n', c')
       | otherwise       = r

isPrime :: Integer -> Bool
isPrime n = case find (<= n) primes of
  (Just m) -> n == m
  _        -> False

euler50-2.hs

import Data.List (find)
import Data.Set (fromAscList, member, Set)
import Zaneli.Euler (primesLimitNum)

main = let Just n = find search primeSums in
       print n

limit = 1000000

primeSums :: [Integer]
primeSums = f =<< (reverse $ scanl (\(n,xs) x -> (n + x, tail xs)) (0, primes) primes)
  where f (n, xs) = takeWhile (< limit) $ scanl (\s (x, y) -> s - x + y) n $ zip primes xs

primes :: [Integer]
primes = reverse $ primesLimitNum limit

primes' :: Set Integer
primes' = fromAscList primes

search :: Integer -> Bool
search n = n < limit && isPrime n

isPrime :: Integer -> Bool
isPrime n = member n primes'

euler51-1.hs

import Data.Char (digitToInt, intToDigit)
import Data.List (find, group, sort)
import Data.Maybe (fromJust, isJust)

main = print $ head $ primes f

targets :: Show a => a -> [Int]
targets n = map (digitToInt . head) $ filter (\ns -> elem ns ["777", "888", "999"]) $ group $ sort $ init $ show n

replace :: Show a => a -> Int -> Int -> String
replace n m m' = map (\x -> if x == (intToDigit m) then (intToDigit m') else x) $ show n

f :: (Show a, Ord b, Read b) => a -> [b] -> Maybe [String]
f n ps | null ts           = Nothing
       | null replacedList = Nothing
       | otherwise         = Just $ head replacedList
          where
            ts = targets n
            isStartZero n = take 3 n == "000"
            isPrime n = elem' (read n) ps
            replacedList = filter (\ms -> (length ms) == 7) $ map (\t -> filter (\m -> (not $ isStartZero m) && (isPrime m)) $ map (\m -> replace n t m) [0..t-1]) ts

primes :: Integral a => (a -> [a] -> Maybe b) -> b
primes f = primes' [2..] []
  where
    primes' list@(n:ns) ps
      | (n >= 1000) && (isJust r)  = fromJust r
      | otherwise                  = primes' (sieve n ns) (n:ps)
        where
          r = f n ps
          sieve n = filter (\m -> m `mod` n /= 0)

elem' :: Ord a => a -> [a] -> Bool
elem' n ns = case find (<= n) ns of
  (Just m) -> n == m
  _        -> False

euler51-2.hs

import Data.Char (digitToInt, intToDigit)
import Data.List (find, group, mapAccumL, minimumBy, sort)
import Data.Maybe (catMaybes)
import Zaneli.Euler (primes, primesLimitNum)

main = print $ head $ minimumBy (\(x:xs)  (y:ys) -> (read x::Integer) `compare` (read y::Integer)) search

targets :: Show a => a -> [Int]
targets n = map (digitToInt . head) $ filter (\ns -> length ns >= 3 && elem (head ns) "789") $ group $ sort $ init $ show n

replace :: Show a => a -> Int -> Int -> String
replace n m m' = map (\x -> if x == (intToDigit m) then (intToDigit m') else x) $ show n

search :: [[String]]
search = minimum $ map snd $ catMaybes $ map (\(p, ps) -> search' p ps undefined) $ takeWhile (\ps -> (fst ps) >= p) ps''
  where
    (p, ps) = primes search'
    limit = let n = length $ head $ head ps in read $ '1':(replicate n '0')
    ps' = primesLimitNum limit
    (_, ps'') = mapAccumL (\(p:ps) _ -> (ps, (p, ps))) ps' ps'

search' :: (Show a, Read a, Ord a) => b -> [a] -> c -> Maybe (a, [[String]])
search' _ ps _ | null ts           = Nothing
               | null replacedList = Nothing
               | otherwise         = Just (n, replacedList)
  where
    n = head ps
    ts = targets n
    isStartZero n = take 3 n == "000"
    isPrime n = elem' n ps
    replacedList = filter (\ms -> (length ms) == 7) $ map (\t -> filter (\m -> (not $ isStartZero m) && (isPrime $ read m)) $ map (\m -> replace n t m) [0..t-1]) ts

elem' :: Ord a => a -> [a] -> Bool
elem' n ns = case find (<= n) ns of
  (Just m) -> n == m
  _        -> False