第7回オフラインリアルタイムどう書く。Haskell による実装。改訂版

問題は http://nabetani.sakura.ne.jp/hena/ord7selectchair/
解答リンク集は http://qiita.com/items/4364285801d1c9f370a1

先日、『第7回オフラインリアルタイムどう書く。Haskell による実装』というタイトルで投稿したのですが、関数のまとめ方などで気になる部分があったので、改訂版を投稿します。

アルゴリズムは変更していません。

off-line07_02.hs

import Data.List
import Data.Char

-- ex) solve "6:NABEbBZn"  =>  "-ZAB-E"
solve :: String -> String
solve str = init $ tail $ foldl f seat cs
  where
    (n, _ : cs) = break (== ':') str
    seat = replicate (read n + 2) '-'
    f seat c = if (isUpper c) then sit c seat else remove (toUpper c) seat

sit :: Char -> String -> String
sit c cs = as ++ (c : bs)
  where
    (as, _ : bs) = splitAt (search cs) cs
    search cs@(_ : cs')
      | isPrefixOf "--" cs = search' 0 ( 1, -1) cs
      | otherwise          = search' 1 (-1, -1) cs'
    -- search' c (i1, i2) cs
    --  c : index counter
    --  i1, i2 : 「条件 2」と「条件 3」に適合する index
    search' _ (i1, i2) "-" = if i1 < 0 then i2 else i1
    search' c (i1, i2) cs@(s : cs')
      | isPrefixOf "---" cs              = c + 1
      | (i1 < 0) && (isPrefixOf "--" cs) = search' (c + 1) (c , i2) cs'
      | (i2 < 0) && (s == '-')           = search' (c + 1) (i1, c ) cs'
      | otherwise                        = search' (c + 1) (i1, i2) cs'

remove :: Char -> String -> String
remove c cs = as ++ ('-' : bs)
  where (as, _ : bs) = break (== c) cs



-- Test
main :: IO ()
main = mapM_ disp testData
  where disp (n, s1, s2) = putStrLn $ show n ++ " : " ++ show (solve s1 == s2)

testData :: [(Int, String, String)]
testData = [(1,  "6:NABEbBZn",        "-ZAB-E"),
            (2,  "1:A",	              "A"),
            (3,  "1:Aa",              "-"),
            (4,  "2:AB",	      "AB"),
            (5,  "2:AaB",	      "B-"),
            (6,  "2:AZa",	      "-Z"),
            (7,  "2:AZz",	      "A-"),
            (8,  "3:ABC",	      "ACB"),
            (9,  "3:ABCa",	      "-CB"),
            (10, "4:ABCD",	      "ADBC"),
            (11, "4:ABCbBD",	      "ABDC"),
            (12, "4:ABCDabcA",	      "-D-A"),
            (13, "5:NEXUS",           "NUESX"),
            (14, "5:ZYQMyqY",	      "ZM-Y-"),
            (15, "5:ABCDbdXYc",       "AYX--"),
            (16, "6:FUTSAL",	      "FAULTS"),
            (17, "6:ABCDEbcBC",       "AECB-D"),
            (18, "7:FMTOWNS",         "FWMNTSO"),
            (19, "7:ABCDEFGabcdfXYZ", "YE-X-GZ"),
            (20, "10:ABCDEFGHIJ",     "AGBHCIDJEF")]