「HaskellでProject Euler(Problem 58～60)」ブログ用

euler58.hs

import Data.List (find, unfoldr)
import Zaneli.Euler (isPrime)

main = let Just (_, l) = search spiralDiagonals in print l

spiralDiagonals :: [(Integer, [Integer])]
spiralDiagonals = zip [3,5..] $  unfoldr spiralDiagonals' (1, 0)
  where
    spiralDiagonals' (n, step) = Just (ns, (m, step'))
      where
        m = n + step' * 4
        ns = [n+step',n+step'*2..m]
        step' = step + 2

search :: Num a => [(a, [Integer])] -> Maybe ((Int, Int), a)
search nss = find (\((n, d), l) -> n*100 `div` d < 10) $ tail $ scanl f ((0, 1), 0) nss
  where
    f ((n, d), _) (l, ns) = ((n', d'), l)
      where
        n' = n + (length $ filter isPrime ns)
        d' = d + (length ns)

euler59-1.hs

import Data.Bits (xor)
import Data.List (find, findIndex, unfoldr)

main = do
  cipher <- readFile "cipher.txt"
  let cs = concatMap (splitOn ',') $ lines cipher
  let Just plain = find (contains " the ") $ map (decrypt cs) $ keys 3
  print $ sum $ map fromEnum plain

keys :: Int -> [String]
keys n = let xs = ['a'..'z'] in perm xs (map (\x -> [x]) xs) n
  where
    perm xs yss@(ys:_) n | length ys >= n = yss
    perm xs yss n                         = perm xs (concatMap (\ys -> map (\x -> x:ys) xs) yss) n

decrypt :: Enum a => [String] -> [a] -> String
decrypt enc key = map (\(e, k) -> toEnum $ (read e) `xor` (fromEnum k)) $ zip enc $ cycle key

splitOn :: Eq a => a -> [a] -> [[a]]
splitOn d xs = unfoldr splitOn' xs
  where
    splitOn' []                          = Nothing
    splitOn' xs
      | Just index <- findIndex (==d) xs = let (x, rest) = splitAt index xs in
                                           Just (x, tail rest)
      | otherwise                        = Just (xs, [])

contains :: Eq a => [a] -> [a] -> Bool
contains xs ys = let m = length xs in
                 any (\n -> xs == (take m $ drop n ys)) [0..length ys-m]

euler59-2.hs

import Data.Bits (xor)
import Data.List (find, isInfixOf, unfoldr)

main = do
  cipher <- readFile "cipher.txt"
  let cs = concatMap (splitOn ',') $ lines cipher
  let Just plain = find (isInfixOf " the ") $ map (decrypt cs) $ keys 3
  print $ sum $ map fromEnum plain

keys :: Int -> [String]
keys n = let xs = ['a'..'z'] in perm xs [""] n
  where
    perm xs yss 0 = yss
    perm xs yss n = perm xs [x:ys | ys <- yss, x <- xs] $ n-1

decrypt :: Enum a => [String] -> [a] -> String
decrypt enc key = zipWith (\e k -> toEnum $ (read e) `xor` (fromEnum k)) enc $ cycle key

splitOn :: Eq a => a -> [a] -> [[a]]
splitOn d xs = unfoldr splitOn' xs
  where
    splitOn' [] = Nothing
    splitOn' xs = let (ys, zs) = break (==d) xs in Just (ys, drop 1 zs)

euler59-3.hs

import Data.Bits (xor)
import Data.Char (chr, isPrint, isSpace, ord)
import Data.List (find, isInfixOf, unfoldr)

main = do
  cipher <- readFile "cipher.txt"
  let cs = map read $ concatMap (splitOn ',') $ lines cipher
  let Just plain = find (anyInfixOf [" the ", "The "]) $ filter (all isValid) $ map (decrypt cs) $ keys 3
  print $ sum $ map ord plain
    where
      anyInfixOf xs x = any (flip isInfixOf x) xs
      isValid x = any ($ x) [isPrint, isSpace]

keys :: Int -> [[Int]]
keys n = sequence $ replicate n [ord 'a'..ord 'z']

decrypt :: [Int] -> [Int] -> String
decrypt enc key = zipWith (\e k -> chr $ e `xor` k) enc $ cycle key

splitOn :: Eq a => a -> [a] -> [[a]]
splitOn d xs = unfoldr splitOn' xs
  where
    splitOn' [] = Nothing
    splitOn' xs = let (ys, zs) = break (==d) xs in Just (ys, drop 1 zs)

euler60.hs

import Zaneli.Euler (isPrime)

limit = 5

main = print $ primes search

search :: (Num a, Ord a, Show a) => a -> [a] -> Maybe a
search n ps | xs@(_:_) <- concatPrimes ps' (limit-1) = Just $ n + (minimum $ map sum xs)
            | otherwise                              = Nothing
  where ps' = filterConcatPrimes n ps

concatPrimes :: (Eq a, Num a, Show b) => [b] -> a -> [[b]]
concatPrimes _ 0      = [[]]
concatPrimes [] _     = []
concatPrimes (x:xs) n = map (x:) (concatPrimes xs' (n-1)) ++ concatPrimes xs n
  where xs' = filterConcatPrimes x xs

filterConcatPrimes :: (Show a, Show b) => a -> [b] -> [b]
filterConcatPrimes n = filter $ isConcatPrime n
  where
    isConcatPrime x y = (isPrime $ concatenating x y) && (isPrime $ concatenating y x)
    concatenating x y = read $ (show x) ++ (show y)

-- Zaneli.Euler.primes とほぼ同様の処理を行っているが、mが素数の場合のみret関数を呼びたいため別途定義。
primes :: Integral a => (a -> [a] -> Maybe b) -> b
primes ret = primes' 3 [2] []
  where
    primes' m list list'
      | not $ isPrime list'  = primes' (m + 2) list list'
      | Just r <- ret m list = r
      | otherwise            = primes' (m + 2) (m:list) (list' ++ [m])
        where
          isPrime = all (\x -> m `mod` x /= 0) . takeWhile (\x -> x ^ 2 <= m)