「HaskellでProject Euler(Problem 40～42)」ブログ用

euler40.hs

import Data.Char (digitToInt)

main = print $ product $ pickUpChampernowne $ map (10^) [0..6]

pickUpChampernowne :: [Int] -> [Int]
pickUpChampernowne targets = pickUp 1 targets 0 []
  where
    pickUp _ [] _ nums = nums
    pickUp n targets@(x:xs) count nums
      | inBetween = pickUp (n+1) xs count' (targetNum:nums)
      | otherwise = pickUp (n+1) targets count' nums
        where
          numStr = show n
          count' = count + (length numStr)
          inBetween = count <= x && x <= count'
          targetNum = digitToInt $ numStr !! (x-count-1)

euler41.hs

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

main = print $ maxPand $ primes limit
  where limit = read $ map intToDigit $ reverse [1..maximum validDigit]

-- エラトステネスの篩を使用してnまでの素数を求める
primes :: Integral a => a -> [a]
primes n = primes' [2..n] []
  where
    primes' list@(m:ms) ps
      | m^2 > n   = (reverse ps) ++ list
      | otherwise = primes' (sieve m ms) (m:ps)
        where sieve n = filter (\m -> m `mod` n /= 0)

-- ns が昇順であることを前提に、最大のパンデジタル数を返す
maxPand :: Show a => [a] -> a
maxPand ns = fromJust $ find isPand $ reverse $ filter isValidDigit ns
  where
    isValidDigit n = elem (length $ show n) validDigit
    isPand n = let x = show n in ['1'..intToDigit $ length x] == (sort x)

-- 1～の総和が3の倍数でない値のリストを返す
-- (各桁の合計が3の倍数であればその数も3の倍数、つまり素数ではないので候補から除くことができる)
validDigit :: [Int]
validDigit = filter (\n -> sum [1..n] `mod` 3 /= 0) [1..9]

euler42.hs

import Data.Char (ord)
import Data.Maybe (fromJust)
import Data.List (find, unfoldr)
import Text.Regex (matchRegexAll, mkRegex)

main = do names <- readFile "words.txt"
          print $ length $ filter isTriangleNum $ listNames names

-- ダブルクオートで囲まれたカンマ区切りの文字列をリストにする
listNames :: String -> [String]
listNames names = concat $ unfoldr f names
  where f ns = fmap (\(_, _, x, xs) -> (xs, x)) $ matchRegexAll (mkRegex "\"([A-Z]+)\"") ns

wordValue :: String -> Int
wordValue xs = sum $ map (\x -> ord x - ord 'A' + 1) xs

isTriangleNum :: String -> Bool
isTriangleNum n = let v = wordValue n in
                  v == (fromJust $ find (>= v) triangleNums)

-- 三角数の無限リストを作る
triangleNums :: [Int]
triangleNums = unfoldr (\(n, m) -> let n' = n+1; m' = n'+m in Just (m', (n', m'))) (0, 0)