CS HW Review Help

(HW04) implement ‘assoc’ without using ‘failwith’; more true to its type

let rec assoc (k: 'k) (l: ('k * 'v) list) : 'v option =
  begin match l with
  | [] -> None
  | (key, v)::tl -> if k = key then Some v else assoc k tl
  end

(HW04) converts optional optional value to just optional value

let join_option (x: 'a option option) : 'a option =
  begin match x with
  | None -> None
  | Some(None) -> None
  | Some(Some v) -> (Some v)
  end

(HW04) takes in list of optional values and returns list containing all values present.

let rec cat_option (l: 'a option list) : 'a list =
  begin match l with
  | [] -> []
  | None::tail -> cat_option tail
  | (Some v)::tail -> v::(cat_option tail)
  end

(HW04) transforms a list with function f and returns list containing all values “present” after transportation

let rec partial_transform (f: 'a -> 'b option) (l: 'a list) : 'b list =
  begin match l with
  | [] -> []
  | v::tail -> 
    begin match f v with
    | None -> partial_transform f tail
    | Some x -> x::(partial_transform f tail)
  end

(HW04) iterates through each element of a list in order and calls side-effecting function on each element.

let rec iter (f: 'a -> unit) (l: 'a list) : unit =
  begin match l with
  | [] -> ()
  | x::tail -> f x ; iter f tail
end

(HW04) determines of two record cells are aliased by using reference equality operator.

let states_aliased (r1: state) (r2: state) : bool =
  r1 == r2

(HW04) swaps contents of two state record cells

let swap (r1: state) (r2: state) : unit =
  let a = r1.count in
  let b = r2.count in
  r2.count <- a ; r1.count <- b

(HW04) given value x and list of values, determine whether any of the elements in the list is an alias of x.

let rec contains_alias (x: 'a) (l: 'a list) : bool =
  begin match l with
  | [] -> false
  | hd::tail -> x == hd || contains_alias x tail
end

(HW04) determines whether given value x is aliased with one of the avlues inside an option in an options list.

let rec contains_alias_option (x: 'a) (l: 'a option list) : bool =
  begin match l with
  | [] -> false
  | None::tl -> contains_alias_option x tl
  | Some hd::tl -> x == hd || contains_alias_option x tl
end

(HW04) all simpleQueues are valid

  let valid (q: 'a queue) : bool =
    true

(HW04) create empty SimpleQueue

  let create () : 'a queue =
    { data = [] }

(HW04) determine whether queue is empty

  let is_empty (q: 'a queue) : bool =
    q.data = []

(HW04) SimpleQueue: add an element to the tail of a queue

let enq (elt: 'a) (q: 'a queue) : unit =
q.data <- q.data @ [elt]

(HW04) SimpleQueue: remove an element from the head of the queue and return the removed head

let deq (q: 'a queue) : 'a option =
begin match q.data with
| [] -> None
| hd :: tl -> q.data <- tl; Some hd
end

(HW04) SimpleQueue: retrieve the list of values stored in the queue in order (leverages the invariant)

let to_list (q: 'a queue) : 'a list =
q.data

(HW04) SimpleQueue: get the length of a queue

let length (q: 'a queue) : int =
List.length q.data

(HW04) SimpleQueue: print out the data of a queue

let rec print (q: 'a queue) (string_of_element: 'a -> string) : unit =
print_endline "--- queue contents ---";
List.iter (fun x -> print_endline (string_of_element x)) q.data;
print_endline "--- end of queue ---"

(HW04) SimpleQueue: convert a list into a queue (leverages the invariant)

let from_list (l: 'a list) : 'a queue =
{ data = l }

(HW04) SimpleQueue: determine whether a given element is in the queue using reference equality (==)

let contains (elt: 'a) (q: 'a queue) : bool =
fold (fun v acc -> v == elt || acc) false q.data

(HW04) SimpleQueue: truncate a queue after the first occurrence of an element (element stays; reference equality)

let truncate (elt: 'a) (q: 'a queue) : unit =
let x = q.data in
let rec loop (l: 'a list) (prev: 'a list) : 'a list =
begin match l with
| [] -> prev
| hd::tl ->
if elt == hd then prev @ [hd]
else loop tl (prev @ [hd])
end
in q.data <- loop x []

(HW04) SimpleQueue: delete all instances of the value elt from the queue

  let delete (elt: 'a) (q: 'a queue) : unit =
    q.data <- fold (fun v acc -> if v = elt then acc else v :: acc) [] q.data

(HW04) SimpleQueue: a SimpleQueue can't have a cycle (it's a list!)

let has_cycle (q: 'a queue) : bool =
false

(HW04) LinkedQueue: node and queue types

type 'a qnode = { v: 'a;
mutable next: 'a qnode option }

type 'a queue = { mutable head: 'a qnode option;
mutable tail: 'a qnode option }

(HW04) LinkedQueue: queue invariant

• q.head and q.tail are either both None, or

• q.head and q.tail both point to Some nodes, and

  • q.tail is reachable by following 'next' pointers from q.head

  • q.tail's next pointer is None (This implies a valid queue has no cycles.)

(HW04) LinkedQueue: find the last node from qn, returning None if a cycle is detected

let rec find_last_node (qn: 'a qnode) : 'a qnode option =
let rec loop (curr: 'a qnode) (seen: 'a qnode list) : 'a qnode option =
begin match curr.next with
| None -> Some curr
| Some n ->
let rec contains_alias (qnl :'a qnode list) : 'a qnode option =
begin match qnl with
| [] -> loop n (curr :: seen)
| h :: t -> if n == h then None else contains_alias t
end in
contains_alias seen
end
in loop qn []

(HW04) LinkedQueue: check whether a queue satisfies the invariant

let valid (q: 'a queue) : bool =
begin match q.head, q.tail with
| None, None -> true
| Some qh, Some qt ->
begin match find_last_node qh with
| Some n -> qt == n
| None -> false
end
| _, _ -> false
end

(HW04) LinkedQueue: create an empty queue

let create () : 'a queue =
{ head = None;
tail = None }

(HW04) LinkedQueue: determine whether a queue is empty

let is_empty (q: 'a queue) : bool =
if not (valid q) then failwith "is_empty: given invalid queue";
q.head = None

(HW04) LinkedQueue: add an element to the tail of a queue

  let enq (elt: 'a) (q: 'a queue) : unit =
    if not (valid q) then failwith "enq: given invalid queue";
    let newnode = Some { v = elt; next = None } in
    begin match q.tail with
    | None ->
       (* Note that the invariant tells us that q.head is also None *)
       q.head <- newnode;
       q.tail <- newnode
    | Some n ->
       n.next <- newnode;
       q.tail <- newnode
    end

(HW04) LinkedQueue: remove an element from the head of the queue

  let deq (q: 'a queue) : 'a option =
    if not (valid q) then failwith "deq: given invalid queue";
    begin match q.head with
    | None ->
       None
    | Some n ->
       q.head <- n.next;
       begin match n.next with
       | None -> q.tail <- None; Some n.v
       | Some _ -> Some n.v
       end
    end

(HW04) LinkedQueue: retrieve the list of values ordered from head to tail

let to_list (q: 'a queue) : 'a list =
if not (valid q) then failwith "to_list: given invalid queue";
let rec loop (no: 'a qnode option) (l: 'a list) : 'a list =
begin match no with
| None -> List.rev l
| Some n -> loop n.next (n.v :: l)
end
in loop q.head []

(HW04) LinkedQueue: get the length of a queue

let length (q: 'a queue) : int =
if not (valid q) then failwith "length: given invalid queue";
let rec loop (no: 'a qnode option) (len: int) : int =
begin match no with
| None -> len
| Some n -> loop n.next (len + 1)
end
in loop q.head 0

(HW04) LinkedQueue: print out the contents of a queue

let rec print (q: 'a queue) (string_of_element: 'a -> string) : unit =
if not (valid q) then failwith "print: given invalid queue";
let rec loop (no: 'a qnode option) : unit =
begin match no with
| None -> ()
| Some n -> print_endline (string_of_element n.v); loop n.next
end
in
print_endline "--- queue contents ---";
loop q.head;
print_endline "--- end of queue -----"

(HW04) LinkedQueue: convert a list [v1; ...; vn] into a queue with v1 at the head (no List library)

let from_list (l: 'a list) : 'a queue =
let q = create () in
iter (fun x -> enq x q) l; q

(HW04) LinkedQueue: check whether a given element is in the queue using reference equality (==)

let contains (elt: 'a) (q: 'a queue) : bool =
if not (valid q) then failwith "contains: given invalid queue";
let rec loop (elt: 'a) (q: 'a qnode option) : bool =
begin match q with
| None -> false
| Some x -> elt == x.v || loop elt (x.next)
end
in
loop elt q.head

(HW04) LinkedQueue: truncate a queue in place after the first occurrence of an element (reference equality)

let truncate (elt: 'a) (q: 'a queue) : unit =
if not (valid q) then failwith "truncate: given invalid queue";
let rec loop (curr: 'a qnode option) : unit =
begin match curr with
| None -> ()
| Some n ->
if n.v == elt then (n.next <- None; q.tail <- Some n)
else loop n.next
end
in loop q.head

(HW04) LinkedQueue: delete all nodes containing elt in place (structural equality)

  let delete (elt: 'a) (q: 'a queue) : unit =
    if not (valid q) then failwith "delete: given invalid queue";
    let rec loop (prev: 'a qnode option) (curr: 'a qnode option) : unit = 
    begin match curr with
    | None -> q.tail <- prev
    | Some n -> 
      if n.v = elt then
        begin (match prev with
        | None -> q.head <- n.next
        | Some n1 -> n1.next <- n.next);
        loop prev n.next
        end
       else loop curr n.next
    end
  in loop None q.head

(HW04) Deque: node and deque types (doubly linked)

type 'a dqnode = {
v: 'a;
mutable next: 'a dqnode option;
mutable prev: 'a dqnode option;
}

type 'a deque = {
mutable head: 'a dqnode option;
mutable tail: 'a dqnode option;
}

(HW04) Deque: deque invariant

Either the deque is empty (head and tail both None), or head = Some n1 and tail = Some n2 where:
(a) n2 is reachable from n1 by following 'next'
(b) n2.next = None
(c) n1 is reachable from n2 by following 'prev'
(d) n1.prev = None
and for every node n:
(e) if n.next = Some m then m.prev = Some n
(f) if n.prev = Some m then m.next = Some n

(HW04) Deque: helper to check whether a dqnode is aliased in a list of dqnodes

let alias (x: 'a dqnode) : 'a dqnode list -> bool =
List.fold_left (fun acc h -> x == h || acc) false

(HW04) Deque: return an empty deque

let create () : 'a deque =
{ head = None; tail = None }

(HW04) Deque: build a valid deque of length 2

let deque_12 () : int deque =
let n1 = { v = 1; prev = None; next = None } in
let n2 = { v = 2; prev = Some n1; next = None } in
n1.next <- Some n2;
{ head = Some n1; tail = Some n2 }

(HW04) Deque: why valid deques of length >= 2 always have cycles

Following next then prev pointers gets you back where you started, so valid deques with length >= 2 ALWAYS have cycles, whereas ordinary queues with cycles are invalid.

(HW04) Deque: an invalid deque that does not contain any cycles

let invalid_acyclic () : int deque =
let n1 = { v = 1; prev = None; next = None } in
{ head = Some n1; tail = None }

(HW04) Deque: an invalid deque that does contain a cycle

let cycle () : int deque =
let n1 = { v = 1; prev = None; next = None } in
n1.next <- Some n1;
{ head = Some n1; tail = Some n1 }

(HW04) Deque: return a list of elements from head to tail in one tail-recursive pass (no @ or List.rev)

let to_list (q: 'a deque) : 'a list =
if not (valid q) then failwith "to_list: given invalid deque";
let rec loop (curr : 'a dqnode option) (acc: 'a list) : 'a list =
begin match curr with
| None -> acc
| Some n -> loop n.prev (n.v::acc)
end
in loop q.tail []

(HW04) Deque: add an element to the head of a deque in place

let insert_head (x: 'a) (q: 'a deque) : unit =
if not (valid q) then failwith "insert_head: given invalid deque";
begin match q.head with
| None ->
let n = { v = x; prev = None; next = None } in
q.head <- Some n;
q.tail <- Some n
| Some h ->
let n = { v = x; prev = None; next = Some h } in
h.prev <- Some n;
q.head <- Some n
end

(HW04) Deque: add an element to the tail of a deque in place

let insert_tail (x: 'a) (q: 'a deque) : unit =
if not (valid q) then failwith "insert_tail: given invalid deque";
begin match q.tail with
| None ->
let n = { v = x; prev = None; next = None } in
q.head <- Some n;
q.tail <- Some n
| Some t ->
let n = { v = x; prev = Some t; next = None } in
t.next <- Some n;
q.tail <- Some n
end

(HW04) Deque: remove and return the first element (fails if empty)

let remove_head (q: 'a deque) : 'a =
if not (valid q) then failwith "remove_head: given invalid deque";
begin match q.head with
| None -> failwith "remove_head: no items to delete"
| Some h ->
begin match h.next with
| None -> q.head <- None; q.tail <- None
| Some m -> m.prev <- None; q.head <- Some m
end;
h.v
end

(HW04) Deque: remove and return the last element (fails if empty)

let remove_tail (q: 'a deque) : 'a =
if not (valid q) then failwith "remove_tail: given invalid deque";
begin match q.tail with
| None -> failwith "remove_tail: no items to delete"
| Some t ->
begin match t.prev with
| None -> q.head <- None; q.tail <- None
| Some m -> m.next <- None; q.tail <- Some m
end;
t.v
end

(HW04) Deque: helper to unlink a given node from the deque

let remove_node (n: 'a dqnode) (q: 'a deque) : unit =
begin match n.prev, n.next with
| None, None -> q.head <- None; q.tail <- None
| None, Some nx -> nx.prev <- None; q.head <- Some nx
| Some pv, None -> pv.next <- None; q.tail <- Some pv
| Some pv, Some nx -> pv.next <- Some nx; nx.prev <- Some pv
end

(HW04) Deque: delete the last (nearest the tail) occurrence of an element (structural equality)

let delete_last (v: 'a) (q: 'a deque) : unit =
if not (valid q) then failwith "delete_last: given invalid deque";
let rec loop (curr: 'a dqnode option) : unit =
begin match curr with
| None -> ()
| Some n -> if n.v = v then remove_node n q else loop n.prev
end
in loop q.tail

(HW04) Deque: delete the first (nearest the head) occurrence of an element (structural equality)

let delete_first (v: 'a) (q: 'a deque) : unit =
if not (valid q) then failwith "delete_first: given invalid deque";
let rec loop (curr: 'a dqnode option) : unit =
begin match curr with
| None -> ()
| Some n -> if n.v = v then remove_node n q else loop n.next
end
in loop q.head

(HW04) Deque: reverse the deque in place (same nodes)

let reverse (q: 'a deque) : unit =
if not (valid q) then failwith "reverse: given invalid deque";
let rec loop (curr: 'a dqnode option) : unit =
begin match curr with
| None -> ()
| Some n ->
let old_next = n.next in
n.next <- n.prev;
n.prev <- old_next;
loop old_next
end
in
loop q.head;
let old_head = q.head in
q.head <- q.tail;
q.tail <- old_h

(HW03) tree.ml: generic binary tree type and leaf helper

type 'a tree =
| Empty
| Node of 'a tree * 'a * 'a tree

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

(HW03) tree.ml: height of a tree

let rec height (t: 'a tree) : int =
begin match t with
| Empty -> 0
| Node (lt, x, rt) -> 1 + max (height lt) (height rt)
end

(HW03) tree.ml: determine whether a tree is perfect

let rec is_perfect (t: 'a tree) : bool =
begin match t with
| Empty -> true
| Node (lt, x, rt) -> height lt = height rt && is_perfect lt && is_perfect rt
end

(HW03) tree.ml: maximum value in a tree (fails on empty)

let rec tree_max (t: 'a tree) : 'a =
begin match t with
| Empty -> failwith "tree_max: called on empty tree"
| Node (lt, x, rt) ->
begin match (lt, rt) with
| Empty, Empty -> x
| Empty, Node _ -> max x (tree_max rt)
| Node _, Empty -> max x (tree_max lt)
| Node _, Node _ -> max x (max (tree_max lt) (tree_max rt))
end
end

(HW03) tree.ml: BST lookup

let rec lookup (x: 'a) (t: 'a tree) : bool =
begin match t with
| Empty -> false
| Node (lt, n, rt) -> x = n || (if x < n then lookup x lt else lookup x rt)
end

(HW03) tree.ml: inorder traversal into a list

let rec inorder (t: 'a tree) : 'a list =
begin match t with
| Empty -> []
| Node (lt, x, rt) -> inorder lt @ [x] @ inorder rt
end

(HW03) tree.ml: BST insert (no duplicates)

let rec insert (x: 'a) (t: 'a tree) : 'a tree =
begin match t with
| Empty -> Node (Empty, x, Empty)
| Node (lt, n, rt) -> if x = n then t
else if x > n then Node (lt, n, insert x rt)
else Node (insert x lt, n, rt)
end

(HW03) tree.ml: number of nodes in a tree

let rec size (t: 'a tree) : int =
begin match t with
| Empty -> 0
| Node (lt, _, rt) -> 1 + size lt + size rt
end

(HW03) tree.ml: build a BST from a list

let rec tree_of_list (l: 'a list) : 'a tree =
begin match l with
| [] -> Empty
| x::rest -> insert x (tree_of_list rest)
end

(HW03) tree.ml: BST delete (replace with max of left subtree)

let rec delete (x: 'a) (t: 'a tree) : 'a tree =
begin match t with
| Empty -> Empty
| Node (lt, n, rt) ->
if x = n then
begin match (lt, rt) with
| (Empty, Empty) -> Empty
| (Node _, Empty) -> lt
| (Empty, Node _) -> rt
| _ ->
let m = tree_max lt in
Node (delete m lt, m, rt)
end
else if x > n then Node (lt, n, delete x rt)
else Node (delete x lt, n, rt)
end

(HW03) higherOrder.ml: is an int in an int list

let rec int_member (i: int) (l: int list) : bool =
begin match l with
| [] -> false
| x :: xs -> i = x || int_member i xs
end

(HW03) higherOrder.ml: is a string in a string list

let rec string_member (s: string) (l: string list) : bool =
begin match l with
| [] -> false
| x :: xs -> s = x || string_member s xs
end

(HW03) higherOrder.ml: generic member

let rec member (x: 'a) (l: 'a list) : bool =
begin match l with
| [] -> false
| y :: ys -> y = x || member x ys
end

(HW03) higherOrder.ml: assoc, look up a key in an association list (fails if missing)

let rec assoc (key: 'k) (l: ('k * 'v) list) : 'v =
begin match l with
| [] -> failwith "assoc: key not found"
| (k, v) :: rest -> if k = key then v else assoc key rest
end

(HW03) higherOrder.ml: transform (map) a function over a list

let rec transform (f: 'a -> 'b) (l: 'a list) : 'b list =
begin match l with
| [] -> []
| x :: xs -> f x :: transform f xs
end

(HW03) higherOrder.ml: capitalize every string in a list

let capitalize (l: string list) : string list =
transform String.uppercase_ascii l

(HW03) higherOrder.ml: fold

let rec fold (combine: 'a -> 'b -> 'b) (base: 'b) (l: 'a list) : 'b =
begin match l with
| [] -> base
| x :: xs -> combine x (fold combine base xs)
end

(HW03) higherOrder.ml: sum using fold

let sum (l: int list) : int =
fold (fun x acc -> x + acc) 0 l

(HW03) higherOrder.ml: list_length using fold

let list_length (l: 'a list) : int =
fold (fun _ acc -> 1 + acc) 0 l

(HW03) higherOrder.ml: concat a list of lists using fold

let concat (l: 'a list list) : 'a list =
fold (@) [] l

(HW03) higherOrder.ml: reverse using fold

let reverse (l: 'a list) : 'a list =
fold (fun x acc -> acc @ [x]) [] l

(HW03) higherOrder.ml: for_all using fold

let for_all (pred: 'a -> bool) (l: 'a list) : bool =
fold (fun x acc -> pred x && acc) true l

(HW03) higherOrder.ml: exists using fold

let exists (pred: 'a -> bool) (l: 'a list) : bool =
fold (fun x acc -> pred x || acc) false l

(HW03) higherOrder.ml: filter (recursive)

let rec filter (pred: 'a -> bool) (l: 'a list) : 'a list =
begin match l with
| [] -> []
| x :: xs ->
let rest = filter pred xs in
if pred x then x :: rest else rest
end

(HW03) higherOrder.ml: filter rewritten using fold

let ho_filter (pred: 'a -> bool) (l: 'a list) : 'a list =
fold (fun x acc -> if pred x then x :: acc else acc) [] l

(HW03) listSet.ml (OrderedListSet): representation and invariant

type 'a set = 'a list
(* sorted in ascending order, no duplicates *)

let empty : 'a set = []

let is_empty (s: 'a set) : bool =
s = empty

(HW03) listSet.ml (OrderedListSet): list_of_set using the invariant

let list_of_set (s: 'a set) : 'a list =
s

(HW03) listSet.ml (OrderedListSet): add while keeping sorted with no duplicates (no List.sort)

let rec add (x: 'a) (s: 'a set) : 'a set =
begin match s with
| [] -> [x]
| y :: ys ->
if x = y then s
else if x < y then x :: s
else y :: add x ys
end

(HW03) listSet.ml (OrderedListSet): remove with short-circuiting

let rec remove (x: 'a) (s: 'a set) : 'a set =
begin match s with
| [] -> []
| y::ys -> if x = y then ys
else if x < y then s
else y :: remove x ys
end

(HW03) listSet.ml (OrderedListSet): member using fold

let member (x: 'a) (s: 'a set) : bool =
fold (fun y acc -> y = x || acc) false s

(HW03) listSet.ml (OrderedListSet): size using fold

let size (s: 'a set) : int =
fold (fun _ acc -> 1 + acc) 0 s

(HW03) listSet.ml (OrderedListSet): equals using the invariants

let equals (s: 'a set) (t: 'a set) : bool =
s = t

(HW03) listSet.ml (OrderedListSet): set_of_list without explicit recursion

let set_of_list (l: 'a list) : 'a set =
fold (fun x acc -> add x acc) empty l

(HW03) treeSet.ml (BSTSet): representation, empty, is_empty

type 'a set = 'a tree

let empty : 'a set = Empty

let is_empty (s: 'a set) : bool =
s = empty

(HW03) treeSet.ml (BSTSet): list_of_set

let rec list_of_set (s: 'a set) : 'a list =
inorder s

(HW03) treeSet.ml (BSTSet): add and remove

let add (x: 'a) (s: 'a set) : 'a set =
insert x s

let remove (x: 'a) (s: 'a set) : 'a set =
delete x s

(HW03) treeSet.ml (BSTSet): size

let rec size (s: 'a set) : int =
begin match s with
| Empty -> 0
| Node (lt, _, rt) -> 1 + size lt + size rt
end

(HW03) treeSet.ml (BSTSet): equals (same elements, structure may differ)

let equals (s: 'a set) (t: 'a set) : bool =
list_of_set s = list_of_set t

(HW03) treeSet.ml (BSTSet): set_of_list

let set_of_list (l: 'a list) : 'a set =
tree_of_list l

(HW03) vocab.ml: convert each text into a set of words

let texts () : (string * string set) list =
transform (fun (a, b) -> (a, set_of_list b)) texts_as_lists

(HW03) vocab.ml: count elements of a list satisfying a predicate

let count_if (pred: 'a -> bool) (l: 'a list) : int =
let filtered = filter (pred) l in
list_length filtered