Added series 6,

funclang-taddeus/series6/ass12.ml

+type monop = Neg | Not
+type binop = Add | Sub | Mul | Div | Mod    (* arithmetic operators *)
+           | Eq | Ne | Lt | Le | Gt | Ge    (* relational operators *)
+           | And | Or                       (* logic operators *)
+type expr = Num of int                      (* integer constant *)
+          | Bool of bool                    (* boolean constant *)
+          | Var of string                   (* variable *)
+          | MonopAp of monop * expr         (* unary operator application *)
+          | BinopAp of binop * expr * expr  (* binary operator application *)
+          | Cond of expr * expr * expr      (* conditional expression *)
+          | Fun of string * expr            (* function abstraction *)
+          | FunAp of expr * expr            (* function application *)
+          | Let of string * expr * expr     (* variable binding *)
+          | LetRec of string * expr * expr  (* recursive variable binding *)
+
+(* Convert a given expression to a string representation. I think the code is
+ * self-explanatory and therefore needs no more documentation *)
+let rec expr2string =
+    let monop2string = function
+          Neg -> "-"
+        | Not -> "not "
+    in
+    let binop2string = function
+          Add -> "+"
+        | Sub -> "-"
+        | Mul -> "*"
+        | Div -> "/"
+        | Mod -> "mod"
+        | Eq -> "="
+        | Ne -> "!="
+        | Lt -> "<"
+        | Le -> "<="
+        | Gt -> ">"
+        | Ge -> ">="
+        | And -> "&&"
+        | Or -> "||"
+    in
+    function
+      Num i -> string_of_int i
+    | Bool b -> string_of_bool b
+    | Var v -> v
+    | MonopAp (op, e) -> monop2string(op) ^ expr2string(e)
+    | BinopAp (op, e1, e2) -> expr2string(e1) ^ " " ^ binop2string(op)
+                              ^ " " ^ expr2string(e2)
+    | Cond (cond, e1, e2) -> "if " ^ expr2string(cond)
+                             ^ " then " ^ expr2string(e1)
+                             ^ " else " ^ expr2string(e2)
+    | Fun (arg, e) -> "fun " ^ arg ^ " -> " ^ expr2string(e)
+    | FunAp (e1, e2) ->
+        (* Add parenthesis around argument when it contains spaces. I'm not
+         * sure if this is required in this implementation, but I found that is
+         * is tidy when trying to represent OCaml syntax (see the 'fac'
+         * function in 'test_expr.ml') *)
+        let eval_e2 = expr2string(e2) in
+        let eval_e2 = (if (String.get eval_e2 0) != '('
+                          && String.contains eval_e2 ' '
+                       then "(" ^ eval_e2 ^ ")" else eval_e2) in
+        "(" ^ expr2string(e1) ^ " " ^ eval_e2 ^ ")"
+    | Let (var, e1, e2) -> "let " ^ var ^ " = " ^ expr2string(e1)
+                           ^ " in " ^ expr2string(e2)
+    | LetRec (var, e1, e2) -> "let rec " ^ var ^ " = " ^ expr2string(e1)
+                              ^ " in " ^ expr2string(e2)
+
+(* Find all free variables within an expression. Where no rules apply,
+ * concatenat the free variables of all sub-expressions *)
+let freevars e =
+    let rec free_vars bound_vars = function
+          Num _ | Bool _ -> []
+        | Var v when List.mem v bound_vars -> []
+        (* FV(x) = {x} *)
+        | Var v -> [v]
+        | MonopAp (_, e) -> free_vars bound_vars e
+        | BinopAp (_, e1, e2)
+        (* FV((e1 e2)) = FV(e1) UNION FV(e2) *)
+        | FunAp (e1, e2) -> free_vars bound_vars e1 @ free_vars bound_vars e2
+        | Cond (cond, e1, e2) -> free_vars bound_vars cond
+                                 @ free_vars bound_vars e1
+                                 @ free_vars bound_vars e2
+        (* FV(lamda x.e) = FV(e) \ {x} *)
+        | Fun (arg, e) -> free_vars (arg::bound_vars) e
+        | Let (v, e1, e2) -> free_vars (v::bound_vars) e2
+                             @ free_vars bound_vars e1
+        | LetRec (v, e1, e2) -> let bound = v::bound_vars in
+                                free_vars bound e2 @ free_vars bound e1
+    in
+    free_vars [] e
+
+(* Substitue all occurences of y by a in exp using the substitution rules
+ * provided in the lecture.
+ * NOTE: I have decided to resolve name clashes here instead of in the eval
+ * function of assignment 13. The reason for this is that both in the lecture
+ * and in lambda calculus wiki's on the internet, name clashes are resolved by
+ * applying the substution rule that I've implemented in lines 112-120 below.
+ * This function is called 'subs', so it should implement this substitution
+ * rule *)
+let rec subs exp y a = match exp with
+      Var x when x = y -> a
+    (* substitute in operator arguments *)
+    | MonopAp (op, e) -> MonopAp (op, subs e y a)
+    | BinopAp (op, e1, e2) -> BinopAp (op, subs e1 y a, subs e2 y a)
+    (* (lambda y.e)[a/x] --> lambda y.e
+     * if y = x *)
+    | Fun (x, _) when x = y -> exp
+    (* (lambda y.e)[a/x] --> lambda w.(e[w/y][a/x])
+     * if y != x, x free in e, y free in a, new variable w
+     * lambda y.(e[a/x])
+     * otherwise *)
+    | Fun (x, e) ->
+        let free_a = freevars a in
+        let free_e = freevars e in
+        if List.mem y free_e && List.mem x free_a then
+            (* Replace x with a new variable w to avoid a name clash *)
+            let all_free_vars = free_a @ free_e in
+            (* Add primes to the new variable until it is free *)
+            let rec add_prime x =
+                let new_x = x ^ "'" in
+                if List.mem new_x all_free_vars then add_prime x else new_x
+            in
+            let w = add_prime x in
+            Fun (w, subs (subs e x (Var w)) y a)
+        else
+            Fun (x, subs e y a)
+    (* (e e')[a/x] --> (e[a/x])(e'[a/x]) *)
+    | FunAp (e1, e2) -> FunAp (subs e1 y a, subs e2 y a)
+    (* Conditional expression has no substirution rules, just substitute in all
+     * sub-expressions recursively *)
+    | Cond (cond, e1, e2) ->  Cond (subs cond y a, subs e1 y a, subs e2 y a)
+    (* Only substitue in a 'let'/'let rec' expression if there is no name clash
+     * with the assigned variable *)
+    | Let (x, e1, e2) when x != y -> Let (x, subs e1 y a, subs e2 y a)
+    | LetRec (x, e1, e2) when x != y -> LetRec (x, subs e1 y a, subs e2 y a)
+    (* No substitition rule applies, just return the expression *)
+    | _ -> exp

funclang-taddeus/series6/ass14.ml

+(* Assumption: Set elements are unique, so no two elements in a single
+ *             set have the same value. *)
+
+type 'a set = Set of 'a list
+
+(* Create an empty set *)
+let emptySet = Set([])
+
+(* Delete an element from a set (if it does not exists in it yet)
+ * and return the new set with the element *)
+let addElem elem set = match set with
+      Set ([]) -> Set([elem])
+    | Set (l) -> if List.mem elem l then set else Set(elem::l)
+
+(* Delete an element from a set (if it exists in it) and return
+ * the new set without the element *)
+let delElem elem set =
+    let rec delFromList elem = function
+          [] -> []
+        | h::t -> if h = elem then t else h::(delFromList elem t)
+    in match set with
+      Set ([]) -> set
+    | Set (l) -> Set(delFromList elem l)
+
+(* Check if an element exists in a set *)
+let isElem elem = function Set (l) -> List.mem elem l
+
+(* Get the union of sets a and b as a new set *)
+let union a b =
+    match a with
+      Set ([]) -> b
+    | Set(la) -> match b with
+          Set ([]) -> a
+        | Set(lb) ->
+            Set(la @ List.filter (fun e -> not (List.mem e la)) lb)
+
+(* Get the intersection of sets a and b as a new set *)
+let intersection a b =
+    match a with
+      Set ([]) -> a
+    | Set(la) -> match b with
+          Set ([]) -> b
+        | Set(lb) -> 
+            let b_in_a = List.filter (fun e -> List.mem e la) lb in
+            Set(List.filter (fun e -> List.mem e lb) b_in_a)
+
+(* Some tests *)
+let a = emptySet;;
+let a = addElem 2 a;;
+let a = addElem 8 a;;
+let a = addElem 3 a;;
+let a = addElem 7 a;;
+let a = addElem 1 a;; (* 2, 8, 3, 7, 1 *)
+
+isElem 7 a;; (* true *)
+isElem 5 a;; (* false *)
+
+let b = delElem 5 a;;
+
+let b = delElem 1 a;;
+let b = delElem 7 b;;
+let b = addElem 9 b;;
+let b = addElem 0 b;; (* 0, 9, 3, 8, 2 *)
+
+union a b;; (* 1, 7, 3, 8, 2, 0, 9 *)
+intersection a b;; (* 3, 8, 2 *)
\ No newline at end of file

funclang-taddeus/series6/ass15.txt

+I will give the algorithmic complexity of each of my function
+implementations, and briefly discuss how I derived them.
+
+emptySet:
+O(1). The function always yields an empty set and takes no arguments.
+
+addElem:
+The same complexity as the List.mem function, which I assume to be O(n)
+(n is the number of elements in the set). The function first has to check
+if the element is already in the list, for which it uses List.mem. If the
+element is not found in the set, it is prepended to it, which is an O(1)
+operation.
+
+delElem:
+O(n). The set (of size n) is looped through to find the item. In the worst
+case, the element is not in the list so that the function has to loop through
+all of the items in the set.
+
+isElem:
+The same complexity as the List.mem function, which I assume to be O(n).
+Regarding the simplicity of the implementation, i assume that my reasoning
+is self-explanatory here.
+
+union:
+O(n * m), given n = size(a) and m = size(b). The function loops through the
+entire set b (m iterations). For each iteration, the List.mem function is used
+on a (O(n)). Together, this gives O(n * m).
+
+intersection:
+O(n * m + m^2). First b_in_a is calculated, which is O(n * m) (see 'union' above).
+Given that x = size(b_in_a), the part that filters elements from b_in_a that are
+not in b is O(x * m). In worst case, x = m, resulting in:
+O(n * m + x * m) = O(n * m + m^2).
\ No newline at end of file

funclang-taddeus/series6/ass16.ml

+module type SET =
+sig
+    type 'a set
+    val emptySet : 'a set
+    val addElem : 'a -> 'a set -> 'a set
+    val delElem : 'a -> 'a set -> 'a set
+    val isElem : 'a -> 'a set -> bool
+    val union : 'a set -> 'a set -> 'a set
+    val intersection : 'a set -> 'a set -> 'a set
+end
+
+module Set : SET =
+struct
+    type 'a set = Set of 'a list
+
+    (* Create an empty set *)
+    let emptySet = Set([])
+
+	(* Delete an element from a set (if it does not exists in it yet)
+     * and return the new set with the element *)
+    let addElem elem set = match set with
+          Set ([]) -> Set([elem])
+        | Set (l) -> if List.mem elem l then set else Set(elem::l)
+
+    (* Delete an element from a set (if it exists in it) and return
+     * the new set without the element *)
+    let delElem elem set =
+        let rec delFromList elem = function
+              [] -> []
+            | h::t -> if h = elem then t else h::(delFromList elem t)
+        in match set with
+          Set ([]) -> set
+        | Set (l) -> Set(delFromList elem l)
+
+    (* Check if an element exists in a set *)
+    let isElem elem = function Set (l) -> List.mem elem l
+
+    (* Get the union of sets a and b as a new set *)
+    let union a b =
+        match a with
+          Set ([]) -> b
+        | Set(la) -> match b with
+              Set ([]) -> a
+            | Set(lb) ->
+                Set(la @ List.filter (fun e -> not (List.mem e la)) lb)
+
+    (* Get the intersection of sets a and b as a new set *)
+    let intersection a b =
+        match a with
+          Set ([]) -> a
+        | Set(la) -> match b with
+              Set ([]) -> b
+            | Set(lb) -> 
+                let b_in_a = List.filter (fun e -> List.mem e la) lb in
+                Set(List.filter (fun e -> List.mem e lb) b_in_a)
+end

funclang-taddeus/series6/ass17.ml

+#use "ass12.ml"
+
+(* Perform all possible beta-reductions using Normal order on an expression
+ * until the normal form has been reached
+ * 
+ * I used my solution of assignment 13 which actually already used normal
+ * order. however in this assignment, it is supposed to. *)
+let rec eval exp =
+    let eval_monop = function
+          (Neg, Num i) -> Num (-i)
+        | (Not, Bool b) -> Bool (not b)
+        | _ -> raise (Failure "Unknown unary operator")
+    in
+    let eval_binop = function
+          (op, Num a, Num b) ->
+            (* Arithmethic or relational operation is possible on numbers *)
+            (match op with
+              Add -> Num (a + b)
+            | Sub -> Num (a - b)
+            | Mul -> Num (a * b)
+            | Div -> Num (a / b)
+            | Mod -> Num (a mod b)
+            | Eq -> Bool (a = b)
+            | Ne -> Bool (a != b)
+            | Lt -> Bool (a < b)
+            | Le -> Bool (a <= b)
+            | Gt -> Bool (a > b)
+            | Ge -> Bool (a >= b)
+            | _ -> raise (Failure "Unknown arithmetic/relational operator"))
+        | (op, Bool a, Bool b) ->
+            (* Locical operation is possible on booleans *)
+            (match op with
+              And -> Bool (a && b)
+            | Or -> Bool (a || b)
+            | _ -> raise (Failure "Unknown locical operator"))
+        (* No operation is possible on a variable and a number/boolean *)
+        | (op, e1, e2) -> BinopAp (op, eval e1, eval e2)
+    in
+    match exp with
+      MonopAp (op, e) -> eval_monop (op, eval e)
+    | BinopAp (op, e1, e2) -> eval_binop (op, e1, e2)
+    | Fun (x, e) -> Fun (x, eval e)
+    | FunAp (Fun (x, Var y), a) when y = x ->
+        (* Applied identity function, evaluates to application argument *)
+        eval a
+    | FunAp (Fun (y, e), a) ->
+        (* Function application, substitute function argument with
+         * application argument in function body. Prevent recursion by
+         * comparing the result with the original expression *)
+        let result = (subs e y a) in
+        if result = exp then result else eval result
+    | FunAp (e1, e2) ->
+        (* Expression application, evaluate both sides. Prevent recursion by
+         * comparing the result with the original expression *)
+        let result = FunAp (eval e1, eval e2) in
+        if result = exp then result else eval result
+    | Cond (cond, e1, e2) ->
+        (* If the condition evaluates to a boolean, choose the corresponding
+         * conditional expression *)
+        (match eval cond with
+          Bool b -> if b then eval e1 else eval e2
+        | c -> Cond (c, eval e1, eval e2))
+    | Let (x, e1, e2) -> eval (subs e2 x e1)
+    | LetRec (x, e1, e2) -> LetRec (x, eval e1, eval e2)
+    | _ -> exp