├── project ├── pics │ ├── klotski_01.png │ ├── klotski_02.png │ └── klotski_03.png ├── klotski.ml └── README.md ├── week1 ├── w1_5.1_simple_functions_over_integers.ml ├── w1_5.2_simple_functions_over_strings.ml ├── w1_4.1_integer_identifiers.ml ├── w1_4.2_string_identifiers.ml ├── w1_4.2_string_identifiers.md ├── w1_6.1_prime_numbers.ml ├── w1_4.1_integer_identifiers.md ├── w1_5.2_simple_functions_over_strings.md ├── w1_5.1_simple_functions_over_integers.md ├── w1_6.1_prime_numbers.md └── README.md ├── week4 ├── w4_3.1_functions_returning_functions.ml ├── w4_1.1_lambdas_as_values.ml ├── w4_5.1_writing_map.ml ├── w4_2.1_first_class_functions.ml ├── w4_4.1_opt_partial_applications.ml ├── w4_6.2_fold_check_predicates.ml ├── w4_6.1_fold_produce_lists.ml ├── w4_3.1_functions_returning_functions.md ├── w4_1.1_lambdas_as_values.md ├── w4_4.2_small_arith_interpreter.ml ├── w4_4.1_opt_partial_applications.md ├── w4_2.1_first_class_functions.md ├── w4_5.1_writing_map.md ├── w4_6.2_fold_check_predicates.md ├── w4_6.1_fold_produce_lists.md ├── README.md └── w4_4.2_small_arith_interpreter.md ├── week6 ├── w6_2.1_opening_modules.ml ├── w6_2.3_wrapping_functions.ml ├── w6_2.1_opening_modules.md ├── w6_3.1_type_abstraction.ml ├── w6_2.3_wrapping_functions.md ├── w6_4.1_remove_from_dictionaries.md ├── w6_4.1_remove_from_dictionaries.ml ├── w6_5.1_char_indexed_hashtables.ml ├── README.md ├── w6_2.2_accessing_modules.ml ├── w6_3.2_multiset.ml ├── w6_3.2_multiset.md ├── w6_2.2_accessing_modules.md ├── w6_5.1_char_indexed_hashtables.md └── w6_3.1_type_abstraction.md ├── week3 ├── w3_5.1_balanced_binary_trees.ml ├── w3_1.1_pattern_matching_exhaustivity.ml ├── w3_1.2_type_array_indexes.ml ├── w3_1.3_option_type.ml ├── w3_2.2_functions_over_lists.ml ├── w3_6.1_advanced_patterns.ml ├── w3_2.1_fifo.ml ├── w3_1.1_pattern_matching_exhaustivity.md ├── w3_5.1_balanced_binary_trees.md ├── w3_3.1_symbolic_arithmetic.ml ├── w3_5.2_list_efficient_concat.ml ├── w3_2.2_functions_over_lists.md ├── w3_6.1_advanced_patterns.md ├── w3_1.3_option_type.md ├── w3_2.1_fifo.md ├── w3_3.2_tries.ml ├── w3_1.2_type_array_indexes.md ├── README.md ├── w3_5.2_list_efficient_concat.md ├── w3_3.1_symbolic_arithmetic.md ├── w3_3.2_tries.md ├── w3_4.1_type_directed_prog.ml └── w3_4.1_type_directed_prog.md ├── week5 ├── w5_5.1_rotating_array.ml ├── w5_7.1_references.ml ├── w5_3.1_printing_lists.ml ├── w5_4.1_printing_with_loops.ml ├── w5_5.2_stack_with_array.ml ├── w5_5.1_rotating_array.md ├── w5_7.2_reading_lines.ml ├── w5_2.1_automatic_grader.ml ├── w5_3.1_printing_lists.md ├── w5_7.2_reading_lines.md ├── w5_4.1_printing_with_loops.md ├── w5_4.2_ascii_art.ml ├── w5_6.1_mutable_lists.ml ├── w5_7.1_references.md ├── README.md ├── w5_5.2_stack_with_array.md ├── w5_6.1_mutable_lists.md ├── w5_3.2_fs_hierarchy.ml ├── w5_2.1_automatic_grader.md ├── w5_4.2_ascii_art.md └── w5_3.2_fs_hierarchy.md ├── week2 ├── w2_5.1_finding_the_minimum.ml ├── w2_5.2_strings_in_arrays.ml ├── w2_3.1_enigma.ml ├── w2_5.1_finding_the_minimum.md ├── w2_4.1_points_and_vectors.ml ├── w2_5.2_strings_in_arrays.md ├── w2_3.1_enigma.md ├── w2_4.2_time_on_planet_shadokus.ml ├── w2_4.1_points_and_vectors.md ├── README.md ├── w2_4.2_time_on_planet_shadokus.md ├── w2_6.1_small_typed_db.ml └── w2_6.1_small_typed_db.md ├── README.md └── week0 └── README.md /project/pics/klotski_01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/smeruelo/mooc-ocaml/HEAD/project/pics/klotski_01.png -------------------------------------------------------------------------------- /project/pics/klotski_02.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/smeruelo/mooc-ocaml/HEAD/project/pics/klotski_02.png -------------------------------------------------------------------------------- /project/pics/klotski_03.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/smeruelo/mooc-ocaml/HEAD/project/pics/klotski_03.png -------------------------------------------------------------------------------- /week1/w1_5.1_simple_functions_over_integers.ml: -------------------------------------------------------------------------------- 1 | let multiple_of n d = 2 | n mod d = 0 3 | 4 | let integer_square_root n = 5 | int_of_float (sqrt (float_of_int n)) 6 | -------------------------------------------------------------------------------- /week1/w1_5.2_simple_functions_over_strings.ml: -------------------------------------------------------------------------------- 1 | let last_character str = 2 | String.get str (String.length str - 1) 3 | 4 | let string_of_bool truth = 5 | if truth then "true" else "false" 6 | -------------------------------------------------------------------------------- /week1/w1_4.1_integer_identifiers.ml: -------------------------------------------------------------------------------- 1 | let x = Random.int 9 + 1;; 2 | 3 | let x_power_2 = x * x;; 4 | let x_power_4 = x_power_2 * x_power_2;; 5 | let x_power_8 = x_power_4 * x_power_4;; 6 | x_power_8 7 | -------------------------------------------------------------------------------- /week4/w4_3.1_functions_returning_functions.ml: -------------------------------------------------------------------------------- 1 | let rec equal_on_common = function 2 | | [] -> fun l2 -> true 3 | | h1 :: t1 -> function 4 | | [] -> true 5 | | h2 :: t2 -> h1 = h2 && equal_on_common t1 t2 6 | -------------------------------------------------------------------------------- /week1/w1_4.2_string_identifiers.ml: -------------------------------------------------------------------------------- 1 | let word = "whatever";; 2 | 3 | let sentence = 4 | let one = word ^ "," in 5 | let two = one ^ one in 6 | let four = two ^ two in 7 | let eight = four ^ four in 8 | eight ^ word;; -------------------------------------------------------------------------------- /week6/w6_2.1_opening_modules.ml: -------------------------------------------------------------------------------- 1 | open Digest 2 | open String 3 | open List 4 | 5 | let print_hashes (hashes : Digest.t list) : unit = 6 | let print_hash h = h |> to_hex |> uppercase_ascii |> print_endline in 7 | iter print_hash hashes;; 8 | -------------------------------------------------------------------------------- /week4/w4_1.1_lambdas_as_values.ml: -------------------------------------------------------------------------------- 1 | let rec last_element = function 2 | | [] -> (invalid_arg "last_element") 3 | | [x] -> x 4 | | x :: tl -> last_element tl;; 5 | 6 | let rec is_sorted = function 7 | | [_] | [] -> true 8 | | x :: y :: tl -> x < y && is_sorted (y :: tl);; 9 | -------------------------------------------------------------------------------- /week4/w4_5.1_writing_map.ml: -------------------------------------------------------------------------------- 1 | type 'a tree = 2 | | Node of 'a tree * 'a * 'a tree 3 | | Leaf of 'a;; 4 | 5 | let wrap l = 6 | List.map (fun x -> [x]) l 7 | 8 | let rec tree_map f = function 9 | | Node (lt, x, rt) -> Node (tree_map f lt, f x, tree_map f rt) 10 | | Leaf x -> Leaf (f x) 11 | -------------------------------------------------------------------------------- /week4/w4_2.1_first_class_functions.ml: -------------------------------------------------------------------------------- 1 | type int_ff = int -> int 2 | 3 | let rec compose = function 4 | | [] -> fun x -> x 5 | | f :: tl -> fun x -> f (compose tl x) 6 | 7 | let rec fixedpoint f start delta = 8 | let next = f start in 9 | if abs_float (next -. start) < delta 10 | then start 11 | else fixedpoint f next delta 12 | -------------------------------------------------------------------------------- /week3/w3_5.1_balanced_binary_trees.ml: -------------------------------------------------------------------------------- 1 | type 'a bt = 2 | | Empty 3 | | Node of 'a bt * 'a * 'a bt;; 4 | 5 | let rec height = function 6 | | Empty -> 0 7 | | Node (lt, _, rt) -> 1 + max (height lt) (height rt);; 8 | 9 | let rec balanced = function 10 | | Empty -> true 11 | | Node (lt, _, rt) -> balanced lt && balanced rt && height lt = height rt;; 12 | -------------------------------------------------------------------------------- /week1/w1_4.2_string_identifiers.md: -------------------------------------------------------------------------------- 1 | # STRING IDENTIFIERS (2 points possible) 2 | Suppose that a variable `word` exists and is a string. 3 | 4 | Define a variable `sentence` that uses 5 string concatenations to create a string containing 9 times `word`, separated by commas (`','`). 5 | 6 | This time, experiment with defining local `let` ... `in`s to store the partial results. 7 | -------------------------------------------------------------------------------- /week1/w1_6.1_prime_numbers.ml: -------------------------------------------------------------------------------- 1 | let rec gcd n m = 2 | if m = 0 3 | then n 4 | else gcd m (n mod m);; 5 | 6 | let rec multiple_upto n r = 7 | if r = 1 then false 8 | else if n mod r = 0 then true 9 | else multiple_upto n (r - 1);; 10 | 11 | let is_prime n = 12 | if n = 1 13 | then false 14 | else not (multiple_upto n (int_of_float (sqrt (float_of_int n))));; 15 | -------------------------------------------------------------------------------- /week3/w3_1.1_pattern_matching_exhaustivity.ml: -------------------------------------------------------------------------------- 1 | type color = Black | Gray | White 2 | 3 | let lighter c1 c2 = 4 | match (c1, c2) with 5 | | (Black, Black) -> false 6 | | (White, White) -> false 7 | | (Gray, Gray) -> false 8 | | (Black, _) -> true 9 | | (_, White) -> true 10 | | (White, Gray) -> false 11 | | (Gray, Black) -> false 12 | | (White, Black) -> false 13 | -------------------------------------------------------------------------------- /week4/w4_4.1_opt_partial_applications.ml: -------------------------------------------------------------------------------- 1 | (* 2 | let a = 0.320641569373584 3 | and b = 2.77192342543023962 4 | and c = 2.08203332204767833 5 | and s = 0.596105228351817118 6 | 7 | ccr a b c s = 0.812726147535 8 | *) 9 | 10 | let ccr = 11 | fun a -> let p_a = 8. *. cos (a /. 2.) in 12 | fun b -> let p_b = cos (b /. 2.) *. p_a in 13 | fun c -> let p_c = cos (c /. 2.) *. p_b in 14 | fun s -> s /. p_c 15 | -------------------------------------------------------------------------------- /week5/w5_5.1_rotating_array.ml: -------------------------------------------------------------------------------- 1 | let rotate a = 2 | let n = Array.length a in 3 | match n with 4 | | 0 -> () 5 | | _ -> 6 | let v = a.(0) in 7 | for i = 0 to n-2 do 8 | a.(i) <- a.(i+1) 9 | done; 10 | a.(n-1)<-v ;; 11 | 12 | let rotate_by a k = 13 | let n = Array.length a in 14 | match n with 15 | | 0 -> () 16 | | n -> 17 | for i = 1 to (n + k) mod n do 18 | rotate a 19 | done 20 | -------------------------------------------------------------------------------- /week1/w1_4.1_integer_identifiers.md: -------------------------------------------------------------------------------- 1 | # INTEGER IDENTIFIERS (2 points possible) 2 | Suppose that a variable `x` exists and is an integer. 3 | 4 | Define a variable `x_power_8` that uses three multiplications to calculate `x` to the power of 8. The only function you are allowed to call is the `(*)` operator. 5 | 6 | **Hint**: use auxiliary variables. 7 | 8 | ### THE GIVEN PRELUDE 9 | ```ocaml 10 | let x = Random.int 9 + 1 (* not 0 *) 11 | ``` 12 | -------------------------------------------------------------------------------- /week3/w3_1.2_type_array_indexes.ml: -------------------------------------------------------------------------------- 1 | type index = Index of int 2 | 3 | let read a (Index i) = a.(i) 4 | 5 | let inside a (Index i) = 6 | i >= 0 && i < Array.length a 7 | 8 | let next (Index i) = Index (i + 1) 9 | 10 | let min_index a = 11 | let rec aux i mv mi = 12 | if inside a i then 13 | if read a i < mv then 14 | aux (next i) (read a i) i 15 | else 16 | aux (next i) mv mi 17 | else 18 | mi 19 | and idx0 = Index 0 20 | in aux idx0 (read a idx0) idx0 21 | -------------------------------------------------------------------------------- /week5/w5_7.1_references.ml: -------------------------------------------------------------------------------- 1 | exception Empty ;; 2 | 3 | let swap ra rb = 4 | let tmp = !rb in 5 | rb := !ra; 6 | ra := tmp 7 | 8 | let update r f = 9 | let old = !r in 10 | r := f !r; 11 | old 12 | 13 | let move l1 l2 = 14 | match !l1 with 15 | | [] -> raise Empty 16 | | hd::tl -> l1 := tl; l2 := hd::!l2 17 | 18 | let reverse l = 19 | let orig = ref l 20 | and rev = ref [] in 21 | try 22 | while true do 23 | move orig rev; 24 | done; 25 | !rev 26 | with Empty -> !rev 27 | -------------------------------------------------------------------------------- /week3/w3_1.3_option_type.ml: -------------------------------------------------------------------------------- 1 | let find (a : string array) (w : string) = 2 | let rec aux i = 3 | if i < Array.length a then 4 | if a.(i) == w then 5 | Some i 6 | else 7 | aux (i + 1) 8 | else 9 | None 10 | in aux 0 11 | 12 | let default_int x = 13 | match x with 14 | | None -> 0 15 | | Some x -> x 16 | 17 | let merge a b = 18 | match (a, b) with 19 | | (None, None) -> None 20 | | (None, Some x) | (Some x, None) -> Some x 21 | | (Some x, Some y) -> Some (x + y) 22 | -------------------------------------------------------------------------------- /week4/w4_6.2_fold_check_predicates.ml: -------------------------------------------------------------------------------- 1 | let for_all p l = 2 | List.fold_left (fun acc x -> acc && p x) true l;; 3 | 4 | let exists p l = 5 | List.fold_left (fun acc x -> acc || p x) false l;; 6 | 7 | let sorted cmp = function 8 | | [] -> true 9 | | hd :: tl as l -> 10 | let f acc x = 11 | match acc with 12 | | Some y -> if cmp y x <= 0 then Some x else None 13 | | None -> None in 14 | match List.fold_left f (Some (List.hd l)) l with 15 | | Some _ -> true 16 | | None -> false;; 17 | -------------------------------------------------------------------------------- /week5/w5_3.1_printing_lists.ml: -------------------------------------------------------------------------------- 1 | let rec print_int_list = function 2 | | [] -> () 3 | | hd :: tl -> print_int hd; print_newline (); print_int_list tl;; 4 | 5 | let print_every_other k l = 6 | let rec aux index = function 7 | | [] -> () 8 | | hd :: tl -> 9 | if index mod k = 0 then (print_int hd; print_newline ()); 10 | aux (index + 1) tl 11 | in aux 0 l;; 12 | 13 | let rec print_list print l = function 14 | | [] -> () 15 | | hd :: tl -> print hd; print_newline (); print_list print tl;; 16 | -------------------------------------------------------------------------------- /week4/w4_6.1_fold_produce_lists.ml: -------------------------------------------------------------------------------- 1 | let filter p l = 2 | let f acc x = 3 | if p x 4 | then x :: acc 5 | else acc in 6 | List.fold_left f [] l;; 7 | 8 | let partition p l = 9 | let f x (lpos, lneg) = 10 | if p x 11 | then (x :: lpos, lneg) 12 | else (lpos, x :: lneg) in 13 | List.fold_right f l ([], []);; 14 | 15 | let rec sort l = 16 | match l with 17 | | [] | [_] as l -> l 18 | | hd :: tl -> let lpos, lneg = partition (fun x -> x <= hd) tl in 19 | (sort lpos) @ (hd :: (sort lneg));; 20 | -------------------------------------------------------------------------------- /week2/w2_5.1_finding_the_minimum.ml: -------------------------------------------------------------------------------- 1 | let min a = 2 | let rec aux i m = 3 | if i < Array.length a then 4 | if a.(i) < m then 5 | aux (i + 1) a.(i) 6 | else 7 | aux (i + 1) m 8 | else 9 | m 10 | in aux 0 a.(0) 11 | 12 | let min_index a = 13 | let rec aux i mv mi = 14 | if i < Array.length a then 15 | if a.(i) < mv then 16 | aux (i + 1) a.(i) i 17 | else 18 | aux (i + 1) mv mi 19 | else 20 | mi 21 | in aux 0 a.(0) 0 22 | 23 | let it_scales = "no" 24 | -------------------------------------------------------------------------------- /week3/w3_2.2_functions_over_lists.ml: -------------------------------------------------------------------------------- 1 | let rec mem x = function 2 | | [] -> false 3 | | hd :: tl -> if hd = x then true else mem x tl;; 4 | 5 | let rec append l1 l2 = 6 | match l1 with 7 | | [] -> l2 8 | | hd :: tl -> hd :: append tl l2;; 9 | 10 | let rec combine l1 l2 = 11 | match l1, l2 with 12 | | ([], []) -> [] 13 | | (hd1 :: tl1, hd2 :: tl2) -> (hd1, hd2) :: combine tl1 tl2;; 14 | 15 | let rec assoc l k = 16 | match l with 17 | | [] -> None 18 | | (key, value) :: tl -> if key = k then Some value else assoc tl k;; 19 | -------------------------------------------------------------------------------- /week3/w3_6.1_advanced_patterns.ml: -------------------------------------------------------------------------------- 1 | type e = EInt of int | EMul of e * e | EAdd of e * e 2 | 3 | let simplify = function 4 | | EMul (e, EInt 0) | EMul (EInt 0, e) -> EInt 0 5 | | EMul (e, EInt 1) | EMul (EInt 1, e) 6 | | EAdd (e, EInt 0) | EAdd (EInt 0, e) 7 | | e -> e;; 8 | 9 | let only_small_lists = function 10 | | ([_] | [_;_]) as l -> l 11 | | _ -> [];; 12 | 13 | let rec no_consecutive_repetition = function 14 | | x :: y :: ys when x = y -> no_consecutive_repetition (y :: ys) 15 | | x :: y :: ys -> x :: no_consecutive_repetition (y :: ys) 16 | | l -> l;; 17 | -------------------------------------------------------------------------------- /week5/w5_4.1_printing_with_loops.ml: -------------------------------------------------------------------------------- 1 | let is_multiple i x = i mod x = 0 2 | 3 | let output_multiples x n m = 4 | for i = n to m do 5 | if is_multiple i x 6 | then (print_string ","; print_int i) 7 | done 8 | 9 | exception Custom_Zero 10 | 11 | let display_sign_until_zero f m = 12 | try 13 | for i = 0 to m do 14 | match f i with 15 | | 0 -> raise Custom_Zero 16 | | x -> 17 | if x > 0 18 | then print_endline "positive" 19 | else print_endline "negative" 20 | done 21 | with 22 | | Custom_Zero -> print_endline "zero" 23 | -------------------------------------------------------------------------------- /week1/w1_5.2_simple_functions_over_strings.md: -------------------------------------------------------------------------------- 1 | # SIMPLE FUNCTIONS OVER STRINGS (12 points possible) 2 | Let's define two functions working with strings: 3 | 4 | 1. `last_character` that returns the last character of a string, assuming that the string argument is not empty; 5 | 2. `string_of_bool` that converts a boolean value to its string representation. 6 | 7 | ### YOUR OCAML ENVIRONMENT 8 | ```ocaml 9 | let last_character str = 10 | "Replace this string by your implementation." ;; 11 | 12 | let string_of_bool truth = 13 | "Replace this string by your implementation." ;; 14 | ``` 15 | -------------------------------------------------------------------------------- /week3/w3_2.1_fifo.ml: -------------------------------------------------------------------------------- 1 | type queue = int list * int list;; 2 | 3 | let is_empty (front, back) = 4 | front == [] && back == [];; 5 | 6 | let enqueue x (front, back) = 7 | (front, x :: back);; 8 | 9 | let split l = 10 | let rec aux back lst = 11 | match lst with 12 | | lst when List.length lst - List.length back <= 1 -> (List.rev lst, List.rev back) 13 | | hd :: tl -> aux (hd :: back) tl in 14 | aux [] l;; 15 | 16 | let dequeue (front, back) = 17 | match front with 18 | | [] -> let (f_hd :: f_tl), b = split back in (f_hd, (f_tl, b)) 19 | | hd :: tl -> (hd, (tl, back));; 20 | -------------------------------------------------------------------------------- /week2/w2_5.2_strings_in_arrays.ml: -------------------------------------------------------------------------------- 1 | let is_sorted a = 2 | let rec aux i = 3 | if i >= (Array.length a) - 1 then 4 | true 5 | else 6 | if String.compare a.(i) a.(i + 1) < 0 then 7 | aux (i + 1) 8 | else 9 | false 10 | in aux 0 11 | 12 | let find dict word = 13 | let rec aux left right = 14 | let m = (left + right) / 2 in 15 | if m == left || m == right then 16 | -1 17 | else 18 | let result = String.compare word dict.(m) in 19 | match result with 20 | | -1 -> aux left m 21 | | 0 -> m 22 | | 1 -> aux m right 23 | in aux (-1) (Array.length dict) 24 | -------------------------------------------------------------------------------- /week3/w3_1.1_pattern_matching_exhaustivity.md: -------------------------------------------------------------------------------- 1 | # PATTERN MATCHING EXHAUSTIVITY (10 points possible) 2 | We have seen in the course the example of non exhaustive pattern matching given below. Write the code for the missing cases. 3 | 4 | ### THE GIVEN PRELUDE 5 | ```ocaml 6 | type color = Black | Gray | White ;; 7 | ``` 8 | 9 | ### YOUR OCAML ENVIRONMENT 10 | ```ocaml 11 | let lighter c1 c2 = 12 | match (c1, c2) with 13 | | (Black, Black) -> false 14 | | (White, White) -> false 15 | | (Gray, Gray) -> false 16 | | (Black, _) -> true 17 | | (_, White) -> true 18 | | (White, Gray) -> false 19 | | (Gray, Black) -> false 20 | ``` 21 | -------------------------------------------------------------------------------- /week2/w2_3.1_enigma.ml: -------------------------------------------------------------------------------- 1 | let exchange k = 2 | if k > 9 && k < 100 then 3 | let ones = k mod 10 4 | and tens = k / 10 5 | in ones * 10 + tens 6 | else (* raise exception *) 7 | k 8 | 9 | let is_valid_answer (grand_father_age, grand_son_age) = 10 | grand_son_age * 4 == grand_father_age && 11 | (exchange grand_father_age) * 3 == exchange grand_son_age 12 | 13 | let find (max_gf, min_gs) = 14 | let rec aux gs = 15 | if gs <= max_gf / 4 then 16 | let gf = gs * 4 in 17 | if is_valid_answer (gf, gs) then 18 | (gf, gs) 19 | else 20 | aux (gs + 1) 21 | else 22 | (-1, -1) 23 | in aux min_gs 24 | -------------------------------------------------------------------------------- /week5/w5_5.2_stack_with_array.ml: -------------------------------------------------------------------------------- 1 | type stack = int array;; 2 | exception Full;; 3 | exception Empty;; 4 | 5 | let create size = 6 | let a = Array.make (size + 1) 0 in 7 | a;; 8 | 9 | let push buf elt = 10 | if buf.(0) = ((Array.length buf) - 1) then 11 | raise Full 12 | else 13 | begin 14 | buf.(buf.(0) + 1) <- elt; 15 | buf.(0) <- buf.(0) + 1 16 | end;; 17 | 18 | let append buf arr = 19 | for i = (Array.length arr) - 1 downto 0 do 20 | push buf arr.(i) 21 | done;; 22 | 23 | let pop buf = 24 | if buf.(0) = 0 then 25 | raise Empty 26 | else 27 | let top = buf.(buf.(0)) in 28 | buf.(0) <- buf.(0) - 1; 29 | top;; 30 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | These are my solutions to the exercises of the MOOC [Functional Programming in OCaml](https://www.fun-mooc.fr/courses/parisdiderot/56002S02/session02/about) by Roberto Di Cosmo, Yann Regis-Gianas and Ralf Treinen (_Université Paris Diderot_). 2 | 3 | The course is divided in weeks: 4 | * [Week 0](week0): Introduction and overview 5 | * [Week 1](week1): Basic types, definitions and functions 6 | * [Week 2](week2): Basic data structures 7 | * [Week 3](week3): More advanced data structures 8 | * [Week 4](week4): Higher order functions 9 | * [Week 5](week5): Exceptions, input/output and imperative constructs 10 | * [Week 6](week6): Modules and data abstraction 11 | * [Final project](project) -------------------------------------------------------------------------------- /week6/w6_2.3_wrapping_functions.ml: -------------------------------------------------------------------------------- 1 | module Exp = struct 2 | 3 | type e = 4 | | EInt of int 5 | | EMul of e * e 6 | | EAdd of e * e 7 | 8 | let int x = EInt x 9 | 10 | let mul a b = 11 | match a, b with 12 | | EInt 0, _ | _, EInt 0 -> EInt 0 13 | | EInt 1, e | e, EInt 1 -> e 14 | | a, b -> EMul (a, b) 15 | 16 | let add a b = 17 | match a, b with 18 | | EInt 0, e | e, EInt 0 -> e 19 | | a, b -> EAdd (a, b) 20 | 21 | let rec eval = function 22 | | EInt x -> x 23 | | EAdd (l, r) -> eval l + eval r 24 | | EMul (l, r) -> eval l * eval r 25 | 26 | end 27 | 28 | 29 | let example x y z = 30 | Exp.int (Exp.eval (Exp.mul (Exp.int x) (Exp.add (Exp.int y) (Exp.int z)))) 31 | -------------------------------------------------------------------------------- /week6/w6_2.1_opening_modules.md: -------------------------------------------------------------------------------- 1 | # OPENING MODULES (45 points possible) 2 | 3 | 1. The code given in the template has been written using some values declared in three modules of [the standard library](http://caml.inria.fr/pub/docs/manual-ocaml/stdlib.html). Can you find what are these three modules? When you have found them, just use `open` directives to have the code accepted by the type checker. Be aware that the `iter` function appears in multiple module and that the order in which you `open` the modules is important. 4 | 5 | ### YOUR OCAML ENVIRONMENT 6 | ```ocaml 7 | let print_hashes (hashes : Digest.t list) : unit = 8 | let print_hash h = h |> to_hex |> uppercase |> print_endline in 9 | iter print_hash hashes;; 10 | ``` 11 | -------------------------------------------------------------------------------- /week2/w2_5.1_finding_the_minimum.md: -------------------------------------------------------------------------------- 1 | # FINDING THE MINIMUM (20 points possible) 2 | Consider a non empty array of integers `a`. 3 | 4 | 1. Write a function `min : int array -> int` that returns the minimal element of `a`. 5 | 6 | 2. Write a function `min_index : int array -> int` that returns the index of the minimal element of `a`. 7 | 8 | Do you think these functions work well on large arrays ? 9 | 10 | 3. Define a variable `it_scales` and set it to `"yes"` or `"no"`. 11 | 12 | ### YOUR OCAML ENVIRONMENT 13 | ```ocaml 14 | let min a = 15 | "Replace this string with your implementation." ;; 16 | 17 | let min_index a = 18 | "Replace this string with your implementation." ;; 19 | 20 | let it_scales = 21 | "Replace this string with your answer." ;; 22 | ``` 23 | -------------------------------------------------------------------------------- /week5/w5_5.1_rotating_array.md: -------------------------------------------------------------------------------- 1 | # ROTATING THE CONTENTS OF AN ARRAY (22 points possible) 2 | In this exercise, you will improve the code shown in the course (and given in the template) for rotating arrays. 3 | 4 | 1. There is something perfectible with the code of `rotate`. 5 | Find what, and fix the function!. 6 | 7 | 2. Define `rotate_by: 'a array -> int -> unit` adding a parameter that allows to rotate by `n` positions. 8 | For instance, `rotate_by [|1;2;3;4|] 3` should yield `[|4;1;2;3|]`. 9 | 10 | ### YOUR OCAML ENVIRONMENT 11 | ``` 12 | let rotate a = 13 | let n = Array.length a in 14 | let v = a.(0) in 15 | for i = 0 to n-2 do 16 | a.(i) <- a.(i+1) 17 | done; 18 | a.(n-1)<-v ;; 19 | 20 | let rotate_by a n = 21 | "Replace this string with your implementation." ;; 22 | ``` 23 | -------------------------------------------------------------------------------- /week6/w6_3.1_type_abstraction.ml: -------------------------------------------------------------------------------- 1 | module Exp : sig 2 | type e 3 | val int : int -> e 4 | val mul : e -> e -> e 5 | val add : e -> e -> e 6 | val to_string : e -> string 7 | end = struct 8 | 9 | type e = EInt of int | EMul of e * e | EAdd of e * e 10 | 11 | let int x = EInt x 12 | 13 | let mul a b = 14 | match a, b with 15 | | EInt 0, _ | _, EInt 0 -> EInt 0 16 | | EInt 1, e | e, EInt 1 -> e 17 | | a, b -> EMul (a, b) 18 | 19 | let add a b = 20 | match a, b with 21 | | EInt 0, e | e, EInt 0 -> e 22 | | a, b -> EAdd (a, b) 23 | 24 | let rec to_string = function 25 | | EInt i -> string_of_int i 26 | | EMul (l, r) -> "(" ^ to_string l ^ " * " ^ to_string r ^ ")" 27 | | EAdd (l, r) -> "(" ^ to_string l ^ " + " ^ to_string r ^ ")" 28 | 29 | end 30 | -------------------------------------------------------------------------------- /week3/w3_5.1_balanced_binary_trees.md: -------------------------------------------------------------------------------- 1 | # BALANCED BINARY TREES (22 points possible) 2 | A binary tree `t`, of the `'a bt` type given in the prelude, is either an empty tree, or the root of a tree with a value and two children subtrees. 3 | 4 | 1. Write a function `height : 'a bt -> int` that computes the height of a tree. 5 | 6 | 2. A tree is balanced if, for all internal node `n`, its two subtrees have the same height. Write a function `balanced : 'a bt -> bool` that tells if a tree is balanced. 7 | 8 | ### THE GIVEN PRELUDE 9 | ```ocaml 10 | type 'a bt = 11 | | Empty 12 | | Node of 'a bt * 'a * 'a bt ;; 13 | ``` 14 | 15 | ### YOUR OCAML ENVIRONMENT 16 | ```ocaml 17 | let rec height t = 18 | "Replace this string with your implementation." ;; 19 | 20 | let rec balanced t = 21 | "Replace this string with your implementation." ;; 22 | ``` 23 | -------------------------------------------------------------------------------- /week4/w4_3.1_functions_returning_functions.md: -------------------------------------------------------------------------------- 1 | # FUNCTIONS RETURNING FUNCTIONS (25 points possible) 2 | The following function checks the pairwise equality of the elements of two lists, on the common length of both lists: 3 | ```ocaml 4 | let rec equal_on_common l1 l2 = match l1,l2 with 5 | | [],_ -> true 6 | | _,[] -> true 7 | | h1::r1,h2::r2 -> h1=h2 && equal_on_common r1 r2 8 | ``` 9 | 10 | 1. Rewrite `equal_on_common : 'a list -> 'a list -> bool` by using nested `function .. ->` constructions. Using the `match .. with` construction or tuple patterns is forbidden. You can (and must) only call the operators `&&` and `=`, and the function `equal_on_common` recursively. 11 | 12 | ### YOUR OCAML ENVIRONMENT 13 | ```ocaml 14 | let rec equal_on_common l1 l2 = match l1,l2 with 15 | | [],_ -> true 16 | | _,[] -> true 17 | | h1::r1,h2::r2 -> h1=h2 && equal_on_common r1 r2;; 18 | ``` 19 | -------------------------------------------------------------------------------- /week5/w5_7.2_reading_lines.ml: -------------------------------------------------------------------------------- 1 | (* 2 | read_lines is an **identifier** for a function that receives unit 3 | that function is defined within a context in which sl exists (clousure!) 4 | so everytime we call read_lines (), it uses the same ref (sl) to store the lines 5 | sl is empty the first time only 6 | *) 7 | let read_lines = 8 | let sl = ref [] in 9 | let rec aux () = 10 | try 11 | sl := read_line () :: !sl ; 12 | aux () 13 | with End_of_file -> List.rev !sl 14 | in fun () -> aux ();; 15 | 16 | 17 | (* 18 | read_lines_fixed is a **function** 19 | everytime we call it, a new context is created in which sl does not exist yet 20 | so a new empty sl is created every time 21 | *) 22 | let read_lines_fixed () = 23 | let sl = ref [] in 24 | let rec aux () = 25 | try 26 | sl := read_line () :: !sl ; 27 | aux () 28 | with End_of_file -> List.rev !sl 29 | in aux (); 30 | -------------------------------------------------------------------------------- /week1/w1_5.1_simple_functions_over_integers.md: -------------------------------------------------------------------------------- 1 | # SIMPLE FUNCTIONS OVER INTEGERS (20 points possible) 2 | Let's define two functions working with integers: 3 | 4 | 1. `multiple_of` that takes two integer parameters, `n` and `d`, and determines whether `n` is a multiple of `d`. The function must return a boolean value. This function can be written without recursion. Look at the operators defined on integers in sequence 1. 5 | 2. `integer_square_root` that calculates the integer square root of a positive integer `n`, that is the largest integer `r` such that `r * r <= n`. **Hint**: you may use floating point arithmetic, but don't forget that you have to convert explicitely between `float` and `int`. 6 | 7 | ### YOUR OCAML ENVIRONMENT 8 | ```ocaml 9 | let multiple_of n d = 10 | "Replace this string by your implementation." ;; 11 | 12 | let integer_square_root n = 13 | "Replace this string by your implementation." ;; 14 | ``` 15 | -------------------------------------------------------------------------------- /week4/w4_1.1_lambdas_as_values.md: -------------------------------------------------------------------------------- 1 | # LAMBDA-EXPRESSIONS AS VALUES (20 points possible) 2 | In this exercise, we will define functions as values, also called lambda expressions, using the keyword `function` to do a pattern-matching on their argument. As a result, you are not allowed to use `match ... with` in your code. 3 | 4 | 1. Define a function `last_element: 'a list -> 'a` that returns the last element of a list. Your function may return `(invalid_arg "last_element")` when the list is empty. 5 | 6 | 2. Write a function `is_sorted: 'a list -> bool` that takes a list `l` as argument, and that checks that the list is sorted in increasing order according to the polymorphic comparison operator `<`. 7 | 8 | ### YOUR OCAML ENVIRONMENT 9 | ```ocaml 10 | let rec last_element = function _ -> 11 | "Replace this string with your implementation." ;; 12 | 13 | let rec is_sorted = function _ -> 14 | "Replace this string with your implementation." ;; 15 | ``` 16 | -------------------------------------------------------------------------------- /week6/w6_2.3_wrapping_functions.md: -------------------------------------------------------------------------------- 1 | # WRAPPING FUNCTIONS IN A MODULE (10 points possible) 2 | 1. Encapsulate the necessary values in a module named `Exp` so that the definition of `example` is accepted by the type checker. 3 | 4 | ### THE GIVEN PRELUDE 5 | ```ocaml 6 | type e = EInt of int | EMul of e * e | EAdd of e * e 7 | ``` 8 | 9 | ### YOUR OCAML ENVIRONMENT 10 | ```ocaml 11 | let int x = EInt x 12 | 13 | let mul a b = 14 | match a, b with 15 | | EInt 0, _ | _, EInt 0 -> EInt 0 16 | | EInt 1, e | e, EInt 1 -> e 17 | | a, b -> EMul (a, b) 18 | 19 | let add a b = 20 | match a, b with 21 | | EInt 0, e | e, EInt 0 -> e 22 | | a, b -> EAdd (a, b) 23 | 24 | let rec eval = function 25 | | EInt x -> x 26 | | EAdd (l, r) -> eval l + eval r 27 | | EMul (l, r) -> eval l * eval r 28 | 29 | let example x y z = (* don't change anything to this defintion *) 30 | Exp.int (Exp.eval (Exp.mul (Exp.int x) (Exp.add (Exp.int y) (Exp.int z)))) 31 | ``` 32 | -------------------------------------------------------------------------------- /week3/w3_3.1_symbolic_arithmetic.ml: -------------------------------------------------------------------------------- 1 | type exp = 2 | | EInt of int 3 | | EAdd of exp * exp 4 | | EMul of exp * exp;; 5 | 6 | let example = 7 | EAdd (EInt 1, EMul (EInt 2, EInt 3));; 8 | 9 | let my_example = 10 | EAdd (EMul (EInt 2, EInt 2), EMul (EInt 3, EInt 3));; 11 | 12 | let rec eval e = 13 | match e with 14 | | EInt x -> x 15 | | EAdd (e1, e2) -> eval e1 + eval e2 16 | | EMul (e1, e2) -> eval e1 * eval e2;; 17 | 18 | let factorize e = 19 | match e with 20 | | EAdd (EMul (e1, e2), EMul (e3, e4)) when e1 = e3 -> EMul (e1, EAdd (e2, e4)) 21 | | _ -> e;; 22 | 23 | let expand e = 24 | match e with 25 | | EMul (e1, EAdd (e2, e3)) -> EAdd (EMul (e1, e2), EMul (e1, e3)) 26 | | _ -> e;; 27 | 28 | let simplify e = 29 | match e with 30 | | EMul (e1, e2) when e1 = EInt 0 || e2 = EInt 0 -> EInt 0 31 | | EMul (e, EInt 1) -> e 32 | | EMul (EInt 1, e) -> e 33 | | EAdd (e, EInt 0) -> e 34 | | EAdd (EInt 0, e) -> e 35 | | _ -> e;; 36 | -------------------------------------------------------------------------------- /week5/w5_2.1_automatic_grader.ml: -------------------------------------------------------------------------------- 1 | type report = message list 2 | and message = string * status 3 | and status = Successful | Failed;; 4 | 5 | type 'a result = Ok of 'a | Error of exn;; 6 | 7 | 8 | let exec f x = 9 | try 10 | Ok (f x) 11 | with 12 | e -> Error e;; 13 | 14 | let compare user reference to_string = 15 | match user, reference with 16 | | (Ok u, Ok r) when u = r -> ("got correct value " ^ to_string u, Successful) 17 | | (Ok u, Ok _) | (Ok u, Error _) -> ("got unexpected value " ^ to_string u, Failed) 18 | | (Error u, Error r) when u = r -> ("got correct exception " ^ exn_to_string u, Successful) 19 | | (Error u, Error _) | (Error u, Ok _) -> ("got unexpected exception " ^ exn_to_string u, Failed);; 20 | 21 | let test user reference sample to_string = 22 | let rec aux = function 23 | | 0 -> [] 24 | | i -> let test_input = sample () in 25 | (compare (exec user test_input) (exec reference test_input) to_string) :: aux (i - 1) 26 | in aux 10;; 27 | -------------------------------------------------------------------------------- /week4/w4_4.2_small_arith_interpreter.ml: -------------------------------------------------------------------------------- 1 | type operation = 2 | | Op of string * operation * operation 3 | | Value of int;; 4 | 5 | type env = (string * (int -> int -> int)) list;; 6 | 7 | let rec lookup_function name = function 8 | | [] -> invalid_arg "lookup_function" 9 | | (str, f) :: tl when str == name -> f 10 | | hd :: tl -> lookup_function name tl;; 11 | 12 | let add_function name f env = 13 | (name, f) :: env;; 14 | 15 | let my_env = [ 16 | ("min", fun x y -> if y >= x then x else y); 17 | ("add", fun x y -> x + y); 18 | ("sub", fun x y -> x - y); 19 | ("mul", fun x y -> x * y); 20 | ("div", fun x y -> x / y) 21 | ];; 22 | 23 | let rec compute env op = 24 | match op with 25 | | Value x -> x 26 | | Op (f_name, op1, op2) -> 27 | let f = lookup_function f_name env in 28 | f (compute env op1) (compute env op2);; 29 | 30 | let rec compute_eff env = function 31 | | Op (name, op1, op2) -> 32 | lookup_function name env (compute_eff env op1) (compute_eff env op2) 33 | | Value x -> x;; 34 | -------------------------------------------------------------------------------- /week5/w5_3.1_printing_lists.md: -------------------------------------------------------------------------------- 1 | # PRINTING LISTS (200 points possible) 2 | 3 | 1. Write a function `print_int_list : int list -> unit` that takes a list of integers as input, and prints all the elements of the list, each on its own line. 4 | 5 | 2. Write a function `print_every_other : int -> int list -> unit` that takes a value `k` and a list of integers as input, and prints the elements of the list that are in positions multiple of `k`, each on its own line. Note: the first element of a list is at the position 0, not 1. 6 | 7 | 3. Write a function `print_list : ('a -> unit) -> 'a list -> unit` that takes a printer of values of some type `'a` and a list of such values as input, and prints all the elements of the list, each on its own line. 8 | 9 | ### YOUR OCAML ENVIRONMENT 10 | ``` 11 | let rec print_int_list l = 12 | "Replace this string with your implementation." ;; 13 | 14 | let print_every_other k l = 15 | "Replace this string with your implementation." ;; 16 | 17 | let rec print_list print l = 18 | "Replace this string with your implementation." ;; 19 | ``` 20 | -------------------------------------------------------------------------------- /week2/w2_4.1_points_and_vectors.ml: -------------------------------------------------------------------------------- 1 | type point = { x : float; y : float; z : float } 2 | type dpoint = { dx : float; dy : float; dz : float } 3 | type physical_object = { position : point; velocity : dpoint } 4 | 5 | let move p dp = 6 | { x = p.x +. dp.dx; y = p.y +. dp.dy; z = p.z +. dp.dz } 7 | 8 | let next obj = 9 | { position = move obj.position obj.velocity ; velocity = obj.velocity} 10 | 11 | let will_collide_soon obj1 obj2 = 12 | let nobj1 = next obj1 13 | and nobj2 = next obj2 in 14 | let distance p1 p2 = 15 | sqrt ((p2.x -. p1.x) ** 2. +. (p2.y -. p1.y) ** 2. +. (p2.z -. p1.z) ** 2.) 16 | in distance nobj1.position nobj2.position < 2. 17 | 18 | (* 19 | will_collide_soon {position = {x = 1.; y = 2.; z = 1.}; velocity = {dx = 0.; dy = 0.; dz = 1.}} 20 | {position = {x = 1.; y = 2.; z = 1.8}; velocity = {dx = 0.; dy = 0.; dz = 0.1}};; 21 | 22 | will_collide_soon {position = {x = 1.; y = 2.; z = 1.}; velocity = {dx = 0.; dy = 0.; dz = 1.}} 23 | {position = {x = 1.; y = 2.; z = 4.8}; velocity = {dx = 0.; dy = 0.; dz = 0.1}};; 24 | *) 25 | -------------------------------------------------------------------------------- /week4/w4_4.1_opt_partial_applications.md: -------------------------------------------------------------------------------- 1 | # OPTIMIZING PARTIAL APPLICATIONS (35 points possible) 2 | Every triangle has a circumscribed circle, that is a circle that goes through the three points of a given triangle. Trigonometry tells us that the radius of this circle is ![s/(2⋅cos(a/2)⋅2⋅cos(b/2)⋅2⋅cos(c/2))](https://latex.codecogs.com/gif.latex?%5Cinline%20%5Cfrac%7Bs%7D%7B2%20%5Ccdot%20%5Ccos%20%28%5Cfrac%7Ba%7D%7B2%7D%29%20%5Ccdot%202%20%5Ccdot%20%5Ccos%20%28%5Cfrac%7Bb%7D%7B2%7D%29%20%5Ccdot%202%20%5Ccdot%20%5Ccos%20%28%5Cfrac%7Bc%7D%7B2%7D%29%7D) where `a`, `b` and `c` are the angles of the triangle, and `s` is its circumference. 3 | 4 | 1. Define a function `ccr: float -> float -> float -> float -> float` that takes as arguments `a`, `b`, `c` and `s`, and returns the radius of circumscribed circle as described above. 5 | 6 | 2. Update `ccr` so that it does as much work as possible when partially applied to each argument, and minimizes the total number of operations (multiplications, divisions and calls to `cos`). 7 | 8 | ### YOUR OCAML ENVIRONMENT 9 | ```ocaml 10 | let ccr = fun a -> fun b -> fun c -> fun s -> 11 | "Replace this string with your implementation." ;; 12 | ``` 13 | -------------------------------------------------------------------------------- /week2/w2_5.2_strings_in_arrays.md: -------------------------------------------------------------------------------- 1 | # SEARCHING FOR STRINGS IN ARRAYS (30 points possible) 2 | 1. Write a function `is_sorted : string array -> bool` which checks if the values of the input array are sorted in strictly increasing order, implying that its elements are unique (use `String.compare`). 3 | 4 | 2. Using the [binary search algorithm](https://en.wikipedia.org/wiki/Binary_search_algorithm), an element can be found very quickly in a sorted array. 5 | Write a function `find : string array -> string -> int` such that `find arr word` is the index of the `word` in the sorted array `arr` if it occurs in `arr` or -1 if word does not occur in `arr`. 6 | The number or array accesses will be counted, to check that you obtain the expected algorithmic complexity. Beware that you really perform the minimal number of accesses. For instance, if your function has to test the contents of a cell twice, be sure to put the result of the access in a variable, and then perform the tests on that variable. 7 | 8 | ### YOUR OCAML ENVIRONMENT 9 | ```ocaml 10 | let is_sorted a = 11 | "Replace this string with your implementation." ;; 12 | 13 | let find dict word = 14 | "Replace this string with your implementation." ;; 15 | ``` 16 | -------------------------------------------------------------------------------- /week3/w3_5.2_list_efficient_concat.ml: -------------------------------------------------------------------------------- 1 | type 'a clist = 2 | | CSingle of 'a 3 | | CApp of 'a clist * 'a clist 4 | | CEmpty;; 5 | 6 | let to_list cl = 7 | let rec aux l = function 8 | | CSingle cs -> cs :: l 9 | | CApp (cl_left, cl_right) -> aux (aux l cl_right) cl_left 10 | | CEmpty -> l 11 | in aux [] cl;; 12 | 13 | let rec of_list = function 14 | | [] -> CEmpty 15 | | hd :: tl -> CApp (CSingle hd, of_list tl);; 16 | 17 | let append cl1 cl2 = 18 | match cl1, cl2 with 19 | | CEmpty, cl | cl, CEmpty -> cl 20 | | cl1, cl2 -> CApp (cl1, cl2);; 21 | 22 | let hd cl = 23 | let rec aux = function 24 | | CEmpty -> None 25 | | CSingle cs -> Some cs 26 | | CApp (cl_left, cl_right) -> match aux cl_left with 27 | | None -> aux cl_right 28 | | Some cs -> Some cs 29 | in aux cl;; 30 | 31 | let tl cl = 32 | let rec aux = function 33 | | CEmpty -> (CEmpty, false) 34 | | CSingle _ -> (CEmpty, true) 35 | | CApp (left, right) -> match aux left with 36 | | left', false -> let (right', found) = aux right in (CApp (left', right'), found) 37 | | left', true -> (CApp (left', right), true) 38 | in match aux cl with 39 | | _, false -> None 40 | | cl_tl, true -> Some cl_tl;; 41 | -------------------------------------------------------------------------------- /week5/w5_7.2_reading_lines.md: -------------------------------------------------------------------------------- 1 | # READING LINES FROM THE STANDARD INPUT (10 points possible) 2 | The code given in the template is an attempt to reading a list of lines from the standard input, slightly different from the one shown in the course notes. 3 | At first sight, it behaves well. 4 | 5 | ``` 6 | # read_lines ();; 7 | Hello 8 | mister 9 | the 10 | caml! 11 | - : string list = [ "Hello" ; "mister" ; "the" ; "caml!" ] 12 | ``` 13 | But if you call this function several times, you get unexpected results. 14 | 15 | 1. Study the code, to understand what is going on, compare with the example shown in the course, and then fix this code. 16 | 17 | **Important note**: it is not possible to implement reading functions that actually ask the user to input something in the current toplevel environment. For that, the environment defines an alternative version of `read_line` that simulates user interaction. Some calls will return a string, some others will (less often) raise `End_of_file`. 18 | 19 | ### YOUR OCAML ENVIRONMENT 20 | ``` 21 | let read_lines = 22 | let sl = ref [] in 23 | let rec aux () = 24 | try 25 | sl := read_line () :: !sl ; 26 | aux () 27 | with 28 | End_of_file -> List.rev !sl in 29 | fun () -> aux () ;; 30 | ``` 31 | -------------------------------------------------------------------------------- /week5/w5_4.1_printing_with_loops.md: -------------------------------------------------------------------------------- 1 | # PRINTING WITH LOOPS (105 points possible) 2 | 3 | 1. Using the `for` loop construct, write an `output_multiples : int -> int -> int -> unit` function that prints all the multiples of `x` in the integer interval `n ... m`, separated by commas (`','`). 4 | 5 | 2. Define a higher order function `display_sign_until_zero: (int -> int) -> int -> unit` that takes a function `f`, an integer `m` and applies `f` from `0` to `m` using a `for` loop. The function will print `"negative"` if the result of f if strictly negative and `"positive"` if strictly positive. Each print should appear on a new line. 6 | Your function has to stop displaying the signs as soon as `f` returns `0`. In this case, it must print a last `"zero"`. 7 | To implement this, you will define your own exception, `raise` it from inside the loop to break it, and catch it outside of the loop so that the function returns a successful `()`. You cannot use a predefined exception. 8 | 9 | ### THE GIVEN PRELUDE 10 | ``` 11 | let is_multiple i x = i mod x = 0 12 | ``` 13 | 14 | ### YOUR OCAML ENVIRONMENT 15 | ``` 16 | let output_multiples x n m = 17 | "Replace this string with your implementation." ;; 18 | 19 | let display_sign_until_zero f m = 20 | "Replace this string with your implementation." ;; 21 | ``` 22 | -------------------------------------------------------------------------------- /week4/w4_2.1_first_class_functions.md: -------------------------------------------------------------------------------- 1 | # USING FIRST CLASS FUNCTIONS (20 points possible) 2 | 3 | 1. Write a function `compose : ('a -> 'a) list -> ('a -> 'a)` that takes as argument a list `l` of functions, and that returns the function that is the composition of the functions in `l`. For instance, `compose [f;g;h] x = f (g (h x))`. Or with concrete functions, `compose [(fun x -> x+1);(fun x -> 3*x);(fun x -> x-1)] 2 = 4`. 4 | 5 | 2. Write a function `fixedpoint : (float -> float) -> float -> float -> float` that takes a function `f` of type `float -> float` and two floating-point arguments `start` and `delta`. The function `fixedpoint` applies repetitively `f` to the result of its previous application, starting from `start`, until it reaches a value `y` where the difference between `y` and `(f y)` is smaller than `delta`. In that case it returns the value of `y`. For instance, `fixedpoint cos 0. 0.001` yields approximately `0.739` ([ref](http://mathworld.wolfram.com/DottieNumber.html)). 6 | 7 | ### THE GIVEN PRELUDE 8 | ```ocaml 9 | type int_ff = int -> int 10 | ``` 11 | 12 | ### YOUR OCAML ENVIRONMENT 13 | ```ocaml 14 | let rec compose = function _ -> 15 | "Replace this string with your implementation." ;; 16 | 17 | let rec fixedpoint f start delta = 18 | "Replace this string with your implementation." ;; 19 | ``` 20 | -------------------------------------------------------------------------------- /week3/w3_2.2_functions_over_lists.md: -------------------------------------------------------------------------------- 1 | # CLASSIC FUNCTIONS OVER LISTS (40 points possible) 2 | In this exercise, we implement the classic functions over lists. 3 | 4 | 1. Write a function `mem : int -> int list -> bool` such that `mem x l` is true if and only if `x` occurs in `l`. 5 | 6 | 2. Write a function `append : int list -> int list -> int list` such that `append l1 l2` is the concatenation of `l1` and `l2`. 7 | 8 | 3. Write a function `combine : int list -> int list -> (int * int) list` such that `combine l1 l2` is the list of pairs obtained by joining the elements of `l1 and l2`. This function assumes that `l1` and `l2` have the same length. For instance, `combine [1;2] [3;4] = [(1, 3); (2, 4)]`. 9 | 10 | 4. Write a function `assoc : (string * int) list -> string -> int option` such that `assoc l k = Some x if (k, x)` is the first pair of `l` whose first component is `k`. If no such pair exists, `assoc l k = None`. 11 | 12 | ### YOUR OCAML ENVIRONMENT 13 | ```ocaml 14 | let rec mem x l = 15 | "Replace this string with your implementation." ;; 16 | 17 | let rec append l1 l2 = 18 | "Replace this string with your implementation." ;; 19 | 20 | let rec combine l1 l2 = 21 | "Replace this string with your implementation." ;; 22 | 23 | let rec assoc l k = 24 | "Replace this string with your implementation." ;; 25 | ``` 26 | -------------------------------------------------------------------------------- /week5/w5_4.2_ascii_art.ml: -------------------------------------------------------------------------------- 1 | type image = int -> int -> bool;; 2 | 3 | let all_white = fun x y -> false;; 4 | 5 | let all_black = fun x y -> true;; 6 | 7 | let checkers = fun x y -> y/2 mod 2 = x/2 mod 2;; 8 | 9 | let square cx cy s = fun x y -> 10 | let minx = cx - s / 2 in 11 | let maxx = cx + s / 2 in 12 | let miny = cy - s / 2 in 13 | let maxy = cy + s / 2 in 14 | x >= minx && x <= maxx && y >= miny && y <= maxy 15 | ;; 16 | 17 | let disk cx cy r = fun x y -> 18 | let x' = x - cx in 19 | let y' = y - cy in 20 | (x' * x' + y' * y') <= r * r 21 | ;; 22 | 23 | type blend = 24 | | Image of image 25 | | And of blend * blend 26 | | Or of blend * blend 27 | | Rem of blend * blend 28 | ;; 29 | 30 | let display_image width height f_image = 31 | for row = 0 to height do 32 | for col = 0 to width do 33 | match f_image col row with 34 | | false -> print_char ' ' 35 | | true -> print_char '#' 36 | done; 37 | print_newline () 38 | done 39 | ;; 40 | 41 | let rec render blend x y = 42 | match blend with 43 | | Image b -> b x y 44 | | And (b1, b2) -> ((render b1) x y) && ((render b2) x y) 45 | | Or (b1, b2) -> ((render b1) x y) || ((render b2) x y) 46 | | Rem (b1, b2) -> ((render b1) x y) && not ((render b2) x y) 47 | ;; 48 | 49 | let display_blend width height blend = 50 | display_image width height (render blend) 51 | ;; 52 | -------------------------------------------------------------------------------- /week2/w2_3.1_enigma.md: -------------------------------------------------------------------------------- 1 | # ENIGMA (30 points possible) 2 | Let us solve the following puzzle: 3 | If you multiply my grand-son age by four, you know how old I am. Now, if you exchange the two digits of our ages then you have to multiply by three my age to get the age of my grand-son! 4 | 5 | 1. Write a function `exchange` of type `int -> int` that takes an integer `x` between 10 and 99 and returns an integer which is `x` whose digits have been exchanged. For instance, `exchange 73 = 37`. 6 | 7 | 2. Define `is_valid_answer` of type `int * int -> bool` such that `is_valid_answer (grand_father_age, grand_son_age)` returns `true` if and only if `grand_father_age` and `grand_son_age` verify the constraints of the puzzle. 8 | 9 | 3. Write a function `find : (int * int) -> (int * int)` that takes a pair `(max_grand_father_age, min_grand_son_age)` and returns a solution `(grand_father_age, grand_son_age)` to the problem, where `min_grand_son_age <= grand_son_age < grand_father_age <= max_grand_father_age` or `(-1, -1)` if there was no valid answer in the given range. 10 | 11 | ### YOUR OCAML ENVIRONMENT 12 | ```ocaml 13 | let exchange k = 14 | "Replace this string with your implementation." ;; 15 | 16 | let is_valid_answer (grand_father_age, grand_son_age) = 17 | "Replace this string with your implementation." ;; 18 | 19 | let find answer = 20 | "Replace this string with your implementation." ;; 21 | ``` 22 | -------------------------------------------------------------------------------- /week5/w5_6.1_mutable_lists.ml: -------------------------------------------------------------------------------- 1 | type 'a xlist = 2 | { mutable pointer : 'a cell } 3 | and 'a cell = 4 | | Nil 5 | | List of 'a * 'a xlist ;; 6 | 7 | let nil () = 8 | { pointer = Nil } ;; 9 | 10 | let cons elt rest = 11 | { pointer = List (elt, rest) } ;; 12 | 13 | exception Empty_xlist ;; 14 | 15 | let head l = 16 | match l.pointer with 17 | | Nil -> raise Empty_xlist 18 | | List (hd, tl) -> hd 19 | 20 | let tail l = 21 | match l.pointer with 22 | | Nil -> raise Empty_xlist 23 | | List (hd, tl) -> tl 24 | 25 | let add a l = 26 | l.pointer <- List (a, { pointer = l.pointer }) 27 | 28 | (* Using the provided functions *) 29 | let add a l = 30 | match l.pointer with 31 | | Nil -> l.pointer <- List (a, nil ()) 32 | | List (hd, tl) -> l.pointer <- List (a, cons hd tl) 33 | 34 | let chop l = 35 | match l.pointer with 36 | | Nil -> raise Empty_xlist 37 | | List (hd, tl) -> l.pointer <- tl.pointer 38 | 39 | let rec append l1 l2 = 40 | match l1.pointer with 41 | | Nil -> l1.pointer <- l2.pointer 42 | | List (hd, tl) -> append tl l2 43 | 44 | let rec filter p l = 45 | match l.pointer with 46 | | Nil -> () 47 | | List (hd, tl) when p hd -> filter p tl 48 | | List (hd, tl) -> l.pointer <- tl.pointer; filter p l 49 | 50 | (* 51 | let xl = { pointer = List (1, { pointer = List (2, { pointer = List (3, { pointer = Nil }) }) }) } 52 | let even a = a mod 2 == 0 53 | *) 54 | -------------------------------------------------------------------------------- /week1/w1_6.1_prime_numbers.md: -------------------------------------------------------------------------------- 1 | # PRIME NUMBERS (30 points possible) 2 | Let's define some usual arithmetical functions. 3 | 4 | 1. `gcd` that takes two non-negative integers `n` and `m`, and that returns the greatest common divisor of `n` and `m`, following Euclid's algorithm. 5 | 2. `multiple_upto : int -> int -> bool` that takes two non-negative integers `n` and `r`, and that tells whether `n` admits at least one divisor between `2` and `r`, inclusive. In other words that there exists a number `d >= 2` an`d <= r`, such that the remainder of the division of `n` by `d` is zero. 6 | 3. `is_prime` that takes a non-negative integer `n` and checks whether it is a prime number. 7 | 8 | **Important note**: You can assume that both `integer_square_root` and `multiple_of` exist, and that they are correct answers to the [Simple functions over integers](w1_5.1_simple_functions_over_integers.md) exercise from the previous sequence. 9 | 10 | Once `is_prime` works, you can try writing a new version of it which is self-contained (that contains all definitions of auxiliary functions as locally defined functions). 11 | 12 | ### YOUR OCAML ENVIRONMENT 13 | ```ocaml 14 | let gcd n m = 15 | "Replace this string with your implementation." ;; 16 | 17 | let multiple_upto n r = 18 | "Replace this string with your implementation." ;; 19 | 20 | let is_prime n = 21 | "Replace this string with your implementation." ;; 22 | ``` 23 | -------------------------------------------------------------------------------- /week2/w2_4.2_time_on_planet_shadokus.ml: -------------------------------------------------------------------------------- 1 | type date = 2 | { year : int; month : int; day : int; hour : int; minute : int } 3 | 4 | let the_origin_of_time = 5 | { year = 1; month = 1; day = 1; hour = 0; minute = 0 } 6 | 7 | let wellformed {year; month; day; hour; minute} = 8 | year >= 1 && month >= 1 && month <= 5 && day >=1 && day <= 4 && 9 | hour >= 0 && hour <= 2 && minute >= 0 && minute <= 1 10 | 11 | let next {year; month; day; hour; minute} = 12 | if minute = 0 then 13 | {year; month; day; hour; minute = 1} 14 | else if hour < 2 then 15 | {year; month; day; hour = hour + 1; minute = 0} 16 | else if day < 4 then 17 | {year; month; day = day + 1; hour = 0; minute = 0} 18 | else if month < 5 then 19 | {year; month = month + 1; day = 1; hour = 0; minute = 0} 20 | else 21 | {year = year + 1; month = 1; day = 1; hour = 0; minute = 0} 22 | 23 | let of_int m = 24 | let minutes_in_hour = 2 in 25 | let minutes_in_day = 3 * minutes_in_hour in 26 | let minutes_in_month = 4 * minutes_in_day in 27 | let minutes_in_year = 5 * minutes_in_month in 28 | let year = m / minutes_in_year + 1 29 | and m = m mod minutes_in_year in 30 | let month = m / minutes_in_month + 1 31 | and m = m mod minutes_in_month in 32 | let day = m / minutes_in_day + 1 33 | and m = m mod minutes_in_day in 34 | let hour = m / minutes_in_hour 35 | and minute = m mod minutes_in_hour 36 | in {year; month; day; hour; minute} 37 | -------------------------------------------------------------------------------- /week3/w3_6.1_advanced_patterns.md: -------------------------------------------------------------------------------- 1 | # ADVANCED PATTERNS (60 points possible) 2 | Let's rewrite some pattern matching with advanced constructs. 3 | 4 | 1. Factorize the pattern matching of function simplify using or-patterns. It should boil down to three cases. 5 | 6 | 2. The `only_small_lists` function takes a list as input and returns this list only if it contains two or less elements, otherwise the empty list is returned. Rewrite this function using or-patterns and an `as`-pattern. It should boil down to two cases. 7 | 8 | 3. Turn the third case of `no_consecutive_repetition` into two distinct cases, dropping the `if` construct in favor of a `when` clause. 9 | 10 | ### THE GIVEN PRELUDE 11 | ```ocaml 12 | type e = EInt of int | EMul of e * e | EAdd of e * e 13 | ``` 14 | 15 | ### YOUR OCAML ENVIRONMENT 16 | ```ocaml 17 | let simplify = function 18 | | EMul (EInt 1, e) -> e 19 | | EMul (e, EInt 1) -> e 20 | | EMul (EInt 0, e) -> EInt 0 21 | | EMul (e, EInt 0) -> EInt 0 22 | | EAdd (EInt 0, e) -> e 23 | | EAdd (e, EInt 0) -> e 24 | | e -> e 25 | 26 | let only_small_lists = function 27 | | [] -> [] 28 | | [x] -> [x] 29 | | [x;y] -> [x;y] 30 | | _ -> [] 31 | 32 | let rec no_consecutive_repetition = function 33 | | [] -> [] 34 | | [x] -> [x] 35 | | x :: y :: ys -> 36 | if x = y then 37 | no_consecutive_repetition (y :: ys) 38 | else 39 | x :: (no_consecutive_repetition (y :: ys)) 40 | ``` 41 | -------------------------------------------------------------------------------- /week3/w3_1.3_option_type.md: -------------------------------------------------------------------------------- 1 | # THE OPTION TYPE (30 points possible) 2 | Optional values are commonly used in OCaml in the return type of partial functions, i.e. functions that may fail on some input. The following questions illustrate such situations. 3 | In the `Pervasives` module which is loaded automatically, there is a type `option` with two constructors: 4 | * `Some (e)` has type `'t option` if e has type `'t` and represents the presence of some value `e` of type `'t` 5 | * `None` has type `'t option` and represents the absence of some value of type `'t` 6 | 7 | 1. Write a function `find : string array -> string -> int option such that find a w = Some idx if a.(idx) = w and find a w = None if there is no such index. 8 | 9 | 2. Sometimes, when a value of type t is missing, a default value should be used. 10 | Write a function default_int : int option -> int such that: default_int None = 0 and default_int (Some x) = x. 11 | 12 | 3. Write a function `merge : int option -> int option -> int option` such that: 13 | * `merge None None = None` 14 | * `merge (Some x) None = merge None (Some x) = Some x` 15 | * `merge (Some x) (Some y) = Some (x + y)` 16 | 17 | ### YOUR OCAML ENVIRONMENT 18 | ```ocaml 19 | let find a w = 20 | "Replace this string with your implementation." ;; 21 | 22 | let default_int = 23 | "Replace this string with your implementation." ;; 24 | 25 | let merge a b = 26 | "Replace this string with your implementation." ;; 27 | ``` 28 | -------------------------------------------------------------------------------- /week2/w2_4.1_points_and_vectors.md: -------------------------------------------------------------------------------- 1 | # POINTS AND VECTORS (30 points possible) 2 | The given prelude defines three types, one for three dimensional points, another for velocity vectors in three dimensions, and another one representing moving objects in space. 3 | 4 | 1. Write a function `move : point -> dpoint -> point` such that `move p dp` is the point `p` whose coordinates have been updated according to `dp`. 5 | (`x` is now `x +. dx`, `y` is now `y +. dy`, `z` is now `z +. dz`). 6 | 7 | 2. Write a function `next : physical_object -> physical_object` such that `next o` is the physical object `o` at time `t + dt`. 8 | The position of `next o` is the position of o moved according to its velocity vector. 9 | Suppose that these objects are spheres whose radius is `1.0`. 10 | 11 | 3. Write a function `will_collide_soon : physical_object -> physical_object -> bool` that tells if at the next instant, the two spheres will intersect. 12 | 13 | ### THE GIVEN PRELUDE 14 | ```ocaml 15 | type point = { x : float; y : float; z : float } 16 | type dpoint = { dx : float; dy : float; dz : float } 17 | type physical_object = { position : point; velocity : dpoint } 18 | ``` 19 | 20 | ### YOUR OCAML ENVIRONMENT 21 | ```ocaml 22 | let move p dp = 23 | "Replace this string with your implementation." ;; 24 | 25 | let next obj = 26 | "Replace this string with your implementation." ;; 27 | 28 | let will_collide_soon p1 p2 = 29 | "Replace this string with your implementation." ;; 30 | ``` 31 | -------------------------------------------------------------------------------- /week4/w4_5.1_writing_map.md: -------------------------------------------------------------------------------- 1 | # USING AND WRITING THE MAP FUNCTION (30 points possible) 2 | The idea of this exercise is to use the principle of the `map` function to implement algorithms that transform data structures using higher-order functions. 3 | 4 | 1. Using the function `map` from the module `List`, write a function `wrap : 'a list -> 'a list list` that transforms a `list` of elements `'a` into a list of singleton lists. 5 | For instance, `wrap [1;2;3]` is equal to `[[1];[2];[3]]` 6 | 2. Consider the definition of the type `tree` given in the prelude. It represents binary trees carrying data items, on its internal nodes, and on its leaves. 7 | Write a function `tree_map : ('a -> 'b) -> 'a tree -> 'b tree` such that `tree_map f t` yields a tree of the same structure as `t`, but with all its data values `x` replaced by `f x`. 8 | For example, suppose a function `string_of_int : int -> string`, that takes an integer and generates the string that represent this integer. Applied to `tree_map` and a tree of integers (i.e. of type `int tree`), it would yield a tree of strings (i.e. of type `string tree`). 9 | 10 | ### THE GIVEN PRELUDE 11 | ```ocaml 12 | type 'a tree = 13 | Node of 'a tree * 'a * 'a tree 14 | | Leaf of 'a;; 15 | ``` 16 | 17 | ### YOUR OCAML ENVIRONMENT 18 | ```ocaml 19 | let wrap l = 20 | "Replace this string with your implementation." ;; 21 | 22 | let rec tree_map f = function _ -> 23 | "Replace this string with your implementation." ;; 24 | ``` 25 | -------------------------------------------------------------------------------- /week3/w3_2.1_fifo.md: -------------------------------------------------------------------------------- 1 | # FIRST IN FIRST OUT (50 points possible) 2 | A queue is a standard FIFO data structure. See wikipedia 3 | 4 | In this exercise, we implement a queue with a pair of two lists `(front, back)` such that `front @ List.rev back` represents the sequence of elements in the queue. 5 | 6 | 1. Write a function `is_empty : queue -> bool` such that `is_empty q` is true if and only if `q` has no element. 7 | 8 | 2. Write a function `enqueue : int -> queue -> queue` such that `enqueue x q` is the queue as `q` except that `x` is at the end of the queue. 9 | 10 | 3. Write a function `split : int list -> int list * int list` such that `split l = (front, back)` where `l = back @ List.rev front` and the length of `back` and `front` is `List.length l / 2` or `List.length l / 2 + 1` 11 | 12 | 4. Write a function `dequeue : queue -> int * queue` such that `dequeue q = (x, q')` where `x `is the front element of the queue `q` and `q'` corresponds to remaining elements. This function assumes that `q` is non empty. 13 | 14 | ### THE GIVEN PRELUDE 15 | ```ocaml 16 | type queue = int list * int list 17 | ``` 18 | 19 | ### YOUR OCAML ENVIRONMENT 20 | ```ocaml 21 | let is_empty (front, back) = 22 | "Replace this string with your implementation." ;; 23 | 24 | let enqueue x (front, back) = 25 | "Replace this string with your implementation." ;; 26 | 27 | let split l = 28 | "Replace this string with your implementation." ;; 29 | 30 | let dequeue (front, back) = 31 | "Replace this string with your implementation." ;; 32 | ``` 33 | -------------------------------------------------------------------------------- /week6/w6_4.1_remove_from_dictionaries.md: -------------------------------------------------------------------------------- 1 | # REMOVE ELEMENTS FROM DICTIONARIES (20 points possible) 2 | The following code is the program explained during the video sequence except that we have modified the interface `DictSig` a little bit. Now, it is possible to `remove` a key from a dictionary. 3 | 4 | 1. Update the code to have it accepted by the type-checker. 5 | 6 | ### THE GIVEN PRELUDE 7 | ```ocaml 8 | module type DictSig = sig 9 | type ('key, 'value) t 10 | val empty : ('key, 'value) t 11 | val add : ('key, 'value) t -> 'key -> 'value -> ('key, 'value) t 12 | exception NotFound 13 | val lookup : ('key, 'value) t -> 'key -> 'value 14 | val remove : ('key, 'value) t -> 'key -> ('key, 'value) t 15 | end ;; 16 | ``` 17 | 18 | ### YOUR OCAML ENVIRONMENT 19 | ```ocaml 20 | module Dict : DictSig = struct 21 | type ('key, 'value) t = 22 | | Empty 23 | | Node of ('key, 'value) t * 'key * 'value * ('key, 'value) t 24 | 25 | let empty = Empty 26 | 27 | let rec add d k v = 28 | match d with 29 | | Empty -> Node (Empty, k, v, Empty) 30 | | Node (l, k', v', r) -> 31 | if k = k' then Node (l, k, v, r) 32 | else if k < k' then Node (add l k v, k', v', r) 33 | else Node (l, k', v', add r k v) 34 | 35 | exception NotFound 36 | 37 | let rec lookup d k = 38 | match d with 39 | | Empty -> 40 | raise NotFound 41 | | Node (l, k', v', r) -> 42 | if k = k' then v' 43 | else if k < k' then lookup l k 44 | else lookup r k 45 | 46 | end ;; 47 | ``` 48 | -------------------------------------------------------------------------------- /week2/README.md: -------------------------------------------------------------------------------- 1 | # Week 2: Basic data structures 2 | 3 | ### 1. Greetings 4 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/VSIxzy56XttM/HD.mp4) 5 | ### 2. User-defined types 6 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/UvRnoNSD1jI1/HD.mp4) 7 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_daad419654f660a486011f5b542d9f7f.pdf) 8 | 1. online questionnaire 9 | ### 3. Tuples 10 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/IlFMdGXNkoQH/HD.mp4) 11 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_e7e26a0ac2e1758814e4999a9242ba71.pdf) 12 | 1. [Enigma](w2_3.1_enigma.md) 13 | ### 4. Records 14 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/YRRX3Bozy7MW/HD.mp4) 15 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_db231ec39f2ce4d5ad1de0abfc8970d9.pdf) 16 | 1. [Points and vectors](w2_4.1_points_and_vectors.md) 17 | 2. [Time on planet shadokus](w2_4.2.points_and_vectors.md) 18 | ### 5. Arrays 19 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/cGt4s3SBESZ5/HD.mp4) 20 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_ff43b8de4f41d5103405ddb62eb8d34e.pdf) 21 | 1. [Finding the minimum](w2_5.1_finding_the_minimum.md) 22 | 2. [Searching for strings in arrays](w2_5.2_strings_in_arrays.md) 23 | ### 6. Case study: A small typed database 24 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/NF3RKQIXDrL9/HD.mp4) 25 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_c0c983a47c57dbdd09a9da5610ef8295.pdf) 26 | 1. [A small typed database](w2_6.1_small_typed_db.md) 27 | -------------------------------------------------------------------------------- /week6/w6_4.1_remove_from_dictionaries.ml: -------------------------------------------------------------------------------- 1 | module type DictSig = sig 2 | type ('key, 'value) t 3 | val empty : ('key, 'value) t 4 | val add : ('key, 'value) t -> 'key -> 'value -> ('key, 'value) t 5 | exception NotFound 6 | val lookup : ('key, 'value) t -> 'key -> 'value 7 | val remove : ('key, 'value) t -> 'key -> ('key, 'value) t 8 | end ;; 9 | 10 | 11 | module Dict : DictSig = struct 12 | 13 | type ('key, 'value) t = 14 | | Empty 15 | | Node of ('key, 'value) t * 'key * 'value * ('key, 'value) t 16 | 17 | let empty = Empty 18 | 19 | let rec add d k v = 20 | match d with 21 | | Empty -> Node (Empty, k, v, Empty) 22 | | Node (l, k', v', r) -> 23 | if k = k' then Node (l, k, v, r) 24 | else if k < k' then Node (add l k v, k', v', r) 25 | else Node (l, k', v', add r k v) 26 | 27 | exception NotFound 28 | 29 | let rec lookup d k = 30 | match d with 31 | | Empty -> raise NotFound 32 | | Node (l, k', v', r) -> 33 | if k = k' then v' 34 | else if k < k' then lookup l k 35 | else lookup r k 36 | 37 | let rec remove d k = 38 | let rec merge l r = 39 | match l with 40 | | Empty -> r 41 | | Node (ll, kk, vv, rr) -> Node (ll, kk, vv, merge rr r) 42 | in 43 | match d with 44 | | Empty -> d 45 | | Node (l, k', v', r) -> 46 | if k = k' then 47 | match l, r with 48 | | Empty, _ -> r 49 | | _, Empty -> l 50 | | _, _ -> merge l r 51 | else if k < k' then Node ((remove l k), k', v', r) 52 | else Node (l, k', v', (remove r k)) 53 | 54 | end ;; 55 | -------------------------------------------------------------------------------- /week3/w3_3.2_tries.ml: -------------------------------------------------------------------------------- 1 | type trie = Trie of int option * char_to_children 2 | and char_to_children = (char * trie) list 3 | 4 | let empty = Trie (None, []) 5 | 6 | let example = 7 | Trie (None, 8 | [('i', Trie (Some 11, 9 | [('n', Trie (Some 5, [('n', Trie (Some 9, []))]))])); 10 | ('t', 11 | Trie (None, 12 | [('e', 13 | Trie (None, 14 | [('n', Trie (Some 12, [])); ('d', Trie (Some 4, [])); 15 | ('a', Trie (Some 3, []))])); 16 | ('o', Trie (Some 7, []))])); 17 | ('A', Trie (Some 15, []))]) 18 | 19 | let children_from_char c2c c = 20 | let rec aux = function 21 | | [] -> None 22 | | (c', t) :: tl when c' = c -> Some t 23 | | _ :: tl -> aux tl 24 | in aux c2c 25 | 26 | let update_children c2c c t = 27 | let rec aux = function 28 | | [] -> [(c, t)] 29 | | (c', t') :: tl when c' = c -> (c, t) :: tl 30 | | hd :: tl -> hd :: (aux tl) 31 | in aux c2c 32 | 33 | let lookup t key = 34 | let rec aux i (Trie (value, c2c)) = 35 | if i >= String.length key 36 | then value 37 | else match children_from_char c2c key.[i] with 38 | | None -> None 39 | | Some t -> aux (i + 1) t 40 | in aux 0 t 41 | 42 | let insert t key value = 43 | let rec aux i (Trie (v, c2c)) = 44 | if i >= String.length key 45 | then Trie (Some value, c2c) 46 | else match children_from_char c2c key.[i] with 47 | | None -> Trie (v, update_children c2c key.[i] (aux (i + 1) empty)) 48 | | Some t -> Trie (v, update_children c2c key.[i] (aux (i + 1) t)) 49 | in aux 0 t 50 | -------------------------------------------------------------------------------- /week6/w6_5.1_char_indexed_hashtables.ml: -------------------------------------------------------------------------------- 1 | module type GenericTrie = sig 2 | type 'a char_table 3 | type 'a trie = Trie of 'a option * 'a trie char_table 4 | val empty : unit -> 'a trie 5 | val insert : 'a trie -> string -> 'a -> 'a trie 6 | val lookup : 'a trie -> string -> 'a option 7 | end 8 | 9 | module CharHashedType = struct 10 | type t = char 11 | let equal c1 c2 = c1 = c2 12 | let hash c = Char.code c 13 | end;; 14 | 15 | module CharHashtbl = Hashtbl.Make(CharHashedType);; 16 | 17 | module Trie : GenericTrie 18 | with type 'a char_table = 'a CharHashtbl.t = 19 | struct 20 | type 'a char_table = 'a CharHashtbl.t 21 | type 'a trie = Trie of 'a option * 'a trie char_table 22 | 23 | let empty () = Trie (None, CharHashtbl.create 100) 24 | 25 | let lookup trie w = 26 | let rec aux i (Trie (value, children)) = 27 | if i >= String.length w then 28 | value 29 | else 30 | try 31 | aux (i + 1) (CharHashtbl.find children w.[i]) 32 | with Not_found -> None 33 | in aux 0 trie 34 | 35 | let insert trie w v = 36 | let rec aux i (Trie (value, children)) = 37 | if i >= String.length w then 38 | Trie (Some v, children) 39 | else 40 | try 41 | let subtrie = CharHashtbl.find children w.[i] in 42 | let newtrie = aux (i + 1) subtrie in 43 | CharHashtbl.replace children w.[i] newtrie ; 44 | Trie (value, children) 45 | with Not_found -> 46 | begin 47 | CharHashtbl.add children w.[i] (aux (i + 1) (empty ())); 48 | Trie (value, children) 49 | end 50 | in aux 0 trie 51 | end;; 52 | -------------------------------------------------------------------------------- /week4/w4_6.2_fold_check_predicates.md: -------------------------------------------------------------------------------- 1 | # USING FOLD TO CHECK PREDICATES (75 points possible) 2 | 1. Using `List.fold_left`, write a function `for_all : ('a -> bool) -> 'a list -> bool`. It takes as argument a list `l` of type `'a list`, and a predicate `p` of type `'a -> bool`. It must return `true` if and only if all elements of `l` satisfy the predicate `p`. 3 | 2. Using `List.fold_left`, write a function `exists : ('a -> bool) -> 'a list -> bool`. It takes as argument a list `l` of type `'a list`, and a predicate `p` of type `'a -> bool`. It must returns `true` if at least one element of `l` satisfies the predicate `p`. 4 | 3. Write a function `sorted : ('a -> 'a -> int) -> 'a list -> bool`, using `List.fold_left` that checks that a list of elements `l` of type `'a` is sorted, according to an ordering function `cmp` of type `'a -> 'a -> int`. 5 | The ordering function returns: 6 | * `1` (or any positive number) if the first element is greater than the second, 7 | * `-1` (or any negative number) if the first element is lesser than the second, 8 | * and `0` otherwise. 9 | 10 | For the `fold_left` part, you can use the type `'a option` as the accumulator: at each iteration of `fold_left`, if the list if sorted until now, the acccumulator is either `Some v`, where `v` is the previous element, or `None` otherwise. 11 | Remember, the empty list is sorted, so you can use the list with at least one element to check using `fold_left`. 12 | 13 | # YOUR OCAML ENVIRONMENT 14 | ``` 15 | let for_all p l = 16 | "Replace this string with your implementation." 17 | 18 | let exists p l = 19 | "Replace this string with your implementation." 20 | 21 | let sorted cmp l = 22 | "Replace this stirng with your implementation." 23 | ``` 24 | -------------------------------------------------------------------------------- /week5/w5_7.1_references.md: -------------------------------------------------------------------------------- 1 | # SIMPLE USES OF REFERENCES (50 points possible) 2 | 1. Define `swap : 'a ref -> 'a ref -> unit` that swaps the contents of two references. 3 | 2. Define `update : 'a ref -> ('a -> 'a) -> 'a` that calls a function on the contents of a reference, updates it with the result, and returns the old value. 4 | For instance `let r = ref 6 in update r (function x -> x + 1)` should return `6` and set the reference to `7`. 5 | 3. Define `move: 'a list ref -> 'a list ref -> unit`, that removes the top argument from the first list and puts it on top of the second list. If the first list is empty, it should `raise Empty`. 6 | 4. A common pattern is to use a reference to perform a computation in an imperative way, but to keep it in a local definition, completely invisible from outside the function implementation. Define `reverse: 'a list -> 'a list`, that has a type and an observable behaviour that look like the ones of a purely functional function, buf that use a reference internally to perform the computation. It takes a list, and returns a copy of the list whose elements are in reverse order. The only functions you can call, except from locally defined functions, are `(!)`, `(:=)`, `ref`, and `move` that you just defined. And you are not allowed to use pattern matching. 7 | 8 | ### THE GIVEN PRELUDE 9 | ``` 10 | exception Empty ;; 11 | ``` 12 | 13 | ### YOUR OCAML ENVIRONMENT 14 | ``` 15 | let swap ra rb = 16 | "Replace this string with your implementation." ;; 17 | 18 | let update r f = 19 | "Replace this string with your implementation." ;; 20 | 21 | let move l1 l2 = 22 | "Replace this string with your implementation." ;; 23 | 24 | let reverse l = 25 | "Replace this string with your implementation." ;; 26 | ``` 27 | -------------------------------------------------------------------------------- /week4/w4_6.1_fold_produce_lists.md: -------------------------------------------------------------------------------- 1 | # USING FOLD TO PRODUCE LISTS (30 points possible) 2 | The idea of this exercise is to write functions that iterate on lists, using the `fold_left` and `fold_right` functions from the `List` module. 3 | 4 | 1. Write a function `filter : ('a -> bool) -> 'a list -> 'a list` that takes a predicate `p` (a function returning a boolean) and a list `l` and returns all the elements of `l` that satisfy `p` (for which `p` returns `true`). 5 | 6 | 2. Define, using `List.fold_right`, a function `partition : ('a -> bool) -> 'a list -> 'a list * 'a list` that takes a predicate `p` and a list `l`, and that partitions `l` by `p`. It returns a pair of two lists `(lpos,lneg)`, where `lpos` is the list of all elements of `l` that satisfy `p`, and `lneg` is the list of all elements that do not satisfy `p`. 7 | 8 | One way of sorting a list is as follows: 9 | * The empty list is already sorted. 10 | * If the list `l` has a head `h` and a rest `r`, then a sorted version of `l` can be obtained in three parts: 11 | * first a sorted version of all elements of `r` that are smaller or equal to `h`, 12 | * then `h`, 13 | * then a sorted version of all elements of `r` that are greater than `h`. 14 | 15 | 3. Write a function `sort:'a list-> 'a list` that implements this algorithm, using the function partition of the previous question. This sorting algorithm is also known as [Quicksort](https://en.wikipedia.org/wiki/Quicksort) where the pivot is always the first element of the list. 16 | 17 | # YOUR OCAML ENVIRONMENT 18 | ``` 19 | let filter p l = 20 | "Replace this string with your implementation";; 21 | 22 | let partition p l = 23 | "Replace this string with your implementation";; 24 | 25 | let rec sort = function _ -> 26 | "Replace this string with your implementation";; 27 | ``` 28 | -------------------------------------------------------------------------------- /week6/README.md: -------------------------------------------------------------------------------- 1 | # Week 6: Modules and data abstraction 2 | 3 | ### 1. Guests 4 | [video1](https://d381hmu4snvm3e.cloudfront.net/videos/6tD0JtVjY690/HD.mp4) 5 | [video2](https://d381hmu4snvm3e.cloudfront.net/videos/35mHUkV8vtJv/HD.mp4) 6 | 7 | ### 2. Structuring software with modules 8 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/ayptJDKdOumK/HD.mp4) 9 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_d691f3b3efbd773e991c84f5dc549d34.pdf) 10 | 1. [Opening modules](w6_2.1_opening_modules.md) 11 | 2. [Accessing modules and submodules](w6_2.2_accessing_modules.md) 12 | 3. [Wrapping functions in a module](w6_2.3_wrapping_functions.md) 13 | 14 | ### 3. Information hiding 15 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/HsPi9JbczS2e/HD.mp4) 16 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_7b3f9a1e2a34731ea91ed3516f6afae4.pdf) 17 | 1. [Type abstraction using a signature](w6_3.1_type_abstraction.md) 18 | 2. [Multiset](w6_3.2_multiset.md) 19 | 20 | ### 4. Case study: A module for dictionaries 21 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/qc7HztbVrMSS/HD.mp4) 22 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_c5fa6fce75affe954f7609f0b487717b.pdf) 23 | 1. [Remove elements from dictionaries](w6_4.1_remove_from_dictionaries.md) 24 | 25 | ### 5. Functors 26 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/CtthsDta8U9m/HD.mp4) 27 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_dd70c26541265120a21b9bf21c985cc1.pdf) 28 | 1. [Char indexed hashtables](w6_5.1_char_indexed_hashtables.md) 29 | 30 | ### 6. Modules as compilation units 31 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/GHc5cYQ1MTQn/HD.mp4) 32 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_f2ccdfae3814582715015538eda56213.pdf) 33 | -------------------------------------------------------------------------------- /week3/w3_1.2_type_array_indexes.md: -------------------------------------------------------------------------------- 1 | # A TYPE FOR ARRAY INDEXES (40 points possible) 2 | The previous week, we asked you the following question: Consider a non empty array of integers `a`, write a function `min_index : int array -> int` that returns the index of the minimal element of `a`. 3 | As the arrays contain integers and the indices of arrays are also represented by integers, you might have confused an index and the content of a cell. To avoid such a confusion, let us define a type for index (given in the prelude below). 4 | This type has a single constructor waiting for one integer. 5 | For instance, if you want to represent the index 0, use the value `Index 0`. 6 | Defining such a type is interesting because it allows the type-checker to check that an integer is not used where an index is expected (or the converse). 7 | 8 | 1. Write a function `read : int array -> index -> int` such that `read a (Index k)` returns the k-th element of `a`. 9 | 10 | 2. Write a function `inside : int array -> index -> bool` such that `inside a idx` is true if and only if `idx` is a valid index for the array `a`. 11 | 12 | 3. Write a function `next : index -> index` such that `next (Index k)` is equal to `Index (k + 1)`. 13 | 14 | 4. Consider a non empty array of integers `a`, write a function `min_index : int array -> index` that returns the index of the minimal element of `a`. 15 | 16 | ### THE GIVEN PRELUDE 17 | ```ocaml 18 | type index = Index of int 19 | ``` 20 | 21 | ### YOUR OCAML ENVIRONMENT 22 | ```ocaml 23 | let read a index = 24 | "Replace this string with your implementation." ;; 25 | 26 | let inside a index = 27 | "Replace this string with your implementation." ;; 28 | 29 | let next index = 30 | "Replace this string with your implementation." ;; 31 | 32 | let min_index a = 33 | "Replace this string with your implementation." ;; 34 | ``` 35 | -------------------------------------------------------------------------------- /week6/w6_2.2_accessing_modules.ml: -------------------------------------------------------------------------------- 1 | module Tree = struct 2 | 3 | type 'a t = 4 | | Leaf of 'a 5 | | Node of 'a t * 'a * 'a t 6 | 7 | module Iterator = struct 8 | 9 | type 'a path = 10 | | Top 11 | | Left of 'a path * 'a * 'a t 12 | | Right of 'a t * 'a * 'a path 13 | 14 | type 'a iterator = Loc of 'a t * 'a path 15 | 16 | exception Fail 17 | 18 | let go_left (Loc (t, p)) = 19 | match p with 20 | | Top -> raise Fail 21 | | Left (father, x, right) -> raise Fail 22 | | Right (left, x, father) -> Loc (left, Left (father, x, t)) 23 | 24 | let go_right (Loc (t, p)) = 25 | match p with 26 | | Top -> raise Fail 27 | | Left (father, x, right) -> Loc (right, Right (t, x, father)) 28 | | Right (left, x, father) -> raise Fail 29 | 30 | let go_up (Loc (t, p)) = 31 | match p with 32 | | Top -> raise Fail 33 | | Left(father, x, right) -> Loc (Node (t, x, right), father) 34 | | Right(left, x, father) -> Loc (Node (left, x, t), father) 35 | 36 | let go_first (Loc (t, p)) = 37 | match t with 38 | | Leaf _ -> raise Fail 39 | | Node (left, x, right) -> Loc (left, Left (p, x, right)) 40 | 41 | let go_second (Loc (t, p)) = 42 | match t with 43 | | Leaf _ -> raise Fail 44 | | Node (left, x, right) -> Loc (right, Right (left, x, p)) 45 | 46 | let focus (Loc ((Leaf x | Node (_, x, _)), _)) = x 47 | 48 | end 49 | 50 | end 51 | 52 | 53 | let bfs t = 54 | let rec aux results = function 55 | | [] -> List.rev results 56 | | l :: ls -> 57 | let results = (Tree.Iterator.focus l) :: results in 58 | try 59 | aux results (ls @ [Tree.Iterator.go_first l; Tree.Iterator.go_second l]) 60 | with Tree.Iterator.Fail -> 61 | aux results ls 62 | in 63 | aux [] [Tree.Iterator.Loc (t, Tree.Iterator.Top)] 64 | -------------------------------------------------------------------------------- /week0/README.md: -------------------------------------------------------------------------------- 1 | # Week 0: Introduction and overview 2 | 3 | ### 1. Greetings 4 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/3jbehxvVsV06/HD.mp4) 5 | ### 2. Introduction to the course 6 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/i66sbZLvsP86/HD.mp4) 7 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_6e2bc99158af73d43dabb3d4ea74b933.pdf) 8 | ### 3. Functional Programming: history and motivation 9 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/cn6dsQpJeeIY/HD.mp4) 10 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_dc067b7ccf6e431fafa35782a4565878.pdf) 11 | 1. online questionnaire 12 | ### 4. The OCaml language: history and key features 13 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/ofnY8kQULyad/HD.mp4) 14 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_d1208a384561b0b21da5e08da1ab211e.pdf) 15 | ### 5. Why the OCaml language: meet the users 16 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/e4knfD4IcbNx/HD.mp4) 17 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_b04aacab285c0131e099361803687b03.pdf) 18 | ### 6. Tools and development environment: first steps in OCaml! 19 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/ZNdQMmWhOd80/HD.mp4) 20 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_7b33dbf49c64877e7ccbea48e5e99317.pdf) 21 | ### 7. A brief showcase of some of OCaml's features 22 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/Zfi5HemrIhqu/HD.mp4) 23 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_a7ff1928f5544d8a4d16239438a71ff9.pdf) 24 | ### 8. Overview of the available resources 25 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/j8q9eCkv5CKE/HD.mp4) 26 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_c778b5ca359ca9af849f5274aa48b045.pdf) 27 | -------------------------------------------------------------------------------- /week6/w6_3.2_multiset.ml: -------------------------------------------------------------------------------- 1 | module type MultiSet_S = sig 2 | 3 | (* A multi-set of type ['a t] is a collection of values of 4 | type ['a] that may occur several times. *) 5 | type 'a t 6 | 7 | (* [occurrences s x] return the number of time [x] occurs 8 | in [s]. *) 9 | val occurrences : 'a t -> 'a -> int 10 | 11 | (* The empty set has no element. There is only one unique 12 | representation of the empty set. *) 13 | val empty : 'a t 14 | 15 | (* [insert s x] returns a new multi-set that contains all 16 | elements of [s] and a new occurrence of [x]. Typically, 17 | [occurrences s x = occurrences (insert s x) x + 1]. *) 18 | val insert : 'a t -> 'a -> 'a t 19 | 20 | (* [remove s x] returns a new multi-set that contains all elements 21 | of [s] minus an occurrence of [x] (if [x] actually occurs in 22 | [s]). Typically, [occurrences s x = occurrences (remove s x) x - 23 | 1] if [occurrences s x > 0]. *) 24 | val remove : 'a t -> 'a -> 'a t 25 | 26 | end 27 | 28 | 29 | module MultiSet : MultiSet_S = struct 30 | type 'a t = ('a * int) list 31 | 32 | let occurrences s x = 33 | try 34 | List.assoc x s 35 | with Not_found -> 0 36 | 37 | let empty = [] 38 | 39 | let insert s x = 40 | match occurrences s x with 41 | | 0 -> List.sort compare ((x, 1) :: s) 42 | | i -> List.sort compare ((x, (i + 1)) :: (List.remove_assoc x s)) 43 | 44 | let remove s x = 45 | match occurrences s x with 46 | | 0 -> s 47 | | 1 -> List.remove_assoc x s 48 | | i -> List.sort compare ((x, (i - 1)) :: (List.remove_assoc x s)) 49 | 50 | end ;; 51 | 52 | 53 | let letters word = 54 | let rec aux s = function 55 | | 0 -> s 56 | | i -> aux (MultiSet.insert s word.[i - 1]) (i - 1) 57 | in aux MultiSet.empty (String.length word);; 58 | 59 | let anagram word1 word2 = 60 | letters word1 = letters word2 ;; 61 | -------------------------------------------------------------------------------- /week1/README.md: -------------------------------------------------------------------------------- 1 | # Week 1: Basic types, definitions and functions 2 | 3 | ### 0. Tezos 4 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/I6bhLOYjz9hK/HD.mp4) 5 | ### 1. Basic Data Types 6 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/5g3K084ReT5q/HD.mp4) 7 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_a198cde3b7315005a64f23667f45da35.pdf) 8 | 1. online questionnaire 9 | 2. online questionnaire 10 | ### 2. More Data Types 11 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/szmM107ucMBg/HD.mp4) 12 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_fe5ebc2306cdc7462a531f4d980446d5.pdf) 13 | 1. online questionnaire 14 | 2. online questionnaire 15 | ### 3. Expressions 16 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/6BKTtJJk6mgE/HD.mp4) 17 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_d3c7279c25a23f98e777a7bebe35d002.pdf) 18 | 1. online questionnaire 19 | 2. online questionnaire 20 | ### 4. Definitions 21 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/nVAYnxd2RLLN/HD.mp4) 22 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_97d8f56bf41502f60ca6fdd5d5da8edc.pdf) 23 | 1. [Integer identifiers](w1_4.1_integer_identifiers.md) 24 | 2. [String identifiers](w1_4.2_string_identifiers.md) 25 | ### 5. Functions 26 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/ZrPOBHdpPd7z/HD.mp4) 27 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_e93acb146e114b5dfa6ce2d12dcb96e4.pdf) 28 | 1. [Simple functions over integers](w1_5.1_simple_functions_over_integers.md) 29 | 2. [Simple functions over strings](w1_5.2_simple_functions_over_strings.md) 30 | ### 6. Recursion 31 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/qaX8fVWsdDBZ/HD.mp4) 32 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_12fa464a36f8e5a187f5acfde99b7029.pdf) 33 | 1. [Prime numbers](w1_6.1_prime_numbers.md) 34 | -------------------------------------------------------------------------------- /week2/w2_4.2_time_on_planet_shadokus.md: -------------------------------------------------------------------------------- 1 | # TIME ON PLANET SHADOKUS (30 points possible) 2 | On planet Shadokus, a year has 5 months, each month has 4 days, each day has 3 hours and each hour has 2 minutes. A calendar date is therefore defined as the record type `date` of the given prelude. 3 | 4 | 1. A date is well-formed if its year index is `>= 1`, its month index is `>= 1` and `<= 5`, its day index is `>= 1` and `<= 4`, its hour index is `>= 0` and `<= 2`, and its minute index is `>= 0` and `<= 1`. 5 | The start of year `12` would be: 6 | ```ocaml 7 | { year = 12; month = 1; day = 1; hour = 0; minute = 0 } 8 | ``` 9 | The end of year `12` would be: 10 | ```ocaml 11 | { year = 12; month = 5; day = 4; hour = 2; minute = 1 } 12 | ``` 13 | 14 | Write a function `wellformed : date -> bool` which checks that the input date is well formed. 15 | 16 | 2. On planet Shadokus, the origin of time is the discovery of the Big-Lambda-Machine, a magical computer that evaluates the infinite lambda-term of time. It is defined by value `the_origin_of_time` of the given prelude. 17 | Write a function `next : date -> date` which computes the date which comes one minute after the input date. 18 | 19 | 3. In this computer, the time is represented by an integer that counts the number of minutes since `1/1/1 0:0` (the origin of time). 20 | Write a function `of_int : int -> date` that converts such an integer into a `date`. 21 | 22 | ### THE GIVEN PRELUDE 23 | ```ocaml 24 | type date = 25 | { year : int; month : int; day : int; 26 | hour : int; minute : int } 27 | 28 | let the_origin_of_time = 29 | { year = 1; month = 1; day = 1; 30 | hour = 0; minute = 0 } 31 | ``` 32 | 33 | ### YOUR OCAML ENVIRONMENT 34 | ```ocaml 35 | let wellformed date = 36 | "Replace this string with your implementation." ;; 37 | 38 | let next date = 39 | "Replace this string with your implementation." ;; 40 | 41 | let of_int minutes = 42 | "Replace this string with your implementation." ;; 43 | ``` 44 | -------------------------------------------------------------------------------- /week4/README.md: -------------------------------------------------------------------------------- 1 | # Week 4: Higher order functions 2 | 3 | ### 1. Functional Expressions 4 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/fSOz0LScMGoU/HD.mp4) 5 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_cdbf8e3df0b4f3188aea1fcef321a120.pdf) 6 | 1. [Lambda expressions as values](w4_1.1_lambdas_as_values.md) 7 | ### 2. Functions as First-Class Values 8 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/eboNEl8Z2Mxw/HD.mp4) 9 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_be705ee61e76da8236eb58e551dfc733.pdf) 10 | 1. [Using first class functions](w4_2.1_first_class_functions.md) 11 | ### 3. Functions with Multiple Arguments 12 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/b1w4y6rGMisT/HD.mp4) 13 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_7e96b222c6673949434b53ae3d10c139.pdf) 14 | 1. [Functions returning functions](w4_3.1_functions_returning_functions.md) 15 | ### 4. Partial Function Application 16 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/l1jfLVYAGWNO/HD.mp4) 17 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_20a41623c77ff6b43b5a93e54418a722.pdf) 18 | 1. [Optimizing partial applications](w4_4.1_opt_partial_applications.md) 19 | 2. [A small arithmetic interpreter](w4_4.2_small_arith_interpreter.md) 20 | ### 5. Mapping Functions on Lists 21 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/Qeyv8cH5PHsV/HD.mp4) 22 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_7fd5b2dce0a7fb54f6604bb1f59cf936.pdf) 23 | 1. [Using and writing the map function](w4_5.1_writing_map.md) 24 | ### 6. Folding Functions on Lists 25 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/bGrvwF0OXLxV/HD.mp4) 26 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_14a4edce0be117d4906119f4e4216f6e.pdf) 27 | 1. [Using fold to produce lists](w4_6.1_fold_produce_lists.md) 28 | 2. [Using fold to check predicates](w4_6.2_fold_check_predicates.md) 29 | -------------------------------------------------------------------------------- /week6/w6_3.2_multiset.md: -------------------------------------------------------------------------------- 1 | # MULTISET (25 points possible) 2 | A multiset is like a set, with the difference that a value can appear more than once. 3 | 4 | 1. Implement a module `MultiSet` that implements the signature `MultiSet_S`. 5 | 2. Define a function `letters: string -> char MultiSet.t` (where `MultiSet` is the module defined in the previous question). This function produces a multiset in which all characters are associated to the times they appear in the input string. 6 | 3. Define a function `anagram: string -> string -> bool` that uses the previous function to tell if two words have the same multiset of characters. 7 | 8 | ### THE GIVEN PRELUDE 9 | ```ocaml 10 | module type MultiSet_S = sig 11 | 12 | (* A multi-set of type ['a t] is a collection of values of 13 | type ['a] that may occur several times. *) 14 | type 'a t 15 | 16 | (* [occurrences s x] return the number of time [x] occurs 17 | in [s]. *) 18 | val occurrences : 'a t -> 'a -> int 19 | 20 | (* The empty set has no element. There is only one unique 21 | representation of the empty set. *) 22 | val empty : 'a t 23 | 24 | (* [insert s x] returns a new multi-set that contains all 25 | elements of [s] and a new occurrence of [x]. Typically, 26 | [occurrences s x = occurrences (insert s x) x + 1]. *) 27 | val insert : 'a t -> 'a -> 'a t 28 | 29 | (* [remove s x] returns a new multi-set that contains all elements 30 | of [s] minus an occurrence of [x] (if [x] actually occurs in 31 | [s]). Typically, [occurrences s x = occurrences (remove s x) x - 32 | 1] if [occurrences s x > 0]. *) 33 | val remove : 'a t -> 'a -> 'a t 34 | 35 | end 36 | ``` 37 | 38 | ### YOUR OCAML ENVIRONMENT 39 | ```ocaml 40 | module MultiSet = struct 41 | (* Replace this comment with your implementation. *) 42 | end ;; 43 | 44 | let letters word = 45 | "Replace this string with your implementation." ;; 46 | 47 | let anagram word1 word2 = 48 | "Replace this string with your implementation." ;; 49 | ``` 50 | -------------------------------------------------------------------------------- /week6/w6_2.2_accessing_modules.md: -------------------------------------------------------------------------------- 1 | # ACCESSING MODULES AND SUBMODULES (15 points possible) 2 | 1.Use fully-qualified names to fix the compilation of [bfs]. (The `open` directive is forbidden here.) 3 | 4 | ### THE GIVEN PRELUDE 5 | ```ocaml 6 | module Tree = struct 7 | 8 | type 'a t = Leaf of 'a | Node of 'a t * 'a * 'a t 9 | 10 | module Iterator = struct 11 | 12 | type 'a path = 13 | | Top 14 | | Left of 'a path * 'a * 'a t 15 | | Right of 'a t * 'a * 'a path 16 | 17 | type 'a iterator = Loc of 'a t * 'a path 18 | 19 | exception Fail 20 | 21 | let go_left (Loc (t, p)) = 22 | match p with 23 | | Top -> raise Fail 24 | | Left (father, x, right) -> raise Fail 25 | | Right (left, x, father) -> Loc (left, Left (father, x, t)) 26 | 27 | let go_right (Loc (t, p)) = 28 | match p with 29 | | Top -> raise Fail 30 | | Left (father, x, right) -> Loc (right, Right (t, x, father)) 31 | | Right (left, x, father) -> raise Fail 32 | 33 | let go_up (Loc (t, p)) = 34 | match p with 35 | | Top -> raise Fail 36 | | Left(father, x, right) -> Loc (Node (t, x, right), father) 37 | | Right(left, x, father) -> Loc (Node (left, x, t), father) 38 | 39 | let go_first (Loc (t, p)) = 40 | match t with 41 | | Leaf _ -> raise Fail 42 | | Node (left, x, right) -> Loc (left, Left (p, x, right)) 43 | 44 | let go_second (Loc (t, p)) = 45 | match t with 46 | | Leaf _ -> raise Fail 47 | | Node (left, x, right) -> Loc (right, Right (left, x, p)) 48 | 49 | let focus (Loc ((Leaf x | Node (_, x, _)), _)) = x 50 | 51 | end 52 | 53 | end 54 | ``` 55 | 56 | ### YOUR OCAML ENVIRONMENT 57 | ```ocaml 58 | let bfs t = 59 | let rec aux results = function 60 | | [] -> 61 | List.rev results 62 | | l :: ls -> 63 | let results = (focus l) :: results in 64 | try 65 | aux results (ls @ [ go_first l; go_second l]) 66 | with Fail -> 67 | aux results ls 68 | in 69 | aux [] [Loc (t, Top)] 70 | ``` 71 | -------------------------------------------------------------------------------- /week6/w6_5.1_char_indexed_hashtables.md: -------------------------------------------------------------------------------- 1 | # CHAR INDEXED HASHTABLES (40 points possible) 2 | Have a look at the [documentation](http://caml.inria.fr/pub/docs/manual-ocaml/libref/Hashtbl.html) of module `Hashtbl`. 3 | 4 | 1. Implement a module `CharHashedType`, compatible with the `HashedType` signature, where `type t = char`. 5 | 2. Use the module defined in the previous question to instantiate the `Hashtbl.Make` functor as a module `CharHashtbl`. 6 | 3. Reimplement the data structure of `trie` from a previous exercise, so that a hash table is used to represent the association between characters and children. To do so, complete the definition of module `Trie`, so that it is compatible with the given signature `GenericTrie`, whose `'a table` type is instanciated to `char` indexed hash tables. 7 | *Be careful*, a hash table is not a purely functional data structure. Therefore, it must be copied when necessary! 8 | *Note*: you must neither change the signature nor the types of module `Trie` or the tests will fail. 9 | 10 | ### THE GIVEN PRELUDE 11 | ```ocaml 12 | module type GenericTrie = sig 13 | type 'a char_table 14 | type 'a trie = Trie of 'a option * 'a trie char_table 15 | val empty : unit -> 'a trie 16 | val insert : 'a trie -> string -> 'a -> 'a trie 17 | val lookup : 'a trie -> string -> 'a option 18 | end 19 | ``` 20 | 21 | ### YOUR OCAML ENVIRONMENT 22 | ```ocaml 23 | module CharHashedType = 24 | struct (* replace this structure with your implementation *) end 25 | 26 | module CharHashtbl = 27 | struct (* replace this structure with your implementation *) end 28 | 29 | module Trie : GenericTrie 30 | with type 'a char_table = 'a CharHashtbl.t = 31 | struct 32 | type 'a char_table = 'a CharHashtbl.t 33 | type 'a trie = Trie of 'a option * 'a trie char_table 34 | 35 | let empty () = 36 | "Replace this string with your implementation." ;; 37 | 38 | let lookup trie w = 39 | "Replace this string with your implementation." ;; 40 | 41 | let insert trie w v = 42 | "Replace this string with your implementation." ;; 43 | 44 | end 45 | ``` 46 | -------------------------------------------------------------------------------- /week3/README.md: -------------------------------------------------------------------------------- 1 | # Week 3: More advanced data structures 2 | 3 | ### 1. Tagged values 4 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/SJqaSRpEgEGE/HD.mp4) 5 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_7ada1ecb3d8a5c7111a16dcbf2dfb230.pdf) 6 | 1. [Pattern matching exhaustivity](w3_1.1_pattern_matching_exhaustivity.md) 7 | 2. [A type for array indexes](w3_1.2_type_array_indexes.md) 8 | 3. [The option type](w3_1.3_option_type.md) 9 | ### 2. Recursive types 10 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/NLQlRuEqcrto/HD.mp4) 11 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_59b1b062aa2578b48a113e7d32d1fc80.pdf) 12 | 1. [First in, first out](w3_2.1_fifo.md) 13 | 2. [Classic functions over lists](w3_2.2_functions_over_lists.md) 14 | ### 3. Tree-like values 15 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/VIVeBeIDFUeT/HD.mp4) 16 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_def6a31bab1595b17081e53a6be8e562.pdf) 17 | 1. [Symbolic manipulation of arithmetic expressions](w3_3.1_symbolic_arithmetic.md) 18 | 2. [Tries](w3_3.2_tries.md) 19 | ### 4. Case study: a story teller 20 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/BK8si2QA2t48/HD.mp4) 21 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_cc3061eb2d687d7384e320770839d18f.pdf) 22 | 1. [Type directed programming](w3_4.1_type_directed_prog.md) 23 | ### 5. Polymorphic algebraic datatypes 24 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/4aPYL46acxss/HD.mp4) 25 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_39dbaacb62ca5793ba1e4710b2acd92b.pdf) 26 | 1. [Balanced binary trees](w3_5.1_balanced_binary_trees.md) 27 | 2. [An implementation of list with an efficient concatenation](w3_5.2_list_efficient_concat.md) 28 | ### 6. Advanced topics 29 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/sVwMaft245qE/HD.mp4) 30 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_78245f4f4a7b35decd39ea58a1a350b6.pdf) 31 | 1. [Advanced patterns](w3_6.1_advanced_patterns.md) 32 | -------------------------------------------------------------------------------- /week6/w6_3.1_type_abstraction.md: -------------------------------------------------------------------------------- 1 | # TYPE ABSTRACTION USING A SIGNATURE (20 points possible) 2 | Encapsulate the type and values given in the template in a module named `Exp`. 3 | 4 | To make `e` abstract, assign a signature to the module `Exp` that makes the type `e` abstract and publish the functions `int`, `mul` and `add`. 5 | 6 | Given that interface, the only way to build a value of type `e` is to use the functions `int`, `mul`, `add`, and `to_string`. Such functions are called _smart constructors_ because they perform some smart operations when they build values. 7 | 8 | These smart constructors enforce the invariant that an expression represented by a value of type `e` is always simplified, i.e. it does not contain a subexpression of the form `e * 1`, `1 * e`, `e * 0`, `0 * e`, `0 + e` or `e + 0`. 9 | 10 | * The following expression should be accepted. 11 | ```ocaml 12 | Exp.mul (Exp.int 0) (Exp.add (Exp.int 1) (Exp.int 2)) 13 | ``` 14 | 15 | * The following expression should be rejected. 16 | ```ocaml 17 | Exp.EMul (Exp.EInt 0) (Exp.EAdd (Exp.EInt 1) (Exp.EInt 2)) 18 | ``` 19 | 20 | Unfortunately, turning `e` into an abstract data type prevents the user from pattern matching over values of type `e`. To allow pattern matching while forbidding the direct application of data constructors, OCaml provides a mechanism called `private types`. The interested student can get more information about this advanced (off-topic) feature [here](http://caml.inria.fr/pub/docs/manual-ocaml-400/manual021.html#toc76). 21 | 22 | ### YOUR OCAML ENVIRONMENT 23 | ```ocaml 24 | type e = EInt of int | EMul of e * e | EAdd of e * e 25 | 26 | let int x = EInt x 27 | 28 | let mul a b = 29 | match a, b with 30 | | EInt 0, _ | _, EInt 0 -> EInt 0 31 | | EInt 1, e | e, EInt 1 -> e 32 | | a, b -> EMul (a, b) 33 | 34 | let add a b = 35 | match a, b with 36 | | EInt 0, e | e, EInt 0 -> e 37 | | a, b -> EAdd (a, b) 38 | 39 | let rec to_string = function 40 | | EInt i -> string_of_int i 41 | | EMul (l, r) -> "(" ^ to_string l ^ " * " ^ to_string r ^ ")" 42 | | EAdd (l, r) -> "(" ^ to_string l ^ " + " ^ to_string r ^ ")" 43 | ``` 44 | -------------------------------------------------------------------------------- /week5/README.md: -------------------------------------------------------------------------------- 1 | # Week 5: Exceptions, input/output and imperative constructs 2 | 3 | ### 1. Imperative features in OCaml 4 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/BZWVRg604kxG/HD.mp4) 5 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_c017863fb0adddb7bbf3fc54ffd60d4f.pdf) 6 | ### 2. Getting and handling your Exceptions 7 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/WMFp1t7L2URp/HD.mp4) 8 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_1191158b2f45c0b782fcdc27726bb65c.pdf) 9 | 1. [Unraveling the automatic grader](w5_2.1_automatic_grader.md) 10 | ### 3. Getting information in and out 11 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/FKao8zu9g4sZ/HD.mp4) 12 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_e6981924492b517f65444fecb1a174f1.pdf) 13 | 1. [Printing lists](w5_3.1_printing_lists.md) 14 | 2. [Displaying a Filesystem Hierarchy](w5_3.2_fs_hierarchy.md) 15 | ### 4.Sequences and iterations 16 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/eJgG1uRT7ZuE/HD.mp4) 17 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_24f72018d64684936d6f61d5c67780fe.pdf) 18 | 1. [Printing with loops](w5_4.1_printing_with_loops.md) 19 | 2. [Producing fine ASCII art](w5_4.2_ascii_art.md) 20 | ### 5.Mutable arrays 21 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/g8avLowwgiTl/HD.mp4) 22 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_c36e8c720dfe804126c6d83bd6e3b24b.pdf) 23 | 1. [Rotating the contents of an array](w5_5.1_rotating_array.md) 24 | 2. [Implementing a stack with an array](w5_5.2_stack_with_array.md) 25 | ### 6.Mutable record fields 26 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/iMsSDFjS5cXS/HD.mp4) 27 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_3a7f2602747f864ce6f4187133b7f649.pdf) 28 | 1. [Implementing mutable lists](w5_6.1_mutable_lists.md) 29 | ### 7.Variables, aka References 30 | [video](https://d381hmu4snvm3e.cloudfront.net/videos/WWvTQhXNEsWW/HD.mp4) 31 | [slides](https://www.fun-mooc.fr/c4x/parisdiderot/56002S02/asset/slides_42953e1ef19d1dc76fafa8c5f46c8c0a.pdf) 32 | 1. [Simple uses of references](w5_7.1_references.md) 33 | 2. [Reading lines from the standard input](w5_7.2_reading_lines.md) 34 | -------------------------------------------------------------------------------- /week5/w5_5.2_stack_with_array.md: -------------------------------------------------------------------------------- 1 | # IMPLEMENTING A STACK WITH AN ARRAY (50 points possible) 2 | In this exercise, we will encode imperative stacks of `int`s using the `type stack = int array` as defined in the prelude. 3 | 4 | We will use the first cell (cell `0`) to store the number of items in the stack. Then the cells of the array starting from `1` will be used to store the elements in the stack. The bottom element of the stack will be stored at position `1`. 5 | 6 | The stack will thus have a maximum capacity, being the length of the array minus one. 7 | 8 | An empty stack of capacity `4` would match the following pattern: `[| 0 ; _ ; _ ; _ ; _|]` 9 | 10 | A stack of capacity `4` containing `1` at the bottom, then `2` and then `3` at the top would match the following pattern: `[| 3 ; 1 ; 2 ; 3 ; _|]` 11 | 12 | 1. Define a function `create : int -> stack` that creates a new stack of the given maximum capacity. 13 | 14 | 2. Define a function `push : stack -> int -> unit` that adds an element as the top of the stack. The function must fail with the exception Full given in the prelude if nothing can be added to the stack. 15 | 16 | 3. Define a function `append : stack -> int array -> unit` that adds an array of integers as the top of the stack. The first element of the array must be at the top of the stack, the others in order, up to the last element, which will be the lowest in the stack. In other words, the last element of the array should be pushed first, etc. 17 | The function must fail with the exception `Full` given in the prelude if some elements could not fit in the stack. But in this case, it should still fill the stack with as many elements as possible. 18 | 19 | 4. Define a function `pop : stack -> int` that takes an element as the top of the stack, removes it from the stack, and return it. 20 | The function must fail with the exception `Empty` given in the prelude if nothing can be taken from the stack. 21 | 22 | ### THE GIVEN PRELUDE 23 | ``` 24 | type stack = int array 25 | exception Full 26 | exception Empty 27 | ``` 28 | 29 | ### YOUR OCAML ENVIRONMENT 30 | ``` 31 | let create size = 32 | "Replace this string with your implementation." ;; 33 | 34 | let push buf elt = 35 | "Replace this string with your implementation." ;; 36 | 37 | let append buf arr = 38 | "Replace this string with your implementation." ;; 39 | 40 | let pop buf = 41 | "Replace this string with your implementation." ;; 42 | ``` 43 | -------------------------------------------------------------------------------- /week3/w3_5.2_list_efficient_concat.md: -------------------------------------------------------------------------------- 1 | # AN IMPLEMENTATION OF LIST WITH AN EFFICIENT CONCATENATION (56 points possible) 2 | Concatenating two standard OCaml lists takes a time proportional to the length of the first list. In this exercise, we implement a data structure for lists with a constant time concatenation. 3 | The preludes gives a type `'a clist`, which is either a single element of type `'a`, the concatenation of two `'a clist` or an empty `'a clist`. 4 | This representation of a list is not linear: it is a tree-like datastructure since the CApp constructor contains two values of type `'a clist`. 5 | The sequence of elements contained in a value of type `'a clist` is obtained by a depth-first traversal of the tree. For instance, the example given in the prelude, of type `int clist` is a valid representation for the sequence `[1;2;3;4]`. 6 | 7 | 1. Write a function `to_list : 'a clist -> 'a list` which computes the `'a list` that contains the same elements as the input `'a clist`, in the same order. 8 | 9 | 2. Write a function `of_list : 'a list -> 'a clist` which computes the `'a clist` that contains the same elements as the input `'a list`, in the same order. 10 | 11 | 3. Write a function `append : 'a clist -> 'a clist -> 'a clist` such that: 12 | * `append CEmpty l = append l CEmpty = l` 13 | * `append l1 l2 = CApp (l1, l2)` otherwise 14 | 15 | 4. Write a function `hd : 'a clist -> 'a option` that returns `Some x` where `x` is the first element of the input `'a clist`, if it is not empty, and returns `None` otherwise. 16 | 17 | 5. Write a function `tl : 'a clist -> 'a clist option` that returns `Some l` where `l` is the input sequence without its first element, if this input sequence is not empty, or returns `None` otherwise. 18 | 19 | ### THE GIVEN PRELUDE 20 | ```ocaml 21 | type 'a clist = 22 | | CSingle of 'a 23 | | CApp of 'a clist * 'a clist 24 | | CEmpty 25 | 26 | let example = 27 | CApp (CApp (CSingle 1, 28 | CSingle 2), 29 | CApp (CSingle 3, 30 | CApp (CSingle 4, CEmpty))) 31 | ``` 32 | 33 | ### YOUR OCAML ENVIRONMENT 34 | ```ocaml 35 | let to_list l = 36 | "Replace this string with your implementation." ;; 37 | 38 | let rec of_list l = 39 | "Replace this string with your implementation." ;; 40 | 41 | let append l1 l2 = 42 | "Replace this string with your implementation." ;; 43 | 44 | let hd l = 45 | "Replace this string with your implementation." ;; 46 | 47 | let tl l = 48 | "Replace this string with your implementation." ;; 49 | ``` 50 | -------------------------------------------------------------------------------- /week5/w5_6.1_mutable_lists.md: -------------------------------------------------------------------------------- 1 | # IMPLEMENTING MUTABLE LISTS (80 points possible) 2 | Using mutable record fields, we can define the type of a list data structure with explicit pointers, as defined by the type `'a xlist` given in the prelude. 3 | 4 | The empty list is written: 5 | 6 | ```ocaml 7 | { pointer = Nil } 8 | ``` 9 | 10 | The singleton list containing only `"one"` is written: 11 | ```ocaml 12 | { pointer = List (1, { pointer = Nil }) } 13 | ``` 14 | 15 | The list containing the elements `1`, then `2` then `3` is written: 16 | ```ocaml 17 | { pointer = 18 | List (1, { pointer = 19 | List (2, { pointer = 20 | List (3, { pointer = 21 | Nil }) }) }) } 22 | ``` 23 | 24 | 1. Define `head : 'a xlist -> 'a` that returns the first element of the list if it exists, or fails with `Empty_xlist`. This function does not modify the list. 25 | 2. Define `tail : 'a xlist -> 'a xlist` that returns the list without its first element if it exists, or fails with `Empty_xlist`. This function does not modify the list. 26 | 3. Define `add : 'a -> 'a xlist -> unit` that modifies the list in place to add an element at the front. 27 | 4. Define `chop : 'a xlist -> unit` that modifies the list to remove its front element, or fails with `Empty_xlist`. 28 | 5. Define `append : 'a xlist -> 'a xlist -> unit`, a destructive concatenation operation that modifies the last pointer of the first list to point to the beginning of the second list. 29 | 6. Define `filter : ('a -> bool) -> 'a xlist -> unit`, a destructive filter operation on lists that removes from the list all elements that do not satisfy the boolean predicate passed as parameter. 30 | 31 | ### THE GIVEN PRELUDE 32 | ``` 33 | type 'a xlist = 34 | { mutable pointer : 'a cell } 35 | and 'a cell = 36 | | Nil 37 | | List of 'a * 'a xlist ;; 38 | 39 | let nil () = 40 | { pointer = Nil } ;; 41 | 42 | let cons elt rest = 43 | { pointer = List (elt, rest) } ;; 44 | 45 | exception Empty_xlist ;; 46 | ``` 47 | 48 | ### YOUR OCAML ENVIRONMENT 49 | ``` 50 | let head l = 51 | "Replace this string with your implementation." ;; 52 | 53 | let tail l = 54 | "Replace this string with your implementation." ;; 55 | 56 | let add a l = 57 | "Replace this string with your implementation." ;; 58 | 59 | let chop l = 60 | "Replace this string with your implementation." ;; 61 | 62 | let rec append l1 l2 = 63 | "Replace this string with your implementation." ;; 64 | 65 | let rec filter p l = 66 | "Replace this string with your implementation." ;; 67 | ``` 68 | -------------------------------------------------------------------------------- /week3/w3_3.1_symbolic_arithmetic.md: -------------------------------------------------------------------------------- 1 | # SYMBOLIC MANIPULATION OF ARITHMETIC EXPRESSIONS (44 points possible) 2 | Abstract syntax trees are a convenient way to represent a syntactic expression in a structured way. 3 | Let us consider arithmetic expressions formed by the following rules: 4 | 5 | * an integer is an arithmetic expression 6 | * if `lhs` and `rhs` are arithmetic expressions then `lhs + rhs` is an arithmetic expression 7 | * if `lhs` and `rhs` are arithmetic expressions then `lhs * rhs` is an arithmetic expression 8 | 9 | Such an expression can be represented by a value of type `exp` as defined in the given prelude (as well as the definition of `1 + 2 * 3` as an example). 10 | 11 | 1. Write the expression `2 * 2 + 3 * 3` in a variable `my_example`. 12 | 13 | 2. Write a function `eval : exp -> int` that computes the value of an arithmetic expression. The evaluation rules are: 14 | * If the expression is an integer `x`, the evaluation is `x` 15 | * If the expression is `lhs + rhs` and `lhs` evaluates to `x` and rhs evaluates to `y`, then the evaluation is `x + y` 16 | * If the expression is `lhs * rhs` and `lhs` evaluates to `x` and rhs evaluates to `y`, then the evaluation is `x * y` 17 | 18 | 3. If an expression is of the form `a * b + a * c` then `a * (b + c)` is a factorized equivalent expression. 19 | Write a function `factorize : exp -> exp` that implements this transformation on its input exp if it has the shape `a * b + a * c` or does nothing otherwise. 20 | 21 | 4. Write the reverse transformation of factorize, `expand : exp -> exp`, which turns an expression of the shape `a * (b + c)` into `a * b + a * c`. 22 | 23 | 5. Implement a function `simplify: exp -> exp` which takes an expression `e` and: 24 | * If `e` is of the shape `e * 0` or `0 * e`, returns the expression `0` 25 | * If `e` is of the shape `e * 1` or `1 * e`, returns the expression `e` 26 | * If `e` is of the shape `e + 0` or `0 + e`, returns the expression `e` 27 | and does nothing otherwise. 28 | 29 | **Remarks:** 30 | 31 | The symbols (`a`, `b`, `c` and `e`) can match any expressions, not just integers. 32 | these are a syntactical rewritings, so two expressions are considered equal if and only if they are exactly the same expressions (simply use the `=` operator to check that). 33 | The rewritings have to be done on the first level of the expression only, not recursively and not deeper in the expression. If the toplevel expression does not match the expected pattern, simply return the expression untouched. 34 | 35 | ### THE GIVEN PRELUDE 36 | ```ocaml 37 | type exp = 38 | | EInt of int 39 | | EAdd of exp * exp 40 | | EMul of exp * exp 41 | 42 | let example = 43 | EAdd (EInt 1, EMul (EInt 2, EInt 3)) 44 | ``` 45 | 46 | ### YOUR OCAML ENVIRONMENT 47 | ```ocaml 48 | let my_example = 49 | "Replace this string with your example." ;; 50 | 51 | let eval e = 52 | "Replace this string with your implementation." ;; 53 | 54 | let factorize e = 55 | "Replace this string with your implementation." ;; 56 | 57 | let expand e = 58 | "Replace this string with your implementation." ;; 59 | 60 | let simplify e = 61 | "Replace this string with your implementation." ;; 62 | ``` 63 | -------------------------------------------------------------------------------- /week5/w5_3.2_fs_hierarchy.ml: -------------------------------------------------------------------------------- 1 | type filesystem = (string * node) list 2 | and node = 3 | | File 4 | | Dir of filesystem 5 | | Symlink of string list;; 6 | 7 | let rec print_path = function 8 | | [] -> () 9 | | [x] -> (print_string x; print_newline ()) 10 | | hd :: tl -> print_string (hd ^ "/"); print_path tl;; 11 | 12 | let rec print_file lvl name = 13 | if lvl = 0 14 | then (print_string name; print_newline ()) 15 | else (print_string "| "; print_file (lvl - 1) name);; 16 | 17 | let rec print_symlink lvl name path = 18 | if lvl = 0 19 | then (print_string (name ^ " -> "); print_path path) 20 | else (print_string "| "; print_symlink (lvl - 1) name path);; 21 | 22 | let rec print_invalid_symlink lvl name = 23 | if lvl = 0 24 | then (print_string (name ^ " -> "); print_string "INVALID"; print_newline ()) 25 | else (print_string "| "; print_invalid_symlink (lvl - 1) name);; 26 | 27 | let rec print_dir lvl name = 28 | if lvl = 0 29 | then (print_string ("/" ^ name); print_newline ()) 30 | else (print_string "| "; print_dir (lvl - 1) name);; 31 | 32 | let print_filesystem root = 33 | let rec aux lvl = function 34 | | [] -> () 35 | | (name, node) :: tl -> match node with 36 | | File -> (print_file lvl name; aux lvl tl) 37 | | Dir fs -> (print_dir lvl name; aux (lvl + 1) fs; aux lvl tl) 38 | | Symlink path -> (print_symlink lvl name path; aux lvl tl) 39 | in 40 | aux 0 root ;; 41 | 42 | let rec resolve sym path = 43 | let rec aux acc path = 44 | match acc, path with 45 | | _, [] -> List.rev acc 46 | | [], ".." :: tl -> aux acc tl 47 | | _, ".." :: tl -> aux (List.tl acc) tl 48 | | _, hd :: tl -> aux (hd :: acc) tl 49 | in 50 | aux (List.tl (List.rev sym)) path;; 51 | 52 | let rec file_exists root path = 53 | let node_matches ((node1_name : string), node1) ((node2_name : string), node2) = 54 | match node1, node2 with 55 | | (File, File) | (Dir _, Dir _) -> node1_name = node2_name 56 | | (_, _) -> false 57 | in 58 | match path with 59 | | [] -> false 60 | | [target] -> 61 | begin 62 | try 63 | let _ = List.find (node_matches (target, File)) root in 64 | true 65 | with 66 | Not_found -> false 67 | end 68 | | hd :: tl -> 69 | begin 70 | try 71 | match List.find (node_matches (hd, Dir [])) root with 72 | | target, Dir fs -> file_exists fs (List.tl path) 73 | | _, _ -> false 74 | with 75 | Not_found -> false 76 | end;; 77 | 78 | let print_filesystem root = 79 | let rec aux abs_path lvl = function 80 | | [] -> () 81 | | (name, node) :: tl -> match node with 82 | | File -> (print_file lvl name; 83 | aux abs_path lvl tl) 84 | | Dir fs -> (print_dir lvl name; 85 | aux (name :: abs_path) (lvl + 1) fs; 86 | aux abs_path lvl tl) 87 | | Symlink path -> 88 | if file_exists root (resolve (List.rev (name :: abs_path)) path) then 89 | (print_symlink lvl name path; 90 | aux abs_path lvl tl) 91 | else 92 | (print_invalid_symlink lvl name; 93 | aux abs_path lvl tl) 94 | in aux [] 0 root ;; 95 | -------------------------------------------------------------------------------- /week5/w5_2.1_automatic_grader.md: -------------------------------------------------------------------------------- 1 | # UNRAVELING THE AUTOMATIC GRADER (60 points possible) 2 | 3 | In this exercise, we will unveil the basics of the grading system. 4 | 5 | **Note**: This exercise is about exceptions, but it uses the `unit` type that is only presented in the next sequence. 6 | 7 | 1. For each question, we call both your function and a reference function on a list of randomly sampled test cases, and observe the results. We also have to handle the case where a function raises an exception instead of producing a result. Sometimes, we even expect your function to raise an exception, and want to compare it to the exception raised by the reference function. 8 | For this, we use the `'a result` type given in the prelude. 9 | Define a function `exec: ('a -> 'b) -> 'a -> 'b result`, that calls the given function on the given argument, and returns `Ok` with the result if everything went well, and `Error` with the exception raised, if there was one. 10 | 11 | 2. To be able to provide you with the nice error reports, we use an intermediate type for producing reports, similar to the one given in the prelude. 12 | Define a function `compare` with the following signature. 13 | ``` 14 | compare : 'a result -> 'a result -> ('a -> string) -> message 15 | ``` 16 | This function will take first the user function's result and then the reference function's result. It also takes a printer compatible with the return type, to display the results as in one the following cases. 17 | * `("got correct value 13", Successful)` 18 | * `("got unexpected value 13", Failed)` 19 | * `("got correct exception Exit", Successful)` 20 | * `("got unexpected exception Exit", Failed)` 21 | You must respect the exact wording for your solution to be accepted. To display exceptions, you can use the provided `exn_to_string` function. 22 | 23 | 3. Then we define random samplers for each type of data that will be passed to your function. For a given type `'a`, a random sampler simply has type `unit -> 'a`, an imperative function that returns a new value of type `'a` every time you give it a unit. 24 | Define a function `test` with the following signature. 25 | ``` 26 | test : ('a -> 'b) -> ('a -> 'b) -> (unit -> 'a) -> ('b -> string) -> report 27 | ``` 28 | This function must proceed to exactly 10 tests, calling the sampler each time, and return the list of messages. For each sample, you will `exec` the user function (the first parameter), then `exec` the reference function, and compare the results. It will then return the list containing the 10 comparison messages. 29 | Your solution must respect the constraint that the first call to the sampler corresponds to the first message of the list, the second to the second, etc. Be cautious about not reversing the list. And since the sampler is an imperative, remember to use `let ... in` constructs if necessary, to force the order of evaluation. 30 | 31 | ### THE GIVEN PRELUDE 32 | ``` 33 | type report = message list 34 | and message = string * status 35 | and status = Successful | Failed 36 | 37 | type 'a result = Ok of 'a | Error of exn 38 | ``` 39 | 40 | ### YOUR OCAML ENVIRONMENT 41 | ``` 42 | let exec f x = 43 | "Replace this string with your implementation." ;; 44 | 45 | let compare user reference to_string = 46 | "Replace this string with your implementation." ;; 47 | 48 | let test user reference sample to_string = 49 | "Replace this string with your implementation." ;; 50 | ``` 51 | -------------------------------------------------------------------------------- /week4/w4_4.2_small_arith_interpreter.md: -------------------------------------------------------------------------------- 1 | # A SMALL ARITHMETIC INTERPRETER (45 points possible) 2 | In this exercise, we will write a small program that computes some operations on integers. We will use a small datatype `operation` that describes all the operations to perform to compute the result. For example, suppose we want to do the following computation: 3 | `mul (add 0 1) (mul 3 4)` 4 | We can describe it as: 5 | ```ocaml 6 | Op ("mul", Op ("add", Value 0, Value 1), Op ("mul", Value 3, Value 4)) 7 | ``` 8 | The `Op` constructor takes as a first argument a `string`, which is the name of the function that is stored in an `environment`. We suppose there exists a variable `initial_env` that contains some predefined functions. 9 | 10 | 1. First of all, we need a way to find a function in an environment of type `env`, which is basically a list of tuples. Each of these tuples contains a `string`, which is the name of the function, and a value of type `int -> int -> int`, which is basically a function that takes two arguments of type `int` and returns an `int` as a result. 11 | Write a function `lookup_function : string -> env -> (int -> int -> int)` that returns the function associated to a name in an environment. If there is no function with the name given, you can return `invalid_arg "lookup_function"`. 12 | 13 | 2. Another useful feature would be to add functions to a given environment. Write the function `add_function : string -> (int -> int -> int) -> env -> env` that takes an environment `e`, a name for the function `n` and a function `f`, and returns a new environment that contains the function `f` that is associated to the name `n`. 14 | 15 | What you can notice now is that unless you put explicit annotations, those two previous functions should be polymorphic and work on any list of couples. Actually, `lookup_function` could have been written as `List.assoc`. 16 | 17 | 3. Create a variable `my_env: env` that is the initial environment plus a function associated to the name `"min"` that takes two numbers and returns the lowest. You cannot use the already defined `Pervasives.min` function, nor any `let .. in`. Take advantage of lambda expressions! 18 | 19 | 4. Now that we have correctly defined the operations to use the environment, we can write the function that computes an operation. Write a function `compute: env -> operation -> int` that takes an environment and an operation description, and computes this operation. The result is either: 20 | * Directly the value. 21 | * An operation that takes two computed values and a function from the environment. 22 | 23 | 5. Let's be a bit more efficient and use the over-application: suppose a function `id: 'a -> 'a`, then `id id` will also have type `'a -> 'a`, since the `'a` is instantiated with `'a -> 'a`. Using that principle, we can apply `id` to itself infinitely since it will always return a function. Write a function `compute_eff : env -> operation -> int` that takes an environment and an operation, and computes it. However, you cannot use `let` inside the function! 24 | 25 | ### THE GIVEN PRELUDE 26 | ```ocaml 27 | type operation = 28 | Op of string * operation * operation 29 | | Value of int 30 | 31 | type env = (string * (int -> int -> int)) list 32 | ``` 33 | 34 | ### YOUR OCAML ENVIRONMENT 35 | ```ocaml 36 | let rec lookup_function n = function _-> 37 | "Replace this string with your implementation" 38 | 39 | let add_function name op env = 40 | "Replace this string with your implementation" 41 | 42 | let my_env = 43 | "Replace this string with your implementation" 44 | 45 | let rec compute env op = 46 | "Replace this string with your implementation" 47 | 48 | let rec compute_eff env = function _ -> 49 | "Replace this string with your implementation" 50 | ``` 51 | -------------------------------------------------------------------------------- /week3/w3_3.2_tries.md: -------------------------------------------------------------------------------- 1 | # TRIES (40 points possible) 2 | The data structure called _trie_ is very convenient to represent a dictionary whose keys are strings. It is space-efficient way while providing a very fast lookup function. 3 | See the [page on WikiPedia](https://en.wikipedia.org/wiki/Trie). 4 | In this exercise, we will implement such a data structure, assuming that we want to associate integers to the strings of the dictionary. 5 | Let us define a trie using two mutually defined types (given in the prelude): 6 | 7 | * `trie` which represents a trie, that is a tree whose root may contain an integer and whose children are indexed by characters 8 | * `char_to_children` which implements the associative data structure whose keys are characters and whose values are trie (childrens) 9 | 10 | As a trade-off between speed and memory consumption, we choose an associative list to represent the association between characters and children. 11 | The prelude also gives examples of empty trie and of another one that contains the following pairs (key, value): 12 | ```ocaml 13 | [("A", 15); ("to", 7); ("tea", 3);("ted", 4); ("ten", 12); ("i", 11); ("in", 5); ("inn", 9)] 14 | ``` 15 | 16 | 1. Write a function `children_from_char : char_to_children -> char -> trie option` such that 17 | * `children_from_char m c = Some t` if `(c, t)` is the first pair in `m` with `c` as a first component 18 | * `children_from_char m c = None` if no such pair exists in `m` 19 | 20 | 2. Write a function `update_children : char_to_children -> char -> trie -> char_to_children` such that 21 | * `children_from_char (update_children m c t) c = Some t` 22 | * `children_from_char (update_children m c t) c' = children_from_char m c'` for `c <> c'` 23 | * if `children_from_char m c = Some t` then `List.length (update_children m c t') = List.length m` 24 | 25 | 3. Write a function `lookup : trie -> string -> int option` such that `lookup trie w = Some i` if `i` is the value of the key `w` in `trie` and `lookup trie w = None` if w is not a key of `trie`. 26 | To look for a key in a trie, iterate over the characters of the key from left to right. Given the current character `c` and the current node of the trie `n`, look for the children `n` for character `c`. If such a children exists, continue with that trie and the remainder of the key. If no such children exists, the key is not in the trie. When the characters of the key are entirely consumed, look at the root of the current trie. If there is an integer, this is the value you are looking for. If there is no integer, the key not in the trie. 27 | 28 | 4. Write a function `insert : trie -> string -> int -> trie` such that `lookup (insert trie w k) w = Some k` and `lookup (insert trie w k) w' = lookup trie w'` for `w <> w'`. 29 | 30 | ### THE GIVEN PRELUDE 31 | ```ocaml 32 | type trie = Trie of int option * char_to_children 33 | and char_to_children = (char * trie) list 34 | 35 | let empty = 36 | Trie (None, []) 37 | 38 | let example = 39 | Trie (None, 40 | [('i', Trie (Some 11, 41 | [('n', Trie (Some 5, [('n', Trie (Some 9, []))]))])); 42 | ('t', 43 | Trie (None, 44 | [('e', 45 | Trie (None, 46 | [('n', Trie (Some 12, [])); ('d', Trie (Some 4, [])); 47 | ('a', Trie (Some 3, []))])); 48 | ('o', Trie (Some 7, []))])); 49 | ('A', Trie (Some 15, []))]) 50 | ``` 51 | 52 | ### YOUR OCAML ENVIRONMENT 53 | ```ocaml 54 | let children_from_char m c = 55 | "Replace this string with your implementation." ;; 56 | 57 | let update_children m c t = 58 | "Replace this string with your implementation." ;; 59 | 60 | let lookup trie w = 61 | "Replace this string with your implementation." ;; 62 | 63 | let insert trie w v = 64 | "Replace this string with your implementation." ;; 65 | ``` 66 | -------------------------------------------------------------------------------- /week5/w5_4.2_ascii_art.md: -------------------------------------------------------------------------------- 1 | # PRODUCING FINE ASCII ART (175 points possible) 2 | In this exercise, we will display black and white images as text, where a black dot is printed as a `'#'` and a white dot as a `' '`. 3 | 4 | Instead of using imperative constructs for storing our images, images will simply be functions that take an `x` and a `y` and return a boolean that indicates if the function is black or white at this point. 5 | This is materialized by the `image` type alias given in the prelude. 6 | We will only use imperative features to display them. 7 | 8 | 1. Define a higher order function `display_image: int -> int -> image -> unit` that takes an integer `width`, another one `height`, a function which takes an `x` and a `y`, and renders (prints) the boolean function as a series of lines, using two nested `for` loops. 9 | Each line corresponds to a `y`, the first line printed being for `y = 0`, the last one for `y = height`. 10 | In each line, the first character printed must be for `x = 0`, the last one for `x = width`. When the function result is `true`, a sharp (`'#'`) must be displayed, and a space otherwise. 11 | To try your function, the prelude defines sample images and image builders. 12 | For instance, the image `disk 5 5 5` would be displayed as the following ASCII art, when rendered between coordinates `0 <= x <= 10` and `0 <= y <= 10`. 13 | ``` 14 | # 15 | ####### 16 | ######### 17 | ######### 18 | ######### 19 | ########### 20 | ######### 21 | ######### 22 | ######### 23 | ####### 24 | # 25 | ``` 26 | 27 | 2. Now, we want to blend images to compose complex images from simple ones. For this, we will use the `blend` type given the prelude. 28 | If we take two functions `f` and `g`, we have that: 29 | * `Image f` is the blended image looking exactly like `f`. 30 | * `And (Image f, Image g)` is the blended image that is black only where both `f` and `g` are both black. 31 | * `Or (Image f, Image g)` is the blended image that is black wherever either `f` or `g` or both are black. 32 | * `Rem (Image f, Image g)` is the blended image that is black wherever `f` is black and `g` is not. 33 | 34 | Write a recursive `render : blend -> int -> int -> bool` function, that tells, for a given `x` and `y` the boolean color of the point, considering the given blended image. 35 | 36 | 3. Define a function `display_blend: int -> int -> blend -> unit` that takes a `width`, another one `height`, a blended image, and displays it by combining the two previous functions. 37 | As an example, the blend `display_blend 10 10 (Rem (Image all_black, Image (disk 5 5 5)))` would be displayed as the following ASCII art. 38 | ``` 39 | ##### ##### 40 | ## ## 41 | # # 42 | # # 43 | # # 44 | 45 | # # 46 | # # 47 | # # 48 | ## ## 49 | ##### ##### 50 | ``` 51 | **Bonus question**: Did you see that the type of `render` is actually equivalent to `blend -> image`? 52 | 53 | ### THE GIVEN PRELUDE 54 | ``` 55 | type image = int -> int -> bool ;; 56 | 57 | let all_white = fun x y -> false ;; 58 | 59 | let all_black = fun x y -> true ;; 60 | 61 | let checkers = fun x y -> y/2 mod 2 = x/2 mod 2 ;; 62 | 63 | let square cx cy s = fun x y -> 64 | let minx = cx - s / 2 in 65 | let maxx = cx + s / 2 in 66 | let miny = cy - s / 2 in 67 | let maxy = cy + s / 2 in 68 | x >= minx && x <= maxx && y >= miny && y <= maxy 69 | ;; 70 | 71 | let disk cx cy r = fun x y -> 72 | let x' = x - cx in 73 | let y' = y - cy in 74 | (x' * x' + y' * y') <= r * r 75 | ;; 76 | 77 | type blend = 78 | | Image of image 79 | | And of blend * blend 80 | | Or of blend * blend 81 | | Rem of blend * blend 82 | ;; 83 | ``` 84 | 85 | ### YOUR OCAML ENVIRONMENT 86 | ``` 87 | let display_image width height f_image = 88 | "Replace this string with your implementation." ;; 89 | 90 | let rec render blend x y = 91 | "Replace this string with your implementation." ;; 92 | 93 | let display_blend width height blend = 94 | "Replace this string with your implementation." ;; 95 | ``` 96 | -------------------------------------------------------------------------------- /week2/w2_6.1_small_typed_db.ml: -------------------------------------------------------------------------------- 1 | (* A phone number is a sequence of four integers. *) 2 | type phone_number = int * int * int * int;; 3 | 4 | (* A contact has a name and a phone number. *) 5 | type contact = { 6 | name : string; 7 | phone_number : phone_number 8 | };; 9 | 10 | (* Here is a dumb contact. *) 11 | let nobody = { name = ""; phone_number = (0, 0, 0, 0) };; 12 | 13 | (* A database is a collection of contacts. *) 14 | type database = { 15 | number_of_contacts : int; 16 | contacts : contact array; 17 | };; 18 | 19 | (* [make n] is the database with no contact and at most [n] contacts stored inside. *) 20 | let make max_number_of_contacts = 21 | { 22 | number_of_contacts = 0; 23 | contacts = Array.make max_number_of_contacts nobody 24 | };; 25 | 26 | (* Queries are represented by a code and a contact. 27 | - If the code is 0 then the contact must be inserted. 28 | - If the code is 1 then the contact must be deleted. 29 | - If the code is 2 then we are looking for a contact 30 | with the same name in the database. *) 31 | type query = { 32 | code : int; 33 | contact : contact 34 | };; 35 | 36 | (* 37 | let search db contact = 38 | let rec aux idx = 39 | if idx >= db.number_of_contacts then 40 | (false, db, nobody) 41 | else if db.contacts.(idx).name = contact.name then 42 | (true, db, db.contacts.(idx)) 43 | else 44 | aux (idx + 1) 45 | in 46 | aux 0;; 47 | *) 48 | 49 | let insert db contact = 50 | if db.number_of_contacts >= Array.length db.contacts then 51 | (false, db, nobody) 52 | else 53 | let (status, db, _) = search db contact in 54 | if status then (false, db, contact) else 55 | let cells i = 56 | if i = db.number_of_contacts then contact else db.contacts.(i) 57 | in 58 | let db' = { 59 | number_of_contacts = db.number_of_contacts + 1; 60 | contacts = Array.init (Array.length db.contacts) cells 61 | } 62 | in 63 | (true, db', contact);; 64 | 65 | (* 66 | let delete db contact = 67 | let (status, db, contact) = search db contact in 68 | if not status then (false, db, contact) 69 | else 70 | let cells i = 71 | if db.contacts.(i).name = contact.name then 72 | nobody 73 | else 74 | db.contacts.(i) in 75 | let db' = { 76 | number_of_contacts = db.number_of_contacts - 1; 77 | contacts = Array.init (Array.length db.contacts) cells 78 | } 79 | in 80 | (true, db', contact);; 81 | *) 82 | 83 | (* Engine parses and interprets the query. 84 | let engine db { code ; contact } = 85 | if code = 0 then insert db contact 86 | else if code = 1 then delete db contact 87 | else if code = 2 then search db contact 88 | else (false, db, nobody);; 89 | *) 90 | 91 | 92 | let proof_of_bug = 93 | [| {code = 0; contact = {name = "uno"; phone_number = (1, 1, 1, 1)}}; 94 | {code = 0; contact = {name = "dos"; phone_number = (2, 2, 2, 2)}}; 95 | {code = 1; contact = {name = "uno"; phone_number = (0, 0, 0, 0)}}; 96 | {code = 0; contact = {name = "tres"; phone_number = (3, 3, 3, 3)}}; 97 | {code = 2; contact = {name = "dos"; phone_number = (0, 0, 0, 0)}}|] ;; 98 | 99 | let delete db contact = 100 | let (status, db, contact) = search db contact in 101 | if not status then 102 | (false, db, contact) 103 | else 104 | let cells i = 105 | if i = db.number_of_contacts - 1 then 106 | nobody 107 | else if db.contacts.(i).name = contact.name then 108 | db.contacts.(db.number_of_contacts - 1) 109 | else 110 | db.contacts.(i) in 111 | let db' = { 112 | number_of_contacts = db.number_of_contacts - 1; 113 | contacts = Array.init (Array.length db.contacts) cells 114 | } in 115 | (true, db', contact) 116 | 117 | let update db contact = 118 | let (status, _, _) = engine db {code = 2; contact} in 119 | if status then 120 | let cells i = 121 | if db.contacts.(i).name = contact.name 122 | then contact 123 | else db.contacts.(i) in 124 | let db' = { 125 | number_of_contacts = db.number_of_contacts; 126 | contacts = Array.init (Array.length db.contacts) cells 127 | } in 128 | (true, db', contact) 129 | else 130 | engine db {code = 0; contact} 131 | 132 | let engine db { code ; contact } = 133 | if code = 0 then insert db contact 134 | else if code = 1 then delete db contact 135 | else if code = 2 then search db contact 136 | else if code = 3 then update db contact 137 | else (false, db, nobody);; 138 | -------------------------------------------------------------------------------- /week2/w2_6.1_small_typed_db.md: -------------------------------------------------------------------------------- 1 | # A SMALL TYPED DATABASE (35 points possible) 2 | The code of the mini-database example is given in the prelude. 3 | 4 | 1. You may have noticed that there is an error in the implementation of our database. This error leads to not finding users that should be in the database (because they have been added at some point, and not deleted since) after certain sequences of queries. 5 | Find the bug and give a sequence of operations `proof_of_bug` of type `query array` that exhibits it when executed one after the other on an initially empty database. 6 | The failure must be triggered by the last query. 7 | 8 | 2. To fix this bug, write a new version of `delete` that enforces the following invariant on the database, which is expected by the other functions. 9 | All the contacts of a database `db` (and no others) should be stored in the array `db.contacts` between indexes `0` and `db.number_of_contacts - 1` (inclusive). 10 | 11 | 3. Write a new function `update : database -> contact -> (bool * database * contact)` that either changes the number of an existing person or inserts a new contact. It should return `true` and the updated database if any of these two options succeeded, or `false` with the untouched database. The returned `contact` is not important, it is here just so the function has the same signature as the others. 12 | 13 | 4. Write an updated `engine` function that does an update when given a query with code 3, and uses your updated delete function. 14 | 15 | ### THE GIVEN PRELUDE 16 | ```ocaml 17 | (* A phone number is a sequence of four integers. *) 18 | type phone_number = int * int * int * int;; 19 | 20 | (* A contact has a name and a phone number. *) 21 | type contact = { 22 | name : string; 23 | phone_number : phone_number 24 | };; 25 | 26 | (* Here is a dumb contact. *) 27 | let nobody = { name = ""; phone_number = (0, 0, 0, 0) };; 28 | 29 | (* A database is a collection of contacts. *) 30 | type database = { 31 | number_of_contacts : int; 32 | contacts : contact array; 33 | };; 34 | 35 | (* [make n] is the database with no contact and at most [n] contacts 36 | stored inside. *) 37 | let make max_number_of_contacts = 38 | { 39 | number_of_contacts = 0; 40 | contacts = Array.make max_number_of_contacts nobody 41 | };; 42 | 43 | (* Queries are represented by a code and a contact. 44 | - If the code is 0 then the contact must be inserted. 45 | - If the code is 1 then the contact must be deleted. 46 | - If the code is 2 then we are looking for a contact 47 | with the same name in the database. *) 48 | type query = { 49 | code : int; 50 | contact : contact; 51 | } 52 | 53 | let search db contact = 54 | let rec aux idx = 55 | if idx >= db.number_of_contacts then 56 | (false, db, nobody) 57 | else if db.contacts.(idx).name = contact.name then 58 | (true, db, db.contacts.(idx)) 59 | else 60 | aux (idx + 1) 61 | in 62 | aux 0;; 63 | 64 | let insert db contact = 65 | if db.number_of_contacts >= Array.length db.contacts then 66 | (false, db, nobody) 67 | else 68 | let (status, db, _) = search db contact in 69 | if status then (false, db, contact) else 70 | let cells i = 71 | if i = db.number_of_contacts then contact else db.contacts.(i) 72 | in 73 | let db' = { 74 | number_of_contacts = db.number_of_contacts + 1; 75 | contacts = Array.init (Array.length db.contacts) cells 76 | } 77 | in 78 | (true, db', contact);; 79 | 80 | let delete db contact = 81 | let (status, db, contact) = search db contact in 82 | if not status then (false, db, contact) 83 | else 84 | let cells i = 85 | if db.contacts.(i).name = contact.name then 86 | nobody 87 | else 88 | db.contacts.(i) in 89 | let db' = { 90 | number_of_contacts = db.number_of_contacts - 1; 91 | contacts = Array.init (Array.length db.contacts) cells 92 | } 93 | in 94 | (true, db', contact);; 95 | 96 | (* Engine parses and interprets the query. *) 97 | let engine db { code ; contact } = 98 | if code = 0 then insert db contact 99 | else if code = 1 then delete db contact 100 | else if code = 2 then search db contact 101 | else (false, db, nobody);; 102 | ``` 103 | 104 | ### YOUR OCAML ENVIRONMENT 105 | ```ocaml 106 | let proof_of_bug = 107 | [| "Replace this string with your queries." |] ;; 108 | 109 | let delete db contact = 110 | "Replace this string with your implementation." ;; 111 | 112 | let update db contact = 113 | "Replace this string with your implementation." ;; 114 | 115 | let engine db { code ; contact } = 116 | "Replace this string with your implementation." ;; 117 | ``` 118 | -------------------------------------------------------------------------------- /week3/w3_4.1_type_directed_prog.ml: -------------------------------------------------------------------------------- 1 | type story = { 2 | context : context; 3 | perturbation : event; 4 | adventure : event list; 5 | conclusion : context; 6 | } 7 | and context = { characters : character list } 8 | and character = { name : string; state : state; location : location } 9 | and event = Change of character * state | Action of character * action 10 | and state = Happy | Hungry | Tired 11 | and action = Eat | GoToRestaurant | Sleep 12 | and location = Appartment | Restaurant 13 | ;; 14 | 15 | let compatible_actions_for_character character context = 16 | match character with 17 | | { location = Restaurant } -> [Eat] 18 | | { location = Appartment } -> [GoToRestaurant] 19 | ;; 20 | 21 | let apply_action character = function 22 | | Eat -> 23 | { state = Happy; 24 | location = character.location; name = character.name } 25 | | GoToRestaurant -> 26 | { location = Restaurant; 27 | state = character.state; name = character.name } 28 | | Sleep -> 29 | { location = character.location; 30 | state = Hungry; name = character.name } 31 | ;; 32 | 33 | let compatible_actions context = 34 | let rec aux = function 35 | | [] -> [] 36 | | character :: cs -> 37 | let can_do = compatible_actions_for_character character context in 38 | let rec aux' = function 39 | | [] -> [] 40 | | a :: actions -> Action (character, a) :: aux' actions 41 | in 42 | aux' can_do 43 | in 44 | aux context.characters 45 | ;; 46 | 47 | let possible_changes_for_character character = 48 | match character with 49 | | { state = Happy } -> [Hungry] 50 | | { state = Hungry } -> [] 51 | | { state = Tired } -> [] 52 | ;; 53 | let apply_change character state = 54 | { name = character.name; state = state; location = character.location } 55 | ;; 56 | 57 | let possible_changes context = 58 | let rec aux = function 59 | | [] -> [] 60 | | character :: cs -> 61 | let possible_changes = possible_changes_for_character character in 62 | let rec aux' = function 63 | | [] -> [] 64 | | c :: changes -> Change (character, c) :: aux' changes 65 | in 66 | aux' possible_changes 67 | in 68 | aux context.characters 69 | ;; 70 | 71 | let character_of_event = function 72 | | Action (character, _) -> character 73 | | Change (character, _) -> character 74 | ;; 75 | 76 | let apply event context = 77 | let rec aux = function 78 | | [] -> assert false 79 | | character :: cs -> 80 | if character = character_of_event event then 81 | match event with 82 | | Action (_, action) -> apply_action character action :: cs 83 | | Change (_, change) -> apply_change character change :: cs 84 | else 85 | character :: aux cs 86 | in 87 | { characters = aux context.characters } 88 | ;; 89 | 90 | let rec is_one_of state states = 91 | match states with 92 | | [] -> false 93 | | state' :: ss -> state = state' || is_one_of state ss 94 | ;; 95 | 96 | let rec all_characters_are states = function 97 | | [] -> 98 | true 99 | | character :: cs -> 100 | is_one_of character.state states && all_characters_are states cs 101 | ;; 102 | 103 | let random_pick xs = 104 | List.nth xs (Random.int (List.length xs)) 105 | ;; 106 | let something_happens context = 107 | let what_can_happen = compatible_actions context @ possible_changes context in 108 | let event = random_pick what_can_happen in 109 | event, apply event context 110 | ;; 111 | let happy context = 112 | all_characters_are [Happy] context.characters 113 | ;; 114 | 115 | let rec end_story events context = 116 | if happy context then 117 | context, List.rev events 118 | else 119 | let event, context = something_happens context in 120 | end_story (event :: events) context 121 | ;; 122 | 123 | let make_story initial_context = 124 | let perturbation, context = something_happens initial_context in 125 | let conclusion, adventure = end_story [] context in 126 | { 127 | context = initial_context; 128 | perturbation = perturbation; 129 | adventure = adventure; 130 | conclusion = conclusion 131 | } 132 | ;; 133 | 134 | let describe_location = function 135 | | Appartment -> "at home" 136 | | Restaurant -> "at the restaurant" 137 | ;; 138 | let describe_state = function 139 | | Happy -> "happy" 140 | | Hungry -> "hungry" 141 | | Tired -> "tired" 142 | ;; 143 | let describe character = 144 | character.name ^ " was " 145 | ^ describe_location character.location 146 | ^ " and was " ^ describe_state character.state ^ ". " 147 | ;; 148 | 149 | let tell_context context = 150 | let rec aux = function 151 | | [] -> "" 152 | | character :: characters -> describe character ^ aux characters 153 | in 154 | aux context.characters 155 | ;; 156 | 157 | let tell_action = function 158 | | Eat -> "ate" 159 | | GoToRestaurant -> "went to the restaurant" 160 | | Sleep -> "took a nap" 161 | ;; 162 | 163 | let tell_event = function 164 | | Action (character, action) -> 165 | character.name ^ " " ^ tell_action action ^ ". " 166 | | Change (character, state) -> 167 | character.name ^ " was made " ^ describe_state state ^ ". " 168 | ;; 169 | 170 | let rec tell_adventure = function 171 | | [] -> "" 172 | | event :: adventure -> tell_event event ^ tell_adventure adventure 173 | ;; 174 | 175 | let tell story = 176 | "Once upon a time, " 177 | ^ tell_context story.context 178 | ^ "One day, something wrong happened. " 179 | ^ tell_event story.perturbation 180 | ^ tell_adventure story.adventure 181 | ^ "At the end, the peace was restored. " 182 | ^ tell_context story.conclusion 183 | ;; 184 | 185 | let story = tell (make_story { 186 | characters = [ 187 | { name = "Sophie"; location = Appartment; state = Happy }; 188 | { name = "Socrate"; location = Appartment; state = Happy }; 189 | ] 190 | });; 191 | -------------------------------------------------------------------------------- /week5/w5_3.2_fs_hierarchy.md: -------------------------------------------------------------------------------- 1 | # DISPLAYING A FILESYSTEM HIERARCHY (320 points possible) 2 | In this exercise, we will pretty-print directory structures. 3 | 4 | The prelude gives the types that we will use to represent directory structures. A `node` in the filesystem is either a simple `File`, a `Directory` that contains a nested filesystem, or a `Symlink`. 5 | The latter, as on Unix systems, is a fake file that redirects to another file. For this, it provides the relative path to this target file. The path is the list of directory to traverse to get to the target file, followed by the later. If one has to go a directory up, we use the common `".."` directory name that represents the parent directory. 6 | A filesystem is a list of named nodes. An example filesystem is given below, in the format that you will have to produce. Don't worry, we'll break this piece by piece. 7 | 8 | ``` 9 | /photos 10 | | /march 11 | | | photo_1.bmp 12 | | | photo_2.bmp 13 | | | photo_3.bmp 14 | | | index.html 15 | | /april 16 | | | photo_1.bmp 17 | | | photo_2.bmp 18 | | | index.html 19 | /videos 20 | | video1.avi 21 | | video2.avi 22 | | video3.avi 23 | | video4.avi 24 | | best.avi -> video4.avi 25 | | index.html 26 | /indexes 27 | | videos.html -> ../videos/index.html 28 | | photos_march.html -> ../photos/march/index.html 29 | | photos_april.html -> ../photos/april/index.html 30 | | photos_may.html -> INVALID 31 | ``` 32 | This output was generated from the following OCaml structure. 33 | 34 | ``` 35 | [ "photos", Dir 36 | [ "march", Dir 37 | [ "photo_1.bmp", File ; 38 | "photo_2.bmp", File ; 39 | "photo_3.bmp", File ; 40 | "index.html", File ] ; 41 | "april", Dir 42 | [ "photo_1.bmp", File ; 43 | "photo_2.bmp", File ; 44 | "index.html", File ] ] ; 45 | "videos", Dir 46 | [ "video1.avi", File ; 47 | "video2.avi", File ; 48 | "video3.avi", File ; 49 | "video4.avi", File ; 50 | "best.avi", Symlink [ "video4.avi" ] ; 51 | "index.html", File ] ; 52 | "indexes", Dir 53 | [ "videos.html", 54 | Symlink [ ".." ; "videos" ; "index.html" ] ; 55 | "photos_march.html", 56 | Symlink [ ".." ; "photos" ; "march" ; "index.html" ] ; 57 | "photos_april.html", 58 | Symlink [ ".." ; "photos" ; "april" ; "index.html" ] ; 59 | "photos_may.html", 60 | Symlink [ ".." ; "photos" ; "may" ; "index.html" ] ] ] 61 | ``` 62 | 63 | 1. Write a function `print_path: string list -> unit` that prints a relative path (the argument of a `Symlink`) and pretty prints it as shown in the example display, using slashes (`'/'`) as separator. 64 | As you can see in the example, the depth of a file in the filesystem (the number of nested folders that are its ancestors) is represented by a sequence of vertical lines. Write a function `print_file: int -> string -> unit` that prints a file name, with the given number of `"| "` in front of it. 65 | 66 | 2. Write a similar function `print_symlink: int -> string -> string list -> unit` that prints the link name, with the given number of `"| "` in front of it, and the relative path (preceded by an arrow `" -> "`). 67 | 68 | 3. Write a similar function `print_dir: int -> string -> unit` that prints the dir name, with the given number of `"| "` in front of it, and the prepended `'/'`. 69 | 70 | 4. Write a function `print_filesystem: filesystem -> unit` that traverses the filesystem, producing the same display as in the example. You will probably need an auxiliary, recursive function, and you will have to use the previous answers. 71 | 72 | 5. Write a function `resolve: string list -> string list -> string list`. It takes as parameters: 73 | * The full path from the root to a symlink, including its name. In the given example, that could be for instance `[ "indexes" ; "photos_april.html" ]`. 74 | * The relative path for this symlink. Here, that would be `[ ".." ; "photos" ; "april" ; "index.html" ]`. 75 | 76 | The function returns the full path from the root to the target of the symlink. Here, we should get `[ "photos" ; "april" ; "index.html" ]`. Note that it may not be as easy as it seems, so you may think about it before plunging into the code. 77 | 78 | 6. Write a function `file_exists : filesystem -> string list -> bool` that tells if a file exists in the filesystem. The path is the full absolute path to the file, and the target must be a `File`, not a `Dir` or a `Symlink`. 79 | Update your function `print_filesystem: filesystem -> unit` so that it replaces the printed relative path by `"INVALID"` when the symlink cannot be resolved to an existing file. 80 | 81 | 82 | # THE GIVEN PRELUDE 83 | ``` 84 | type filesystem = 85 | (string * node) list 86 | and node = 87 | | File 88 | | Dir of filesystem 89 | | Symlink of string list 90 | ``` 91 | 92 | # YOUR OCAML ENVIRONMENT 93 | ``` 94 | let rec print_path path = 95 | "Replace this string with your implementation." ;; 96 | 97 | let rec print_file lvl name = 98 | "Replace this string with your implementation." ;; 99 | 100 | let rec print_symlink lvl name path = 101 | "Replace this string with your implementation." ;; 102 | 103 | let rec print_dir lvl name = 104 | "Replace this string with your implementation." ;; 105 | 106 | let print_filesystem root = 107 | (* This pre-completed structure is only here to help you. 108 | If it confuses you, don't hesitate to change it. *) 109 | let rec print_filesystem lvl items = 110 | "Replace this string with your implementation." in 111 | print_filesystem 0 root ;; 112 | 113 | let rec resolve sym path = 114 | (* This pre-completed structure is only here to help you. 115 | If it confuses you, don't hesitate to change it. *) 116 | let rec resolve acc path = 117 | "Replace this string with your implementation." in 118 | resolve (List.tl (List.rev sym)) path ;; 119 | 120 | let rec file_exists root path = 121 | "Replace this string with your implementation." ;; 122 | ``` 123 | -------------------------------------------------------------------------------- /week3/w3_4.1_type_directed_prog.md: -------------------------------------------------------------------------------- 1 | # TYPE DIRECTED PROGRAMMING (40 points possible) 2 | In this exercise, you will experiment with type-directed programming. 3 | 4 | We give you the example program of the lecture in which two type definitions have been changed as in the given prelude. A case `Tired` has been added to type `state`, and a case `Sleep` has been added to type `action`. 5 | By clicking the typecheck button, you can notice that several warnings are issued by the OCaml compiler. Go through the code and fix these warnings as follow. 6 | 7 | 1. Update `apply_action` so that the `Sleep` action turns a character from the `Tired` state to the `Hungry` state. 8 | 2. Update `possible_changes_for_character` so that the `Tired` state behaves as the `Hungry` state. 9 | 3. Update `describe_state` so that the description of the `Tired` state is `"tired"`. 10 | 4. Update `tell_action` so that `tell_action Sleep` is `"took a nap"`. 11 | 12 | ### THE GIVEN PRELUDE 13 | ```ocaml 14 | type story = { 15 | context : context; 16 | perturbation : event; 17 | adventure : event list; 18 | conclusion : context; 19 | } 20 | and context = { characters : character list } 21 | and character = { name : string; state : state; location : location } 22 | and event = Change of character * state | Action of character * action 23 | and state = Happy | Hungry | Tired 24 | and action = Eat | GoToRestaurant | Sleep 25 | and location = Appartment | Restaurant 26 | ``` 27 | 28 | ### YOUR OCAML ENVIRONMENT 29 | ```ocaml 30 | let compatible_actions_for_character character context = 31 | match character with 32 | | { location = Restaurant } -> [Eat] 33 | | { location = Appartment } -> [GoToRestaurant] 34 | ;; 35 | 36 | let apply_action character = function 37 | | Eat -> 38 | { state = Happy; 39 | location = character.location; name = character.name } 40 | | GoToRestaurant -> 41 | { location = Restaurant; 42 | state = character.state; name = character.name } 43 | ;; 44 | 45 | let compatible_actions context = 46 | let rec aux = function 47 | | [] -> [] 48 | | character :: cs -> 49 | let can_do = compatible_actions_for_character character context in 50 | let rec aux' = function 51 | | [] -> [] 52 | | a :: actions -> Action (character, a) :: aux' actions 53 | in 54 | aux' can_do 55 | in 56 | aux context.characters 57 | ;; 58 | 59 | let possible_changes_for_character character = 60 | match character with 61 | | { state = Happy } -> [Hungry] 62 | | { state = Hungry } -> [] 63 | ;; 64 | let apply_change character state = 65 | { name = character.name; state = state; location = character.location } 66 | ;; 67 | 68 | let possible_changes context = 69 | let rec aux = function 70 | | [] -> [] 71 | | character :: cs -> 72 | let possible_changes = possible_changes_for_character character in 73 | let rec aux' = function 74 | | [] -> [] 75 | | c :: changes -> Change (character, c) :: aux' changes 76 | in 77 | aux' possible_changes 78 | in 79 | aux context.characters 80 | ;; 81 | 82 | let character_of_event = function 83 | | Action (character, _) -> character 84 | | Change (character, _) -> character 85 | ;; 86 | 87 | let apply event context = 88 | let rec aux = function 89 | | [] -> assert false 90 | | character :: cs -> 91 | if character = character_of_event event then 92 | match event with 93 | | Action (_, action) -> apply_action character action :: cs 94 | | Change (_, change) -> apply_change character change :: cs 95 | else 96 | character :: aux cs 97 | in 98 | { characters = aux context.characters } 99 | ;; 100 | 101 | let rec is_one_of state states = 102 | match states with 103 | | [] -> false 104 | | state' :: ss -> state = state' || is_one_of state ss 105 | ;; 106 | 107 | let rec all_characters_are states = function 108 | | [] -> 109 | true 110 | | character :: cs -> 111 | is_one_of character.state states && all_characters_are states cs 112 | ;; 113 | 114 | let random_pick xs = 115 | List.nth xs (Random.int (List.length xs)) 116 | ;; 117 | let something_happens context = 118 | let what_can_happen = compatible_actions context @ possible_changes context in 119 | let event = random_pick what_can_happen in 120 | event, apply event context 121 | ;; 122 | let happy context = 123 | all_characters_are [Happy] context.characters 124 | ;; 125 | 126 | let rec end_story events context = 127 | if happy context then 128 | context, List.rev events 129 | else 130 | let event, context = something_happens context in 131 | end_story (event :: events) context 132 | ;; 133 | 134 | let make_story initial_context = 135 | let perturbation, context = something_happens initial_context in 136 | let conclusion, adventure = end_story [] context in 137 | { 138 | context = initial_context; 139 | perturbation = perturbation; 140 | adventure = adventure; 141 | conclusion = conclusion 142 | } 143 | ;; 144 | 145 | let describe_location = function 146 | | Appartment -> "at home" 147 | | Restaurant -> "at the restaurant" 148 | ;; 149 | let describe_state = function 150 | | Happy -> "happy" 151 | | Hungry -> "hungry" 152 | ;; 153 | let describe character = 154 | character.name ^ " was " 155 | ^ describe_location character.location 156 | ^ " and was " ^ describe_state character.state ^ ". " 157 | ;; 158 | 159 | let tell_context context = 160 | let rec aux = function 161 | | [] -> "" 162 | | character :: characters -> describe character ^ aux characters 163 | in 164 | aux context.characters 165 | ;; 166 | 167 | let tell_action = function 168 | | Eat -> "ate" 169 | | GoToRestaurant -> "went to the restaurant" 170 | ;; 171 | 172 | let tell_event = function 173 | | Action (character, action) -> 174 | character.name ^ " " ^ tell_action action ^ ". " 175 | | Change (character, state) -> 176 | character.name ^ " was made " ^ describe_state state ^ ". " 177 | ;; 178 | 179 | let rec tell_adventure = function 180 | | [] -> "" 181 | | event :: adventure -> tell_event event ^ tell_adventure adventure 182 | ;; 183 | 184 | let tell story = 185 | "Once upon a time, " 186 | ^ tell_context story.context 187 | ^ "One day, something wrong happened. " 188 | ^ tell_event story.perturbation 189 | ^ tell_adventure story.adventure 190 | ^ "At the end, the peace was restored. " 191 | ^ tell_context story.conclusion 192 | ;; 193 | 194 | let story = tell (make_story { 195 | characters = [ 196 | { name = "Sophie"; location = Appartment; state = Happy }; 197 | { name = "Socrate"; location = Appartment; state = Happy }; 198 | ] 199 | });; 200 | ``` 201 | -------------------------------------------------------------------------------- /project/klotski.ml: -------------------------------------------------------------------------------- 1 | (* --- Given prelude --- *) 2 | 3 | exception NotFound ;; 4 | 5 | type 'e rel = 'e -> 'e list ;; 6 | type 'e prop = 'e -> bool ;; 7 | 8 | type ('a, 'set) set_operations = { 9 | empty : 'set; (* The empty set. *) 10 | mem : 'a -> 'set -> bool; (* [mem x s = true] iff [x] is in [s]. *) 11 | add : 'a -> 'set -> 'set; (* [add s x] is the set [s] union {x}. *) 12 | } ;; 13 | 14 | type ('configuration, 'move) puzzle = { 15 | move : 'configuration -> 'move -> 'configuration; 16 | possible_moves : 'configuration -> 'move list; 17 | final : 'configuration -> bool 18 | } ;; 19 | 20 | type piece_kind = S | H | V | C | X ;; 21 | type piece = piece_kind * int ;; 22 | let x = (X, 0) and s = (S, 0) and h = (H, 0) ;; 23 | let (c0, c1, c2, c3) = ((C, 0), (C, 1), (C, 2), (C, 3)) ;; 24 | let (v0, v1, v2, v3) = ((V, 0), (V, 1), (V, 2), (V, 3)) ;; 25 | let all_pieces : piece list = [ s; h; c0; c1; c2; c3; v0; v1; v2; v3 ] ;; 26 | 27 | type board = piece array array ;; 28 | let initial_board = 29 | [| [| v0 ; s ; s ; v1 |]; 30 | [| v0 ; s ; s ; v1 |]; 31 | [| v2 ; h ; h ; v3 |]; 32 | [| v2 ; c0 ; c1 ; v3 |]; 33 | [| c2 ; x ; x ; c3 |] |] ;; 34 | 35 | let initial_board_simpler = 36 | [| [| c2 ; s ; s ; c1 |] ; 37 | [| c0 ; s ; s ; c3 |] ; 38 | [| v1 ; v2 ; v3 ; v0 |] ; 39 | [| v1 ; v2 ; v3 ; v0 |] ; 40 | [| x ; x ; x ; x |] |] ;; 41 | 42 | let initial_board_trivial = 43 | [| [| x ; s ; s ; x |] ; 44 | [| x ; s ; s ; x |] ; 45 | [| x ; x ; x ; x |] ; 46 | [| x ; x ; x ; x |] ; 47 | [| x ; x ; x ; x |] |] ;; 48 | 49 | type direction = { dcol : int; drow : int; } ;; 50 | type move = Move of piece * direction * board ;; 51 | let move _ (Move (_, _, b)) = b ;; 52 | 53 | 54 | (* --- Preliminaries --- *) 55 | 56 | let rec loop p f x = 57 | if p x 58 | then x 59 | else loop p f (f x) ;; 60 | 61 | let rec find p = function 62 | | [] -> raise NotFound 63 | | hd :: tl when p hd = true -> hd 64 | | _ :: tl -> find p tl ;; 65 | 66 | let rec exists p l = 67 | try 68 | ignore (find p l); true 69 | with NotFound -> false ;; 70 | 71 | 72 | (* --- Part A: A Generic Problem Solver --- *) 73 | 74 | let near : int rel = 75 | fun x -> [x - 2; x - 1; x; x + 1; x + 2] ;; 76 | 77 | let flat_map (r : 'e rel) = 78 | fun l -> List.concat (List.map r l) ;; 79 | 80 | let rec iter_rel (r : 'e rel) (n : int) = 81 | fun x -> match n with 82 | | 0 -> [x] 83 | | i -> flat_map r (iter_rel r (n - 1) x) ;; 84 | 85 | let solve (r : 'a rel) (p : 'a prop) (x : 'a) = 86 | find p (loop (exists p) (flat_map r) [x]) ;; 87 | 88 | let solve_path (r : 'a rel) (p : 'a prop) (x : 'a) = 89 | let p' = fun l -> p (List.hd l) 90 | and r'= fun l -> List.map (fun e -> e :: l) (r (List.hd l)) 91 | in List.tl (List.rev (solve r' p' [x; x])) ;; 92 | 93 | let archive_map (opset : ('a, 'set) set_operations) (r : 'a rel) (s, l) = 94 | let rec aux s' l' = function 95 | | [] -> (s', l') 96 | | hd :: tl -> 97 | if not (opset.mem hd s') 98 | then aux (opset.add hd s') (hd :: l') tl 99 | else aux s' l' tl 100 | in aux s [] (flat_map r l) ;; 101 | 102 | let solve' (opset : ('a, 'set) set_operations) (r : 'a rel) (p : 'a prop) (x : 'a) = 103 | let exists' (s, l) = exists p l 104 | and find' (s, l) = find p l 105 | in find' (loop exists' (archive_map opset r) (opset.empty, [x])) ;; 106 | 107 | let solve_path' (opset : ('a list, 'set) set_operations) (r : 'a rel) (p : 'a prop) (x : 'a) = 108 | let p' = fun l -> p (List.hd l) 109 | and r' = fun l -> List.map (fun e -> e :: l) (r (List.hd l)) 110 | in List.tl (List.rev (solve' opset r' p' [x; x])) ;; 111 | 112 | let solve_puzzle (p : ('c, 'm) puzzle) (opset : ('c list, 'set) set_operations) (c : 'c) = 113 | let r c = List.map (p.move c) (p.possible_moves c) 114 | and pred c = p.final c 115 | in solve_path' opset r pred c ;; 116 | 117 | 118 | (* --- Part B: A Solver for Klotski --- *) 119 | 120 | let final board = 121 | board.(3).(1) = s && board.(3).(2) = s && board.(4).(1) = s && board.(4).(2) = s ;; 122 | 123 | type location = { row : int; col : int} ;; 124 | 125 | (* List of locations occupied by a piece *) 126 | let piece_cells (b : board) (p : piece) = 127 | let rec aux accum = function 128 | | 20 -> accum 129 | | i -> let r = (i / 4) and c = (i mod 4) in 130 | if b.(r).(c) = p 131 | then aux ({ row = r ; col = c } :: accum) (i + 1) 132 | else aux accum (i + 1) 133 | in aux [] 0 ;; 134 | 135 | let copy_board (b : board) = 136 | let b' = [| [||] ; [||] ; [||] ; [||] ; [||] |] in 137 | for row = 0 to 4 do 138 | b'.(row) <- Array.copy b.(row) 139 | done; 140 | b' ;; 141 | 142 | let move_piece (b : board) (p : piece) { drow; dcol } = 143 | let in_bounds loc = 144 | loc.row >= 0 && loc.row < 5 && loc.col >= 0 && loc.col < 4 145 | and free loc = 146 | b.(loc.row).(loc.col) = x || b.(loc.row).(loc.col) = p in 147 | let cells = piece_cells b p in 148 | let new_cells = 149 | List.map (fun loc -> { row = loc.row + drow ; col = loc.col + dcol }) cells in 150 | if List.for_all in_bounds new_cells && List.for_all free new_cells then 151 | let b' = copy_board b in 152 | List.iter (fun loc -> b'.(loc.row).(loc.col) <- x) cells; 153 | List.iter (fun loc -> b'.(loc.row).(loc.col) <- p) new_cells; 154 | Some b' 155 | else 156 | None ;; 157 | 158 | let possible_moves (b : board) = 159 | let all_dir = [ { drow = 0; dcol = -1 } 160 | ; { drow = 0; dcol = 1 } 161 | ; { drow = -1; dcol = 0 } 162 | ; { drow = 1; dcol = 0 } ] 163 | and define_move = fun p dir -> 164 | match move_piece b p dir with 165 | | None -> None 166 | | Some b' -> Some (Move (p, dir, b')) in 167 | let rec filter_moves accum = function 168 | | [] -> accum 169 | | hd :: tl -> match hd with 170 | | None -> filter_moves accum tl 171 | | Some m -> filter_moves (m :: accum) tl in 172 | filter_moves [] (List.concat (List.map (fun p -> List.map (define_move p) all_dir) all_pieces)) ;; 173 | 174 | let klotski : (board, move) puzzle = { move; possible_moves; final } ;; 175 | 176 | module BoardSet = Set.Make (struct 177 | type t = board 178 | let compare b1 b2 = 179 | let rec aux r row1 row2 c = 180 | let p1 = row1.(c) 181 | and p2 = row2.(c) in 182 | match p1, p2 with 183 | | (type1, num1), (type2, num2) when type1 = type2 && num1 = num2 -> 184 | if c = 3 then 185 | if r = 4 186 | then 0 187 | else aux (r + 1) b1.(r + 1) b2.(r + 1) 0 188 | else 189 | aux r row1 row2 (c + 1) 190 | | (type1, num1), (type2, num2) when type1 = type2 && num1 != num2 -> compare num1 num2 191 | | (X, _), (_, _) -> -1 192 | | (_, _), (X, _) -> 1 193 | | (V, _), (_, _) -> -1 194 | | (_, _), (V, _) -> 1 195 | | (C, _), (_, _) -> -1 196 | | (_, _), (C, _) -> 1 197 | | (H, _), (_, _) -> -1 198 | | (_, _), (H, _) -> 1 199 | | _, _ -> 1 200 | in aux 0 b1.(0) b2.(0) 0 ;; 201 | end) ;; 202 | 203 | let solve_klotski initial_board = 204 | let opset = { empty = BoardSet.empty 205 | ; mem = (fun l -> BoardSet.mem (List.hd l)) 206 | ; add = (fun l -> BoardSet.add (List.hd l)) } 207 | in solve_puzzle klotski opset initial_board ;; 208 | -------------------------------------------------------------------------------- /project/README.md: -------------------------------------------------------------------------------- 1 | # A SOLVER FOR KLOTSKI (210 points possible) 2 | Klotski is a sliding block puzzle, that has a fairly detailed [page on WikiPedia](https://en.wikipedia.org/wiki/Klotski). 3 | The purpose of this project is to write a solver for Klotski using a graph exploration algorithm. 4 | 5 | The Klotski puzzle is made of a board of 4x5 places which contains the following 10 pieces: 6 | 7 | * one 2x2 square piece (written `S`) ; 8 | * one 2x1 horizontal rectangle piece (written `H`) ; 9 | * four 1x2 vertical rectangle pieces (written `V0`, `V1`, `V2` and `V3`) ; 10 | * four 1x1 square pieces (written `C0`, `C1`, `C2`, `C3`). 11 | 12 | The puzzle is presented in the initial configuration that is shown in the following picture: 13 | 14 | ![](./pics/klotski_01.png) 15 | 16 | A move in this puzzle consists in sliding a piece at a time, and to win you must have managed to move the large square piece all the way down, reaching a configuration that matches the following shape pattern: 17 | 18 | ![](./pics/klotski_02.png) 19 | 20 | To solve the puzzle, one may search all its state space for a winning configuration. 21 | The state space of the Klotski puzzle can be described as a graph, having as nodes the configurations of the board, and as arrows the possible moves. 22 | 23 | In the following picture, we show an excerpt of the Klotski graph, starting from the initial configuration. 24 | All the boards reachable from the initial configuration in one step are shown, as well as a few of the boards reachable in two steps. 25 | 26 | ![](./pics/klotski_03.png) 27 | 28 | Since all moves can be undone, it is easy to see that one can move from any configuration of the graph to any other configuration of the graph. 29 | This means that, when exploring the graph, one will naturally pass through the same configuration more than once, following different paths. 30 | To avoid spending our time running in circles when searching for a solution, we will need to avoid visiting a configuration more than once! 31 | 32 | ## APPROACH 33 | To solve the Klotski puzzle, you will proceed in two steps: 34 | 35 | * A: As a first step, you will write a _generic solver_ for any problem whose search space can be represented by a graph, and making sure you handle properly loops in the graph. 36 | 37 | * B: As a second step, you will describe the Klotski puzzle search space as a graph. 38 | 39 | Once the two steps above are done, finding a solution will just be a matter of passing the Klotski graph to the generic solver. 40 | 41 | **Note:** this project may take quite a lot of time to be graded, because it is long, and because the algorithm is complex. 42 | We suggest that you use the typecheck button and the toplevel extensively, so that you are reasonnably sure of your code before submitting it to the tests. 43 | Also, we added a function `grade_only : int list -> unit`, that you may call in your code to select the exercises to grade. 44 | All other exercises won't be graded at all, and considered failed. For instance, if you write `grade_only [ 3 ] ;;` at the beginning of your file, only exercise 3 will be tested. 45 | 46 | ## PRELIMINARIES 47 | First, you will implement some useful basic functions. 48 | 49 | 1. Write a function `loop` of type `('a -> bool) -> ('a -> 'a) -> 'a -> 'a` such that `loop p f x = x` when `p x = true` and `loop p f x = loop p f (f x)` otherwise. 50 | 51 | 2. Write a function `exists` of type `('a -> bool) -> 'a list -> bool` such that `exists p l = true` if and only if there exists an element `x` of `l` such that `p x = true`. 52 | 53 | 3. Write a function `find` of type `('a -> bool) -> 'a list -> 'a` such that `find p l = x` if `x` is the first element of `l` for which `p x = true`. 54 | If no such element exists, find raises the exception `NotFound` given in the prelude. 55 | 56 | ## PART A: A GENERIC PROBLEM SOLVER 57 | The goal of this section is to implement a generic problem solver based on graph exploration. 58 | The questions will help you start with a naive implementation and refine it step-by-step. 59 | 60 | A general way to look at problem solving is to consider some set **Е** representing the states of the problem and to consider also a finite binary relation ℛ that represents the small reasoning steps that can be made to move from one state of the problem to another. 61 | 62 | Remember that a binary relation is a subset of all the pairs in **Е**. 63 | We will write **_x_**ℛ**_y_** if (**_x_**, **_y_**) is in ℛ. 64 | The image of **_x_** under ℛ in **Е** is written ℛ(**_x_**) and it is defined as the set of all **_y_** in **Е** such that **_x_**ℛ**_y_**. 65 | A relation can be viewed through this image function as a function from **Е** to the subsets of **Е**. 66 | Hence, we can use the following type definition (also given in the prelude) to represent binary relations. 67 | 68 | ```ocaml 69 | type 'e rel = 'e -> 'e list 70 | ``` 71 | 72 | 4. As an exercise, we want to define a relation **_x_**𝒩 **_y_** that tells if the difference between two integers is at most 2. 73 | For instance, we have that 1𝒩 3, 3𝒩 1 and 2𝒩 2, but not 1𝒩 4 or 5𝒩 0. 74 | Define `near: int rel` that encodes the image of this relation as an OCaml function. 75 | For instance, `near 2` should return something like `[0;1;2;3;4]`. 76 | 77 | In practice, the `'e rel` type describes the function which, from a given configuration of the problem, gives all the possible configurations in which we can end up after performing a step. 78 | In this question, we want not just to look at the possible next steps from a single configuration, but from a set of configurations. 79 | 80 | Formally, we will say that we extend the image function ℛ of a binary relation ℛ over **Е** to a function ⌐ℛ defined as follows. 81 | 82 | ⌐ℛ([ ]) = [ ] 83 | 84 | ⌐ℛ(**_x_** :: **_xs_**) = ℛ(**_x_**) @ ⌐ℛ(**_xs_**). 85 | 86 | Basically, this computes the list of all possible new configuration that are reachable in one step from any configuration in an original list, losing track of the exact predecessor of each configuration. 87 | We just know that if a configuration is present in the resulting set, then there must have been one in the original set that led to it in one step. 88 | 89 | 5. Write a function `flat_map` of type `'e rel -> ('e list -> 'e list)` such that `flat_map r` represents ⌐ℛ if `r` represents a binary relation ℛ. 90 | For instance, `flat_map near` applied to `[2;3;4]` should return something like `[0;1;2;3;4;1;2;3;4;5;2;3;4;5;6]`. 91 | 92 | A binary relation over the set of problem configurations relates all pairs of configurations that are separated by a single step (for us, moving one piece of the game). 93 | Sometimes, we want to relate a configuration with its possible futures, up to a given number of steps. 94 | Formally, if ℛ is a binary relation over **Е**, we say that **_x_**ℛn**_y_** iff there exists a chain of elements **_e_**i of **Е** of length **_n−1_** such as **_x_**ℛ**_e_**1ℛ...ℛ**_e_**n-1ℛ**_y_**. 95 | The image function of ℛn is simply the image function of ℛ iterated **_n_** times. 96 | 97 | 6. Write a function `iter_rel: 'e rel -> int -> 'e rel` that computes this iteration. 98 | Iterating a relation 1 time or less does nothing (identity). 99 | For instance, `iter_rel near 2` should be the image function of the relation that tells is two integers are separated by 4 of less. 100 | 101 | The transitive closure of a binary relation ℛ is the relation that iterates ℛ over and over. 102 | Therefore, this is the union of all the relations obtained by iterating **_n_** times the relation ℛ, for all **_n_**. 103 | 104 | Formally, ℛ(**_x_**) = ℛ0(**_x_**) ∪ ℛ1(**_x_**) ∪ ℛ2(**_x_**) ∪ ... 105 | 106 | Or more constructively, ℛ0(**_x_**) = [**_x_**] and ℛn+1(**_x_**) = ⌐ℛ(ℛn(**_x_**)). 107 | 108 | We are not interested in computing the transitive closure of any relation, which could not terminate, depending on the relation. 109 | Our purpose is to compute the possible futures, starting from the initial configuration of the problem, until a specific property of the state is reached (in our case, we won the game). 110 | 111 | To represent such a property, we use the following type (also given in the prelude). 112 | It is a function that takes a state, and tells if the property holds (returning `true`) or not. 113 | 114 | ```ocaml 115 | type 'e prop = 'e -> bool 116 | ``` 117 | 118 | Solving a problem characterized by a property **_p_** and a relation ℛ for an initial problem state **_s_** is finding an element **_x_** in ℛ(**_s_**) such that **_p_**(**_x_**) = `true`. 119 | 120 | 7. Write a function `solve` of type `'a rel -> 'a prop -> 'a -> 'a` such that `solve r p x` computes the iteration of the relation ℛ represented by `r` starting at `x` until it reaches an element `y` such that `p y`. 121 | For instance, `solve near (fun x -> x = 12) 0` should simply return `12`. 122 | Internally, the function will start from the set `[0]`, and iterate near to obtain first `[-2;-1;0;1;2]`, then a sequence of growing lists, until eventually one iteration returns a list that contains `12`. 123 | 124 | 8. Define a function `solve_path` of type `'a rel -> 'a prop -> 'a -> 'a list` such that `solve_path r p x` behaves exactly as solve except that it produces not only the final value y such that p y but also all the intermediate elements from `x` to `y` that show how `x` is related to `y` through `r`. 125 | For instance, `solve_path near (fun x -> x = 12) 0` should return `[0;2;4;6;8;10;12]`. 126 | This function can be written simply by calling `solve` with well-chosen arguments. 127 | The idea is to iterate over the set of paths to destinations, instead of the set of destinations. 128 | 129 | The previous solver is very naive since it introduces a lot of redundancy in the search process. 130 | This is due to the simplistic representation of sets as lists: an element may be repeated several times in a list. 131 | Let us assume that we are given a more efficient data structure for sets over elements of type `'a` as specified by the following record type `('a, 'set) set_operations` (also given in the prelude). 132 | 133 | ```ocaml 134 | type ('a, 'set) set_operations = 135 | { empty : 'set ; 136 | mem : 'a -> 'set -> bool ; 137 | add : 'a -> 'set -> 'set } 138 | ``` 139 | 140 | This is a pattern that you will see in some OCaml libraries, to combine a set of operations in something more syntactically lightweight than an object or a functor. 141 | It is simple to use: given that you have a value `ops` of this type, just use `ops.empty` to obtain an empty set, `ops.add 13 s` to create a new set that is a copy of an existing set `s` augmented with a new element `13`, `s.add 1 (s.add 2 s.empty)` to create a set from scratch containing two elements `1` and `2`, and finally `s.mem 8 s` to test if `8` is an element of a set `s`. 142 | 143 | From now on, we will assume that a value of type `('a, 'set) set_operations` will be provided as input to the solver (you won't have to write one). 144 | For your own tests, you can use `int_set_operations: (int, _) set_operations` and `int_list_set_operations: (int list, _) set_operations` that are predefined. 145 | 146 | 9. Write a function `archive_map` of type `('a, 'set) set_operations -> 'a rel -> ('set * 'a list) -> ('set * 'a list)` 147 | such that: `archive_map opset rel (s, l) = (s', l')`, where: 148 | * `l'` is the list of elements that are reachable using `rel` from the elements of `l` and which are not already in the set `s`. 149 | * `s'` is the union of `s` and the elements of `l'`. 150 | 151 | 10. Use `archive_map` to program a new function `solve'` (don't forget the quote after the name) of type `('a, 'set) set_operations -> 'a rel -> 'a prop -> 'a -> 'a` that explores the search space with no redundancy. 152 | 153 | 11. Same question for `solve_path'` of type `('a list, 'set) set_operations -> 'a rel -> 'a prop -> 'a -> 'a list`. 154 | 155 | The last step of this first part is to implement a solver for a one-player puzzle. 156 | A one-player puzzle is characterized by the following elements. 157 | 158 | * a type for `'configuration`s which represent the states of the puzzle ; 159 | * a type for `'move`s which represent how the player can move from one configuration to another ; 160 | * a function `move : 'configuration -> 'move -> 'configuration` which applies a move to a configuration to get a new one ; 161 | * a function `possible_moves : 'configuration -> 'move list` which returns the list of moves that can be applied to an input configuration ; 162 | * a function `final : 'configuration -> bool` which returns true if and only if the input configuration is the one we are looking for. 163 | 164 | The following record type `puzzle` (also given in the prelude) will be used to characterize a puzzle. 165 | ```ocaml 166 | type ('configuration, 'move) puzzle = 167 | { move : 'configuration -> 'move -> 'configuration; 168 | possible_moves : 'configuration -> 'move list; 169 | final : 'configuration -> bool } 170 | ``` 171 | 172 | 12. Implement `solve_puzzle : ('c, 'm) puzzle -> ('c list, 's) set_operations -> 'c -> 'c list` such that `solve_puzzle p opset c` is a list of moves the application of which to the configuration `c` results in a configuration `c'` such that `p.final c' = true`. 173 | Here, opset is a record of set operations which the implementation of `solve_puzzle` may use. 174 | 175 | 176 | ## PART B: A SOLVER FOR KLOTSKI 177 | 178 | Let's start by giving names to the pieces on the board: 179 | * the one 2x2 square piece are written `S` ; 180 | * the one 2x1 horizontal rectangle piece are written `H` ; 181 | * the four 1x2 vertical rectangle pieces are written `V0`, `V1`, `V2` and `V3` ; 182 | * the four 1x1 square pieces are written `C0`, `C1`, `C2`, `C3`. 183 | 184 | As you have surely noticed, the board has two places which are not covered by any piece. 185 | We will write `X` to denote such a place. 186 | 187 | The type to describe the different kind of pieces is naturally an enumeration: 188 | 189 | ```ocaml 190 | type piece_kind = S | H | V | C | X 191 | ``` 192 | 193 | A piece is characterized by its kind and an index. 194 | 195 | ```ocaml 196 | type piece = piece_kind * int 197 | ``` 198 | 199 | Let us enumerate the pieces using toplevel definitions: 200 | 201 | ```ocaml 202 | let x = (X, 0) and s = (S, 0) and h = (H, 0) 203 | let (c0, c1, c2, c3) = ((C, 0), (C, 1), (C, 2), (C, 3)) 204 | let (v0, v1, v2, v3) = ((V, 0), (V, 1), (V, 2), (V, 3)) 205 | let all_pieces : piece list = [ s; h; c0; c1; c2; c3; v0; v1; v2; v3 ] 206 | ``` 207 | 208 | A board is a matrix of 5x4 places. 209 | Each place refers to the piece that covers it. 210 | 211 | ```ocaml 212 | type board = piece array array 213 | ``` 214 | 215 | You can use the function `display_board: board -> unit` to visualize a board configuration in the toplevel. 216 | 217 | For instance, the initial configuration is written as follows: 218 | 219 | ![](./pics/klotski_01.png) 220 | ```ocaml 221 | [| [| (V,0) ; (S,0) ; (S,0) ; (V,1) |] ; 222 | [| (V,0) ; (S,0) ; (S,0) ; (V,1) |] ; 223 | [| (V,2) ; (H,0) ; (H,0) ; (V,3) |] ; 224 | [| (V,2) ; (C,0) ; (C,1) ; (V,3) |] ; 225 | [| (C,2) ; (X,0) ; (X,0) ; (C,3) |] |] 226 | ``` 227 | 228 | 13. Write a function `final: board -> bool` such that `final board = true` if and only if `board` is a final configuration for Klotski. 229 | 230 | We have defined the configurations of our puzzle, now we have to define the moves. 231 | We will use the following types (also given in the prelude). 232 | 233 | ```ocaml 234 | type move = Move of piece * direction * board 235 | and direction = { dcol : int; drow : int } 236 | ``` 237 | 238 | A move is characterized by a direction and a piece it is applied to. 239 | The third component is the board that is obtained when this move is applied to the current board. 240 | 241 | With this definition of a move, applying a move to a board is very simple: we just extract the image board from it. 242 | 243 | ```ocaml 244 | let move _ (Move (_, _, b)) = b 245 | ``` 246 | 247 | 14. Write a function `move_piece : board -> piece -> direction -> board option` such that `move_piece board p { drow; dcol } = Some board'` if moving the piece `p` in `board` in direction `{ drow; dcol }` is possible and gives `board'`. 248 | Otherwise, if this move is not possible, `move_piece` returns `None`. 249 | 250 | 15. Define `possible_moves : board -> move list` that returns a list of moves that can be applied to board. 251 | 252 | At this point, you can define the puzzle instance to pass to the generic solver. 253 | 254 | ```ocaml 255 | let klotski : (board, move) puzzle = { move; possible_moves; final } 256 | ``` 257 | 258 | 16. The solver also expects a data structure to represent sets of boards. 259 | Use the standard library's functor `Set.Make` to implement this data structure as a module `BoardSet` of signature `Set.S with type elt = board`. 260 | The required comparison function `compare : board -> board -> int` should be such that `compare b1 b2 = 0` if all cells of both arrays are exactly the same. 261 | Otherwise, it should compare the cells of the two arrays pairwise, starting from cell `.(0).(0)`, then `.(0).(1)`, `.(0).(2)`, `.(0).(3)`, `.(1).(0)`, etc. 262 | up to the last cell `.(4).(3)`. 263 | The function should return the result of the first comparison of cells that does not return `0`. 264 | To compare to cells at index `.(i).(j)`, the first component (the kind of piece) is compared. 265 | The result is `< 0` if `b1.(i).(j) < b2.(i).(j)` and `> 0` if `b1.(i).(j) > b2.(i).(j)`. 266 | For this the pieces are ordered as follows: `S > H > C > V > X`. 267 | If both first components are the same, the result is the comparison of the second component, with the usual order on integers. 268 | 269 | 17. Update your `compare` function, so that it performs as few array accesses as possible, respecting the previous ordering algorithm. 270 | It must read the arrays up to the first pair of cells that differ. 271 | It should only read the entire arrays in case of equality. 272 | **Hint:** If you used loops, you can use an exception. 273 | **Note:** All array accesses are counted, so `a.(y).(x)` counts for two. 274 | If you read several cells in a same row, better put the row in a variable! 275 | 276 | 277 | ## PUTTING IT ALL TOGETHER 278 | 279 | Write a function `solve_klotski : board -> board list` such that `solve_klotski initial_board` is a list of boards from the `initial_board` to a `board` such that `final board = true`. 280 | This list must come from a sequence of valid moves of this puzzle. 281 | 282 | You can use the function `display_solution: board list -> unit` to visualize a solution in the toplevel. 283 | The two values `initial_board_trivial` and `initial_board_simpler` are variants of the initial configuration whose resolution should be much faster. 284 | 285 | 286 | ### THE GIVEN PRELUDE 287 | ```ocaml 288 | exception NotFound 289 | 290 | type 'e rel = 'e -> 'e list 291 | type 'e prop = 'e -> bool 292 | 293 | type ('a, 'set) set_operations = { 294 | empty : 'set; (* The empty set. *) 295 | mem : 'a -> 'set -> bool; (* [mem x s = true] iff [x] is in [s]. *) 296 | add : 'a -> 'set -> 'set; (* [add s x] is the set [s] union {x}. *) 297 | } 298 | 299 | type ('configuration, 'move) puzzle = { 300 | move : 'configuration -> 'move -> 'configuration; 301 | possible_moves : 'configuration -> 'move list; 302 | final : 'configuration -> bool 303 | } 304 | 305 | type piece_kind = S | H | V | C | X 306 | type piece = piece_kind * int 307 | let x = (X, 0) and s = (S, 0) and h = (H, 0) 308 | let (c0, c1, c2, c3) = ((C, 0), (C, 1), (C, 2), (C, 3)) 309 | let (v0, v1, v2, v3) = ((V, 0), (V, 1), (V, 2), (V, 3)) 310 | let all_pieces : piece list = [ s; h; c0; c1; c2; c3; v0; v1; v2; v3 ] 311 | 312 | type board = piece array array 313 | let initial_board = 314 | [| [| v0 ; s ; s ; v1 |]; 315 | [| v0 ; s ; s ; v1 |]; 316 | [| v2 ; h ; h ; v3 |]; 317 | [| v2 ; c0 ; c1 ; v3 |]; 318 | [| c2 ; x ; x ; c3 |] |] 319 | 320 | let initial_board_simpler = 321 | [| [| c2 ; s ; s ; c1 |] ; 322 | [| c0 ; s ; s ; c3 |] ; 323 | [| v1 ; v2 ; v3 ; v0 |] ; 324 | [| v1 ; v2 ; v3 ; v0 |] ; 325 | [| x ; x ; x ; x |] |] 326 | 327 | let initial_board_trivial = 328 | [| [| x ; s ; s ; x |] ; 329 | [| x ; s ; s ; x |] ; 330 | [| x ; x ; x ; x |] ; 331 | [| x ; x ; x ; x |] ; 332 | [| x ; x ; x ; x |] |] 333 | 334 | type direction = { dcol : int; drow : int; } 335 | type move = Move of piece * direction * board 336 | let move _ (Move (_, _, b)) = b 337 | ``` 338 | 339 | ### YOUR OCAML ENVIRONMENT 340 | ```ocaml 341 | let rec loop p f x = 342 | "Replace this string with your implementation." ;; 343 | 344 | let rec exists p l = 345 | "Replace this string with your implementation." ;; 346 | 347 | let rec find p l = 348 | "Replace this string with your implementation." ;; 349 | 350 | (* --- Part A: A Generic Problem Solver --- *) 351 | 352 | let near x = 353 | "Replace this string with your implementation." ;; 354 | 355 | let rec flat_map r = 356 | "Replace this string with your implementation." ;; 357 | 358 | let rec iter_rel rel n = 359 | "Replace this string with your implementation." ;; 360 | 361 | let solve r p x = 362 | "Replace this string with your implementation." ;; 363 | 364 | let solve_path r p x = 365 | "Replace this string with your implementation." ;; 366 | 367 | let archive_map opset r (s, l) = 368 | "Replace this string with your implementation." ;; 369 | 370 | let solve' opset r p x = 371 | "Replace this string with your implementation." ;; 372 | 373 | let solve_path' opset r p x = 374 | "Replace this string with your implementation." ;; 375 | 376 | let solve_puzzle p opset c = 377 | "Replace this string with your implementation." ;; 378 | 379 | (* --- Part B: A Solver for Klotski --- *) 380 | 381 | let final board = 382 | "Replace this string with your implementation." ;; 383 | 384 | let move_piece board piece { drow; dcol } = 385 | "Replace this string with your implementation." ;; 386 | 387 | let possible_moves board = 388 | "Replace this string with your implementation." ;; 389 | 390 | module BoardSet = Set.Make (struct 391 | type t = board 392 | let compare b1 b2 = 393 | failwith "Replace this with your implementation." ;; 394 | end) 395 | 396 | let solve_klotski initial_board = 397 | "Replace this string with your implementation." ;; 398 | ``` --------------------------------------------------------------------------------