answers.ml

Download file: answers.ml
(*** Keep these lines. ***)
let qfile = "qqs.ml" ;;
let formatter = Format.(make_formatter (fun _ _ _ -> ()) (fun () -> ())) ;;
Topdirs.dir_use formatter (if Sys.file_exists qfile then qfile else Sys.getenv "HOME" ^ "/Exam-OCaml/" ^ qfile) ;;

(************************************)


(*****  QUESTION 1  *****)

let rec f1 x acu = function
  | [] -> acu
  | y :: ys -> f1 x (if x = y then acu else y :: acu) ys

;;
let () = q1 { ff = f1 } ;;

(*****  QUESTION 2  *****)

let f2 f e1 = try f () ; false with e2 -> e1 = e2  

;;
let () = q2 { ff = f2 } ;;

(*****  QUESTION 3  *****)

let f3 s c ll = List.length (List.filter (fun t -> t.size = s && t.color = c) ll)

(* Variant *)
let rec f3 s c = function
  | [] -> 0
  | t :: rest -> if t.size = s && t.color = c then 1 + f3 s c rest else f3 s c rest

;;
let () = q3 { ff = f3 } ;;


(*****  QUESTION 4  *****)

let f4 ll = List.filter (fun t -> t.color <> White) ll

;;
let () = q4 { ff = f4 } ;;

(*****  QUESTION 5  *****)

(* Insert x in list l, if not already there. *)
let insert x l = if List.mem x l then l else x :: l

let f5 c ll = List.fold_left (fun acu t -> if t.color = c then insert t.message acu else acu) [] ll

;;
let () = q5 { ff = f5 } ;;

(*****  QUESTION 6  *****)

(* Insert t in association list 'asso'. Its key is given by f t. *)
let ins f asso t =

  let key = f t in

  (* Insert in the association list *)
  let rec loop acu = function
    (* Not found => we create a new entry *)
    | [] -> (key, [t]) :: acu

    | (k,l) as p :: rest ->
      (* This is the key we are looking for. *)
      if k = key then List.rev_append ((k, t :: l) :: acu) rest

      (* This is another key *)
      else loop (p :: acu) rest
  in

  loop [] asso
;;

let f6 ll = List.fold_left (ins (fun t -> t.size)) [] ll

;;
let () = q6 { ff = f6 } ;;

(*****  QUESTION 7  *****)

let f7 tree =

  let rec loop (idmin,pmin) t =
    let acu0 = if t.value.price < pmin then (t.id, t.value.price) else (idmin, pmin) in
    List.fold_left loop acu0 t.children
  in

  fst (loop (tree.id,tree.value.price) tree)

;;
let () = q7 { ff = f7 } ;;

(*****  QUESTION 8  *****)

let mk_leaf i = { value = i ; id = 0 ; children = [] }
let mk_node i l = { value = i ; id = 0 ; children = l }

(* mk_tree : crits contient la liste des niveaux. Un niveau est une liste de filtres. *)
let mk_tree cat crits =
  let rec loop cat = function
    | [] -> mk_leaf (List.length cat)
    | ks :: rest -> mk_node (List.length cat) (List.map (fun k -> loop (List.filter k cat) rest) ks)
  in
  loop cat crits

let mk_size_crit l  = List.map (fun s t -> t.size = s) l
let mk_color_crit l = List.map (fun c t -> t.color = c) l

let f8 sizes colors cat = mk_tree cat [ mk_size_crit sizes ; mk_color_crit colors ]

;;
let () = q8 { ff = f8 } ;;