aplastaneitor.hs

-- Estrategias para aplanar arboles
-- ATENCIÓN: Estas nuevas funciones no han sido probadas 
--           (No tengo GHC disponible en esta maquina)
module Aplaneitor where 

data Tree a = Leaf a | Trees [Tree a] deriving(Show)
cow = Trees [Leaf 1, Trees [ Leaf 2, Leaf 3], Leaf 4]

-- Estrategias para aplanar arboles

-- Auxiliar ---------------------

append xs y = xs ++ [y]

--1-------------------

toList (Leaf x)      = [x]
toList (Trees trees) = concat (map toList trees)

--2-------------------

toList (Leaf x) = [x]
toList (Tree trees) = foldl (\acu x-> acu ++ toList x) [] trees

--3------------------- Passing the acumulator

toList (Tree t) = alpha x []
  where alpha (Leaf  x)     acu = append acu x
        alpha (Trees trees) acu = foldr alpha acu trees

--4------------------- Passing the acumulator

toList (Tree t) = alpha x []
        alpha (Leaf x)        acu = append acu x 
        alpha (Trees [])      acu = acu  
        alpha (Trees t:trees) acu = let acu' = alpha t acu
                                    in alpha (Trees trees) acu' 

--4------------------- Passing the acumulator

toList (Tree t) = foldrTree append [] t 

-- It's possible a version with instance Foldable Tree where

foldlTree :: (b->a->b)->b->(Tree a)->b
foldlTree f acu (Leaf x)       = f acu x
foldlTree f acu (Trees [])     = acu
foldlTree f acu (Trees (t:ts)) = let acu' = foldlTree f acu t
                                 in foldlTree f  acu' (Trees ts) 

foldrTree :: (a->b->b)->b->(Tree a)->b
foldrTree f acu (Leaf x)       = f x acu
foldrTree f acu (Trees [])     = acu
foldrTree f acu (Trees (t:ts)) = let acu' = foldrTree f acu (Trees ts) 
                                 in foldrTree f acu' t

----------------------------------------------------------------------------------

-- Functor

mapTree::(a->b)->Tree a->Tree b
mapTree f (Leaf x)   = Leaf (f x)
mapTree f (Trees trees) = Trees ( map (mapTree f) trees)

------------------------------------------------------------------
From http://en.wikipedia.org/wiki/Catamorphism

data Tree a = Leaf a
            | Branch (Tree a) (Tree a)

type TreeAlgebra a r = (a -> r, r -> r -> r)

foldTree :: TreeAlgebra a r -> Tree a -> r
foldTree (f, g) (Leaf x)     = f x
foldTree (f, g) (Branch l r) = g (foldTree (f, g) l) (foldTree (f, g) r)

treeDepth :: TreeAlgebra a Integer
treeDepth = (const 1, \l r -> 1 + max l r)

sumTree :: (Num a) => TreeAlgebra a a
sumTree = (id, (+))