Haskell - 1時間以内に解けなければプログラマ失格となってしまう5つの問題

原問題はこちら

blog.svpino.com

なんかまたFizzBuzzの匂いがします。5番がすこしだけ篩になりそうな問題です。4番はpermしてconsしてmax取れば良いので簡単です。他のはプログラミング入門かなんかに載っているはずです。

5番の問題をやってみました

module Main where

data Calc = Smt | C Int deriving (Eq, Show)
data Calced = Plus | Minus | Cons | D Int deriving (Eq, Show)

reduc :: [Calced] -> Int
reduc list = reducHelper list 1 0 0
    where
        reducHelper [] sign stack ans = (sign * stack) + ans
        reducHelper (x:xs) sign stack ans =
            case x of
                Plus -> reducHelper xs 1 0 $ (sign * stack) + ans
                Minus -> reducHelper xs (-1) 0 $ (sign * stack) + ans
                Cons -> reducHelper xs sign (stack * 10) ans
                D y -> reducHelper xs sign (stack + y) ans

patterns :: [Calc] -> [[Calced]]
patterns [] = [[]]
patterns (x:xs) =
    case x of
        Smt -> map (\x -> (Plus):x) (patterns xs) ++ map (\x -> (Minus):x) (patterns xs) ++ map (\x -> (Cons):x) (patterns xs)
        C i -> map (\x -> (D i):x) (patterns xs)

solve q = filter ((==100) . fst) (map (\x -> (reduc x, x)) (patterns q))

main = do
    let q = [(C 1), Smt, (C 2), Smt, (C 3), Smt, (C 4), Smt, (C 5), Smt, (C 6), Smt, (C 7), Smt, (C 8), Smt, (C 9)]
    putStrLn $ show $ solve q
    putStrLn $ (show $ length (solve q)) ++ " patterns"

こんなコードを書いているとHaskellの力を見くびられそうです。もっと短く書くことはできると思います。reducを拡張すれば書けるとか割るとかも入れられるようになっていますが当然求められていません。

組み込みの順列関数とか使うのはなんとなく販促な気がしています。組み込みの順列関数を使うならばf p m cなる関数fにp + m + c == 8になるように数字を次々と入れていってpやm,cの分だけ記号を入れたリストから順列を作り出してreducすれば良さそうです。