(* Telle qu'initialement écrites:
 * - la factorielle est en O(n)
 * - fibonacci en O(2^n)
 * Ecrites en programmation dynamique, les deux sont linéaires,
 * cela n'a aucun interêt pour la factorielle. *)

let dynfib n =
  let memo = Array.make (n+1) None in
  let rec aux n =
    match memo.(n) with
      | Some vn -> vn
      | None ->
          let vn = if n < 2 then 1 else (aux (n-1))+(aux (n-2)) in
            memo.(n) <- Some vn ;
            vn
  in
    aux n

(* Fibonacci version "programmation dynamique améliorée":
 * il n'y a besoin de mémoriser que les deux derniers termes.
 * Pour tester l'efficacité de ces fonctions on les appelera avec
 * un très grand argument, malgré les problèmes de dépassement de capacité
 * des entiers apparaissant rapidement -- résultats négatifs & co. *)

(* Avec un tableau *)
let fibo m =
  let memo = [| 1 ; 0 |] in
    for i = 1 to m do
      let p = memo.(0) in
      let q = memo.(1) in
        memo.(0) <- p+q ;
        memo.(1) <- p ;
        (* On peut se passer de mémoriser p et q en faisant:
         * memo.(0) <- memo.(0)+memo.(1) ; memo.(1) <- memo.(0)-memo.(1) *)
    done ;
    memo.(0)

(* Avec un tableau, plus concis -- mais apparemment moins efficace. *)
let fibo m =
  let memo = [| 1 ; 0 |] in
    for i = 1 to m do
      memo.(i mod 2) <- memo.(0) + memo.(1)
    done ;
    memo.(m mod 2)

(* Version purement fonctionnelle, avec récursivité terminale.
 * Cette version est la plus efficace des trois. *)
let fibo m =
  (* Invariant: fib(n)=p et fib(n-1)=q *)
  let rec aux n p q =
    if n = m then p else aux (n+1) (p+q) p
  in
    aux 1 1 1

(* Calcul direct de Fibonacci, en utilisant la formule de Binet.
 * On l'obtient en remarquant:
 * [fib(n),fib(n-1)] = X(n) = M ^ n * X(0)
 * puis en diagonalisant la matrice M.
 * En Caml ** représente l'exponentiation. *)

let phi = 1.618033988749894
let fib n = ((phi ** n) -. ((-. phi) ** (-. n)))/.(sqrt 5.)

(* Sous-listes communes ---------------------------------------------------- *)

(* Utilitaire pour afficher une liste *)
let print_list l =
  print_string "[" ;
  List.iter
    (fun i -> Printf.printf "%d;" i)
    l ;
  print_string "]"

(* Verifie que l est sous-liste de s *)
let rec sublist s l = match s,l with
  | _,[] -> true
  | [],_ -> false
  | a::qs,b::ql -> if a=b then sublist qs ql else sublist qs l

(* Liste des sous-listes de l, complexité en O(2^n).
 * Il suffit de remarquer qu'on parcourt les sous-listes de la queue de liste,
 * qui est de taille 2^(n-1). Quand on somme sur les appels récursifs ça reste
 * du O(2^n). *)
let rec sublists l =
  match l with
    | [] -> [[]]
    | h::l ->
        (* Si S est l'ensemble des sous-listes de l, l'ensemble des sous-listes
         * de h::l est: S union { h::sl | sl appartenant à S } *)
        let s = sublists l in
        let hs = List.map (fun a -> h::a) s in
          s@hs

(* On redéfinit: max [x1;x2;..;xn] = max( .. max(max(0,x1),x2) ..,xn) *)
let max l = List.fold_left max 0 l

(* La fonction suivante est très inefficace, sa complexité est en O(2^n),
 * où n est le max des longueurs des listes en entrée. *)
let lcs x y =
  let sx = sublists x in
  let common = List.filter (fun l -> sublist y l) sx in
   (* Merci à l'élève XXX pour cette écriture.
    * Initialement je calculais l'intersection selon une technique générale
    * mais moins efficace ici:
    * let sy = sublists y in
    * let common = List.filter (fun l -> List.mem l sy) sx in ... *)
    max (List.map List.length common)

let lcs2 x y =
  (* L'utilisation de tableaux est plus efficace ici *)
  let x = Array.of_list x in
  let y = Array.of_list y in
  let p = Array.length x in
  let q = Array.length y in
  let memo = Array.make_matrix p q None in
  let rec l i j =
    if i<0 || j<0 then 0 else
    match memo.(i).(j) with
      | Some m -> m
      | None ->
          let lij =
            max [ l (i-1) (j-1) + (if x.(i)=y.(j) then 1 else 0) ;
                  l (i-1) j ;
                  l i (j-1) ]
          in
            memo.(i).(j) <- Some lij ;
            lij
  in
    l (p-1) (q-1)

let _ =
  (* Résultat attendu: 4 *)
  let p,q = [ 1;2;3;4;5;6 ],[ 0;2;1;2;3;5;7 ] in
  let print_result f name =
    print_string name ;
    print_list p ;
    print_char ' ' ;
    print_list q ;
    print_string " = " ;
    print_int (f p q) ;
    print_newline ()
  in
    print_result lcs "lcs " ;
    print_result lcs2 "lcs2 "

(* On programme ici la version qui renvoie une des plus longues sous-listes.
 * On utilise la formule équivalente considérant les suffixes de x et y
 * au lieu des préfixes, ce qui permet de calculer la sous-liste commune
 * directement dans le bon sens:
 * l(i,j) = lcs ([x_i;x_i+1;...;x_p],[y_j;..;y_q]) *)

let max =
  List.fold_left (fun a l -> if List.length a > List.length l then a else l) []

let lcs3 x y =
  (* L'utilisation de tableaux est plus efficace ici *)
  let x = Array.of_list x in
  let y = Array.of_list y in
  let p = Array.length x in
  let q = Array.length y in
  let memo = Array.make_matrix p q None in
  let rec l i j =
    if i=p || j=q then [] else
    match memo.(i).(j) with
      | Some m -> m
      | None ->
          let lij =
            max [ (let tl = l (i+1) (j+1) in
                     if x.(i)=y.(j) then x.(i)::tl else tl) ;
                  l (i+1) j ;
                  l i (j+1) ]
          in
            memo.(i).(j) <- Some lij ;
            lij
  in
    l 0 0

let _ =
  let a,b = [ 1;2;0;3;4;5;6 ],[ 0;2;1;2;3;0;5;7 ] in
    print_string "lcs3 " ;
    print_list a ;
    print_char ' ' ;
    print_list b ;
    print_string " = " ;
    (* Résultat attendu: [1;2;0;5] *)
    print_list (lcs3 [ 1;2;0;3;4;5;6 ] [ 0;2;1;2;3;0;5;7 ]) ;
    print_newline ()