Haskellで文字列圧縮(エンコーダーのみ)

仕組み

  • 各文字の出現頻度を数えて一番多いものに"1"、二番目に"01"、三番目に"001"を割り振る。
  • ex "aaaaaaaaaaaa" -> "11111111111"
  • その後6ビットずつに区切る
  • ex "11111111111" -> ["111111","111111"]
  • 2進数として読み、文字に変換する
  • ex ["111111","111111"] -> "``"

動作例

Main> compress "aaaaaaaaaaaaabbbbbbbbbbbbbb"
Just "KKKK_`0"
Main> compress "qwerrfvghhvjnbknjkfaghjgfjda"
Just "!1!%!%%%B5B\"#!)A!$)#1;C\"!#1"

課題

文字の種類が多いものはうまく圧縮できない。
生成したビット列の長さが6で割りきれないときは勝手に0を補っている。
返り値が Maybe String 。
デコーダがない。(致命的)

ソースコード

import Data.Map as M
import Data.List
import Data.Char

allChar = Prelude.map chr [0..127]

genDict str = fromList $ Prelude.map func $ zip [1..] $ Prelude.map snd $ reverse $ sort $ zip (Prelude.map (countChar str) allChar) allChar
	where 
		func (a,b) = (b,makeCodeLengthN a)
		makeCodeLengthN 1 = "1"
		makeCodeLengthN n = '0' : makeCodeLengthN (n-1)
		countChar [] _ = 0
		countChar (x:xs) c = if x==c
			then 1 + countChar xs c
			else countChar xs c

translate [] d = return []
translate (x:xs) d = do
	y <- M.lookup x d
	ys <- translate xs d
	return (y++ys)

bitToChar str = func (reverse str) 0
	where
		func [] a = chr (33+a)
		func (x:xs) a = if x=='1'
			then func xs (a*2+1)
			else func xs (a*2)

split6 str = if length str < 6
	then [str]
	else fst (splitAt 6 str) : split6 (snd (splitAt 6 str) )

compress str = do
	a <- translate str $ genDict str
	return ( Prelude.map bitToChar (split6 a) )