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 f1 g l = List.filter (fun x -> g x <> 0) l 

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


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

let f2 = fun f -> ( f (fun g x -> g x) (fun x h -> h x) )

let () = q2 { ff = f2 }


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

let f3 g y x = match g x with
  | None -> y
  | Some z -> z

let () = q3 { ff = f3 }


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

let f4 g l = List.map (function | A x -> (try A (g x) with Switch -> B x)
                                | B x -> (try B (g x) with Switch -> A x)) l

let () = q4 { ff = f4 }


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

let f5 g l = List.map (function A x -> A (g x) | B y -> B y) l

let () = q5 { ff = f5 }


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

let f6 l =

  (* loop expects suma, input list 
   * it returns (sumb, result list) *)
  let rec loop suma = function
    (* We count the sum of Bs from the right, hence 0 at the right-end of the list. *)
    | [] -> (0, [])

    | A x :: rest ->
        (* Sums A when going to the right *)
        let (sumb, tail) = loop (suma + x) rest in
          (sumb, A suma :: tail)

    | B x :: rest ->
        (* Sums B when going back (to the left) *)
        let (sumb, tail) = loop suma rest in
          (sumb + x, B sumb :: tail)
  in

  let (_, res) = loop 0 l in
    res

let () = q6 { ff = f6 }


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

let rec f7 g = function
  | Node (left, right) -> Node (f7 g left, f7 g right)
  | Aleaf x -> Aleaf (g x)
  | Bleaf y -> Bleaf y


let () = q7 { ff = f7 }


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

let rec f8 t1 t2 =

  match t1, t2 with
    | Aleaf x, Aleaf y -> if x <> y then Some (t1, t2) else None
    | Bleaf x, Bleaf y -> if x <> y then Some (t1, t2) else None

    | Aleaf _, _
    | Bleaf _, _
    | _, Aleaf _
    | _, Bleaf _ -> Some (t1, t2)

    | Node (l1, r1), Node (l2, r2) ->
        begin match f8 l1 l2 with
          | None -> f8 r1 r2
          | Some z -> Some z
        end

let () = q8 { ff = f8 }