Fold A Binary Tree in Order, Calculate the Sum of a Tree, Abstract Syntax Trees Ocaml Assignment Solution

Instructions

Objective

Write a program to fold a binary tree in order, calculate the sum of a tree, abstract syntax trees Ocaml assignment solution.

Requirements and Specifications

This is a program to fold a binary tree in order, calculate the sum of a tree, abstract syntax trees Ocaml using various tree manipulation techniques and also many abstract syntaxes.

Screenshots of output

Source Code

Eval.ml

open Ast exception TypeError exception UndefinedVar exception DivByZeroError (* Remove shadowed bindings *) let prune_env (env : environment) : environment = let binds = List.sort_uniq compare (List.map (fun (id, _) -> id) env) in List.map (fun e -> (e, List.assoc e env)) binds (* Env print function to stdout *) let print_env_std (env : environment): unit = List.iter (fun (var, value) -> let vs = match value with | Int_Val(i) -> string_of_int i | Bool_Val(b) -> string_of_bool b in Printf.printf "- %s => %s\n" var vs) (prune_env env) (* Env print function to string *) let print_env_str (env : environment): string = List.fold_left (fun acc (var, value) -> let vs = match value with | Int_Val(i) -> string_of_int i | Bool_Val(b) -> string_of_bool b in acc ^ (Printf.sprintf "- %s => %s\n" var vs)) "" (prune_env env) (***********************) (****** Your Code ******) (***********************) (* evaluate an expression in an environment *) let rec eval_expr (e : exp) (env : environment) : value = let makeIOp e1 e2 f = match (eval_expr e1 env, eval_expr e2 env) with | (Int_Val a, Int_Val b) -> Int_Val (f a b) | _ -> raise TypeError in let makeBOp e1 e2 f = match (eval_expr e1 env, eval_expr e2 env) with | (Bool_Val a, Bool_Val b) -> Bool_Val (f a b) | _ -> raise TypeError in match e with | Var s -> if List.mem_assoc s env then List.assoc s env else raise UndefinedVar | Number n -> Int_Val n | True -> Bool_Val true | False -> Bool_Val false | Plus (e1, e2) -> makeIOp e1 e2 (fun x y -> x + y) | Minus (e1, e2) -> makeIOp e1 e2 (fun x y -> x - y) | Times (e1, e2) -> makeIOp e1 e2 (fun x y -> x * y) | Div (e1, e2) -> (match (eval_expr e1 env, eval_expr e2 env) with | (Int_Val a, Int_Val b) -> if b = 0 then raise DivByZeroError else Int_Val (a/b) | _ -> raise TypeError) | Mod (e1, e2) -> (match (eval_expr e1 env, eval_expr e2 env) with | (Int_Val a, Int_Val b) -> if b = 0 then raise DivByZeroError else Int_Val (a mod b) | (_ , _) -> raise TypeError) | Eq (e1, e2) -> (match (eval_expr e1 env, eval_expr e2 env) with | (Bool_Val a , Bool_Val b) -> Bool_Val (a=b) | (Int_Val a, Int_Val b) -> Bool_Val (a = b) | _ -> raise TypeError) | Leq (e1, e2) -> (match (eval_expr e1 env, eval_expr e2 env) with | (Int_Val a, Int_Val b) -> Bool_Val (a <= b) | _ -> raise TypeError) | Lt (e1, e2) -> (match (eval_expr e1 env, eval_expr e2 env) with | (Int_Val a, Int_Val b) -> Bool_Val (a < b) | _ -> raise TypeError ) | Not e1 -> (match eval_expr e1 env with | Bool_Val a -> Bool_Val (not a) | _ -> raise TypeError) | And (e1, e2) -> makeBOp e1 e2 (fun x y -> (x && y)) | Or (e1, e2) -> makeBOp e1 e2 (fun x y -> (x || y)) (* evaluate a command in an environment *) let rec eval_command (c : com) (env : environment) : environment = match c with | Skip -> env | Comp (c1, c2) -> eval_command c2 (eval_command c1 env) | Declare (t, s) -> (match t with | Int_Type -> (s, Int_Val 0) :: env | Bool_Type -> (s, Bool_Val false) :: env ) | Assg (s, e) -> if List.mem_assoc s env then match (List.assoc s env, eval_expr e env) with | (Int_Val _, Int_Val x) -> (s, Int_Val x)::(List.remove_assoc s env) | (Bool_Val _, Bool_Val x) -> (s, Bool_Val x)::(List.remove_assoc s env) | _ -> raise TypeError else raise UndefinedVar | Cond (e, c1, c2) -> (match eval_expr e env with | Bool_Val b -> if b then eval_command c1 env else eval_command c2 env | _ -> raise TypeError) | While (e, c) -> (match eval_expr e env with | Bool_Val b -> if b then eval_command (While (e, c)) (eval_command c env) else env | _ -> raise TypeError) | For (e, c) -> (match eval_expr e env with | Int_Val n -> if n <= 0 then env else eval_command (For (Number (n - 1), c)) (eval_command c env) | _ -> raise TypeError)

assignment.ml

open Ast open Eval type 'a tree = Leaf | Node of 'a tree * 'a * 'a tree let rec insert tree x = match tree with | Leaf -> Node(Leaf, x, Leaf) | Node(l, y, r) -> if x = y then tree else if x < y then Node(insert l x, y, r) else Node(l, y, insert r x) let construct l = List.fold_left (fun acc x -> insert acc x) Leaf l (**********************************) (* Problem 1: Tree In-order Fold *) (**********************************) let rec fold_inorder f acc t = match t with | Leaf -> acc | Node (l,x,r) -> (fold_inorder f (f (fold_inorder f acc l) x) r) (*****************************************) (* Problem 2: Tree Level-order Traversal *) (*****************************************) let levelOrder t = let growAcc i acc = if (List.length acc) < (i + 1) then (acc@[[]]) else acc in let rec getNodes t h acc = match t with | Leaf -> acc | Node (l,x,r) -> getNodes r (h + 1) ( getNodes l (h + 1) (List.mapi (fun i s -> if i = h then s@[x] else s) (growAcc h acc))) in getNodes t 0 [] (***************************************) (* Problem 3: Tail-recursive Tree Sum *) (***************************************) let rec sum_tree t = match t with | Leaf -> 0 | Node (l, x, r) -> sum_tree l + x + sum_tree r let sumtailrec t = let rec sumrec acc lst = match lst with | [] -> acc | (Leaf::tl) -> sumrec acc tl | ((Node (l, x, r))::tl) -> sumrec (acc + x) (l::r::tl) in sumrec 0 [t] (******************************) (* Problem 4: Imp Interperter *) (**** Your code in eval.ml ****) (******************************) (* Parse a file of Imp source code *) let load (filename : string) : Ast.com = let ch = try open_in filename with Sys_error s -> failwith ("Cannot open file: " ^ s) in let parse : com = try Parser.main Lexer.token (Lexing.from_channel ch) with e -> let msg = Printexc.to_string e and stack = Printexc.get_backtrace () in Printf.eprintf "there was an error: %s%s\n" msg stack; close_in ch; failwith "Cannot parse program" in close_in ch; parse (* Interpret a parsed AST with the eval_command function defined in eval.ml *) let eval (parsed_ast : Ast.com) : environment = let env = [] in eval_command parsed_ast env (********) (* Done *) (********) let _ = print_string ("Testing your code ...\n") let main () = let error_count = ref 0 in (* Testcases for Problem 1 *) let _ = try assert (fold_inorder (fun acc x -> acc @ [x]) [] (Node (Node (Leaf,1,Leaf), 2, Node (Leaf,3,Leaf))) = [1;2;3]); assert (fold_inorder (fun acc x -> acc + x) 0 (Node (Node (Leaf,1,Leaf), 2, Node (Leaf,3,Leaf))) = 6) with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in (* Testcases for Problem 2 *) let _ = try assert (levelOrder (construct [3;20;15;23;7;9]) = [[3];[20];[15;23];[7];[9]]); assert (levelOrder (construct [41;65;20;11;50;91;29;99;32;72]) = [[41];[20;65];[11;29;50;91];[32;72;99]]) with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in (* Testcases for Problem 3 *) let _ = try let tree = let rec loop tree i = if i = 1000 then tree else loop (insert tree (Random.int 1000)) (i+1) in loop Leaf 0 in assert (sumtailrec tree = sum_tree tree) with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in (* Testcases for Problem 4 *) let _ = try let parsed_ast = load ("programs/aexp-add.imp") in let result = print_env_str(eval (parsed_ast)) in assert(result = "- x => 10\n\ - y => 15\n"); with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in let _ = try let parsed_ast = load ("programs/aexp-combined.imp") in let result = print_env_str(eval (parsed_ast)) in assert(result = "- w => -13\n\ - x => 1\n\ - y => 2\n\ - z => 3\n"); with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in let _ = try let parsed_ast = load ("programs/bexp-combined.imp") in let result = print_env_str(eval (parsed_ast)) in assert(result = "- res1 => 1\n\ - res10 => 0\n\ - res11 => 0\n\ - res12 => 0\n\ - res13 => 1\n\ - res14 => 1\n\ - res15 => 1\n\ - res16 => 0\n\ - res2 => 0\n\ - res3 => 1\n\ - res4 => 0\n\ - res5 => 0\n\ - res6 => 1\n\ - res7 => 0\n\ - res8 => 0\n\ - res9 => 1\n\ - w => 5\n\ - x => 3\n\ - y => 5\n\ - z => -3\n"); with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in let _ = try let parsed_ast = load ("programs/cond.imp") in let result = print_env_str(eval (parsed_ast)) in assert(result = "- n1 => 255\n\ - n2 => -5\n\ - res1 => 1\n\ - res2 => 255\n"); with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in let _ = try let parsed_ast = load ("programs/fact.imp") in let result = print_env_str(eval (parsed_ast)) in assert(result = "- f => 120\n\ - n => 1\n"); with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in let _ = try let parsed_ast = load ("programs/fib.imp") in let result = print_env_str(eval (parsed_ast)) in assert(result = "- f0 => 5\n\ - f1 => 8\n\ - k => 6\n\ - n => 5\n\ - res => 8\n"); with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in let _ = try let parsed_ast = load ("programs/for.imp") in let result = print_env_str(eval (parsed_ast)) in assert(result = "- i => 101\n\ - n => 101\n\ - sum => 5151\n"); with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in let _ = try let parsed_ast = load ("programs/palindrome.imp") in let result = print_env_str(eval (parsed_ast)) in assert(result = "- n => 135\n\ - res => 1\n\ - res2 => 0\n\ - reverse => 123454321\n\ - reverse2 => 531\n\ - temp => 0\n"); with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in let _ = try let parsed_ast = load ("programs/while.imp") in let result = print_env_str(eval (parsed_ast)) in assert(result = "- n => 0\n\ - sum => 5050\n"); with e -> (error_count := !error_count + 1; print_string ((Printexc.to_string e)^"\n")) in Printf.printf ("%d out of 12 programming questions are incorrect.\n") (!error_count) let _ = main()