0
0

More than 5 years have passed since last update.

# エントロピー符号(2013.2.13の過去問)

Posted at

``````module Doukaku.Entropy (solve) where
import Numeric.Lens (hex, binary)
import Control.Lens (review, preview)

solve :: String -> String
solve = decrypt . concatMap parse

data BDD = Leaf Char | Done | Undefined | Node BDD BDD deriving (Eq, Show)

define :: [Char] -> Char -> BDD -> BDD
define [] c Undefined = if c == '\0' then Done else Leaf c
define ('1':bs) c bdd = case bdd of
Undefined -> Node Undefined (define bs c Undefined)
Node f t -> Node f (define bs c t)
define ('0':bs) c bdd = case bdd of
Undefined -> Node (define bs c Undefined) Undefined
Node f t -> Node (define bs c f) t
define _ c _ = error ("Bad definition of " ++ [c])

codebdd :: BDD
codebdd = define "000"     't'
\$ define "0010"    's'
\$ define "0011"    'n'
\$ define "0100"    'i'
\$ define "01010"   'd'
\$ define "0101101" 'c'
\$ define "010111"  'l'
\$ define "0110"    'o'
\$ define "0111"    'a'
\$ define "10"      'e'
\$ define "1100"    'r'
\$ define "1101"    'h'
\$ define "111"     '\0'
\$ Undefined

decrypt :: String -> String
decrypt is = maybe "*invalid*" answer \$ decrypt' codebdd is
where
answer (n, s) = s ++ ':' : show n

decrypt' :: BDD -> String -> Maybe (Int, String)
decrypt' Done _ = Just (0, [])
decrypt' (Leaf c)  xs = do
(n', cs) <- decrypt' codebdd xs
return (n', c:cs)
decrypt' (Node f _) ('0':xs) = do
(n', cs) <- decrypt' f xs
return (n' + 1, cs)
decrypt' (Node _ t) ('1':xs) = do
(n', cs) <- decrypt' t xs
return (n' + 1, cs)
decrypt' _ _ = Nothing

parse :: Char -> String
parse c = reverse . tail . review binary \$ n
where n = maybe 0 id . preview hex \$ '1':c:[] :: Int
``````

パース時に`1`を付加して`tail`をかけているのは変換後に上位の`0`が飛ばないようにするためで、@kei_q さんに教わった手法です。

http://qiita.com/Nabetani/items/24b9be4ee3bae4c89a95 に他の方の回答もありますので、見ると参考になるでしょう。

0
0
0

Register as a new user and use Qiita more conveniently

1. You get articles that match your needs
2. You can efficiently read back useful information
3. You can use dark theme
What you can do with signing up
0
0