Standard ML: Size of binary tree computed incorrectly? - functional-programming

My book has the following function which calculates the number of non-leaf nodes in a binary tree:
fun size Empty = 0
| size(Node(t_1, _, t_2)) = size t_1 + size t_2 + 1;
Suppose I want to calculate all nodes in a binary tree. How would I modify this function to do so?
Here's what I was thinking:
fun size Empty = 0
| size(Node(Empty, _, Empty)) = 1
| size(Node(t_1, _, t_2)) = size t_1 + size t_2 + 1;
Does this look right?
Thanks,
bclayman

Both of the implementations that you provided are actually the same. The second case of your second implementation is a special case of you your third pattern. For your first implementation, size(Node(Empty,1,Empty)) will recurse one the left subtree, returning 0, recurse on the right subtree, which returns 0, and then adds 1, yielding the result 1. In fact, if you switch the order of the second and third case, the compiler will tell you that it is redundant:
test.sml:3.5-5.38 Error: match redundant
Empty => ...
Node (t_1,_,t_2) => ...
--> Node (Empty,_,Empty) => ...

Matt is correct that your two functions are functionally the same -- both of which return a count of all nodes in the tree. I didn't notice this at first since I took it at face value that your first function counted nonleaf nodes and then noticed that your Node(Empty,_,Empty) pattern is the correct pattern of a leaf (if a leaf is defined as a node with no non-empty children). But -- this means that the function in the book doesn't just count nonleaf (parents) nodes. If you do want a function which just counts parent nodes, there is a use for your pattern after all:
fun parents Empty = 0
| parents(Node(Empty, _, Empty)) = 0
| parents(Node(t_1, _, t_2)) = parents t_1 + parents t_2 + 1;
If your application of trees is one in which heavy use is made of the parent node vs. leaf node distinction, you could (at the cost of making some of your function definitions more involved) ditch the Node constructor in favor of separate Parent and Leaf constructors. Something like:
datatype 'a tree = Empty | Leaf of 'a | Parent of 'a tree * 'a * 'a tree;
Then you can write functions like
fun countLeaves Empty = 0
| countLeaves (Leaf _) = 1
| countLeaves (Parent(t1,_,t2)) = countLeaves t1 + countLeaves t2;
So e.g.
- val t = Parent(Parent(Leaf "2", "*", Leaf "3"), "+", Leaf "4");
- countLeaves t;
val it = 3 : int

Related

How to find the minimum element in a Map and return a tuple (key,minimum element)?

I have these types :
type position = float * float
type node = position
I've written those modules to create my Map :
module MyMap =
struct
type t = node
let compare (a1,b1) (a2,b2) =
if a1 > a2 then 1
else if a1 < a2 then -1
else if b1 > b2 then 1
else if b1 < b2 then -1
else 0
end
module DistMap = Map.Make(MyMap)
I've tried to write functions that used iter but my attempts to formulate my ideas in a correct syntax were unsuccessful.
My goal would be able to have a function that takes a Map as argument and return a tuple of the minimum element and its key.
Thanks.
If you're asking for the minimum key and its corresponding element, that's easy: use DistMap.min_binding_opt, or DistMap.min_binding if you're fine with raising an exception on an empty map.
If you're asking for the minimum element and its corresponding key, you will want to use a fold. Luckily, the DistMap module returned by Map.Make exposes a fold function, so you don't have to do extra allocation by, say, calling to_seq and doing a fold on the result. In addition, because the type of elements in a map is not constrained by the functor application (i.e., you can create a map with any element type), you will need the client to supply a comparison function for the element type.
DistMap.fold has type (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b, so we'll have to instantiate 'b in such a way as to keep track of both the key and the min element; in other words, we'll instantiate 'a as the element type of the map (let’s call it t), and 'b as (key * t) option (where key = position = float * float).
Here's what the code might look like:
let min_element_and_its_key map ~compare_element =
let take_min key element key_and_min_element =
match key_and_min_element with
| None -> Some (key, element)
| Some (key_for_min_element, min_element) ->
if compare_element element min_element < 0
then Some (key, element)
else Some (key_for_min_element, min_element)
in
DistMap.fold take_min map None
min_element_and_its_key will return None on an empty map.
Example client code (which you can run in an ocaml repl) might look like:
let map = DistMap.(empty |> add (3., 3.) "a" |> add (4., 4.) "b") in
min_element_and_its_key map ~compare_element:String.compare;;
(* Output: *)
- : (node * string) option = Some ((3., 3.), "a")
In general, anytime that you want to traverse all keys/elements in a data structure and accumulate a value, a fold is the way to go. iter will sort of work, but you'll have to accumulate the value in mutable state instead of accumulating it directly as the return value of the function you're folding with.

How to collapse a recursive tree in OCaml

I have a tree type:
type tree = Vertex of int * tree list;;
My recursive equality definition is that two trees are equal if their ints are equal and all of their children are equal.
How do I build the function
topo: tree -> tree list
that creates a list of all of the trees in depth first search order with each tree appearing once and only once (according to the equality definition)? I want to do this in a computationally efficient way. Maybe use lazy or a hashmap?
Here is my attempt, the code blows up when the length is too large:
type tree = Vertex of int * (tree list)
let rec base = function
| 0 -> Vertex (0, [])
| i -> Vertex (i, [base (i - 1)])
let rec range = function
| 0 -> [0]
| i -> i :: range (i - 1)
let agg i = Vertex (-1, List.map base (range i))
let rec equals (a: tree) (b: tree) : bool =
let rec deep_match a_dep b_dep = match a_dep, b_dep with
| [], [] -> true
| [], _
| _, [] -> false
| x::xs, y::ys -> equals x y && deep_match xs ys
in
let Vertex (ai, al) = a in
let Vertex (bi, bl) = b in
ai = bi && deep_match al bl
let rec in_list (a: tree) (l: tree list) : bool = match l with
| [] -> false
| hd::tl -> equals a hd || in_list a tl
let rec topological (pool: tree list) (t: tree) : tree list =
if in_list t pool then pool else
t::match t with
| Vertex(_, []) -> pool
| Vertex(_, deps) -> List.fold_left topological pool deps
let big_agg = agg 100_000
let topo_ordered = topological [] big_agg;;
Printf.printf "len %i\n" (List.length topo_ordered)
To make it efficient you need to implement ordering and hash-consing. With total ordering, you can store your trees in a balanced tree or even a hashtable, thus turning your in_list into O(logN) or even O(1). Adding hash-consing will enable O(1) comparison of your trees (at the cost of less efficient tree construction).
Instead of having both, depending on your design constraints, you can have only one. For the didactic purposes, let's implement hash-consing for your particular representation
To implement hash-consing you need to make your constructor private and hide data constructors behind an abstraction wall (to prevent users from breaking you hash-consing properties):
module Tree : sig
type t = private Vertex of int * t list
val create : int -> t list -> t
val equal : t -> t -> bool
end = struct
type t = Vertex of int * t list
let repository = Hashtbl.create 64
let create n children =
let node = Vertex (n,children) in
try Hashtbl.find repository node
with Not_found -> Hashtbl.add repository node node; node
let equal x y = x == y
end
Since we guaranteed that structurally equal trees are physically equal during the tree creation (i.e., if there exists an equal tree in our repository then we return it), we are now able to substitute structural equality with physical equality, i.e., with pointer comparison.
We got a fast comparison with the price - we now leaking memory, since we need to store all ever created trees and the create function is now O(N). We can alleviate the first problem by using ephemerons, but the latter problem will persist, of course.
Another issue, is that we're not able to put our trees into ordered structure, like a map or a set. We can of course use regular polymorphic compare, but since it will be O(N), inserting to such structure will become quadratic. Not an option for us. Therefore we need to add total ordering on our trees. We can theoretically do this without changing the representation (using ephemerons), but it is easier just to add an order parameter to our tree representation, e.g.,
module Tree : sig
type order (* = private int *) (* add this for debuggin *)
type t = private Vertex of order * int * t list
val create : int -> t list -> t
val equal : t -> t -> bool
val compare : t -> t -> int
end = struct
type order = int
type t = Vertex of order * int * t list
type tree = t
module Repository = Hashtbl.Make(struct
type t = tree
let max_hash = 16
let rec equal (Vertex (_,p1,x)) (Vertex (_,p2,y)) =
match compare p1 p2 with
| 0 -> equal_trees x y
| n -> false
and equal_trees xs ys = match xs, ys with
| [],[] -> true
| [],_ | _,[] -> false
| x :: xs, y::ys -> equal x y && equal_trees xs ys
let rec hash (Vertex (_,p,xs)) =
hash_trees (Hashtbl.hash p) max_hash xs
and hash_trees hash depth = function
| x :: xs when depth > 0 ->
hash_trees (Hashtbl.hash x) (depth-1) xs
| _ -> hash
end)
let repository = Repository.create 64
let create n children =
try Repository.find repository (Vertex (0,n,children))
with Not_found ->
let order = Repository.length repository + 1 in
let node = Vertex (order,n,children) in
Repository.add repository node node; node
let equal x y = x == y
let order (Vertex (order,_,_)) = order
let compare x y = compare (order x) (order y)
end
We had to manually implement the structural variants of equal and hash for our trees because we need to ignore the order in comparison, when we store a new tree in the repository. It looks like a bit of work, but in the real-life you can do this using derivers.
Anyways, now we got a comparable version of a tree with a comparison function which is O(1), so we can put our trees in sets and maps, and implement your topo efficiently.
A nice feature of both implementations is a tight representation of a tree, since sharing is guaranteed by the create function. E.g.,
# let t1 = Tree.create 42 [];;
val t1 : Tree.t = Tree.Vertex (1, 42, [])
# let t3 = Tree.create 42 [t1; t1];;
val t3 : Tree.t =
Tree.Vertex (2, 42, [Tree.Vertex (1, 42, []); Tree.Vertex (1, 42, [])])
# let t5 = Tree.create 42 [t1; t3; t1];;
val t5 : Tree.t =
Tree.Vertex (3, 42,
[Tree.Vertex (1, 42, []);
Tree.Vertex (2, 42, [Tree.Vertex (1, 42, []); Tree.Vertex (1, 42, [])]);
Tree.Vertex (1, 42, [])])
#
In this example, t1 in t5 and t3 will be the same pointer.
For optimal performance, one possibility would be to use hashconsing. However, in your current example, both the generation and the unicity test are quadratic in n. Fixing both points seems to already improve performance a lot.
First, we can avoid the quadratic tree generation by adding a lot of sharing:
let range max =
let rec range elt l n =
if n > max then elt::l
else
let next = Vertex(n,[elt]) in
range next (elt::l) (n+1) in
range (Vertex(0,[])) [] 1
let agg i = Vertex (-1, range i)
With this change, it is become reasonable to generate a tree with 1010 elements (but only 105 unique elements).
Then, the unicity test can be done with a set (or a hashtable):
module S = Set.Make(struct type t = tree let compare = compare end)
let rec topological (set, pool) t =
if S.mem t set then (set, pool) else
let set = S.add t set in
let set, pool =
match t with
| Vertex(_, []) -> set, pool
| Vertex(_, deps) -> List.fold_left topological (set,pool) deps in
set, t::pool

Understanding passing of polymorphic types in Standard ML

I am working on some exercises to help my understanding of SML and find I am having a hard time understanding how generic/polymorphic types are passed into functions.
I am given the following initial information:
datatype 'a tree = Leaf | Node of 'a tree * 'a * 'a tree
val testTree = Node (Node (Node (Leaf, ("a", 107), Leaf), ("c", 417), Node (Leaf, ("e", ~151), Node (Leaf, ("o", ~499), Leaf))), ("s", 35), Node (Leaf, ("u", ~387), Node (Leaf, ("y", 263), Leaf)))
fun nameCompare (n1: name, n2: name) : order = String.compare (n1, n2)
fun treeLookup cmp =
let
fun lkup (x, btree) =
case tree of
Leaf => NONE
| Node (lt, y, rt) =>
(case cmp (x, y) of
LESS => lkup (x, lt)
| EQUAL => SOME y
| GREATER => lkup (x, rt))
in
lkup
end
When I try to call treeLookup I continue to get type matching errors.
For example this is what I may be calling
treeLookup nameCompare ("a", testTree)
and Ill get an error like this
treeLookup nameCompare ("a", testTree);
^^^^^^^^
Type clash: expression of type
(string * int) tree
cannot have type
string tree
What do I need to do in order to satisfy the type of the tree when passing it to treeLookup?
In your tree
a' : ("a", 107)
treeLookup calls the cmp on every element and the one you passed. You passed in nameCompare which takes two strings and a string, and "a" which is a string. That means your tree should only have strings in it.
To solve that you'll probably want to make your tree be a map, effectively comparing only on the first value of the pair:
| Node (lt, (k,v), rt) =>
(case cmp (x, k)
Possibly changing the definition as well:
datatype 'k 'v tree = Leaf | Node of 'k 'v tree * ('k * 'v) * 'k 'v tree
Alternatively, you can change your comparison function to take ('a * 'b), but that means that e.g. you'd need to do treeLookup with an element ("a", 107) which would try to match both fields.
You're comparing a string against an item in the tree, which is a string * int.
You could always change your comparison function; something like
fun nameCompare (n, (k,v)) = String.compare (n1, k)
should do.

Grabbing a list of nodes in a tree?

How would you go about grabbing a list of nodes from a tree structure that meet a certain criteria using ocaml? Since everything's created anew, there's no saved data structure. Any type of function that tries to return a list could only return one element when it hits a node, not a list.
Here's a tree type:
type tree = Leaf of int | Node of int * tree * tree
Here's a function that returns all the even values from the nodes of a tree:
let evens t =
let rec go sofar = function
| Leaf k -> if k mod 2 = 0 then k :: sofar else sofar
| Node (k, lt, rt) ->
let sofar' = if k mod 2 = 0 then k :: sofar else sofar in
let sofar'' = go sofar' lt in
go sofar'' rt
in
go [] t

Binary trees as innested pairs

I'm trying to represent a generic binary tree as a pair.
I'll use the SML syntax as example. This is my btree type definition:
datatype btree = leaf | branch of btree*btree;
So, I'd like to write a function that, given a btree, print the following:
bprint leaf = 0
bprint (branch (leaf,leaf)) = (0,0)
bprint (branch (leaf, branch (leaf,leaf))) = (0, (0, 0))
and so on.
The problem is that this function always return different types. This is obviously a problem for SML and maybe for other functional languages.
Any idea?
Since all you want to do is to print the tree structure to the screen, you can just do that and have your function's return type be unit. That is instead of trying to return the tuple (0, (0, 0)) just print the string (0, (0, 0)) to the screen. This way you won't run into any difficulties with types.
If you really do not need a string representation anywhere else, as already mentioned by others, just printing the tree might be the easiest way:
open TextIO
datatype btree = leaf | branch of btree * btree
fun print_btree leaf = print "0"
| print_btree (branch (s, t)) =
(print "("; print_btree s; print ", "; print_btree t; print ")")
In case you also want to be able to obtain a string representing a btree, the naive solution would be:
fun btree_to_string leaf = "0"
| btree_to_string (branch (s, t)) =
"(" ^ btree_to_string s ^ ", " ^ btree_to_string t ^ ")"
However, I do not really recommend this variant since for big btrees there is a problem due to the many string concatenations.
Something nice to think about is the following variant, which avoids the concatenation problem by a trick (that is for example also used in Haskell's Show class), i.e., instead of working on strings, work on functions from char lists to char lists. Then concatenation can be replaced by function composition
fun btree_to_string' t =
let
fun add s t = s # t
fun add_btree leaf = add [#"0"]
| add_btree (branch (s, t)) =
add [#"("] o add_btree s o add [#",", #" "] o add_btree t o add [#")"]
in implode (add_btree t []) end

Resources