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