// [snippet: Ninety-Nine F# Problems - Problems 54 - 60 - Binary trees]
/// 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.
///
///
///
/// A binary tree is either empty or it is composed of a root element and two successors,
/// which are binary trees themselves.
///
/// (a)
/// / \
/// (b) (c)
/// / \ \
/// (d) (e) (f)
///
/// In F#, we can characterize binary trees with a type definition:
///
type 'a Tree = Empty | Branch of 'a * 'a Tree * 'a Tree
///
/// This says that a Tree of type a consists of either an Empty node, or a Branch containing one
/// value of type a with exactly two subtrees of type a.
///
/// Given this definition, the tree in the diagram above would be represented as:
///
let tree1 = Branch ('a', Branch ('b', Branch ('d', Empty, Empty),
Branch ('e', Empty, Empty)),
Branch ('c', Empty,
Branch ('f', Branch ('g', Empty, Empty),
Empty)))
/// Since a "leaf" node is a branch with two empty subtrees, it can be useful to define a
/// shorthand function:
let leaf x = Branch (x, Empty, Empty)
/// Then the tree diagram above could be expressed more simply as:
let tree1' = Branch ('a', Branch ('b', leaf 'd',
leaf 'e'),
Branch ('c', Empty,
Branch ('f', leaf 'g',
Empty)))
/// Other examples of binary trees:
///
/// -- A binary tree consisting of a root node only
let tree2 = Branch ('a', Empty, Empty)
///
/// -- An empty binary tree
let tree3 = Empty
///
/// -- A tree of integers
let tree4 = Branch (1, Branch (2, Empty, Branch (4, Empty, Empty)),
Branch (2, Empty, Empty))
// [/snippet]
// [snippet: (*) Problem 54A : Check whether a given term represents a binary tree.]
/// In Prolog or Lisp, one writes a predicate to do this.
///
/// Example in Lisp:
/// * (istree (a (b nil nil) nil))
/// T
/// * (istree (a (b nil nil)))
/// NIL
///
/// Non-solution:
/// F#'s type system ensures that all terms of type 'a Tree are binary trees: it is just not
// possible to construct an invalid tree with this type. Hence, it is redundant to introduce
/// a predicate to check this property: it would always return True
// [/snippet]
// [snippet: (**) Problem 55 : Construct completely balanced binary trees]
/// In a completely balanced binary tree, the following property holds for every node:
/// The number of nodes in its left subtree and the number of nodes in its right subtree
/// are almost equal, which means their difference is not greater than one.
///
/// Write a function cbal-tree to construct completely balanced binary trees for a given
/// number of nodes. The predicate should generate all solutions via backtracking. Put
/// the letter 'x' as information into all nodes of the tree.
///
/// Example:
/// * cbal-tree(4,T).
/// T = t(x, t(x, nil, nil), t(x, nil, t(x, nil, nil))) ;
/// T = t(x, t(x, nil, nil), t(x, t(x, nil, nil), nil)) ;
/// etc......No
///
/// Example in F#, whitespace and "comment diagrams" added for clarity and exposition:
///
/// > cbalTree 4;;
/// val trees : char Tree list =
/// [
/// permutation 1
/// x
/// / \
/// x x
/// \
/// x
/// Branch ('x', Branch ('x', Empty, Empty),
/// Branch ('x', Empty,
/// Branch ('x', Empty, Empty)));
///
/// permutation 2
/// x
/// / \
/// x x
/// /
/// x
/// Branch ('x', Branch ('x', Empty, Empty),
/// Branch ('x', Branch ('x', Empty, Empty),
/// Empty));
///
/// permutation 3
/// x
/// / \
/// x x
/// \
/// x
/// Branch ('x', Branch ('x', Empty,
/// Branch ('x', Empty, Empty)),
/// Branch ('x', Empty, Empty));
///
/// permutation 4
/// x
/// / \
/// x x
/// /
/// x
/// Branch ('x', Branch ('x', Branch ('x', Empty, Empty),
/// Empty),
/// Branch ('x', Empty, Empty))
/// ]
(*[omit:(Solution 1)]*)
let rec cbalTree n =
match n with
| 0 -> [Empty]
| n -> let q,r = let x = n - 1 in x / 2, x % 2
[ for i=q to q + r do
for lt in cbalTree i do
for rt in cbalTree (n - 1 - i) do
yield Branch('x', lt, rt) ]
(*[/omit]*)
(*[omit:(Solution 2)]*)
let nodes t =
let rec nodes' t cont =
match t with
| Empty -> cont 0
| Branch(_, lt, rt) ->
nodes' lt (fun nlt -> nodes' rt (fun nrt -> cont (1 + nlt + nrt)))
nodes' t id
let rec allTrees n =
match n with
| 0 -> [Empty]
| n ->
[ for i=0 to n - 1 do
for lt in cbalTree i do
for rt in cbalTree (n - 1 - i) do
yield Branch('x', lt, rt) ]
let cbalTree' n = allTrees n |> List.filter(fun t ->
match t with
| Empty -> true
| Branch(_, lt, rt) -> abs (nodes lt - nodes rt) <= 1 )
(*[/omit]*)
// [/snippet]
// [snippet: (**) Problem 56 : Symmetric binary trees]
/// Let us call a binary tree symmetric if you can draw a vertical line through the root
/// node and then the right subtree is the mirror image of the left subtree. Write a
/// predicate symmetric/1 to check whether a given binary tree is symmetric. Hint: Write
/// a predicate mirror/2 first to check whether one tree is the mirror image of another.
/// We are only interested in the structure, not in the contents of the nodes.
///
/// Example in F#:
///
/// > symmetric <| Branch ('x', Branch ('x', Empty, Empty), Empty);;
/// val it : bool = false
/// > symmetric <| Branch ('x', Branch ('x', Empty, Empty), Branch ('x', Empty, Empty))
/// val it : bool = true
(*[omit:(Solution)]*)
let symmetric tree =
let rec mirror t1 t2 cont =
match t1,t2 with
| Empty,Empty -> cont true
| Empty, Branch _ -> cont false
| Branch _, Empty -> cont false
| Branch (_, lt1, rt1), Branch (_, lt2, rt2) ->
mirror lt1 rt2 (fun isMirrorLeft -> mirror rt1 lt2 (fun isMirrorRight -> cont (isMirrorLeft && isMirrorRight)))
match tree with
| Empty -> true
| Branch (_,lt, rt) -> mirror lt rt id
(*[/omit]*)
// [/snippet]
// [snippet: (**) Problem 57 : Binary search trees (dictionaries)]
/// Use the predicate add/3, developed in chapter 4 of the course, to write a predicate
/// to construct a binary search tree from a list of integer numbers.
///
/// Example:
/// * construct([3,2,5,7,1],T).
/// T = t(3, t(2, t(1, nil, nil), nil), t(5, nil, t(7, nil, nil)))
///
/// Then use this predicate to test the solution of the problem P56.
///
/// Example:
/// * test-symmetric([5,3,18,1,4,12,21]).
/// Yes
/// * test-symmetric([3,2,5,7,4]).
/// No
///
/// Example in F#:
///
/// > construct [3; 2; 5; 7; 1]
/// val it : int Tree =
/// Branch (3,Branch (2,Branch (1,Empty,Empty),Empty),
/// Branch (5,Empty,Branch (7,Empty,Empty)))
/// > [5; 3; 18; 1; 4; 12; 21] |> construct |> symmetric;;
/// val it : bool = true
/// > [3; 2; 5; 7; 1] |> construct |> symmetric;;
/// val it : bool = true
(*[omit:(Solution)]*)
let insert x tree =
let rec insert' t cont =
match t with
| Empty -> cont <| Branch(x, Empty, Empty)
| Branch(y, lt, rt) as t ->
if x < y then
insert' lt <| fun lt' -> cont <| Branch(y, lt', rt)
elif x > y then
insert' rt <| fun rt' -> cont <| Branch(y, lt, rt')
else
t
insert' tree id
let construct xs = xs |> List.fold(fun tree x -> insert x tree) Empty
(*[/omit]*)
// [/snippet]
// [snippet: (**) Problem 58 : Generate-and-test paradigm]
/// Apply the generate-and-test paradigm to construct all symmetric, completely balanced
/// binary trees with a given number of nodes.
///
/// Example:
/// * sym-cbal-trees(5,Ts).
/// Ts = [t(x, t(x, nil, t(x, nil, nil)), t(x, t(x, nil, nil), nil)),
/// t(x, t(x, t(x, nil, nil), nil), t(x, nil, t(x, nil, nil)))]
///
/// Example in F#:
///
/// > symCbalTrees 5;;
/// val it : char Tree list =
/// [Branch
/// ('x',Branch ('x',Empty,Branch ('x',Empty,Empty)),
/// Branch ('x',Branch ('x',Empty,Empty),Empty));
/// Branch
/// ('x',Branch ('x',Branch ('x',Empty,Empty),Empty),
/// Branch ('x',Empty,Branch ('x',Empty,Empty)))]
(*[omit:(Solution)]*)
let symCbalTrees = cbalTree >> List.filter symmetric
(*[/omit]*)
// [/snippet]
// [snippet: (**) Problem 59 : Construct height-balanced binary trees]
/// In a height-balanced binary tree, the following property holds for every node: The
/// height of its left subtree and the height of its right subtree are almost equal,
/// which means their difference is not greater than one.
///
/// Example:
/// ?- hbal_tree(3,T).
/// T = t(x, t(x, t(x, nil, nil), t(x, nil, nil)), t(x, t(x, nil, nil), t(x, nil, nil))) ;
/// T = t(x, t(x, t(x, nil, nil), t(x, nil, nil)), t(x, t(x, nil, nil), nil)) ;
/// etc......No
///
/// Example in F#:
///
/// > hbalTree 'x' 3 |> Seq.take 4;;
/// val it : seq =
/// seq
/// [Branch
/// ('x',Branch ('x',Branch ('x',Empty,Empty),Branch ('x',Empty,Empty)),
/// Branch ('x',Branch ('x',Empty,Empty),Branch ('x',Empty,Empty)));
/// Branch
/// ('x',Branch ('x',Branch ('x',Empty,Empty),Branch ('x',Empty,Empty)),
/// Branch ('x',Branch ('x',Empty,Empty),Empty));
/// Branch
/// ('x',Branch ('x',Branch ('x',Empty,Empty),Branch ('x',Empty,Empty)),
/// Branch ('x',Empty,Branch ('x',Empty,Empty)));
/// Branch
/// ('x',Branch ('x',Branch ('x',Empty,Empty),Branch ('x',Empty,Empty)),
/// Branch ('x',Empty,Empty))]
(*[omit:(Solution)]*)
let hbalTree a height =
let rec loop h cont =
match h with
| 0 -> cont [Empty, 0]
| 1 -> cont [Branch (a, Empty, Empty), 1]
| _ -> loop (h-1) (fun lts ->
loop (h-2) (fun rts ->
cont <| [let t = lts @ rts
for (t1,h1) in t do
for (t2,h2) in t do
let ht = 1 + max h1 h2
if ht = h then
yield Branch (a, t1, t2), ht] ))
loop height id |> List.map fst
(*[/omit]*)
// [/snippet]
// [snippet: (**) Problem 60 : Construct height-balanced binary trees with a given number of nodes]
/// Consider a height-balanced binary tree of height H. What is the maximum number of nodes
/// it can contain?
/// Clearly, MaxN = 2**H - 1. However, what is the minimum number MinN? This question is more
/// difficult. Try to find a recursive statement and turn it into a function minNodes that
/// returns the minimum number of nodes in a height-balanced binary tree of height H. On the
/// other hand, we might ask: what is the maximum height H a height-balanced binary tree with
/// N nodes can have? Write a function maxHeight that computes this.
///
/// Now, we can attack the main problem: construct all the height-balanced binary trees with a
/// given nuber of nodes. Find out how many height-balanced trees exist for N = 15.
///
/// Example in Prolog:
/// ?- count_hbal_trees(15,C).
/// C = 1553
///
/// Example in F#:
///
/// > hbalTreeNodes 'x' 15 |> List.length;;
/// val it : int = 1553
/// > [0 .. 3] |> List.map (hbalTreeNodes 'x');;
/// val it : char Tree list list =
/// [[Empty]; [Branch ('x',Empty,Empty)];
/// [Branch ('x',Branch ('x',Empty,Empty),Empty);
/// Branch ('x',Empty,Branch ('x',Empty,Empty))];
/// [Branch ('x',Branch ('x',Empty,Empty),Branch ('x',Empty,Empty))]]
(*[omit:(Solution)]*)
let minNodes height =
let rec minNodes' h cont =
match h with
| 0 -> cont 0
| 1 -> cont 1
| _ -> minNodes' (h - 1) <| fun h1 -> minNodes' (h - 2) <| fun h2 -> cont <| 1 + h1 + h2
minNodes' height id
let maxHeight nodes =
let rec loop n acc =
match n with
| 0 -> acc
| _ -> loop (n >>> 1) (acc + 1)
let fullHeight = loop nodes 0 // this is the height of a tree with full nodes
let minNodesH1 = minNodes (fullHeight + 1)
if nodes < minNodesH1 then
fullHeight
else
fullHeight + 1
let numNodes tree =
let rec numNodes' tree cont =
match tree with
| Empty -> cont 0
| Branch(_, lt , rt) ->
numNodes' lt <| fun ln -> numNodes' rt <| fun rn -> cont <| 1 + ln + rn
numNodes' tree id
let hbalTreeNodes x nodes =
let maxH = maxHeight nodes
let minH = if maxH = 0 then 0 else maxH - 1
[minH .. maxH] |> List.collect(fun n -> hbalTree x n) |> List.filter(fun t -> nodes = numNodes t)
(*[/omit]*)
// [/snippet]