17
17
18
18
-- Portability : portable
19
19
--
20
- -- Multi-way trees (/aka/ rose trees) and forests.
20
+ -- = Multi-way Trees and Forests
21
+ --
22
+ -- The @'Tree' a@ type represents a lazy, possibly infinite, multi-way tree
23
+ -- (also known as a /rose tree/).
24
+ --
25
+ -- The @'Forest' a@ type represents a forest of @'Tree' a@s.
21
26
--
22
27
-----------------------------------------------------------------------------
23
28
24
29
module Data.Tree (
25
- Tree (.. ), Forest ,
26
- -- * Two-dimensional drawing
27
- drawTree , drawForest ,
28
- -- * Extraction
29
- flatten , levels , foldTree ,
30
- -- * Building trees
31
- unfoldTree , unfoldForest ,
32
- unfoldTreeM , unfoldForestM ,
33
- unfoldTreeM_BF , unfoldForestM_BF ,
30
+
31
+ -- * Trees and Forests
32
+ Tree (.. )
33
+ , Forest
34
+
35
+ -- * Construction
36
+ , unfoldTree
37
+ , unfoldForest
38
+ , unfoldTreeM
39
+ , unfoldForestM
40
+ , unfoldTreeM_BF
41
+ , unfoldForestM_BF
42
+
43
+ -- * Elimination
44
+ , foldTree
45
+ , flatten
46
+ , levels
47
+
48
+ -- * Ascii Drawings
49
+ , drawTree
50
+ , drawForest
51
+
34
52
) where
35
53
36
54
#if MIN_VERSION_base(4,8,0)
@@ -70,7 +88,7 @@ import Data.Semigroup (Semigroup (..))
70
88
import Data.Functor ((<$) )
71
89
#endif
72
90
73
- -- | Multi- way trees, also known as /rose trees/.
91
+ -- | Non-empty, possibly infinite, multi- way trees; also known as /rose trees/.
74
92
data Tree a = Node {
75
93
rootLabel :: a , -- ^ label value
76
94
subForest :: Forest a -- ^ zero or more child trees
@@ -194,11 +212,41 @@ instance MonadZip Tree where
194
212
munzip (Node (a, b) ts) = (Node a as, Node b bs)
195
213
where (as, bs) = munzip (map munzip ts)
196
214
197
- -- | Neat 2-dimensional drawing of a tree.
215
+ -- | 2-dimensional ASCII drawing of a tree.
216
+ --
217
+ -- ==== __Examples__
218
+ --
219
+ -- > putStr $ drawTree $ fmap show (Node 1 [Node 2 [], Node 3 []])
220
+ --
221
+ -- @
222
+ -- 1
223
+ -- |
224
+ -- +- 2
225
+ -- |
226
+ -- `- 3
227
+ -- @
228
+ --
198
229
drawTree :: Tree String -> String
199
230
drawTree = unlines . draw
200
231
201
- -- | Neat 2-dimensional drawing of a forest.
232
+ -- | 2-dimensional ASCII drawing of a forest.
233
+ --
234
+ -- ==== __Examples__
235
+ --
236
+ -- > putStr $ drawForest $ map (fmap show) [(Node 1 [Node 2 [], Node 3 []]), (Node 10 [Node 20 []])]
237
+ --
238
+ -- @
239
+ -- 1
240
+ -- |
241
+ -- +- 2
242
+ -- |
243
+ -- `- 3
244
+ --
245
+ -- 10
246
+ -- |
247
+ -- `- 20
248
+ -- @
249
+ --
202
250
drawForest :: Forest String -> String
203
251
drawForest = unlines . map drawTree
204
252
@@ -213,34 +261,112 @@ draw (Node x ts0) = lines x ++ drawSubTrees ts0
213
261
214
262
shift first other = zipWith (++) (first : repeat other)
215
263
216
- -- | The elements of a tree in pre-order.
264
+ -- | Returns the elements of a tree in pre-order.
265
+ --
266
+ -- @
267
+ --
268
+ -- a
269
+ -- / \\ => [a,b,c]
270
+ -- b c
271
+ -- @
272
+ --
273
+ -- ==== __Examples__
274
+ --
275
+ -- > flatten (Node 1 [Node 2 [], Node 3 []]) == [1,2,3]
217
276
flatten :: Tree a -> [a ]
218
277
flatten t = squish t []
219
278
where squish (Node x ts) xs = x: Prelude. foldr squish xs ts
220
279
221
- -- | Lists of nodes at each level of the tree.
280
+ -- | Returns the list of nodes at each level of the tree.
281
+ --
282
+ -- @
283
+ --
284
+ -- a
285
+ -- / \\ => [[a], [b,c]]
286
+ -- b c
287
+ -- @
288
+ --
289
+ -- ==== __Examples__
290
+ --
291
+ -- > levels (Node 1 [Node 2 [], Node 3 []]) == [[1],[2,3]]
292
+ --
222
293
levels :: Tree a -> [[a ]]
223
294
levels t =
224
295
map (map rootLabel) $
225
296
takeWhile (not . null ) $
226
297
iterate (concatMap subForest) [t]
227
298
228
- -- | Catamorphism on trees.
299
+ -- | Fold a tree into a "summary" value in depth-first order.
300
+ --
301
+ -- For each node in the tree, apply @f@ to the @rootLabel@ and the result
302
+ -- of applying @f@ to each @subForent@.
303
+ --
304
+ -- This is also known as the catamorphism on trees.
305
+ --
306
+ -- ==== __Examples__
307
+ --
308
+ -- Sum the values in a tree:
309
+ --
310
+ -- > foldTree (\x xs -> sum (x:xs)) (Node 1 [Node 2 [], Node 3 []]) == 6
311
+ --
312
+ -- Find the maximum value in the tree:
313
+ --
314
+ -- > foldTree (\x xs -> maximum (x:xs)) (Node 1 [Node 2 [], Node 3 []]) == 3
315
+ --
229
316
--
230
317
-- @since 0.5.8
231
318
foldTree :: (a -> [b ] -> b ) -> Tree a -> b
232
319
foldTree f = go where
233
320
go (Node x ts) = f x (map go ts)
234
321
235
- -- | Build a tree from a seed value
322
+ -- | Build a (possibly infinite) tree from a seed value in breadth-first order.
323
+ --
324
+ -- @unfoldTree f b@ constructs a tree by starting with the tree
325
+ -- @Node { rootLabel=b, subForest=[] }@ and repeatedly applying @f@ to each
326
+ -- 'rootLabel' value in the tree's leaves to generate its 'subForest'.
327
+ --
328
+ -- For a monadic version see 'unfoldTreeM_BF'.
329
+ --
330
+ -- ==== __Examples__
331
+ --
332
+ -- Construct the tree of @Integer@s where each node has two children:
333
+ -- @left = 2*x@ and @right = 2*x + 1@, where @x@ is the 'rootLabel' of the node.
334
+ -- Stop when the values exceed 7.
335
+ --
336
+ -- > let buildNode x = if 2*x + 1 > 7 then (x, []) else (x, [2*x, 2*x+1])
337
+ -- > putStr $ drawTree $ fmap show $ unfoldTree buildNode 1
338
+ --
339
+ -- @
340
+ --
341
+ -- 1
342
+ -- |
343
+ -- +- 2
344
+ -- | |
345
+ -- | +- 4
346
+ -- | |
347
+ -- | `- 5
348
+ -- |
349
+ -- `- 3
350
+ -- |
351
+ -- +- 6
352
+ -- |
353
+ -- `- 7
354
+ -- @
355
+ --
236
356
unfoldTree :: (b -> (a , [b ])) -> b -> Tree a
237
357
unfoldTree f b = let (a, bs) = f b in Node a (unfoldForest f bs)
238
358
239
- -- | Build a forest from a list of seed values
359
+ -- | Build a (possibly infinite) forest from a list of seed values in
360
+ -- breadth-first order.
361
+ --
362
+ -- @unfoldForest f seeds@ invokes 'unfoldTree' on each seed value.
363
+ --
364
+ -- For a monadic version see 'unfoldForestM_BF'.
365
+ --
240
366
unfoldForest :: (b -> (a , [b ])) -> [b ] -> Forest a
241
367
unfoldForest f = map (unfoldTree f)
242
368
243
- -- | Monadic tree builder, in depth-first order
369
+ -- | Monadic tree builder, in depth-first order.
244
370
unfoldTreeM :: Monad m => (b -> m (a , [b ])) -> b -> m (Tree a )
245
371
unfoldTreeM f b = do
246
372
(a, bs) <- f b
@@ -251,26 +377,30 @@ unfoldTreeM f b = do
251
377
unfoldForestM :: Monad m => (b -> m (a , [b ])) -> [b ] -> m (Forest a )
252
378
unfoldForestM f = Prelude. mapM (unfoldTreeM f)
253
379
254
- -- | Monadic tree builder, in breadth-first order,
255
- -- using an algorithm adapted from
256
- -- /Breadth-First Numbering: Lessons from a Small Exercise in Algorithm Design/,
257
- -- by Chris Okasaki, /ICFP'00/.
380
+ -- | Monadic tree builder, in breadth-first order.
381
+ --
382
+ -- See 'unfoldTree' for more info.
383
+ --
384
+ -- Implemented using an algorithm adapted from /Breadth-First Numbering: Lessons
385
+ -- from a Small Exercise in Algorithm Design/, by Chris Okasaki, /ICFP'00/.
258
386
unfoldTreeM_BF :: Monad m => (b -> m (a , [b ])) -> b -> m (Tree a )
259
387
unfoldTreeM_BF f b = liftM getElement $ unfoldForestQ f (singleton b)
260
388
where
261
389
getElement xs = case viewl xs of
262
390
x :< _ -> x
263
391
EmptyL -> error " unfoldTreeM_BF"
264
392
265
- -- | Monadic forest builder, in breadth-first order,
266
- -- using an algorithm adapted from
267
- -- /Breadth-First Numbering: Lessons from a Small Exercise in Algorithm Design/,
268
- -- by Chris Okasaki, /ICFP'00/.
393
+ -- | Monadic forest builder, in breadth-first order
394
+ --
395
+ -- See 'unfoldForest' for more info.
396
+ --
397
+ -- Implemented using an algorithm adapted from /Breadth-First Numbering: Lessons
398
+ -- from a Small Exercise in Algorithm Design/, by Chris Okasaki, /ICFP'00/.
269
399
unfoldForestM_BF :: Monad m => (b -> m (a , [b ])) -> [b ] -> m (Forest a )
270
400
unfoldForestM_BF f = liftM toList . unfoldForestQ f . fromList
271
401
272
- -- takes a sequence (queue) of seeds
273
- -- produces a sequence (reversed queue) of trees of the same length
402
+ -- Takes a sequence (queue) of seeds and produces a sequence (reversed queue) of
403
+ -- trees of the same length.
274
404
unfoldForestQ :: Monad m => (b -> m (a , [b ])) -> Seq b -> m (Seq (Tree a ))
275
405
unfoldForestQ f aQ = case viewl aQ of
276
406
EmptyL -> return empty
0 commit comments