(** 1. Récurrence sur les entiers : exponentiation *)

(* Versions de base *)
let rec exp_naive k n =
  if n = 0 then 1
  else k * exp_naive k (n-1)

let rec exp_rapide k n =
  if n = 0 then 1
  else let x = exp_rapide (k*k) (n/2) in
       if n mod 2 = 0 then x else k * x

(* Versions récursives terminales.
   Note générale à propos de la récursion terminale : c'est la bonne manière
   d'écrire du code Caml optimisé lorsque l'on s'attend à de grands nombres
   d'appels emboîtés. Ce n'est jamais un objectif du cours à ce semestre, mais
   le concept ayant été vu au premier semestre, je mets les variantes
   lorsqu'elles sont accessibles. À propos des "grands nombres" : ce n'est
   pas comme en Python où on est limité par défaut à 1000 appels emboîtés. 
   En Caml, on peut aller jusqu'à quelques dizaines de milliers voire 100.000 
   appels sans que l'optimisation devienne nécessaire. *)
let exp_naive_rt k n =
  let rec aux n acc =
    if n = 0 then acc
    else aux (n-1) (k*acc)
  in
  aux n 1
  
let exp_rapide_rt k n =
  let rec aux k n acc =
    if n = 0 then acc
    else if n mod 2 = 0
    then aux (k*k) (n/2) acc
    else aux (k*k) (n/2) (k*acc)
  in
  aux k n 1

(* Tests *)
let _ = assert (exp_naive 2 10 = 1024)
let _ = assert (exp_naive_rt 2 10 = 1024)
let _ = assert (exp_rapide 2 10 = 1024)
let _ = assert (exp_rapide_rt 2 10 = 1024)
  
(** 2. Récurrence sur les listes : tri *)

let rec est_triee = function
  | [] -> true
  | [_] -> true
  | x::y::l -> x <= y && est_triee (y::l)
(* Note : l'opérateur [&&] étant paresseux,
     x <= y && est_triee (y::l)
   est équivalent à
     if x <= y then est_triee (y::l) else false
   et l'appel récursif est donc un appel terminal *)

(* Tri par insertion *)
let rec insere x = function
  | [] -> [x]
  | y::l when x<=y -> x :: y :: l
  | y::l (* x>y *) -> y :: insere x l

let rec insere_sans_doublon x = function
  | [] -> [x]
  | y::l when x<y -> x :: y :: l
  | y::l when x>y -> y :: insere_sans_doublon x l
  | y::l (* x=y *)-> y :: l
          
let rec tri_insertion = function
  | [] -> []
  | x :: l -> insere x (tri_insertion l)

(* Note : pour obtenir une variante récursive terminale simple de [insere],
   il faut gérer le fait que l'accumulateur est une version retournée de la
   liste d'origine. Ce n'est pas exigé dans ce cours, mais le principe a pu
   avoir déjà été vu sur des exemples similaires au premier semestre. 
   Je vous mets donc une version ci-dessous, juste pour l'exemple.
   Notez aussi que c'est d'un intérêt limité dans un algo quadratique. *)

(* [rev_concat l1 l2] retourne [l1] et concatène le résultat devant [l2] *)
let rec rev_concat l1 l2 = match l1 with
  | [] -> l2
  | x::l -> rev_concat l (x::l2)
            
let insere_rt x l =
  let rec aux l acc = match l with
    | [] -> rev_concat acc [x]
    | y::_ when x<=y -> rev_concat acc (x::l)
    | y::l' (* x>y *)-> aux l' (y::acc)
  in
  aux l []

let tri_insertion_rt l =
  let rec aux l acc = match l with
    | [] -> acc
    | x::l -> aux l (insere_rt x acc)
  in
  aux l []
    
(* Tri par fusion *)            
let rec separe = function
  | [] -> [], []
  | [x] -> [x], []
  | x::y::l -> let l1, l2 = separe l in
               x::l1, y::l2

let rec fusion l1 l2 = match l1, l2 with
  | [], _ -> l2
  | _, [] -> l1
  | x::q1, y::_ when x<=y -> x :: fusion q1 l2
  | x::_, y::q2 (* x>y *) -> y :: fusion l1 q2

let rec tri_fusion = function
  | [] -> []
  | [x] -> [x]
  | l -> let l1, l2 = separe l in
         fusion (tri_fusion l1) (tri_fusion l2)

(* Versions récursives terminales, pour l'exemple.
   Les listes [l1] et [l2] construites par [separe_rt] sont retournées par
   rapport à la liste d'origine, mais c'est avant le tri donc ce n'est pas
   grave (et par ailleurs, le tri par fusion n'est déjà pas un tri stable).
   Dans le cas de la fusion, on gère le retournement comme dans le tri
   insertion. *)
let separe_rt l =
  let rec aux l l1 l2 = match l with
    | [] -> l1, l2
    | [x] -> x::l1, l2
    | x::y::l -> aux l (x::l1) (y::l2)
  in
  aux l [] []

let fusion_rt l1 l2 =
  let rec aux l1 l2 l = match l1, l2 with
    | [], _ -> rev_concat l l2
    | _, [] -> rev_concat l l1
    | x::q1, y::_ when x<=y -> aux q1 l2 (x::l)
    | x::_, y::q2 (* x>y *) -> aux l1 q2 (y::l)
  in
  aux l1 l2 []

let rec tri_fusion_rt = function
  | [] -> []
  | [x] -> [x]
  | l -> let l1, l2 = separe_rt l in
         fusion_rt (tri_fusion_rt l1) (tri_fusion_rt l2)
  
(* Rendre [tri_fusion] elle-même récursive terminale serait nettement plus
   technique, à cause des deux appels récursifs et de l'interaction avec 
   [fusion]. En outre, le nombre logarithmique d'appels emboîtés rend fort 
   lointaine la saturation de la pile. *)


(* Tests *)
let genere_sequence n =
  let rec aux n s =
    if n < 0 then s
    else aux (n-1) (n::s)
  in
  aux (n-1) []

let genere_liste_aleatoire mx n =
  let rec aux n s =
    if n = 0 then s
    else aux (n-1) (Random.int mx :: s)
  in
  aux n []
      
let _ = assert (est_triee (genere_sequence 1000000))
let _ = assert (est_triee (tri_insertion (genere_liste_aleatoire 1000000 10000)))
let _ = assert (est_triee (tri_fusion (genere_liste_aleatoire 1000000 100000)))
let _ = assert (est_triee (tri_insertion_rt (genere_liste_aleatoire 1000000 10000)))
let _ = assert (est_triee (tri_fusion_rt (genere_liste_aleatoire 1000000 1000000)))

      
(** Arbres binaires, base *)

type arbre =
  | V
  | N of arbre * arbre

let rec taille = function
  | V -> 0
  | N(g, d) -> 1 + taille g + taille d

(* Une version récursive terminale, un peu plus élaborée que celles vues
   jusqu'ici. La fonction auxiliaire ne travaille pas sur un arbre, mais sur 
   la listes des sous-arbres qui doivent encore être traités. La liste en
   question est utilisée comme une pile des sommets restant à explorer, et
   permet de stocker sur le tas ces informations qui seraient sinon conservées
   dans la pile d'appels. *)
let taille_rt a =
  let rec aux l acc = match l with
    | [] -> acc
    | V::l -> aux l acc
    | N(g, d)::l -> aux (g::d::l) (1+acc)
  in
  aux [a] 0
(* Une telle fonction auxiliaire génère à la compilation un code assembleur
   identique à celui qu'aurait pu donner un compilateur d'un langage impératif
   sur une boucle while modifiant deux variables locales (une pour chaque
   argument).
   Le code Python suivant donne une idée étonamment proche de la réalité,
   avec V et [] codés par None, e::l par (e, l) et N(g, d) par (g, d).

     def taille(a):
         l = (a, None)
         acc = 0
         while l is not None:
             n = l[0]
             l = l[1]
             if n is not None:
                 l = (n[0], (n[1], l))
                 acc += 1
         return acc
 *)
  

let max x y = if x > y then x else y
let rec hauteur = function
  | V -> -1
  | N(g, d) -> 1 + max (hauteur g) (hauteur d)

let rec equilibre = function
  | V -> true
  | N(g, d) -> let hg = hauteur g and hd = hauteur d in
               equilibre g && equilibre d && -2 < hg-hd && hg-hd < 2

(* À propos du type option : il est prédéfini par
     type 'a option =
       | None
       | Some of 'a
   On le manipule donc comme les autres types algébriques, avec constructeurs
   et filtrage. *)
let rec equilibre = function
  | V -> Some(-1)
  | N(g, d) -> match equilibre g, equilibre d with
               | Some hg, Some hd -> if -2 < hg-hd && hg-hd < 2
                                     then Some(1 + max hg hd)
                                     else None
               | _ -> None

let rec complet = function
  | V -> true
  | N(N(_, _), V) -> false
  | N(V, N(_, _)) -> false
  | N(g, d) -> complet g && complet d
(* Note de syntaxe : le deuxième et le troisième cas peuvent être regroupés
   avec la notation suivante :
     | N(N(_, _), V) | N(V, N(_, _)) -> false
 *)

(* Même amélioration que pour la deuxième version de [equilibre], avec une
   fonction principale pour convertir le résultat de type [int option] en
   un booléen. *)
let rec parfait_aux = function
  | V -> Some(-1)
  | N(g, d) -> match parfait_aux g, parfait_aux d with
               | Some hg, Some hd -> if hg = hd then Some (hg+1)
                                     else None
               | _ -> None
let parfait a =
  if parfait_aux a = None then false else true

(* Note : en mémoire, une seule copie du sous-arbre [a] sert à la fois de
   fils gauche et de fils droit. Ce genre de partage est possible quand on
   a comme ici des objets immuables. *)
let rec genere_parfait h =
  if h < 0
  then V
  else let a = genere_parfait (h-1)
       in N(a, a)

(* Une version récursive terminale (pas demandée, mais celle-ci est facile). *)
let genere_parfait_rt h =
  let rec aux h acc =
    if h < 0 then acc
    else aux (h-1) (N(acc, acc))
  in
  aux h V
        
(* Version basique, et version en une seule passe comme déjà vu. *)
let rec braun = function
  | V -> true
  | N(g, d) -> let tg = taille g and td = taille d in
               (tg = td || tg = td+1) && braun g && braun d

let rec braun = function
  | V -> Some 0
  | N(g, d) -> match braun g, braun d with
               | Some tg, Some td -> if tg = td || tg = td+1
                                     then Some(1+tg+td)
                                     else None
               | _ -> None

      
(** Cordes *)

type corde =
  | Feuille of string
  | Noeud of int * corde * corde

let c = Noeud(18, Noeud(4, Feuille "L'ea",
                        Noeud(6, Feuille "u coul", Feuille "e, en bo")),
              Noeud(6, Feuille "ucle c", Feuille "alme."))
(* Phrase extraite de La Horde du Contrevent (Alain Damasio) *)
           
let rec to_string = function
  | Feuille s -> s
  | Noeud(_, c1, c2) -> to_string c1 ^ to_string c2

(* On profite du fait que chaque nœud connaît la longueur de sa sous-chaîne
   de gauche pour accélerer le calcul. *)
let rec longueur = function
  | Feuille s -> String.length s
  | Noeud(n, _, c2) -> n + longueur c2

(* Version récursive terminale *)
let longueur_rt c =
  let rec aux c acc = match c with
    | Feuille s -> acc + String.length s
    | Noeud(n, _, c2) -> aux c2 (n+acc)
  in
  aux c 0

let rec char i = function
  | Feuille s -> s.[i] 
  | Noeud(n, r1, r2) when i < n -> char i r1
  | Noeud(n, r1, r2) (* i>=n *) -> char (i-n) r2

let concat r1 r2 = Noeud(longueur r1, r1, r2)

let rec coupe i = function
  | Feuille s ->
     let n = String.length s in
     Feuille (String.sub s 0 i), Feuille (String.sub s i (n-i))
  | Noeud(n, r1, r2) when i < n ->
     let r11, r12 = coupe i r1 in
     r11, concat r12 r2
  | Noeud(n, r1, r2) (* i>=n *) ->
     let r21, r22 = coupe (i-n) r2 in
     concat r1 r21, r22

let insere s i r =
  let r1, r2 = coupe i r in
  concat r1 (concat (Feuille s) r2)

let supprime i l r =
  let r1, r2 = coupe i r in
  let _, r3 = coupe l r2 in
  concat r1 r3