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. Check it out!