Skip to content

U
uva
Commit e074b980 authored by Taddeus Kroes's avatar Taddeus Kroes
Browse files
Options

Added series 6,

parent bda428c4
Hide whitespace changes
Inline Side-by-side
Showing with 353 additions and 0 deletions
funclang-taddeus/series6/ass12.ml 0 → 100644
View file @ e074b980
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 0 → 100644
View file @ e074b980
(* 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 0 → 100644
View file @ e074b980
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 0 → 100644
View file @ e074b980
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 0 → 100644
View file @ e074b980
#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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment