Hi, I have problems with assignation of types, I did this ... ***** End: -- Codigo de Huffman The rest of the message is ignored: > -- > -- > -- Un arbol binario comun > -- > data BinTree a = Hoja a > | Nodo (BinTree a) (BinTree a) > > type Huff = BinTree Char > > -- Arbol especifico para la funcion `combinar' > -- > data Tree = Leaf Int Char > | Node Int Tree Tree > > -- Binary search tree para la funcion `freqs' > -- > data BSTree a = Nil | BSNode a (BSTree a) (BSTree a) > > > > -- Calculo de las frequencias de cada letra > -- > freq :: BSTree (Char,Int) -> String -> BSTree (Char,Int) > freq t [] = t > freq t (x:xs) = insertTree x (freq t xs) > > insertTree :: Char -> BSTree (Char,Int) -> BSTree >(Char,Int) > insertTree x Nil = BSNode (x,1) Nil Nil > insertTree x (BSNode (c,n) t1 t2) | x==c = BSNode (c,n+1) t1 t2 > | x<c = BSNode (c,n) (insertTree x t1) t2 > | x>c = BSNode (c,n) t1 (insertTree x t2) > > flatten :: BSTree a -> [a] > flatten Nil = [] > flatten (BSNode x t1 t2) = [x] ++ (flatten t1) ++ (flatten t2) > > iSort :: [(Char,Int)] -> [(Char,Int)] > iSort [] = [] > iSort (x:xs) = ins x (iSort xs) > > ins :: (Char,Int) -> [(Char,Int)] -> [(Char,Int)] > ins a [] = [a] > ins a@(c,n) l@((d,m):xs) | n<=m = a:l > | otherwise = (d,m):ins a xs > > freqs :: String -> [(Char,Int)] > freqs xs = (iSort . flatten) (freq Nil xs) > > > > -- Decodificacion > -- > decodificar :: [Int] -> Huff -> String > decodificar xs t = aux xs t t > where aux [] (Hoja c) t = [c] > aux (x:xs) (Hoja c) t = [c] ++ aux (x:xs) t t > aux (0:xs) (Nodo t1 t2) t = aux xs t1 t > aux (1:xs) (Nodo t1 t2) t = aux xs t2 t > > > > -- Codificacion respecto a un arbol dado > -- > cod :: Char -> Huff -> [Int] > cod c t = head (aux c t) > where aux c (Hoja d) | c==d = [[]] > | otherwise = [] > aux c (Nodo t1 t2) = [ (0:xs) | xs <- aux c t1 ] ++ > [ (1:xs) | xs <- aux c t2 ] > > codificar :: String -> Huff -> [Int] > codificar xs t = concat (map (\c->cod c t) xs) > > > > > --Construccion del arbol de Huffman > -- > combinar :: [Tree] -> [Tree] > combinar [t] = [t] > combinar (t1:t2:ts) = insert (Node (w1+w2) t1 t2) ts > where weight (Leaf n x) = n > weight (Node n _ _) = n > insert t [] = [t] > insert t (u:us) | weight t < weight u = t:u:us > | otherwise = u:(insert t us) > w1 = weight t1 > w2 = weight t2 > > combinarTodos :: [Tree] -> Tree > combinarTodos [t] = t > combinarTodos ts = combinarTodos (combinar ts) > > > > -- Pegamos la construccion del arbol y la codificacion del texto > -- > codificarTexto :: String -> ([Int], Huff) > codificarTexto xs = (ys, t) > where ls = freqs xs > desmarcar (Leaf n x) = Hoja x > desmarcar (Node n t1 t2) = Nodo (desmarcar t1) (desmarcar t2) > t = (desmarcar . combinarTodos) (map (\(c,n)->Leaf n c) >ls) > ys = codificar xs t > > > > > -- Example > -- > prueba1 = let (s, t) = codificarTexto "Salvete, omnes" > in decodificar s t > > > > "Please, I need help.
__________________________________________________________________ Your favorite stores, helpful shopping tools and great gift ideas. Experience the convenience of buying online with Shop@Netscape! http://shopnow.netscape.com/ Get your own FREE, personal Netscape Mail account today at http://webmail.netscape.com/ _______________________________________________ Haskell mailing list [EMAIL PROTECTED] http://www.haskell.org/mailman/listinfo/haskell
