[Haskell-cafe] Permutation with k levels
Daniel Fischer
daniel.is.fischer at web.de
Tue Nov 7 08:34:28 EST 2006
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
More information about the Haskell-Cafe
mailing list