「HaskellでProject Euler(Problem 22～24)」ブログ用

euler22-1.hs

import Data.Char (ord)
import Data.List (sort)
import Text.Regex (matchRegexAll, mkRegex)

main = do names <- readFile "names.txt"
          print $ scoreSum $ sort $ listNames names

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

-- 文字列のリストから、インデックスを数えつつスコアの合計値を算出する
scoreSum :: [String] -> Int
scoreSum = fst . foldl (\(sum, index) name -> (sum + score index name, index + 1)) (0, 1)

-- インデックスと文字からスコアを算出する
score :: Int -> String -> Int
score index name = index * (foldl (\a b -> a + score' b) 0 name)
  where score' x = ord x - ord 'A' + 1

euler22-2.hs

import Data.Char (ord)
import Data.List (sort, unfoldr)
import Text.Regex (matchRegexAll, mkRegex)

main = do names <- readFile "names.txt"
          print $ scoreSum $ sort $ listNames names

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

-- 文字列のリストとインデックスを表す無限リストから、スコアの合計値を算出する
scoreSum :: [String] -> Int
scoreSum = sum . zipWith score [1..]

-- インデックスと文字からスコアを算出する
score :: Int -> String -> Int
score index name = index * sum (map score' name)
  where score' x = ord x - ord 'A' + 1

euler23.hs

import Data.Array (Array, listArray, (!))
import Zaneli.Euler (divSum)

main = print $ foldl addNonAbdSum 0 [1..maxValue]
  where
    addNonAbdSum sum n | isAbdSum n = sum
                       | otherwise  = sum + n
      where
        isAbdSum n = any (\m -> (n - m) > 0 && isAbundants ! (n - m)) abundant

-- 過剰数のリスト
abundant :: [Integer]
abundant = [n | n <- [minValue..maxValue], isAbundant n]

-- インデックスの値が過剰数かどうかを表す配列
isAbundants :: Array Integer Bool
isAbundants = listArray (1, maxValue) [isAbundant n | n <- [1..maxValue]]

-- 過剰数かどうかを返す
isAbundant :: Integral a => a -> Bool
isAbundant n = divSum n > n

minValue = 12
maxValue = 28123

euler24-1.hs

import Data.List (foldl1')

main = print $ search [0..9] 1000000

-- listは昇順にソート済みである前提
search :: [Integer] -> Int -> Integer
search list n | n < 1 || n > limit = error $ "n must be greater than or equal to 1, or less than or equal to " ++ show limit
              | otherwise          = search' list n []
  where
    limit = permNum list
    search' :: [Integer] -> Int -> [Integer] -> Integer
    search' [] _   = listToNum . reverse
    search' list n = search' nextList nextNum . (num:)
      where
        -- 先頭要素に同じ数値が出現するパターン数
        interval = (permNum list) `div` length list
        -- n番目に出現する数値のlist内の要素番号
        index = (n - 1) `div` interval
        -- numはn番目に出現すると確定した数値、nextListはnumを除いたリスト
        (num, nextList) = let (l1, l2h:l2t) = splitAt index list in (l2h, l1 ++ l2t)
        -- num確定後、次の桁以降での探したい出現位置
        nextNum = n - (interval * index)

-- 全ての組み合わせのパターン数
permNum :: [a] -> Int
permNum list = product [1..(length list)]

-- 各桁ごとの数値のリストを10進表記の数値に変換
listToNum :: [Integer] -> Integer
listToNum = foldl1' (\a b -> a * 10 + b)

euler24-2.hs

import Data.Char (intToDigit)
import Data.List (delete, mapAccumL, mapAccumR)

main = print $ ordered $ 1000000-1

-- 0から数えて辞書順でn番目に出現する数値を返す
ordered :: Int -> String
ordered n = listToDigits $ snd $ mapAccumL f [0..9] (indices n)
  where f xs i = let x = xs !! i in (delete x xs, x)

-- 0から数えてn番目に出現する数値の要素番号のリストを返す
indices :: Integral a => a -> [a]
indices n = snd $ mapAccumR divMod n [10,9..1]

-- 各桁ごとの数値のリストを10進表記の数値に変換
listToDigits :: [Int] -> String
listToDigits x = map intToDigit x