読者です 読者をやめる 読者になる 読者になる

Haskellで「1時間以内に解けなければプログラマ失格となってしまう5つの問題が話題に」の5問目を解いてみた

$ cat p5.hs 
import Debug.Trace

output lst _ _ [] = lst
output lst _ [] _ = lst
output lst n (x:xs) (y:ys)
    | n==x = output (lst++[y]) (n+1) (xs) ys
    | otherwise = output lst (n+1) (x:xs) ys

filt100 lst n [] = lst
filt100 lst n (x:xs)
    | x==100 = filt100 (lst++[n]) (n+1) xs
    | otherwise = filt100 lst (n+1) xs

calc (x:[]) = x
calc (x:y:z:xs)
    | y=="+" = calc $ (show (read x+read z)):xs
    | y=="-" = calc $ (show (read x-read z)):xs

listup :: Int -> [String]
listup n
    | n<9 = map ((show n ++ " + ") ++) (listup (n+1)) ++
            map ((show n ++ " - ") ++) (listup (n+1)) ++
            map (show n ++) (listup (n+1))
    | otherwise = [show n]

main = do
    let lists = listup 1
    let arr = filt100 [] 0 $ map read $ map calc $ map words lists
    mapM_ putStrLn $ map (foldr1 (++)) $ map words $ output [] 0 arr lists

$ time ./p5 
1+2+3-4+5+6+78+9
1+2+34-5+67-8+9
1+23-4+5+6+78-9
1+23-4+56+7+8+9
12+3+4+5-6-7+89
12+3-4+5+67+8+9
12-3-4+5-6+7+89
123+4-5+67-89
123+45-67+8-9
123-4-5-6-7+8-9
123-45-67+89

real    0m0.296s
user    0m0.284s
sys 0m0.009s
  • letで束縛したリストを複数回使っているあたりが手続き的だし、最適化されていないところ
  • 以下記事を見るとどうやら自分がguardをうまく使いこなせていない、ということが分かる

qiita.com

訂正

$ cat p5_2.hs 
import Debug.Trace

filtfunc str = case read . calc $ words str of
    100 -> True
    _ -> False

calc (x:[]) = x
calc (x:y:z:xs) = case y of
    "+" -> calc $ (show (read x+read z)):xs
    "-" -> calc $ (show (read x-read z)):xs

listup :: Int -> [String]
listup n
    | n<9 = map ((show n ++ " + ") ++) (listup (n+1)) ++
            map ((show n ++ " - ") ++) (listup (n+1)) ++
            map (show n ++) (listup (n+1))
    | otherwise = [show n]

main = do
    mapM_ putStrLn $ map (foldr1 (++)) $ map words $ filter filtfunc $ listup 1

$ time ./p5_2 
1+2+3-4+5+6+78+9
1+2+34-5+67-8+9
1+23-4+5+6+78-9
1+23-4+56+7+8+9
12+3+4+5-6-7+89
12+3-4+5+67+8+9
12-3-4+5-6+7+89
123+4-5+67-89
123+45-67+8-9
123-4-5-6-7+8-9
123-45-67+89

real    0m0.305s
user    0m0.293s
sys 0m0.008s