lesson5.ml

(** Exercise : First-order functions on lists *)

let rec nth l n = match l with
  | [] -> failwith "List too small"
  | x :: xs -> if n = 0 then x else nth xs (n-1)

let rev l =
  let rec loop acu = function
    | [] -> acu
    | x :: xs -> loop (x ::acu) xs
  in
  loop [] l

let rec append l1 l2 = match l1 with
  | [] -> l2
  | x :: xs -> x :: (append xs l2)

(* rev_append with an auxiliary function *)
let rev_append l1 l2 =
  let rec loop acu = function
    | [] -> acu
    | x :: xs -> loop (x :: acu) xs      
  in
  loop l2 l1

(* Variant *)
let rec rev_append l1 l2 =
  match l1 with
  | [] -> l2
  | x :: xs -> rev_append xs (x :: l2)

(** Exercise : Higher-order functions on lists *)

let rec map f = function
  | [] -> []
  | x :: xs -> f x :: (map f xs)

let rev_map f l =
  let rec loop acu = function
    | [] -> acu
    | x :: xs -> loop (f x :: acu) xs
  in
  loop [] l

let rec iter f = function
  | [] -> ()
  | x :: xs -> f x ; iter f xs

let rec print_list sep conv = function
  (* Empty list *)
  | [] -> Printf.printf "(empty)\n%!"

  (* Last element *)
  | [x] -> Printf.printf "%s\n%!" (conv x)
             
  | x :: xs ->
    Printf.printf "%s%s" (conv x) sep ;
    print_list sep conv xs

let rec fold op acu = function
  | [] -> acu
  | x :: xs -> fold op (op acu x) xs
                 
let rec exists pred = function
  | [] -> false
  | x :: xs -> pred x || exists pred xs

let exists' pred l = fold (fun acu x -> pred x || acu) false l

let (++) f g x = f (g x)

let forall pred l = not (exists (not ++ pred) l)

(** Exercise : Association lists *)

let rec assoc key = function
  | [] -> raise Not_found
  | (a,b) :: xs -> if a = key then b else assoc key xs

let rec remove_assoc key = function
  | [] -> []
  | (a,b) :: xs -> if a = key then xs else (a,b) :: remove_assoc key xs
                                             
(** Trees *)

type 'a tree = Leaf of 'a | Node of 'a tree * 'a tree								 

let print_tree tos tree =
  let rec loop margin = function
    | Leaf x -> Printf.printf "___ %s\n%!" (tos x)
    | Node (a,b) ->
       Printf.printf "____" ;
       loop (margin ^ "|   ") a ;
       Printf.printf "%s|\n%s|" margin margin ;
       loop (margin ^ "    ") b
  in
  loop "   " tree
						 
let rec depth = function
  | Leaf _ -> 0
  | Node (a, b) -> 1 + max (depth a) (depth b)


let rec build n x =
  if n = 0 then Leaf x
  else
    let sub = build (n-1) x in
    Node (sub, sub)

let build_fold n init f =
  let rec loop n v =
    if n = 0 then (Leaf v, f v)
    else
      (* Build the left subtree. *)
      let (sub1, v1) = loop (n-1) v in

      (* Build the right subtree. *)
      let (sub2, v2) = loop (n-1) v1 in
      
      (Node (sub1, sub2), v2)
  in

  let (tree, _) = loop n init in
  tree

let tree1 = build_fold 3 10 (fun x -> x+2)
let tree2 = build_fold 2 "o" (fun x -> "(" ^ x ^ ")")

let soi = string_of_int
		       
let () = print_tree soi tree1
let () = print_tree (fun s -> s) tree2

let rec tmap f = function
  | Leaf x -> Leaf (f x)
  | Node (a,b) -> Node (tmap f a, tmap f b)

let () = print_tree (fun s -> "\"" ^ s ^ "\"") (tmap soi tree1)
		       
let rec tfind pred = function
  | Leaf x -> if pred x then Some x else None
  | Node (a,b) ->
     match tfind pred a with
     | None -> tfind pred b
     | r -> r

let contains x tree = tfind (fun y -> y = x) tree <> None
	      
let rec replace pred sub tree =
  if pred tree then sub
  else match tree with
       | Leaf _ -> tree
       | Node (a,b) -> Node (replace pred sub a, replace pred sub b)

let () = print_tree soi (replace (fun t -> contains 14 t && depth t = 1) (Leaf 0) tree1)