Grundlagen der Funktionalen Programmierung: Bäume |
|
1module Tree2
2where
3
4import Prelude hiding ( head, tail
5 , last, init
6 )
7import qualified Prelude as P
8import ShowTree
9
10data Tree a = Nil
11 | Leaf a
12 | Fork (Tree a) (Tree a)
13 deriving (Show)
14
15-- invariant:
16-- Nil only as root
17
18invTree :: Tree a -> Bool
19invTree Nil = True
20invTree (Leaf _x) = True
21invTree (Fork Nil r) = False
22invTree (Fork l Nil) = False
23invTree (Fork l r) = invTree l && invTree r
24
25-- slow flatten
26
27flatten :: Tree a -> [a]
28flatten Nil = []
29flatten (Leaf x) = [x]
30flatten (Fork l r) = flatten l ++ flatten r
31
32-- fast flatten
33
34flatten1 :: Tree a -> [a]
35flatten1 t = go t []
36 where
37 go Nil acc = acc
38 go (Leaf x) acc = x : acc
39 go (Fork l r) acc = (go l . go r) acc
40
41flatten1' :: Tree a -> [a]
42flatten1' t = go t []
43 where
44 go Nil = id
45 go (Leaf x) = (x :)
46 go (Fork l r) = go l . go r
47
48-- simple minded build, builds lists as trees
49
50build0 :: [a] -> Tree a
51build0 xs = foldr (<++>) Nil (map Leaf xs)
52
53-- smart but a bit slow build due to splitAt and length
54
55build1 :: [a] -> Tree a
56build1 [] = Nil
57build1 [x] = Leaf x
58build1 xs = Fork (build1 l) (build1 r)
59 where
60 (l, r) = splitAt (length xs `div` 2) xs
61
62-- smart and fast build
63
64build2 :: [a] -> Tree a
65build2 xs
66 | null xs = Nil
67 | otherwise = build' (map Leaf xs)
68 where
69 build' [t] = t
70 build' ts = build' (merge ts)
71
72 merge (t1 : t2 : ts) = Fork t1 t2 : merge ts
73 merge ts = ts
74
75-- some test trees
76
77t0, t1, t2, t100 :: Tree Int
78t0 = build0 [1..9]
79t1 = build1 [1..9]
80t2 = build2 [1..9]
81t100 = build1 [1..100]
82
83-- list like functions for trees
84
85head :: Tree a -> a
86head Nil = error "head: empty list"
87head (Leaf x) = x
88head (Fork l _r) = head l
89
90last :: Tree a -> a
91last Nil = error "last: empty list"
92last (Leaf x) = x
93last (Fork _l r) = last r
94
95-- <++> is ++ for trees
96
97infixr 5 <++>
98(<++>) :: Tree a -> Tree a -> Tree a
99Nil <++> t2 = t2
100t1 <++> Nil = t1
101t1 <++> t2 = Fork t1 t2
102
103cons :: a -> Tree a -> Tree a
104cons x t = Leaf x <++> t
105
106snoc :: Tree a -> a -> Tree a
107snoc t x = t <++> Leaf x
108
109tail :: Tree a -> Tree a
110tail Nil = error "tail: empty tree"
111tail (Leaf _x) = Nil
112tail (Fork l r) = tail l <++> r
113
114init :: Tree a -> Tree a
115init Nil = error "init: empty tree"
116init (Leaf _x) = Nil
117init (Fork l r) = l <++> init r
118
119viewL :: Tree a -> Maybe (a, Tree a)
120viewL Nil = Nothing
121viewL (Leaf x) = Just (x, Nil)
122viewL (Fork l r)= Just (x, r1 <++> r)
123 where
124 Just (x, r1) = viewL l
125
126viewR :: Tree a -> Maybe (Tree a, a)
127viewR Nil = Nothing
128viewR (Leaf x) = Just (Nil, x)
129viewR (Fork l r)= Just (l1 <++> l, x)
130 where
131 Just (l1, x) = viewR r
132
133mapTree :: (a -> b) -> Tree a -> Tree b
134mapTree f Nil = Nil
135mapTree f (Leaf x) = Leaf (f x)
136mapTree f (Fork l r) = Fork (mapTree f l) (mapTree f r)
137
138instance Functor Tree where
139 fmap = mapTree
140
141filterTree :: (a -> Bool) -> Tree a -> Tree a
142filterTree p Nil = Nil
143filterTree p (Leaf x)
144 | p x = Leaf x
145 | otherwise = Nil
146filterTree p (Fork l r) = filterTree p l <++> filterTree p r
147
148-- nice try:
149-- filterTree p (Fork l r) = filterTree p l `Fork` filterTree p r
150
151sumTree :: Num a => Tree a -> a
152sumTree Nil = 0
153sumTree (Leaf x) = x
154sumTree (Fork l r) = sumTree l + sumTree r
155
156size :: Tree a -> Int
157size Nil = 0
158size (Leaf _) = 1
159size (Fork l r) = size l + size r
160
161minpath :: Tree a -> Int
162minpath Nil = 0
163minpath (Leaf _) = 1
164minpath (Fork l r) = (minpath l `min` minpath r) + 1
165
166maxpath :: Tree a -> Int
167maxpath Nil = 0
168maxpath (Leaf _) = 1
169maxpath (Fork l r) = (maxpath l `max` maxpath r) + 1
170
171fold :: (b -> b -> b) -> (a -> b) -> b ->
172 Tree a -> b
173fold op f c Nil = c
174fold op f c (Leaf x) = f x
175fold op f c (Fork l r) = fold op f c l `op` fold op f c r
176
177fold' :: (b -> b -> b) -> (a -> b) -> b ->
178 Tree a -> b
179fold' op f c = fold''
180 where
181 fold'' Nil = c
182 fold'' (Leaf x) = f x
183 fold'' (Fork l r) = fold'' l `op` fold'' r
184
185sumTree' :: Num a => Tree a -> a
186sumTree' = fold (+) id 0
187
188size' :: Tree a -> Int
189size' = fold (+) (const 1) 0
190
191minpath' :: Tree a -> Int
192minpath' = fold (\ x y -> x `min` y + 1) (const 1) 0
193
194maxpath' :: Tree a -> Int
195maxpath' = fold (\ x y -> x `max` y + 1) (const 1) 0
196
197notNil :: Tree a -> Bool
198notNil = fold (&&) (const True) False
199
200-- slow flatten with fold
201
202flatten' :: Tree a -> [a]
203flatten' = fold (++) (\ x -> [x]) []
204
205-- fast flatten, O(n)
206
207flatten'' :: Tree a -> [a]
208flatten'' = go []
209 where
210 go acc Nil = acc
211 go acc (Leaf x) = x : acc
212 go acc (Fork l r) = go (go acc r) l
213
214-- mapTree with fold, like map for lists with foldr
215
216mapTree' :: (a -> b) -> Tree a -> Tree b
217mapTree' f = fold Fork (Leaf . f) Nil
218
219-- --------------------
220--
221-- conversion of trees into pseudo graphics
222
223showTree :: Show a => Tree a -> String
224showTree = formatStringNTree . toNTree
225 where
226 toNTree Nil = NTree "Nil" []
227 toNTree (Leaf x) = NTree ("Leaf " ++ show x) []
228 toNTree (Fork l r) = NTree "Fork" [toNTree l, toNTree r]
229
230-- formatted print of trees
231printTree :: Show a => Tree a -> IO ()
232printTree = putStrLn . showTree
233
234-- --------------------
|
Letzte Änderung: 08.01.2020 | © Prof. Dr. Uwe Schmidt |