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.

Copy Source
Copy Link
Tools:

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



 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



 
 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
// 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 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 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)
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



 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
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



 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 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'
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
// 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 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
// 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

More information

Link: http://fssnip.net/at
Posted: 2 years ago
Author: Cesar Mendoza (website)
Tags: Ninety-Nine F# Problems, tutorial, F#, trees