This message seems to have lingered in obscuriy for a while, I only just received it. What about permLev :: Int -> (a -> a -> a) -> [a] -> [a] permLev 0 _ _ = [] permLev 1 _ xs = xs permLev k f xs = do x <- xs y <- permLev (k-1) f xs return (f x y) l1 :: [(String,Double)] l1 = [("A",0.8),("B",0.2)] com :: Num b => ([a],b) -> ([a],b) -> ([a],b) com (xs,x) (ys,y) = (xs ++ ys, x*y) ? Does *PermGen> permLev 1 com l1 [("A",0.8),("B",0.2)] *PermGen> permLev 2 com l1 [("AA",0.6400000000000001),("AB",0.16000000000000003), ("BA",0.16000000000000003),("BB",4.000000000000001e-2)] *PermGen> permLev 3 com l1 [("AAA",0.5120000000000001),("AAB",0.12800000000000003), ("ABA",0.12800000000000003),("ABB",3.200000000000001e-2), ("BAA",0.12800000000000003),("BAB",3.200000000000001e-2), ("BBA",3.200000000000001e-2),("BBB",8.000000000000002e-3)] *PermGen> permLev 4 com l1 [("AAAA",0.40960000000000013),("AAAB",0.10240000000000003), ("AABA",0.10240000000000003),("AABB",2.5600000000000008e-2), ("ABAA",0.10240000000000003),("ABAB",2.5600000000000008e-2), ("ABBA",2.5600000000000008e-2),("ABBB",6.400000000000002e-3), ("BAAA",0.10240000000000003),("BAAB",2.5600000000000008e-2), ("BABA",2.5600000000000008e-2),("BABB",6.400000000000002e-3), ("BBAA",2.5600000000000008e-2),("BBAB",6.400000000000002e-3), ("BBBA",6.400000000000002e-3),("BBBB",1.6000000000000005e-3)] satisfy you? Cheers, Daniel Am Montag, 30. Oktober 2006 18:45 schrieb Nuno Pinto:
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