2 people like it.

Like the snippet!

## Ninety-Nine F# Problems - Problems 61 - 69 - Binary trees

These are F# solutions of Ninety-Nine Haskell Problems which are themselves translations of Ninety-Nine Lisp Problems and Ninety-Nine Prolog Problems. The solutions are hidden so you can try to solve them yourself.

### Ninety-Nine F# Problems - Problems 61 - 69 - Binary trees

1: /// These are F# solutions of Ninety-Nine Haskell Problems 2: /// (http://www.haskell.org/haskellwiki/H-99:_Ninety-Nine_Haskell_Problems), 3: /// which are themselves translations of Ninety-Nine Lisp Problems 4: /// (http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html) 5: /// and Ninety-Nine Prolog Problems 6: /// (https://sites.google.com/site/prologsite/prolog-problems). 7: /// 8: /// If you would like to contribute a solution or fix any bugs, send 9: /// an email to paks at kitiara dot org with the subject "99 F# problems". 10: /// I'll try to update the problem as soon as possible. 11: /// 12: /// The problems have different levels of difficulty. Those marked with a single asterisk (*) 13: /// are easy. If you have successfully solved the preceeding problems you should be able to 14: /// solve them within a few (say 15) minutes. Problems marked with two asterisks (**) are of 15: /// intermediate difficulty. If you are a skilled F# programmer it shouldn't take you more than 16: /// 30-90 minutes to solve them. Problems marked with three asterisks (***) are more difficult. 17: /// You may need more time (i.e. a few hours or more) to find a good solution 18: /// 19: /// Though the problems number from 1 to 99, there are some gaps and some additions marked with 20: /// letters. There are actually only 88 problems. 21: /// 22: /// 23: /// Binary trees 24: /// 25: /// As defined in problem 54A. 26: 27: type 'a Tree = Empty | Branch of 'a * 'a Tree * 'a Tree 28: 29: /// 30: /// An example tree: 31: /// 32: let tree4 = Branch (1, Branch (2, Empty, Branch (4, Empty, Empty)), 33: Branch (2, Empty, Empty))

### (*) Problem 61 : Count the leaves of a binary tree

1: /// A leaf is a node with no successors. Write a predicate count_leaves/2 to count them. 2: /// 3: /// Example: 4: /// % count_leaves(T,N) :- the binary tree T has N leaves 5: /// 6: /// Example in F#: 7: /// 8: /// > countLeaves tree4 9: /// val it : int = 2 10: 11: (Solution)

### (*) Problem 62 : Collect the internal nodes of a binary tree in a list

1: /// An internal node of a binary tree has either one or two non-empty successors. Write a 2: /// predicate internals/2 to collect them in a list. 3: /// 4: /// Example: 5: /// % internals(T,S) :- S is the list of internal nodes of the binary tree T. 6: /// 7: /// Example in F#: 8: /// 9: /// >internals tree4;; 10: /// val it : int list = [1; 2] 11: 12: (Solution)

### (*) Problem 62B : Collect the nodes at a given level in a list

1: /// A node of a binary tree is at level N if the path from the root to the node has 2: /// length N-1. The root node is at level 1. Write a predicate atlevel/3 to collect 3: /// all nodes at a given level in a list. 4: /// 5: /// Example: 6: /// % atlevel(T,L,S) :- S is the list of nodes of the binary tree T at level L 7: /// 8: /// Example in F#: 9: /// 10: /// >atLevel tree4 2;; 11: /// val it : int list = [2,2] 12: 13: (Solution)

### (**) Problem 63 : Construct a complete binary tree

1: /// A complete binary tree with height H is defined as follows: 2: /// • The levels 1,2,3,...,H-1 contain the maximum number of nodes (i.e 2**(i-1) at the 3: /// level i) 4: /// • In level H, which may contain less than the maximum possible number of nodes, 5: /// all the nodes are "left-adjusted". This means that in a levelorder tree traversal all 6: /// internal nodes come first, the leaves come second, and empty successors (the 7: /// nil's which are not really nodes!) come last. 8: /// 9: /// Particularly, complete binary trees are used as data structures (or addressing 10: /// schemes) for heaps. 11: /// 12: /// We can assign an address number to each node in a complete binary tree by 13: /// enumerating the nodes in level-order, starting at the root with number 1. For every 14: /// node X with address A the following property holds: The address of X's left and right 15: /// successors are 2*A and 2*A+1, respectively, if they exist. This fact can be used to 16: /// elegantly construct a complete binary tree structure. 17: /// 18: /// Write a predicate complete_binary_tree/2. 19: /// 20: /// Example: 21: /// % complete_binary_tree(N,T) :- T is a complete binary tree with N nodes. 22: /// 23: /// Example in F#: 24: /// 25: /// > completeBinaryTree 4 26: /// Branch ('x', Branch ('x', Branch ('x', Empty, Empty), Empty), 27: /// Branch ('x', Empty, Empty)) 28: /// 29: /// > isCompleteBinaryTree <| Branch ('x', Branch ('x', Empty, Empty), 30: /// Branch ('x', Empty, Empty)) 31: /// val it : bool = true 32: 33: (Solution)

### (**) Problem 64 : Layout a binary tree (1)

1: /// Given a binary tree as the usual Prolog term t(X,L,R) (or nil). As a preparation for 2: /// drawing the tree, a layout algorithm is required to determine the position of each 3: /// node in a rectangular grid. Several layout methods are conceivable, one of them is 4: /// shown in the illustration below: 5: /// 6: /// 1 2 3 4 5 6 7 8 9 10 11 12 7: /// 8: /// 1 (n) 9: /// / \ 10: /// 2 (k) (u) 11: /// / \ / 12: /// 3 (c) (m) (p) 13: /// / \ \ 14: /// 4 (a) (h) (s) 15: /// / / 16: /// 5 (g) (q) 17: /// / 18: /// 6 (e) 19: /// 20: /// In this layout strategy, the position of a node v is obtained by the following two rules: 21: /// • x(v) is equal to the position of the node v in the inorder sequence 22: /// • y(v) is equal to the depth of the node v in the tree 23: /// 24: /// Write a function to annotate each node of the tree with a position, where (1,1) in the 25: /// top left corner or the rectangle bounding the drawn tree. 26: /// 27: /// Here is the example tree from the above illustration: 28: /// 29: let tree64 = Branch ('n', 30: Branch ('k', 31: Branch ('c', 32: Branch ('a', Empty, Empty), 33: Branch ('h', 34: Branch ('g', 35: Branch ('e', Empty, Empty), 36: Empty), 37: Empty) 38: ), 39: Branch ('m', Empty, Empty)), 40: Branch ('u', 41: Branch ('p', 42: Empty, 43: Branch ('s', 44: Branch ('q', Empty, Empty), 45: Empty) 46: ), 47: Empty 48: )) 49: /// Example in F#: 50: /// 51: /// > layout tree64;; 52: /// val it : (char * (int * int)) Tree = 53: /// Branch 54: /// (('n', (8, 1)), 55: /// Branch 56: /// (('k', (6, 2)), 57: /// Branch 58: /// (('c', (2, 3)),Branch (('a', (1, 4)),Empty,Empty), 59: /// Branch 60: /// (('h', (5, 4)), 61: /// Branch (('g', (4, 5)),Branch (('e', (3, 6)),Empty,Empty),Empty), 62: /// Empty)),Branch (('m', (7, 3)),Empty,Empty)), 63: /// Branch 64: /// (('u', (12, 2)), 65: /// Branch 66: /// (('p', (9, 3)),Empty, 67: /// Branch (('s', (11, 4)),Branch (('q', (10, 5)),Empty,Empty),Empty)), 68: /// Empty)) 69: 70: (Solution)

### (**) Problem 65 : Layout a binary tree (2)

1: /// An alternative layout method is depicted in the illustration below: 2: /// 3: /// 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 4: /// 5: /// 1 (n) 6: /// / \ 7: /// 2 (k) (u) 8: /// / \ / 9: /// 3 (c) (m) (p) 10: /// / \ \ 11: /// 4 (a) (e) (q) 12: /// / \ 13: /// 5 (d) (g) 14: /// 15: /// Find out the rules and write the corresponding function. Hint: On a given level, the 16: /// horizontal distance between neighboring nodes is constant. 17: /// 18: /// Use the same conventions as in problem P64 and test your function in an appropriate way. 19: /// 20: /// Here is the example tree from the above illustration: 21: /// 22: let tree65 = Branch ('n', 23: Branch ('k', 24: Branch ('c', 25: Branch ('a', Empty, Empty), 26: Branch ('e', 27: Branch ('d', Empty, Empty), 28: Branch ('g', Empty, Empty)) 29: ), 30: Branch ('m', Empty, Empty)), 31: Branch ('u', 32: Branch ('p', 33: Empty, 34: Branch ('q', Empty, Empty)), 35: Empty)) 36: /// Example in F#: 37: /// 38: /// > layout65 tree65;; 39: /// val it : (char * (int * int)) Tree = 40: /// Branch 41: /// (('n', (15, 1)), 42: /// Branch 43: /// (('k', (7, 2)), 44: /// Branch 45: /// (('c', (3, 3)),Branch (('a', (1, 4)),Empty,Empty), 46: /// Branch 47: /// (('e', (5, 4)),Branch (('d', (4, 5)),Empty,Empty), 48: /// Branch (('g', (6, 5)),Empty,Empty))), 49: /// Branch (('m', (11, 3)),Empty,Empty)), 50: /// Branch 51: /// (('u', (23, 2)), 52: /// Branch (('p', (19, 3)),Empty,Branch (('q', (21, 4)),Empty,Empty)), 53: /// Empty)) 54: 55: (Solution)

### (***) Problem 66 : Layout a binary tree (3)

1: /// Yet another layout strategy is shown in the illustration below: 2: /// 3: /// 1 2 3 4 5 6 7 4: /// 5: /// 1 (n) 6: /// / \ 7: /// 2 (k) (u) 8: /// / \ / 9: /// 3 (c) (m) (p) 10: /// / \ \ 11: /// 4 (a) (e) (q) 12: /// / \ 13: /// 5 (d) (g) 14: /// 15: /// The method yields a very compact layout while maintaining a certain symmetry in 16: /// every node. Find out the rules and write the corresponding Prolog predicate. Hint: 17: /// Consider the horizontal distance between a node and its successor nodes. How tight 18: /// can you pack together two subtrees to construct the combined binary tree? 19: /// 20: /// Use the same conventions as in problem P64 and P65 and test your predicate in an 21: /// appropriate way. Note: This is a difficult problem. Don't give up too early! 22: /// 23: /// Which layout do you like most? 24: /// 25: /// Example in F#: 26: /// 27: /// > layout66 tree65;; 28: /// val it : (char * (int * int)) Tree = 29: /// Branch 30: /// (('n', (5, 1)), 31: /// Branch 32: /// (('k', (3, 2)), 33: /// Branch 34: /// (('c', (2, 3)),Branch (('a', (1, 4)),Empty,Empty), 35: /// Branch 36: /// (('e', (3, 4)),Branch (('d', (2, 5)),Empty,Empty), 37: /// Branch (('g', (4, 5)),Empty,Empty))), 38: /// Branch (('m', (4, 3)),Empty,Empty)), 39: /// Branch 40: /// (('u', (7, 2)), 41: /// Branch (('p', (6, 3)),Empty,Branch (('q', (7, 4)),Empty,Empty)),Empty)) 42: 43: (Solution)

### (**) Problem 67 : A string representation of binary trees

1: /// Somebody represents binary trees as strings of the following type: 2: /// 3: /// a(b(d,e),c(,f(g,))) 4: /// 5: /// a) Write a Prolog predicate which generates this string representation, if the tree is 6: /// given as usual (as nil or t(X,L,R) term). Then write a predicate which does this 7: /// inverse; i.e. given the string representation, construct the tree in the usual form. 8: /// Finally, combine the two predicates in a single predicate tree_string/2 which can be 9: /// used in both directions. 10: /// 11: /// Example in Prolog 12: /// ?- tree_to_string(t(x,t(y,nil,nil),t(a,nil,t(b,nil,nil))),S). 13: /// S = 'x(y,a(,b))' 14: /// ?- string_to_tree('x(y,a(,b))',T). 15: /// T = t(x, t(y, nil, nil), t(a, nil, t(b, nil, nil))) 16: /// 17: /// Example in F#: 18: /// 19: /// > stringToTree "x(y,a(,b))";; 20: /// val it : string Tree = 21: /// Branch 22: /// ("x",Branch ("y",Empty,Empty),Branch ("a",Empty,Branch ("b",Empty,Empty))) 23: /// > "a(b(d,e),c(,f(g,)))" |> stringToTree |> treeToString = "a(b(d,e),c(,f(g,)))";; 24: /// val it : bool = true 25: 26: (Solution 1) 27: 28: (Solution 2)

### (**) Problem 68 : Preorder and inorder sequences of binary trees

1: /// Preorder and inorder sequences of binary trees. We consider binary trees with 2: /// nodes that are identified by single lower-case letters, as in the example of problem 3: /// P67. 4: /// 5: /// a) Write predicates preorder/2 and inorder/2 that construct the preorder and inorder 6: /// sequence of a given binary tree, respectively. The results should be atoms, e.g. 7: /// 'abdecfg' for the preorder sequence of the example in problem P67. 8: /// 9: /// b) Can you use preorder/2 from problem part a) in the reverse direction; i.e. given a 10: /// preorder sequence, construct a corresponding tree? If not, make the necessary 11: /// arrangements. 12: /// 13: /// c) If both the preorder sequence and the inorder sequence of the nodes of a binary 14: /// tree are given, then the tree is determined unambiguously. Write a predicate 15: /// pre_in_tree/3 that does the job. 16: /// 17: /// Example in F#: 18: /// 19: /// Main> let { Just t = stringToTree "a(b(d,e),c(,f(g,)))" ; 20: /// po = treeToPreorder t ; 21: /// io = treeToInorder t } in preInTree po io >>= print 22: /// Branch 'a' (Branch 'b' (Branch 'd' Empty Empty) (Branch 'e' Empty Empty)) 23: 24: (Solution)

### (**) Problem 69 : Dotstring representation of binary trees.

1: /// We consider again binary trees with nodes that are identified by single lower-case 2: /// letters, as in the example of problem P67. Such a tree can be represented by the 3: /// preorder sequence of its nodes in which dots (.) are inserted where an empty 4: /// subtree (nil) is encountered during the tree traversal. For example, the tree shown in 5: /// problem P67 is represented as 'abd..e..c.fg...'. First, try to establish a syntax (BNF or 6: /// syntax diagrams) and then write a predicate tree_dotstring/2 which does the 7: /// conversion in both directions. Use difference lists. 8: /// 9: /// Example in F#: 10: /// 11: /// > dotString2Tree "abd..e..c.fg...";; 12: /// val it : char Tree = 13: /// Branch 14: /// ('a',Branch ('b',Branch ('d',Empty,Empty),Branch ('e',Empty,Empty)), 15: /// Branch ('c',Empty,Branch ('f',Branch ('g',Empty,Empty),Empty))) 16: /// 17: /// > tree2Dotstring it;; 18: /// val it : string = "abd..e..c.fg..." 19: 20: (Solution)

union case Tree.Empty: 'a Tree

union case Tree.Branch: 'a * 'a Tree * 'a Tree -> 'a Tree

type 'a Tree =

| Empty

| Branch of 'a * 'a Tree * 'a Tree

Full name: Snippet.Tree<_>

type: 'a Tree

implements: System.IEquatable<'a Tree>

implements: System.Collections.IStructuralEquatable

implements: System.IComparable<'a Tree>

implements: System.IComparable

implements: System.Collections.IStructuralComparable

| Empty

| Branch of 'a * 'a Tree * 'a Tree

Full name: Snippet.Tree<_>

type: 'a Tree

implements: System.IEquatable<'a Tree>

implements: System.Collections.IStructuralEquatable

implements: System.IComparable<'a Tree>

implements: System.IComparable

implements: System.Collections.IStructuralComparable

These are F# solutions of Ninety-Nine Haskell Problems

(http://www.haskell.org/haskellwiki/H-99:_Ninety-Nine_Haskell_Problems),

which are themselves translations of Ninety-Nine Lisp Problems

(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)

and Ninety-Nine Prolog Problems

(https://sites.google.com/site/prologsite/prolog-problems).

If you would like to contribute a solution or fix any bugs, send

an email to paks at kitiara dot org with the subject "99 F# problems".

I'll try to update the problem as soon as possible.

The problems have different levels of difficulty. Those marked with a single asterisk (*)

are easy. If you have successfully solved the preceeding problems you should be able to

solve them within a few (say 15) minutes. Problems marked with two asterisks (**) are of

intermediate difficulty. If you are a skilled F# programmer it shouldn't take you more than

30-90 minutes to solve them. Problems marked with three asterisks (***) are more difficult.

You may need more time (i.e. a few hours or more) to find a good solution

Though the problems number from 1 to 99, there are some gaps and some additions marked with

letters. There are actually only 88 problems.

Binary trees

As defined in problem 54A.These are F# solutions of Ninety-Nine Haskell Problems

(http://www.haskell.org/haskellwiki/H-99:_Ninety-Nine_Haskell_Problems),

which are themselves translations of Ninety-Nine Lisp Problems

(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)

and Ninety-Nine Prolog Problems

(https://sites.google.com/site/prologsite/prolog-problems).

If you would like to contribute a solution or fix any bugs, send

an email to paks at kitiara dot org with the subject "99 F# problems".

I'll try to update the problem as soon as possible.

The problems have different levels of difficulty. Those marked with a single asterisk (*)

are easy. If you have successfully solved the preceeding problems you should be able to

solve them within a few (say 15) minutes. Problems marked with two asterisks (**) are of

intermediate difficulty. If you are a skilled F# programmer it shouldn't take you more than

30-90 minutes to solve them. Problems marked with three asterisks (***) are more difficult.

You may need more time (i.e. a few hours or more) to find a good solution

Though the problems number from 1 to 99, there are some gaps and some additions marked with

letters. There are actually only 88 problems.

Binary trees

As defined in problem 54A.

val tree4 : int Tree

Full name: Snippet.tree4

type: int Tree

implements: System.IEquatable<int Tree>

implements: System.Collections.IStructuralEquatable

implements: System.IComparable<int Tree>

implements: System.IComparable

implements: System.Collections.IStructuralComparable

Full name: Snippet.tree4

type: int Tree

implements: System.IEquatable<int Tree>

implements: System.Collections.IStructuralEquatable

implements: System.IComparable<int Tree>

implements: System.IComparable

implements: System.Collections.IStructuralComparable

An example tree:

An example tree:

let foldTree branchF emptyV t =

let rec loop t cont =

match t with

| Empty -> cont emptyV

| Branch(x,left,right) -> loop left (fun lacc ->

loop right (fun racc ->

cont (branchF x lacc racc)))

loop t id

let countLeaves tree = tree |> foldTree (fun _ lc rc -> 1 + lc + rc) 0

let rec loop t cont =

match t with

| Empty -> cont emptyV

| Branch(x,left,right) -> loop left (fun lacc ->

loop right (fun racc ->

cont (branchF x lacc racc)))

loop t id

let countLeaves tree = tree |> foldTree (fun _ lc rc -> 1 + lc + rc) 0

// using foldTree from problem 61

let insternals tree = tree |> foldTree (fun x (lc,lt) (rc,rt) -> if lt || rt then ([x] @ lc @ rc ,true) else ([], true)) ([],false) |> fst

let insternals tree = tree |> foldTree (fun x (lc,lt) (rc,rt) -> if lt || rt then ([x] @ lc @ rc ,true) else ([], true)) ([],false) |> fst

let atLevel tree level =

let rec loop l tree cont =

match tree with

| Empty -> cont []

| Branch(x, lt , rt) ->

if l = level then

cont [x]

else

loop (l + 1) lt (fun lacc -> loop (l + 1) rt (fun racc -> cont <| lacc @ racc))

loop 1 tree id

let rec loop l tree cont =

match tree with

| Empty -> cont []

| Branch(x, lt , rt) ->

if l = level then

cont [x]

else

loop (l + 1) lt (fun lacc -> loop (l + 1) rt (fun racc -> cont <| lacc @ racc))

loop 1 tree id

let completeBinaryTree n =

let rec loop l cont =

if l <= n then

loop (2*l) (fun lt -> loop (2*l+1) (fun rt -> cont <| Branch ('x', lt, rt)))

else

cont Empty

loop 1 id

let isCompleteBinaryTree tree =

let rec loop level tree cont =

match tree with

| Empty -> cont ([], 0)

| Branch(_, lt, rt) ->

loop (2*level) lt (fun (ll,lc) -> loop (2*level+1) rt (fun (rl, rc) -> cont <| ([level] @ ll @ rl, 1 + lc + rc)))

let levels, nodes = loop 1 tree (fun (ls,ns) -> List.sort ls, ns)

levels |> Seq.zip (seq { 1 .. nodes }) |> Seq.forall(fun (a,b) -> a = b)

let rec loop l cont =

if l <= n then

loop (2*l) (fun lt -> loop (2*l+1) (fun rt -> cont <| Branch ('x', lt, rt)))

else

cont Empty

loop 1 id

let isCompleteBinaryTree tree =

let rec loop level tree cont =

match tree with

| Empty -> cont ([], 0)

| Branch(_, lt, rt) ->

loop (2*level) lt (fun (ll,lc) -> loop (2*level+1) rt (fun (rl, rc) -> cont <| ([level] @ ll @ rl, 1 + lc + rc)))

let levels, nodes = loop 1 tree (fun (ls,ns) -> List.sort ls, ns)

levels |> Seq.zip (seq { 1 .. nodes }) |> Seq.forall(fun (a,b) -> a = b)

val tree64 : char Tree

Full name: Snippet.tree64

type: char Tree

implements: System.IEquatable<char Tree>

implements: System.Collections.IStructuralEquatable

implements: System.IComparable<char Tree>

implements: System.IComparable

implements: System.Collections.IStructuralComparable

Full name: Snippet.tree64

type: char Tree

implements: System.IEquatable<char Tree>

implements: System.Collections.IStructuralEquatable

implements: System.IComparable<char Tree>

implements: System.IComparable

implements: System.Collections.IStructuralComparable

Given a binary tree as the usual Prolog term t(X,L,R) (or nil). As a preparation for

drawing the tree, a layout algorithm is required to determine the position of each

node in a rectangular grid. Several layout methods are conceivable, one of them is

shown in the illustration below:

1 2 3 4 5 6 7 8 9 10 11 12

1 (n)

/ \

2 (k) (u)

/ \ /

3 (c) (m) (p)

/ \ \

4 (a) (h) (s)

/ /

5 (g) (q)

/

6 (e)

In this layout strategy, the position of a node v is obtained by the following two rules:

• x(v) is equal to the position of the node v in the inorder sequence

• y(v) is equal to the depth of the node v in the tree

Write a function to annotate each node of the tree with a position, where (1,1) in the

top left corner or the rectangle bounding the drawn tree.

Here is the example tree from the above illustration:

Given a binary tree as the usual Prolog term t(X,L,R) (or nil). As a preparation for

drawing the tree, a layout algorithm is required to determine the position of each

node in a rectangular grid. Several layout methods are conceivable, one of them is

shown in the illustration below:

1 2 3 4 5 6 7 8 9 10 11 12

1 (n)

/ \

2 (k) (u)

/ \ /

3 (c) (m) (p)

/ \ \

4 (a) (h) (s)

/ /

5 (g) (q)

/

6 (e)

In this layout strategy, the position of a node v is obtained by the following two rules:

• x(v) is equal to the position of the node v in the inorder sequence

• y(v) is equal to the depth of the node v in the tree

Write a function to annotate each node of the tree with a position, where (1,1) in the

top left corner or the rectangle bounding the drawn tree.

Here is the example tree from the above illustration:

let layout tree =

let next x = function

| Empty -> x

| Branch (_, _ , Branch ((_,(x,_)), _, _)) -> x + 1

| Branch ((_,(x,_)), _, _) -> x + 1

let rec loop x y tree cont =

match tree with

| Empty -> cont Empty

| Branch(a, lt, rt) ->

loop x (y+1) lt (fun lt' ->

let x' = next x lt'

loop (x'+ 1) (y+1) rt (fun rt' ->

cont <| Branch((a,(x',y)), lt', rt')))

loop 1 1 tree id

let next x = function

| Empty -> x

| Branch (_, _ , Branch ((_,(x,_)), _, _)) -> x + 1

| Branch ((_,(x,_)), _, _) -> x + 1

let rec loop x y tree cont =

match tree with

| Empty -> cont Empty

| Branch(a, lt, rt) ->

loop x (y+1) lt (fun lt' ->

let x' = next x lt'

loop (x'+ 1) (y+1) rt (fun rt' ->

cont <| Branch((a,(x',y)), lt', rt')))

loop 1 1 tree id

val tree65 : char Tree

Full name: Snippet.tree65

type: char Tree

implements: System.IEquatable<char Tree>

implements: System.Collections.IStructuralEquatable

implements: System.IComparable<char Tree>

implements: System.IComparable

implements: System.Collections.IStructuralComparable

Full name: Snippet.tree65

type: char Tree

implements: System.IEquatable<char Tree>

implements: System.Collections.IStructuralEquatable

implements: System.IComparable<char Tree>

implements: System.IComparable

implements: System.Collections.IStructuralComparable

An alternative layout method is depicted in the illustration below:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

1 (n)

/ \

2 (k) (u)

/ \ /

3 (c) (m) (p)

/ \ \

4 (a) (e) (q)

/ \

5 (d) (g)

Find out the rules and write the corresponding function. Hint: On a given level, the

horizontal distance between neighboring nodes is constant.

Use the same conventions as in problem P64 and test your function in an appropriate way.

Here is the example tree from the above illustration:

An alternative layout method is depicted in the illustration below:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

1 (n)

/ \

2 (k) (u)

/ \ /

3 (c) (m) (p)

/ \ \

4 (a) (e) (q)

/ \

5 (d) (g)

Find out the rules and write the corresponding function. Hint: On a given level, the

horizontal distance between neighboring nodes is constant.

Use the same conventions as in problem P64 and test your function in an appropriate way.

Here is the example tree from the above illustration:

let height tree = tree |> foldTree (fun _ lacc racc -> 1 + max lacc racc) 0

let layout65 tree =

let separation =

let depth = height tree

fun level -> (pown 2 <| depth - level + 1) / 2

let rec loop x y tree cont =

match tree with

| Empty -> cont Empty

| Branch(a, lt, rt) ->

let sep = separation (y+1)

loop (x - sep) (y+1) lt (fun lt' ->

loop (x + sep) (y+1) rt (fun rt' ->

cont <| Branch((a,(x, y)), lt', rt')))

loop (separation 1 - 1) 1 tree id

let layout65 tree =

let separation =

let depth = height tree

fun level -> (pown 2 <| depth - level + 1) / 2

let rec loop x y tree cont =

match tree with

| Empty -> cont Empty

| Branch(a, lt, rt) ->

let sep = separation (y+1)

loop (x - sep) (y+1) lt (fun lt' ->

loop (x + sep) (y+1) rt (fun rt' ->

cont <| Branch((a,(x, y)), lt', rt')))

loop (separation 1 - 1) 1 tree id

let layout66 tree =

// This functions places the tree on a grid with the root node on (0,1)

let rec helper gs x y tree =

let guards gs =

let children = function

| Branch(_, l, r) -> [r; l]

| Empty -> []

List.collect children gs

let isNotGuarded x = function

| Branch((_,(x', _)), _, _)::_ -> x > x'

| _ -> true

let rec placeNode gs a x y radius l r =

match helper gs (x + radius) (y + 1) r with

| None -> placeNode gs a (x + 1) y (radius + 1) l r // increase the radius

| Some r' -> Some <| Branch ((a,(x,y)), l, r')

match tree with

| Empty -> Some Empty

| Branch(a, l, r) when isNotGuarded x gs ->

helper (guards gs) (x - 1) (y + 1) l

|> Option.bind(fun l' -> placeNode (l' :: guards gs) a x y 1 l' r)

| _ -> None

// find the X coordinate of the farthest node to the left

let rec findX = function

| Branch((_,(x,_)), Empty , _) -> x

| Branch(_, l , _) -> findX l

| Empty -> 0

let tree' = helper [] 0 1 tree |> Option.get

let minX = -1 + findX tree'

// translate the tree so that the farthest node to the left is on the 1st column.

foldTree (fun (a,(x,y)) lacc racc -> Branch((a,(x-minX,y)), lacc, racc) ) Empty tree'

// This functions places the tree on a grid with the root node on (0,1)

let rec helper gs x y tree =

let guards gs =

let children = function

| Branch(_, l, r) -> [r; l]

| Empty -> []

List.collect children gs

let isNotGuarded x = function

| Branch((_,(x', _)), _, _)::_ -> x > x'

| _ -> true

let rec placeNode gs a x y radius l r =

match helper gs (x + radius) (y + 1) r with

| None -> placeNode gs a (x + 1) y (radius + 1) l r // increase the radius

| Some r' -> Some <| Branch ((a,(x,y)), l, r')

match tree with

| Empty -> Some Empty

| Branch(a, l, r) when isNotGuarded x gs ->

helper (guards gs) (x - 1) (y + 1) l

|> Option.bind(fun l' -> placeNode (l' :: guards gs) a x y 1 l' r)

| _ -> None

// find the X coordinate of the farthest node to the left

let rec findX = function

| Branch((_,(x,_)), Empty , _) -> x

| Branch(_, l , _) -> findX l

| Empty -> 0

let tree' = helper [] 0 1 tree |> Option.get

let minX = -1 + findX tree'

// translate the tree so that the farthest node to the left is on the 1st column.

foldTree (fun (a,(x,y)) lacc racc -> Branch((a,(x-minX,y)), lacc, racc) ) Empty tree'

let treeToString tree =

let rec loop t cont =

match t with

| Empty -> cont ""

| Branch(x, Empty, Empty) -> cont <| x.ToString()

| Branch(x, lt, rt) ->

loop lt <| fun lstr -> loop rt <| fun rstr -> cont <| x.ToString() + "(" + lstr + "," + rstr + ")"

loop tree id

let rec loop t cont =

match t with

| Empty -> cont ""

| Branch(x, Empty, Empty) -> cont <| x.ToString()

| Branch(x, lt, rt) ->

loop lt <| fun lstr -> loop rt <| fun rstr -> cont <| x.ToString() + "(" + lstr + "," + rstr + ")"

loop tree id

// using foldTree

let treeToString' tree = tree |> foldTree (fun x lstr rstr -> if lstr = "" && rstr = "" then x.ToString() else x.ToString() + "(" + lstr + "," + rstr + ")") ""

let stringToTree str =

let chars = str |> List.ofSeq

let getNodeValue xs =

let rec loop (acc : System.Text.StringBuilder) = function

| [] -> (acc.ToString(), [])

| (','::xs) as rest -> acc.ToString(), rest

| ('('::xs) as rest -> acc.ToString(), rest

| (')'::xs) as rest-> acc.ToString(), rest

| x::xs -> loop (acc.Append(x)) xs

loop (new System.Text.StringBuilder()) xs

let leaf a = Branch(a, Empty, Empty)

let rec loop chars cont =

match chars with

| [] -> cont (Empty, [])

| (x::_) as xs ->

let value, rest = getNodeValue xs

match rest with

| '('::','::rs -> if value = "" then cont (Empty, rs) else loop rs <| fun (rt,rs) -> cont (Branch(value, Empty, rt),rs)

| '('::rs -> loop rs <| fun (lt,rs) -> loop rs <| fun (rt,rs) -> cont (Branch(value, lt, rt), rs)

| ','::rs -> if value = "" then loop rs cont else cont (leaf value, rs)

| _::rs -> cont <| if value = "" then Empty, rs else leaf value ,rs

| [] -> cont <| (leaf value, [])

loop chars fst

let treeToString' tree = tree |> foldTree (fun x lstr rstr -> if lstr = "" && rstr = "" then x.ToString() else x.ToString() + "(" + lstr + "," + rstr + ")") ""

let stringToTree str =

let chars = str |> List.ofSeq

let getNodeValue xs =

let rec loop (acc : System.Text.StringBuilder) = function

| [] -> (acc.ToString(), [])

| (','::xs) as rest -> acc.ToString(), rest

| ('('::xs) as rest -> acc.ToString(), rest

| (')'::xs) as rest-> acc.ToString(), rest

| x::xs -> loop (acc.Append(x)) xs

loop (new System.Text.StringBuilder()) xs

let leaf a = Branch(a, Empty, Empty)

let rec loop chars cont =

match chars with

| [] -> cont (Empty, [])

| (x::_) as xs ->

let value, rest = getNodeValue xs

match rest with

| '('::','::rs -> if value = "" then cont (Empty, rs) else loop rs <| fun (rt,rs) -> cont (Branch(value, Empty, rt),rs)

| '('::rs -> loop rs <| fun (lt,rs) -> loop rs <| fun (rt,rs) -> cont (Branch(value, lt, rt), rs)

| ','::rs -> if value = "" then loop rs cont else cont (leaf value, rs)

| _::rs -> cont <| if value = "" then Empty, rs else leaf value ,rs

| [] -> cont <| (leaf value, [])

loop chars fst

let inOrder tree =

let rec loop tree cont =

match tree with

| Empty -> cont ""

| Branch(x, lt, rt) ->

loop lt <| fun l -> loop rt <| fun r -> cont <| l + x.ToString() + r

loop tree id

let preOrder tree =

let rec loop tree cont =

match tree with

| Empty -> cont ""

| Branch(x, lt, rt) ->

loop lt <| fun l -> loop rt <| fun r -> cont <| x.ToString() + l + r

loop tree id

// using foldTree

let inOrder' t = foldTree (fun x l r acc -> l (x.ToString() + (r acc))) id t ""

let preOrder' t = foldTree (fun x l r acc -> x.ToString() + l (r acc)) id t ""

let stringToTree' preO inO =

let split (str : string) char = let arr = str.Split([|char|]) in if arr.Length = 1 then "","" else arr.[0], arr.[1]

let leaf x = Branch(x, Empty, Empty)

let rec loop xss cont =

match xss with

| [], _ -> cont (Empty, [])

| x::xs, inO ->

match split inO x with

| "", "" -> cont ((leaf x), xs)

| inOl, "" -> loop (xs,inOl) <| fun (l, xs) -> cont (Branch(x, l, Empty), xs)

| "", inOr -> loop (xs, inOr) <| fun (r, xs) -> cont (Branch(x, Empty, r), xs)

| inOl, inOr -> loop (xs,inOl) <| fun (l, xs) -> loop (xs, inOr) <| fun (r,xs) -> cont (Branch(x, l, r), xs)

loop ((preO |> List.ofSeq), inO) fst

let rec loop tree cont =

match tree with

| Empty -> cont ""

| Branch(x, lt, rt) ->

loop lt <| fun l -> loop rt <| fun r -> cont <| l + x.ToString() + r

loop tree id

let preOrder tree =

let rec loop tree cont =

match tree with

| Empty -> cont ""

| Branch(x, lt, rt) ->

loop lt <| fun l -> loop rt <| fun r -> cont <| x.ToString() + l + r

loop tree id

// using foldTree

let inOrder' t = foldTree (fun x l r acc -> l (x.ToString() + (r acc))) id t ""

let preOrder' t = foldTree (fun x l r acc -> x.ToString() + l (r acc)) id t ""

let stringToTree' preO inO =

let split (str : string) char = let arr = str.Split([|char|]) in if arr.Length = 1 then "","" else arr.[0], arr.[1]

let leaf x = Branch(x, Empty, Empty)

let rec loop xss cont =

match xss with

| [], _ -> cont (Empty, [])

| x::xs, inO ->

match split inO x with

| "", "" -> cont ((leaf x), xs)

| inOl, "" -> loop (xs,inOl) <| fun (l, xs) -> cont (Branch(x, l, Empty), xs)

| "", inOr -> loop (xs, inOr) <| fun (r, xs) -> cont (Branch(x, Empty, r), xs)

| inOl, inOr -> loop (xs,inOl) <| fun (l, xs) -> loop (xs, inOr) <| fun (r,xs) -> cont (Branch(x, l, r), xs)

loop ((preO |> List.ofSeq), inO) fst

// using foldTree

let tree2DotString t = foldTree (fun x l r acc -> x.ToString() + l (r acc)) (fun acc -> "." + acc) t ""

let dotString2Tree str =

let chars = str |> List.ofSeq

let rec loop chars cont =

match chars with

| [] -> failwith "the string is not well formed"

| '.'::xs -> cont (Empty, xs)

| x::xs -> loop xs <| fun (l,xs) -> loop xs <| fun (r,xs) -> cont (Branch(x, l , r), xs)

loop chars fst

let tree2DotString t = foldTree (fun x l r acc -> x.ToString() + l (r acc)) (fun acc -> "." + acc) t ""

let dotString2Tree str =

let chars = str |> List.ofSeq

let rec loop chars cont =

match chars with

| [] -> failwith "the string is not well formed"

| '.'::xs -> cont (Empty, xs)

| x::xs -> loop xs <| fun (l,xs) -> loop xs <| fun (r,xs) -> cont (Branch(x, l , r), xs)

loop chars fst

### More information

Link: |
http://fssnip.net/at |

Posted: |
2 years ago |

Author: |
Cesar Mendoza (website) |

Tags: |
Ninety-Nine F# Problems, tutorial, F#, trees |