Correction en OCaml

• Sujet

• Retour à la page des TP

(* Question 1 *)

let edges_to_matrix (e, n) =
  let m = Array.make_matrix n n None in
  List.iter (fun (i,j,p) -> m.(i).(j) <- Some p) e;
  m
;;

let matrix_to_lists m =
  let n = Array.length m in
  let rec make_adj j i =
    if j >= n then []
    else match m.(i).(j) with
      | Some p -> (j, p) :: make_adj (j+1) i
      | None -> make_adj (j+1) i
  in
  Array.init n (make_adj 0)
;;

let lists_to_edges a =
  let n = Array.length a in
  let rec lists_to_edges i =
    if i < 0 then []
    else (lists_to_edges (i-1)) @ (List.map (fun (j, p) -> i, j, p) a.(i))
  in
  lists_to_edges (n - 1), n
;;

let edges_to_lists (e, n) =
  let add_edge a (i, j, p) =
    a.(i) <- (j, p) :: a.(i);
    a
  in
  List.fold_left add_edge (Array.make n []) e

(* Question 2 *)

(* Chaque arête apparaît en tout au plus deux fois dans le tas.
Quand on atteint n - 1 arêtes, on n'effectue plus que des extractions, jusqu'à épuisement du tas. *)

(* Question 3 *)

let rec insert l e = match l with
  | [] -> [e]
  | h :: t when e <= h -> e :: h :: t
  | h :: t -> h :: insert t e
;;

let extract_min = function
  | [] -> invalid_arg "extract_min"
  | h :: t -> h, t
;;

let tri_insertion l = List.fold_left insert [] l
;;

(* Question 4 *)

(* Oh. *)

(* Question 5 *)

let prim create is_empty insert extract g =
  let n = Array.length g in
  let seen = Array.make n false in
  let rec prim next =
    if is_empty next then []
    else let (p, i, j), after = extract next in
      if seen.(j) then prim after
      else begin
        seen.(j) <- true;
        (i, j, p) :: prim (List.fold_left insert after (List.map (fun (k, p) -> p, j, k) g.(j)))
      end
  in
  seen.(0) <- true;
  prim (List.fold_left insert (create ()) (List.map (fun (j, p) -> p, 0, j) g.(0)))
;;

let prim_list = prim (fun () -> []) ((=) []) insert extract_min
;;

(* Question 6 *)

let rec heapify (<<) (t, n) i =
  if 2*i+1 < n && t.(2*i+1) << t.(2*i) && t.(2*i+1) << t.(i) then begin
    let tmp = t.(i) in
    t.(i) <- t.(2*i+1);
    t.(2*i+1) <- tmp;
    heapify (<<) (t, n) (2*i+1)
  end else if 2*i < n && t.(2*i) << t.(i) then begin
    let tmp = t.(i) in
    t.(i) <- t.(2*i);
    t.(2*i) <- tmp;
    heapify (<<) (t, n) (2*i)
  end
;;

let heapify_all (<<) t =
  let n = Array.length t in
  for i = (n-1)/2 downto 0 do
    heapify (<<) (t, n) i
  done
;;

(* Question 7 *)

let insert_heap (<<) (t, n) e =
  t.(n) <- e;
  let rec loop i =
    heapify (<<) (t, n+1) i;
    if i > 0 then loop (i/2)
  in
  loop (n/2);
  t, n+1
;;

let rec extract_heap (<<) (t, n) =
  let ans = t.(0) in
  t.(0) <- t.(n-1);
  heapify (<<) (t, n-1) 0;
  ans, (t, n-1)
;;

(* Question 8 *)

let prim_heap g = prim (fun () -> Array.make (Array.length g) (0,0,0), 0) (fun (_, n) -> n = 0)
                       (insert_heap (<)) (extract_heap (<)) g
;;

(* Question 9 *)

let tri_tas t =
  let n = Array.length t in
  for i = (n-1)/2 downto 0 do
    heapify (>) (t, n) i
  done;
  for i = n-1 downto 1 do
    let tmp = t.(0) in
    t.(0) <- t.(i);
    t.(i) <- tmp;
    heapify (>) (t, i) 0
  done
;;