Merge branch 'master' of ssh://vo20.nl/git/uva

funcprog/week4/week4.ml

+(* Sort the list in ascending order using quicksort. *)
+let rec quickSort (l: int list) = match l with
+    | [] -> []
+    | pivot::tail -> let left, right = List.partition (fun x -> x < pivot) tail
+    in quickSort left @ [pivot] @ quickSort right
+;;
+
+Printf.printf "8.1: %b\n" ((=)(quickSort [4;3;1;2]) [1;2;3;4])
+
+(* Sort the list in ascending order using merge sort. *)
+let rec mergeSort (l: int list) = match l with
+    | [] | [_] -> l
+    | _ ->
+    (* Split the lists into lists of length one (which are sorted by
+     * definition), and repeatedly merge the lists together. *)
+    let rec merge a b = match a, b with
+        | [], _ -> b
+        | _, [] -> a
+        | ha::ta, hb::tb when ha < hb -> ha::(merge ta b)
+        | ha::ta, hb::tb              -> hb::(merge a tb)
+    (* Split the list "equally" in two parts: left and right. *)
+    in let rec split left right len = match left, len with
+        | [], _ | _, 0 -> (left, right)
+        | h::t, _ -> split t (h::right) (len - 1)
+    in let left, right = split l [] ((List.length l) / 2)
+    (* Recursively merge the left and right sorted lists. *)
+    in merge (mergeSort left) (mergeSort right)
+;;
+
+Printf.printf "8.2: %b\n" ((=)(mergeSort [4;3;1;2]) [1;2;3;4])
+
+(* --- Assignment 9 --- *)
+
+(* A trie node has a key, a value and a list of children. *)
+type ('a, 'b) trie = Empty | Node of 'a list * 'b * ('a, 'b) trie list
+
+(* Helper functions, Return a list, cutoff at the node where the key equals
+ * elem. *)
+let rec front_of_lst lst elem = match lst with
+    | [] -> Empty
+    | t::h -> match t with
+        | Empty | Node([], _,_) -> Empty
+        | Node(c::d, _, _) when c == elem -> t
+        | Node(c::d, _, _) -> front_of_lst h elem
+;;
+
+(* Helper function, changes the value in a node to v. *)
+let change_node_value node v = match node with
+    | Empty -> raise (Failure "Empty Node")
+    | Node(a,b,lst) -> Node(a,v,lst)
+;;
+
+(* Helper function: given a list of nodes, remove given node from the list and
+ * return the modified list. *)
+let rec remove_node lst n =
+    let a = List.hd lst
+    in let b = List.tl lst
+    in match a, n with
+        | Empty, _ -> [a] @ remove_node b n
+        | Node([], g, h), _ -> [a]
+        | Node(t::l, g, h), Empty -> [a] @ remove_node b n
+        | Node(t::l, g, h), Node(tt::ll, _, _) when t == tt -> remove_node b n
+        | Node(t::l, g, h), Node(_, _, _) -> [a] @ remove_node b n
+;;
+
+(* Insert a node into the trie. *)
+let rec insert trie k v =
+    match trie, k with
+    | Empty, [] -> Node([], None, [])
+    | Empty, _ -> insert (Node([], None, [])) k v
+    | Node(a, b, lst), [] -> trie
+    | Node(a, b, lst), c::d ->
+    let found = front_of_lst lst c in match d, found with
+        | [], Empty -> Node(a, b, lst @ [Node([c], Some v, [])])
+        | [], _     -> Node(a, b, (remove_node lst found)
+                       @ [(change_node_value found (Some v))])
+        | _, Empty  -> Node(a, b, lst @ [insert (Node([c], None, [])) d v])
+        | _, _      -> Node(a, b, [insert found d v] @ (remove_node lst found))
+;;
+
+(* Helper function: check if a node equals the given part of the key in a list
+ * of nodes. *)
+let rec check lst k = match lst, k with
+| [], _ -> Empty
+| Node(a, _, _)::b, k when a = [k] -> List.hd lst
+| a::b, k -> check b k
+;;
+
+(* Remove a value from the trie. The value is replaced by None. *)
+let rec remove trie k = match trie, k with
+    | Empty, _ -> trie
+    | Node(a,b,lst), [] -> change_node_value trie None
+    | Node(a,b,lst), h::t ->
+    let in_list = check lst h in match in_list with
+        | Empty -> trie
+        | _ -> Node(a,b, [remove in_list t] @ (remove_node lst in_list))
+;;
+
+(* Returns the value that is associated with the key. *)
+(* type 'a option = Some of 'a | None *)
+let rec lookup trie k = match trie, k with
+    | Empty,_ -> None
+    | Node(a,b,lst),[] -> b
+    | Node(a,b,lst),h::t ->
+    let in_list = check lst h in match in_list with
+        | Empty -> None
+        | _ -> lookup in_list t
+;;
+
+(* --- Assignment 10 --- *)
+
+(* I explicitly replaced the following names given in the assignment, because
+ * the original name were unclear or wrong:
+ * - "rel_op" -> "equal_op", since these operators express (in)equality.
+ * - "mon_op" -> "unary_op", since these operators are unary (one parameter).
+ * - "bin_op" -> "binary_op", for consistency with unary_op. *)
+type arith_op = Plus | Minus | Times | Divide | Modulo
+type equal_op = Eq | Neq | Lt | Lte | Gt | Gte
+type logic_op = And | Or
+type unary_op = Negation | Not
+type const = BoolConst of bool | IntConst of int
+
+type binary_op =
+| ArithOp of arith_op
+| EqualOp of equal_op
+| LogicOp of logic_op
+;;
+
+type expr =
+| Enclosure of expr
+| BinaryOp of expr * binary_op * expr
+| UnaryOp of unary_op * expr
+| Id of string
+| Const of const
+;;
+
+let eval_arith_op = function
+| Plus -> "+"
+| Minus -> "-"
+| Times -> "*"
+| Divide -> "/"
+| Modulo -> "mod"
+;;
+
+let eval_equal_op = function
+| Eq -> "="
+| Neq -> "!="
+| Lt -> "<"
+| Lte -> "<="
+| Gt -> ">"
+| Gte -> ">="
+;;
+
+let eval_logic_op = function
+| And -> "&&"
+| Or -> "||"
+;;
+
+let eval_unary_op = function
+| Negation -> "-"
+| Not -> "not"
+;;
+
+let eval_const = function
+| IntConst i -> string_of_int i
+| BoolConst b -> string_of_bool b
+;;
+
+let eval_binary_op = function
+| ArithOp op -> eval_arith_op(op)
+| EqualOp op -> eval_equal_op(op)
+| LogicOp op -> eval_logic_op(op)
+;;
+
+let rec eval = function
+| Enclosure e -> "(" ^ eval(e) ^ ")"
+| BinaryOp (e1, op, e2) -> eval(e1) ^ " " ^ eval_binary_op(op) ^ " " ^ eval(e2)
+| UnaryOp (op, e) -> eval_unary_op(op) ^ eval(e)
+| Id id -> id
+| Const c -> eval_const(c)
+;;