module ListSets =
// 1.1
let rec mem item list =
match list with
| [] -> false
| x :: xs ->
if item = x
then true
else mem item xs

let () = Printf.printf “mem 2 [1;2;3] = %O \n” <| mem 2 [1;2;3]
let () = Printf.printf “mem 4 [1;2;3] = %O \n” <| mem 4 [1;2;3]

// 1.2 1)
let union left right =
let rec accumulate what where =
match what with
| [] -> where
| x :: xs ->
if mem x where
then accumulate xs where
else accumulate xs (x :: where)
in
accumulate left (accumulate right [])

let () = Printf.printf “union [1;1;2] [2;3;3] = %O \n” <| union [1;1;2] [2;3;3]

let intersection left right =
let rec accumulate what where =
match what with
| [] -> where
| x :: xs ->
if mem x right && not (mem x where)
then accumulate xs (x :: where)
else accumulate xs where
in accumulate left []

let () = Printf.printf “intersection [1;2;2;3] [2;3;3;4] = %O \n” <| intersection [1;2;2;3] [2;3;3;4]

// 1.2 2)
let rec foo2 equal y list =
match list with
| [] -> []
| x :: xs ->
if equal y x
then x :: foo2 equal y xs
else foo2 equal y xs

let foo1 item = foo2 (fun x y -> x = y) item

let () = Printf.printf “foo2 (<) 3 [1;3;2;4;5] = %O \n” <| foo2 (<) 3 [1;3;2;4;5]
let () = Printf.printf “foo2 (>) 3 [1;3;2;4;5] = %O \n” <| foo2 (>) 3 [1;3;2;4;5]
let () = Printf.printf “foo2 (=) 3 [1;3;2;4;5] = %O \n” <| foo2 (=) 3 [1;3;2;4;5]

let () = Printf.printf “foo2 (<) ‘b’ [‘a’;’b’;’c’;’d’;’b’] = %O \n” <| foo2 (<) ‘b’ [‘a’;’b’;’c’;’d’;’b’]
let () = Printf.printf “foo1 ‘b’ [‘a’;’b’;’c’;’d’;’b’] = %O \n” <| foo1 ‘b’ [‘a’;’b’;’c’;’d’;’b’]

module BinTree =

// 3.1
// was before
// type IntTree
// = Empty
// | Leaf of int
// | Branch of int * IntTree * IntTree

// 3.6
type Tree<‘a>
= Empty
| Leaf of ‘a // isn’t Leaf(x) identical to Branch (x, Empty, Empty)?
| Branch of ‘a * Tree<‘a> * Tree<‘a>

// 3.2
let emptyTree = Empty

let buildTree left right x = Branch (x, left, right)

let () = Printf.printf “buildTree Empty (Leaf ‘world’) ‘hello’ = %A \n”
<| buildTree Empty (Leaf “world”) “hello”

let isLeaf tree =
match tree with
| Leaf _ -> true
| _ -> false

let () = Printf.printf “isLeaf (Leaf ‘world’) = %A \n”
<| isLeaf (Leaf “world”)

let () = Printf.printf “isLeaf Empty = %A \n”
<| isLeaf (Empty)

exception EmptyTree

let head tree =
match tree with
| Empty -> raise EmptyTree
| Leaf x -> x
| Branch (x, _, _) -> x

let () = Printf.printf “head (Leaf 1) = %A \n”
<| head (Leaf 1)

let () = Printf.printf “head (Branch 1 Empty Empty) = %A \n”
<| head (Branch(1, Empty, Empty))

exception NotABranch

let left tree =
match tree with
| Empty -> raise NotABranch
| Leaf _ -> raise NotABranch
| Branch (_, l, _) -> l

let () = Printf.printf “left (Branch 1 (Leaf 2) (Leaf 3)) = %A \n”
<| left (Branch(1, Leaf 2, Leaf 3))

let right tree =
match tree with
| Empty -> raise NotABranch
| Leaf _ -> raise NotABranch
| Branch (_, _, r) -> r

let () = Printf.printf “right (Branch 1 (Leaf 2) (Leaf 3)) = %A \n”
<| right (Branch(1, Leaf 2, Leaf 3))

module Sorted =

// 3.3
open BinTree

type Comparison = Less | Equal | Greater

let compare x y =
if x = y
then Equal
else
if x < y
then Greater
else Less

// 3.4
let add tree item =
let rec add_item tree =
match tree with
| Empty -> Leaf (item)
| Leaf(other) ->
match compare other item with
| Less -> Branch(other, Leaf(item), Empty)
| Equal -> tree
| Greater -> Branch(other, Empty, Leaf(item))

| Branch(root, left, right) ->
match compare root item with
| Less -> Branch(root, add_item(left), right)
| Equal -> tree
| Greater -> Branch(root, left, add_item(right))

in add_item tree

let rec addList tree list =
match list with
| [] -> tree
| x :: xs -> addList (add tree x) xs

let () = Printf.printf “addList (Leaf 5) [2;1;7;6] = %+A \n”
<| addList (Leaf 5) [2;1;7;6]

let () = Printf.printf “add (addList (Leaf 5) [2;1;7;6]) 8 = %+A \n”
<| add (addList (Leaf 5) [2;1;7;6]) 8

let () = Printf.printf “polymorphism_test = %+A\n” (addList emptyTree [“e”;”b”;”a”;”f”;”g”])

module Evaluator =

// 4
open BinTree

// 4.1
type Operator = Plus | Minus | Multiply | Divide
type Op = Value of float | Operator of Operator

exception NotAValue

let fromValue value =
match value with
| Value value -> value
| _ -> raise NotAValue

// 4.2
let Op op left right = buildTree left right (Operator op)

exception MustBeOperator of Op

// 4.3
let rec Eval tree =
if isLeaf(tree)
then fromValue (head tree)
else
match head tree with
| Operator Plus -> Eval (left tree) + Eval (right tree)
| Operator Minus -> Eval (left tree) – Eval (right tree)
| Operator Multiply -> Eval (left tree) * Eval (right tree)
| Operator Divide -> Eval (left tree) / Eval (right tree)
| _ -> raise <| MustBeOperator (head tree)

let subject =
Op Plus // (2 * 5) + (12 – 7) = 15
(Op Multiply // 2 * 5 = 10
(Leaf (Value 2.))
(Leaf (Value 5.)))
(Op Minus // 12 – 7 = 5
(Leaf (Value 12.))
(Leaf (Value 7.)))

let () = Printf.printf “subject = %+A \n” subject
let () = Printf.printf “Eval subject = %+A \n” (Eval subject)