1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
> tree ::= Leaf num | Fork tree tree
PROBLEM: write down the definition of a function which takes a tree and
returns a tree of the SAME SHAPE, containing the same data, but with the
leaves moved around so that the data appears in ascending order, when
the tree is scanned from left to right.
> reorder :: tree->tree
> reorder t = refoliate t (sort (fringe t))
Our idea here is that `fringe' extracts a list of all the data in the
tree, while `refoliate' takes a tree and a list of data, and replaces
the leaves of the tree with the given data, preserving the shape of the
tree. We define fringe first, as it is the easiest.
> fringe :: tree->[num]
> fringe (Leaf n) = [n]
> fringe (Fork s t) = fringe s ++ fringe t
Aside - there is a trivial change to the last line which alters the
behaviour of fringe so that the call to sort is no longer necessary. We
can replace `++' by a call to the library function `merge'. This would
improve the efficiency of the solution.
We define `refoliate' in terms of an auxiliary function which takes a
subtree and the list of replacement data, and returns a pair - the
refoliated subtree, and the unused part of the list.
> refoliate :: tree->[num]->tree
> refoliate t x = fst (refol t x)
> refol :: tree->[num]->(tree,[num])
> refol (Leaf n) (a:x) = (Leaf a,x)
> refol (Fork s t) x = (Fork s1 t1,x'')
> where
> (s1,x') = refol s x
> (t1,x'') = refol t x'
Here is an example tree on which to call `reorder', to see that the
algorithm works.
> t1 = mktree [19,0,17,2,15,4,13,6,11,8,9,10,7,12,5,14,3,16,1,18]
mktree takes a list and builds a (well-balanced) tree from it.
> mktree :: [num]->tree
> mktree [] = error "cannot have empty tree"
> mktree [a] = Leaf a
> mktree x = Fork (mktree (take n x)) (mktree (drop n x))
> where n = # x div 2
Finally, we define a function same_shape, which can be used to confirm
that reorder holds the shape constant.
> same_shape :: tree->tree->bool
> same_shape (Leaf a) (Leaf b) = True
> same_shape (Fork s t) (Fork s1 t1) = same_shape s s1 & same_shape t t1
> same_shape s t = False ||all other cases
> test = same_shape t1 (reorder t1)
|
