<html>
<head>
<style>
P
{
margin:0px;
padding:0px
}
body
{
FONT-SIZE: 10pt;
FONT-FAMILY:Tahoma
}
</style>
</head>
<body>Hi all,<BR>
<BR>
I am coding a zip application (using huffman algorithm) for academic reasons.<BR>
In the process i needed a permute function that i coded but disliked a lot..<BR>
<BR>
I went to the internet looking for a good generic permute algorithm in haskell the best one i found was not generic at all:<BR>
<BR>
<STRONG> import List<BR><BR> perms [] = [[]]<BR> perms (x:<FONT face="">xs</FONT>) = [ p ++ [x] ++ s | xs' <- perms xs<BR> , (p, s) <- zip (inits xs') (tails xs') ]</STRONG><BR>
<STRONG></STRONG> <BR>
I also found information regarding this subject in: <A href="http://www.haskell.org/hawiki/PermutationExample">http://www.haskell.org/hawiki/PermutationExample</A><BR>
<BR>
What am i coding in specific? I receive a list in the form:<BR>
<BR>
<FONT color=#008000> -- l1 is a pair of the identifier and the associated probability</FONT><BR>
<STRONG> l1 = [("A",0.6),("B",0.2)]</STRONG><BR>
<BR>
I must return the permutation with k levels; for example:<BR>
<BR>
<FONT color=#008000> -- permute l k = ...</FONT><BR>
<FONT color=#008000> -- should return</FONT><BR>
<STRONG> permute l1 0 = []</STRONG><BR>
<STRONG> permute l1 1 = l1</STRONG><BR>
<STRONG> permute l2 2 = [("AA",0.64),("AB",0.16),("BA",0.16),("BB",0.04)]</STRONG><BR>
<STRONG> permute l3 3 = [("AAA", Pa*Pa*Pa), ("AAB",Pa*Pa*Pb),("ABA",...),("ABB",...),("BAA",...),("BAB",...),("BBA",...),("BBB",...)]</STRONG><BR>
<STRONG></STRONG> <BR>
<FONT color=#008000> --where</FONT><FONT color=#008000>:</FONT><BR>
<FONT color=#008000> -- 0.64 = Pa*Pa</FONT><BR>
<FONT color=#008000> -- 0.16 = Pa*Pb</FONT><BR>
<FONT color=#008000> -- 0.04 = Pb*Pb</FONT><BR>
<BR>
All of my friend are developing this in c... Of course its easier but i have enough of c and c# at work, so I'm doing this in haskell, the way i like it :)<BR>
For all interested in huffman coding: <A href="http://en.wikipedia.org/wiki/Huffman_coding">http://en.wikipedia.org/wiki/Huffman_coding</A><BR>
<BR>
Thanks in advance for the help, and greetings to all!<BR>
Nuno<BR>
<BR>
P.s. Follows the code i developed until now.. Its open source :P Just hope no-one submit the same work as i did :P<BR>
<HR id=[object]>
<BR>
<FONT color=#008000>-- <resumo><BR>-- Este modulo define uma ferramenta de compressão usando para o <BR>-- efeito o algoritmo de Huffman.<BR>--<BR>-- HZip quer dizer isso mesmo: HuffmanZip.<BR>-- </resumo></FONT><BR><STRONG>module HZip where</STRONG><BR>
<STRONG> import List</STRONG><BR>
<BR>
<FONT color=#008000>-- #region Notas<BR>-- . Ver parte de compressão/rendimento pois pode ter boas dicas para eficiência.<BR>-- #endregion</FONT><BR>
<FONT color=#008000></FONT> <BR>
<FONT color=#008000>-- #region Constantes para efeitos de teste.<BR>-- <resumo><BR>-- Listas usadas para efeito de teste.<BR>-- </resumo></FONT><BR><STRONG> l1 = [("b",0.15),("d",0.08),("f",0.02),("g",0.01),("e",0.08),("c",0.15),("a",0.5),("h",0.01)]<BR> l2 = [("a",0.8),("b",0.2)]</STRONG><BR><FONT color=#008000>-- #endregion</FONT><BR>
<FONT color=#008000></FONT> <BR>
<FONT color=#008000>-- #region Funções Auxiliares</FONT><BR><FONT color=#008000>-- <resumo><BR>-- Função que testa a convergência de funções.<BR>-- Quando o valor da próxima iteração é igual ao da anterior<BR>-- devolve o resultado respectivo.<BR>--<BR>-- Da autoria de </FONT><A href="mailto:jas@di.uminho.pt"><FONT face="" color=#008000>jas<at>di<dot>uminho<dot>pt</FONT></A><BR><FONT color=#008000>-- </resumo><BR>-- <variavel termo='f'><BR>-- A função a aplicar recursivamente.<BR>-- </variavel><BR>-- <variavel termo='s'><BR>-- A solução actual do problema.<BR>-- </variavel><BR>-- <devolve><BR>-- O resultado final da operação.<BR>-- </devolve><BR>-- limit :: (a -> a) -> a -> a</FONT><BR><STRONG> limit f s | s == next = s<BR> | otherwise = limit f next<BR> where next = f s</STRONG><BR>
<STRONG></STRONG> <BR>
<FONT color=#008000>-- <resumo><BR>-- Calcula a metade das probabilidades.<BR>-- </resumo><BR>-- <variavel termo='l'><BR>-- A lista de probabilidades.<BR>-- </variavel><BR>-- <devolve><BR>-- O total das probabilidades a dividir por 2.<BR>-- </devolve></FONT><BR><STRONG> metade l = (sum l) / 2</STRONG><BR>
<BR>
<FONT color=#008000>-- <resumo><BR>-- Devolve o primeiro elemento de um tuplo de 3.<BR>-- </resumo><BR>-- <variavel termo='t'><BR>-- O tuplo.<BR>-- </variavel><BR>-- <devolve><BR>-- O primeiro elemento.<BR>-- </devolve></FONT><BR><STRONG> fst3 (a,_,_) = a</STRONG><BR>
<BR>
<FONT color=#008000>-- <resumo><BR>-- Devolve o segundo elemento de um tuplo de 3.<BR>-- </resumo><BR>-- <variavel termo='t'><BR>-- O tuplo.<BR>-- </variavel><BR>-- <devolve><BR>-- O segundo elemento.<BR>-- </devolve></FONT><BR><STRONG> snd3 (_,b,_) = b</STRONG><BR>
<BR>
<FONT color=#008000>-- <resumo><BR>-- Devolve o terceiro elemento de um tuplo de 3.<BR>-- </resumo><BR>-- <variavel termo='t'><BR>-- O tuplo.<BR>-- </variavel><BR>-- <devolve><BR>-- O terceiro elemento.<BR>-- </devolve><BR></FONT><STRONG> trd3 (_,_,c) = c</STRONG><BR><FONT face="" color=#008000>-- #endregion</FONT><BR>
<FONT color=#008000></FONT> <BR>
<FONT color=#008000>-- #region Funções: Teoria da informação<BR>-- <resumo><BR>-- Calcula a quantidade de informação de uma determinada mensagem.<BR>-- </resumo><BR>-- <variavel termo='p'><BR>-- A probabilidade da mensagem.<BR>-- </variavel><BR>-- <devolve><BR>-- A quantidade de informação da mensagem.<BR>-- </devolve><BR>-- i :: Float -> Float</FONT><BR><STRONG> i p = logBase 2 (1/p)</STRONG><BR>
<BR>
<FONT color=#008000>-- <resumo><BR>-- Entropia, função que calcula a informação média por mensagem.<BR>-- </resumo><BR>-- <variavel termo='l'><BR>-- A lista de probabilidades.<BR>-- </variavel><BR>-- <devolve><BR>-- A informação média por mensagem.<BR>-- </devolve><BR>-- h :: [Float] -> Float</FONT><BR><STRONG> h l = sum $ map (\p -> if p == 0 then 0 else p * i p) l</STRONG><BR>
<BR>
<FONT color=#008000>-- <resumo><BR>-- Calcula o comprimento médio do código (N).<BR>-- </resumo><BR>-- <variavel termo='l'><BR>-- Lista do tipo (c,p) em que:<BR>-- p -> Probabilidade do acontecimento.<BR>-- c -> Comprimento da palavra código.<BR>-- </variavel><BR>-- <devolve><BR>-- O comprimento médio do código.<BR>-- </devolve><BR>-- n :: [(Float,Int)] -> Float</FONT><BR><STRONG> n l = sum $ map (\(c,p) -> p * c) l</STRONG><BR>
<BR>
<FONT color=#008000>-- <resumo><BR>-- Desigualdade de Kraft.<BR>-- </resumo><BR>-- <variavel termo='l'><BR>-- A lista de comprimento das palavras código.<BR>-- </variavel><BR>-- <devolve><BR>-- True, se o código binário for univocamente decifravel<BR>-- False caso contrário.<BR>-- </devolve><BR>-- kr :: [Int] -> Bool</FONT><BR><STRONG> kr l = 1 >= sum ( map (\n -> 2^^(-n)) l )</STRONG><BR>
<BR>
<FONT color=#008000>-- <resumo><BR>-- Algoritmo dos códigos de Huffman.<BR>-- </resumo><BR>-- <variavel termo='l'><BR>-- Lista do tipo (c,p) em que:<BR>-- c -> Caracter identificativo.<BR>-- p -> Probabilidade desse caracter acontecer.<BR>-- </variavel><BR>-- <devolve><BR>-- Tuplo do tipo (t,n,b) em que:<BR>-- t -> Tabela de Huffman resultante.<BR>-- n -> Comprimento médio do código.<BR>-- b -> Se o código resultante é unívocamente decifravel.<BR>-- </devolve><BR>-- huffman :: [(String,Float)] -> ([(String,Float,[Int])], Float, Float, Bool)</FONT><BR><STRONG> huffman l = (tabHuffman,n lProbTam,kr lTamanhos)<BR> where lProbTam = map (\(c,p,b) -> (p,fromIntegral(length b))) tabHuffman<BR> lTamanhos = map (\(c,p,b) -> (length b)) tabHuffman<BR> tabHuffman = concat $ limit passo5 [map (\(c,p) -> (c,p,[])) (passo1 l)]</STRONG><BR>
<BR>
<FONT face="" color=#008000>-- <resumo><BR>-- Ordena as mensagens por ordem decrescente de probabilidade.<BR>-- </resumo><BR>-- <variavel termo='l'><BR>-- Lista do tipo (c,p) em que:<BR>-- c -> Caracter identificativo.<BR>-- p -> Probabilidade desse caracter acontecer.<BR>-- </variavel><BR>-- <devolve><BR>-- A lista ordenada por ordem decrescente de probabilidade.<BR>-- </devolve><BR>-- passo1 :: [(String,Float)] -> [(String,Float)]<BR> passo1 l = sortBy (\(_,p1) (_,p2) -> compare p2 p1) l</FONT><BR>
<FONT color=#008000>-- <resumo><BR>-- Repete o calculo para cada um dos subconjuntos.<BR>-- </resumo><BR>-- <variavel termo='l'><BR>-- Lista do tipo (c,p,b) em que:<BR>-- c -> Caracter identificativo.<BR>-- p -> Probabilidade desse caracter acontecer.<BR>-- b -> Lista de inteiros com o binário correspondente.<BR>-- </variavel><BR>-- <devolve><BR>-- A lista ordenada por ordem decrescente de probabilidade.<BR>-- </devolve><BR>-- passo5 :: [(String,Float,[Int])] -> [(String,Float,[Int])]</FONT><BR><STRONG> passo5 </STRONG><A href="mailto:l@(h"><STRONG>l@(h</STRONG></A><STRONG>:[]) = (passo234 0 (metade (map (\(_,p,_) -> p) h)) h (length h) [] [])<BR> passo5 </STRONG><A href="mailto:l@(h:t"><STRONG>l@(h:t</STRONG></A><STRONG>) = (passo234 0 (metade (map (\(_,p,_) -> p) h)) h (length h) [] []) `union` (passo5 t)</STRONG><BR>
<BR>
<FONT color=#008000>-- <resumo><BR>-- Divide os subconjuntos cada um com apróximadamente métade da probabilidade<BR>-- mantendo a ordenação. Em seguida atribui o código binário e termina a codificação<BR>-- para o subconjunto se este tiver apenas um elemento.<BR>-- </resumo><BR>-- <variavel termo='ac'><BR>-- O acumulador de probabilidade.<BR>-- </variavel><BR>-- <variavel termo='e'><BR>-- Sublista a esquerda.<BR>-- </variavel><BR>-- <variavel termo='d'><BR>-- Sublista a direita.<BR>-- </variavel><BR>-- <variavel termo='n'><BR>-- Define o comportamento de paragem caso sublista tenha comprimento 1.<BR>-- </variavel><BR>-- <variavel termo='l'><BR>-- O calculo actual da tabela de huffman.<BR>-- </variavel><BR>-- <devolve><BR>-- Um passo da tabela de huffman.<BR>-- </devolve><BR>-- passo234 :: Float -> Float -> [(String,Float,[Int])] -> Int -> [(String,Float,[Int])]<BR>-- -> [(String,Float,[Int])] -> [[(String,Float,[Int])]]</FONT><BR><STRONG> passo234 _ _ [] _ e [] = [e] <BR> passo234 _ _ [] _ e d = [e]++[d]<BR> passo234 _ _ (h:t) 1 e d = passo234 0 0 [] 1 [h] d<BR> passo234 ac met </STRONG><A href="mailto:l@((c,p,b):t"><STRONG>l@((c,p,b):t</STRONG></A><STRONG>) n [] d = passo234 (ac+p) met t n [(c,p,b++[0])] d<BR> passo234 ac met </STRONG><A href="mailto:l@((c,p,b):t"><STRONG>l@((c,p,b):t</STRONG></A><STRONG>) _ e d | ac < met = passo234 (ac+p) met t 2 (e++[(c,p,b++[0])]) d<BR> |otherwise = passo234 (ac+p) met t 2 e (d++[(c,p,b++[1])])</STRONG><BR>
<BR>
<FONT color=#008000>-- <resumo><BR>-- Codifica por blocos conforme um factor.<BR>-- </resumo><BR>-- <variavel termo='l'><BR>-- Lista do tipo (c,p) em que:<BR>-- c -> Caracter identificativo.<BR>-- p -> Probabilidade desse caracter acontecer.<BR>-- </variavel><BR>-- <variavel termo='k'><BR>-- k = 1, codificação = 8 bits.<BR>-- k = 2, codificaçao = 16 bits.<BR>-- k = 3, codificação = 32 bits.<BR>-- k = n, cofificação = 2^(<FONT face="">n+2</FONT>) bits.<BR>-- </variavel><BR>-- <devolve><BR>-- A tabela de huffman associada,<BR>-- H (fonte),<BR>-- N,<BR>-- Se o codigo gerado é unívocamente decifravel.<BR>-- </devolve><BR>-- permute deve ser subsituido por (permute l k)</FONT><BR><STRONG> blocos l k = (fst3 tabHuffman, h (map snd l), (snd3 tabHuffman)/k, trd3 tabHuffman)<BR> where tabHuffman = huffman permute</STRONG><BR>
<BR>
<FONT color=#008000>-- <resumo><BR>-- Cria as permutações da de simbolos e calcula a probabilidade associada.<BR>-- </resumo><BR>-- <variavel termo='l'><BR>-- Lista do tipo (c,p) em que:<BR>-- c -> Caracter identificativo.<BR>-- p -> Probabilidade desse caracter acontecer.<BR>-- </variavel><BR>-- <variavel termo='k'><BR>-- Número de niveis.<BR>-- </variavel><BR>-- <devolve><BR>-- Uma lista com os novos simbolos (codificação por blocos) e a respectiva<BR>-- probabilidade.<BR>-- </devolve></FONT><BR><STRONG> permute = [("aa",0.64),("ab",0.16),("ba",0.16),("bb",0.04)]</STRONG><BR>
<BR>
<FONT color=#008000>-- <resumo><BR>-- Calcula a compressão num determinado passo.<BR>-- </resumo><BR>-- <variavel termo='l'><BR>-- Lista do tipo (c,p) em que:<BR>-- c -> Caracter identificativo.<BR>-- p -> Probabilidade desse caracter acontecer.<BR>-- </variavel><BR>-- <variavel termo='k'><BR>-- Número do passo.<BR>-- </variavel><BR>-- <devolve><BR>-- Percentagem de compressão.<BR>-- </devolve></FONT><BR><STRONG> compressao l k = (nf - n_)/nf<BR> where nf = snd3 (huffman l)<BR> n_ = trd4 (blocos l k)<BR> trd4 (_,_,c,_) = c</STRONG><BR><FONT color=#008000>-- #endregion</FONT><BR><br /><hr />Windows Live Spaces is here! It’s easy to create your own personal Web site. <a href='http://spaces.live.com/signup.aspx' target='_new'>Check it out!</a></body>
</html>