# [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...
```