(* I - Enumérations d'ensembles *)
                    

 (* Utilitaires *)

 let prem ens = match ens with 
      |  []   -> failwith "Erreur dans prem"
      | t::q  -> t ;;
 
 let sp ens = match ens with 
      |  []   -> failwith "Erreur dans sp"
      | t::q  -> q ;;
      
 let rec siem  i ens =  match ens with
      |  []   -> failwith "Erreur"
      | t::q  -> if i=1 then q else t::(siem (i-1) q) ;;
      
 let rec ieme  i ens =  match ens with
      |  []   -> failwith "Erreur dans ieme"
      | t::q  -> if i=1 then t else ieme (i-1) q ;;
      
 let rec ajout e lst_ens = match lst_ens with
      |  []   ->  []
      | t::q  -> (e::t)::(ajout e q) ;;
      

 (* Déterminations d'ensembles *)

 let rec parties e =
    if e = [] then [[]]
    else let x = prem e and e_1 = sp e
        in let part = parties e_1
        in  part @ (ajout x part) ;;
                    
 let rec combinaisons p e =
    if p > list_length e then [] 
    else if p=0 then [[]]
    else let x = prem e and e_1 = sp e
         in  (combinaisons p e_1) @ (ajout x (combinaisons (p-1) e_1)) ;;
 
 let rec permutations e =
    let n = list_length e in
    if n= 1 then [[prem e]]
    else  
      let rec aux  i accu =       (* parcours de E *)
             if i=0 then accu
             else  let x = ieme i e  and e_i = siem i e
                   in aux (i-1) ((ajout x (permutations e_i)) @ accu)
      in aux n []    
    ;;        

 let rec bijections e f =
    let n = list_length e and p = list_length f in
    if n <> p or n = 0 then  []
    else  let x = prem e  and e_1 = sp e in
    if n= 1 then [["("^x^","^(prem f)^")"]]
    else 
        let rec aux  i accu =              (* parcours de F *)
            if i=0 then accu
            else  let y = ieme i f  and f_i = siem i f 
                in let chaine = "("^x^","^y^")" 
                in aux (i-1) ((ajout chaine (bijections e_1 f_i)) @ accu)
         in aux n []    
    ;;        

 let rec surjections e f =
    let n = list_length e and p = list_length f in
    if n < p or n = 0 or p = 0 then  []
    else  let x = prem e  and e_1 = sp e in
    if n= 1 then [["("^x^","^(prem f)^")"]]  (* car n=p=1 *)
    else 
        let rec aux  i accu =             (* parcours de F *)    
            if i=0 then accu           
            else  let y = ieme i f  and f_i = siem i f 
                in let chaine = "("^x^","^y^")" 
                in aux (i-1) ((ajout chaine (surjections e_1 f_i)) @
                             (ajout chaine (surjections e_1 f)) @ accu)
         in aux p []    
    ;;        

 let rec nb_surjections n p =
    if n < p or n = 0 or p = 0   then  0   else  
    if n= 1 then 1      (* car n=p=1 *)
    else let rec aux  i accu =
            if i=0 then accu
            else   aux (i-1) (nb_surjections (n-1) (p-1) +
                              nb_surjections (n-1)  p    + accu)
          in aux p 0    
    ;;        

 (*-------------------------------------------------------------------------*)
 
 
        (* II - Programmation dynamique : chemin de poids minimum *)
      
   
 let M = [| [|1;4;6;8;2|];
            [|2;4;0;2;4|];
            [|3;5;0;8;9|];
            [|8;0;7;6;0|];
            [|0;9;5;9;1|];
            [|2;7;5;5;2|] |] ;;
            
 let n = vect_length M - 1  and  
     p = vect_length M.(0) - 1 ;;    (* cf l'annexe *)
 
 let choix = make_matrix (n+1) (p+1) 0  and  cout = make_matrix (n+1) (p+1) 0;;
 
 
 let construire_tableaux =  (* remplissage par lignes de bas en haut
                                               et de droite à gauche *)
     cout.(n).(p) <- M.(n).(p);
     for j = p-1 downto 0 do  
          choix.(n).(j)  <- 1;
           cout.(n).(j)  <- cout.(n).(j+1) + M.(n).(j); 
     done;        
     for i = n-1 downto 0 do 
           cout.(i).(p)  <- cout.(i+1).(p) + M.(i).(p);
     done ;
 
     for i = n-1 downto 0 do 
       for j = p-1 downto 0 do 
          if cout.(i+1).(j) < cout.(i).(j+1) 
             then cout.(i).(j) <- cout.(i+1).(j) + M.(i).(j)
             else begin
                     cout.(i).(j) <- cout.(i).(j+1) + M.(i).(j);
                    choix.(i).(j) <- 1;
                  end
       done
     done ;;
   
 let affiche_chemin =
   let affiche  x y = 
      print_char `(`; print_int (x+1); 
      print_char `,`; print_int (y+1); print_string") "   in
   
   affiche 0 0 ;
   let i = ref 0 and j = ref 0 in
     for k = 1 to n + p do
        if choix.(!i).(!j) = 0 then i := !i + 1  else j := !j + 1;
        affiche !i !j
     done;
   print_newline ()   
 ;;   

       
 (*-------------------------------------------------------------------------*)
      
         (* III - Plus longue sous-suite commune à deux suites *)  

         
 let est_sous_suite x y =                                      (* itérative *)
   let n= string_length x and p = string_length y 
       and i = ref 0 and j =ref 0 in
   while (!i < n) && (!j < p) do
      if x.[!i] = y.[!j] then begin i := !i + 1; j := !j + 1 end
      else i := !i + 1
   done;
   !j = p  ;;   
 

 let rec est_sous_suite x y =                         
     let n = string_length x and p = string_length y in
   
     let rec aux i j =                               (* récursive terminale *)
       if j = p then true else                       (* sans  sub_string    *)
          if i= n then false else
             if x.[i] = y.[j] then aux (i+1) (j+1) else aux (i+1) j
    in aux 0 0        
   ;;
 
 
 let rec est_sous_suite x y =                        (* récursive terminale *)
   let n = string_length x and p = string_length y in
     if p = 0 then true else 
        if n = 0 then false else 
            if x.[0] = y.[0] 
             then est_sous_suite (sub_string x 1 (n-1)) (sub_string y 1 (p-1))  
             else est_sous_suite (sub_string x 1 (n-1))  y
 ;;
             
    
 let rec plssc x y =
     if x = "" or y = "" then ""
     else
          let x_1 = sub_string x 1 (string_length x - 1)    
          and y_1 = sub_string y 1 (string_length y - 1)  in
          let z_1 = plssc x_1 y_1 in 
          if x.[0] = y.[0] then (char_for_read x.[0]) ^z_1
          else let xz = (char_for_read x.[0]) ^z_1 in
               if  est_sous_suite y_1 xz then xz
               else let yz =  (char_for_read y.[0]) ^z_1 in
               if  est_sous_suite x_1 yz then yz   
               else z_1            
 ;;
     

 let cout = make_matrix 10 10 0 and  choix = make_matrix 10 10 0 ;;
    
 let construire_tableaux x y =
   let n = string_length x  and  p = string_length y  in 
 
   for j = 0 to p-1 do if y.[j] = x.[n-1] 
             then begin cout.(n-1).(j) <- 1; choix.(n-1).(j) <- 0  end
             else begin cout.(n-1).(j) <- 0; choix.(n-1).(j) <- -1 end                                         
   done;
   for i = 0 to n-2 do if x.[i] = y.[p-1] 
             then begin cout.(i).(p-1) <- 1; choix.(i).(p-1) <- 0 end
             else begin cout.(i).(p-1) <- 0; choix.(i).(p-1) <- 1 end                                         
   done;

   for i= n-2 downto 0 do 
       for j = p-2 downto 0 do
           if x.[i] = y.[j]  then 
                               begin 
                                  cout.(i).(j) <-  cout.(i+1).(j+1) + 1; 
                                  choix.(i).(j) <- 0
                               end
           else 
               if cout.(i+1).(j) >= cout.(i).(j+1) 
               then  
                 begin choix.(i).(j) <-  1; cout.(i).(j) <- cout.(i+1).(j) end
               else  
                 begin choix.(i).(j) <- -1; cout.(i).(j) <- cout.(i).(j+1) end
       done
   done ;;
 
  
 let plssc_1 x y =
   let n = string_length x  and  p = string_length y  
   and i = ref 0  and  j = ref 0  and z = ref "" in
   construire_tableaux x y;
   while !i < n  && !j < p do
     if choix.(!i).(!j) = 0 then
       begin  z := !z ^(char_for_read x.[!i]); i := !i + 1; j := !j +1 end
     else if choix.(!i).(!j) = 1 then i := !i + 1 else j := !j +1
   done;
   !z ;;
 
 plssc   "ceinturer" "occurrent"  ;;
 plssc_1 "ceinturer" "occurrent"  ;;
 
  (*-------------------------------  FIN  -----------------------------------*)