オフラインリアルタイムどう書く第8回の参考問題をHaskellで書きました。
問題の詳細はこちら
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
他の過去問も解いています。（解けそうな問題から書いてます。。。汗）