オフラインリアルタイムどう書く第8回の参考問題をHaskellで書いた


オフラインリアルタイムどう書く第8回の参考問題をHaskellで書きました。
問題の詳細は[こちら](http://nabetani.sakura.ne.jp/hena/ord8entco/)

```hs:decode.hs
import qualified Data.Map as Map
import qualified Data.List as List
import Data.Char
import Control.Monad

bin = ["0000","0001","0010","0011","0100","0101","0110","0111",
       "1000","1001","1010","1011","1100","1101","1110","1111"]

table = Map.fromList [("000", "t"),
					  ("0010", "s"),
					  ("0011", "n"),
					  ("0100", "i"),
					  ("01010", "d"),
					  ("0101101", "c"),
					  ("010111", "l"),
					  ("0110", "o"),
					  ("0111", "a"),
					  ("10", "e"),
					  ("1100", "r"),
					  ("1101", "h"),
					  ("111", "")
					 ]

tableKeys :: [String]
tableKeys = Map.keys table

--入力文字列を2進数へ変換する関数
hexToBin :: String -> String
hexToBin  = concatMap (reverse . (bin !!) . digitToInt)

--入力に対応する文字は必ず見つかるのでMaybe値から通常の値を取り出して返す
tableLookUp :: String -> String
tableLookUp k = let x = Map.lookup k table
                in case x of
                	(Just y) -> y
                	Nothing -> error "invalid key"

-- > isPrefix "10" "10000" == Maybe ("10", "e", "000")
-- > isPrefix "0010" "00101101" == Maybe ("0010", "s", "1101")
-- > isPrefix "0000" "00101101" == Nothing
-- isPrefix s t sがtのプレフィックズならば
-- 三つ組(s, sに対応する文字, tからsを取り除いた残り)を返し
-- プレフィックスでなければNothingを返す
isPrefix :: String -> String -> Maybe (String, String, String)
isPrefix s t = let u = List.stripPrefix s t
               in case u of
               	 Just v -> Just (s, tableLookUp s, v)
               	 Nothing -> Nothing


parse :: String -> [Maybe (String, String)]
parse s = let x = foldl mplus Nothing $ map (`isPrefix` s) tableKeys
           in case x of
           	Just (s, "", u) -> [Just (s, "")] -- 終端文字を読み込んだらそれ以上再帰しない
           	Just (s, t, u) -> (Just (s, t)):(parse u)
           	Nothing -> [Nothing] -- 対応する文字がない符号を読み込んだらNothingを返す

solve' :: String -> Maybe (String, String)
solve' s = foldl add (Just ("", "")) $ (parse . hexToBin) s
	where
		add :: Maybe (String, String) -> Maybe (String, String) -> Maybe (String, String)
		add Nothing _ = Nothing
		add _ Nothing = Nothing
		add (Just (s, t)) (Just (s', t')) = Just (s++s', t++t')

solve :: String -> String
solve s = let x = solve' s
          in case x of
          	Just (y, z) -> z ++ ":" ++ (show $ length y)
          	Nothing -> "*invalid*"

test = [
		("16d9d4fbd", "ethanol:30"),
		("df", "e:5"),
		("ad7", "c:10"),
		("870dcb", "t:6"),
		("880f63d", "test:15"),
		("a57cbe56", "cat:17"),
		("36abef2", "roll:23"),
		("ad576cd8", "chant:25"),
		("3e2a3db4fb9", "rails:25"),
		("51aa3b4c2", "eeeteee:18"),
		("ad5f1a07affe", "charset:31"),
		("4ab8a86d7afb0f", "slideshare:42"),
		("ac4b0b9faef", "doctor:30"),
		("cafebabe", "nlh:17"),
		("43e7", "sra:15"),
		("53e7", "eera:15"),
		("86cf", "tera:16"),
		("b6cf", "hon:15"),
		("0", "*invalid*"),
		("c", "*invalid*"),
		("d", "*invalid*"),
		("e", "*invalid*"),
		("babecafe", "*invalid*"),
		("8d", "*invalid*"),
		("ad", "*invalid*"),
		("af", "*invalid*"),
		("ab6e0", "*invalid*"),
		("a4371", "*invalid*"),
		("a4371", "*invalid*"),
		("96e3", "*invalid*"),
		("0dc71", "*invalid*"),
		("2a9f51", "*invalid*"),
		("a43fb2", "*invalid*"),
		("ab6e75", "*invalid*"),
		("a5dcfa", "*invalid*"),
		("ca97", "*invalid*"),
		("6822dcb", "*invalid*")
		]

main = mapM_ (\(x, y) -> print (solve x == y)) test
```

他の過去問も解いています。（解けそうな問題から書いてます。。。汗）

+ [第9回オフラインリアルタイムどう書くの参考問題をHaskellで書いた](http://qiita.com/liveinwood/items/5e8cb20c4424dba4354a)
+ [第10回オフラインリアルタイムどう書くの問題をHaskellで書いた](http://qiita.com/liveinwood/items/64f4e7f26f70dced5096)
+ [第14回オフラインリアルタイムどう書くの参考問題をHaskellで書いた](http://qiita.com/liveinwood/items/c95b42364e6103a73c27)
+ [第17回オフラインリアルタイムどう書くの参考問題をHaskellで書いた](http://qiita.com/liveinwood/items/f9891d2f17034686631a)