復習 & Haskellの学習

頭の体操を兼ねて、Haskellでの解法を考えてみています。

が、あまりHaskellならではの実装をできていない気もします…

テンプレート

parse :: [String] -> [Data d]

入力行をStringの配列で受け取って、問題データの配列を出力する
Stringの配列から必要な分だけ使って問題データに変換し、あとは末尾再帰

solve :: Data d -> String

問題データを受け取って、解答の文字列を出力する

方針

一番後ろの'CS'をひっくり返すのが、1手で最大のダメージを減らす方法
ダメージ以下になるまで繰り返し（再帰）して回数を調べる
ひっくり返せなくなったらIMPOSSIBLE

実装

gcj.hs

import Control.Monad

parse :: [String] -> [(Int, String, Int)]
parse (x:xs) = ((\(n:ls:_) -> (read n, ls, 0)) $ words x) : parse xs

cost = foldl fn (0,1,-1,-1,0)
        where fn (d,c, lcs, lc, n) t
                | t == 'C' = (d, c*2, lcs, n, n+1)
                | t == 'S' = (d+c ,c, lc, lc, n+1)

solve :: (Int, String, Int) -> String
solve (n, ls, hk) =
    case cost ls of
        (d,_,_  ,_,_) | d <= n  -> show hk
        (_,_,lcs,_,_) | lcs < 0 -> "IMPOSSIBLE"
        (_,_,lcs,_,_)           -> solve (n, take lcs ls ++ "SC" ++ drop (lcs+2) ls, hk+1)

main = do
    n  <- readLn
    xs <- getContents
    forM_ (zip [1..n] $ parse $ lines xs) $ \(i,d) ->
        putStrLn $ "Case #" ++ show i ++ ": " ++ solve d

parse

この問題では1 Case = 1行なので、(x:xs)でパターンマッチして変換するだけ

cost

タプルの構造は、(合計ダメージ, 攻撃チャージ, 最後に'CS'が出てきたIndex, 最後の'C'のIndex, 現在のIndex)
3番目の項目は、ダメージを減らす一手を行う場所を求めるためのもの
後ろ2つは3番目の項目を決めるためのもの

solve

'CS'が見つからなくなるか、合計ダメージが指定以下になるまでダメージを減らす手を繰り返す
'CS'をひっくり返すので、その前後を取ってきて'SC'を挟めば良い

おまけ

mainは固定なのでpointfreeにしてみるのも面白いのですが、
まったく読めなくなりますね…

pointfreemain.hs

main = (getContents >>=).(mapM_ printCase .).(. (parse.lines)).zip.enumFromTo 1 =<< readLn
    where printCase (i,d) = putStrLn $ "Case #" ++ show i ++ ": " ++ solve d

再帰 -> unfoldr に置き換え版

ダメージ量を減らしながら文字列を変化させていって変化させられなくなったら生成を止める -> これってunfoldrを適用できね？、ということでやってみた

ついでにfoldlをfoldl'に変更

gcj.hs

import Control.Monad
import Data.List

parse :: [String] -> [(Int, String)]
parse (x:xs) = ((\(n:ls:_) -> (read n, ls)) $ words x) : parse xs

cost :: String -> (Int, Maybe String)
cost str =
    case foldl' fn (0,1,-1,-1,0) str of
        (d,_,lcs,_,_) | lcs < 0 -> (d, Nothing)
        (d,_,lcs,_,_)           -> (d, Just $ take lcs str ++ "SC" ++ drop (lcs+2) str)
        where fn (d,c, lcs, lc, n) t
                | t == 'C' = (d, c*2, lcs, n, n+1)
                | t == 'S' = (d+c ,c, lc, lc, n+1)

solve :: (Int, String) -> String
solve (n, ls) =
    case findIndex (<= n) $ unfoldr (cost <$>) Just ls of
        (Just i) -> show i
        Nothing  -> "IMPOSSIBLE"

main = do
    n <- readLn
    xs <- getContents
    forM_ (zip [1..n] $ parse $ lines xs) $ \(i,d) ->
        putStrLn $ "Case #" ++ show i ++ ": " ++ solve d

costがMaybe(a, b)を返さず、(cost <$>)をunfoldrに与えている理由

unfold :: (b -> Maybe (a, b)) -> b -> [a]

a <- ダメージの計算結果
b <- 一番後ろの'CS'をひっくり返した文字列, もうひっくり返せないならNothing

b -> Maybe (a, b)について f Nothing -> Nothing
-> これってMaybeの定義そのものじゃね？