Exercices

Exercices

Arbres binaires

On représente les arbres binaires sous forme de vecteurs. Soit un arbre a de hauteur h, la taille du vecteur sera 2^(h+1)-1. Soit un noeud en position i, le sous-arbre gauche de ce noeud est dans l'intervalle d'indices [i+1 , i+1+2^h] et son sous-arbre droit dans l'intervalle [i+1+2^h+1 , 2^(h+1)-1]. Cette représentation est intéressante si l'arbre est presque complètement rempli. Les étiquettes de tels arbres doivent posséder une valeur spéciale indiquant que le noeud n'existe pas. On représentera donc des arbres étiquetés par des valeurs de type 'a et par des vecteurs de type 'a array.

Écrire une fonction qui prend en entrée un arbre binaire du type 'a arbre_bin
```
# let fill_array tree tab empty = 
   let rec aux i p = function
       Empty -> tab.(i) <- empty 
     | Node (l,e,r) -> 
         tab.(i) <- e ;
         aux (i+1) (p/2) l ;
         aux (i+p) (p/2) r 
    in aux 0 (((Array.length tab)+1)/2) tree ;;
val fill_array : 'a arbre_bin -> 'a array -> 'a -> unit = <fun>
```
```
# type 'a arbre_bin = 
     Empty
   | Node of 'a arbre_bin * 'a * 'a arbre_bin ;;
type 'a arbre_bin = | Empty | Node of 'a arbre_bin * 'a * 'a arbre_bin
```
défini à la page ??, un tableau, que l'on supposera de taille suffisante, et qui stocke les étiquettes contenues dans l'arbre dans le tableau selon la discipline de placement définie ci-dessus.
Écrire la fonction de création d'une feuille (arbre de hauteur 0).
```
# let leaf empty = [| empty |]  ;;
val leaf : 'a -> 'a array = <fun>
```

Écrire une fonction qui construit un nouvel arbre à partir d'une étiquette et de deux autres arbres.


# let node elt left right = 
   let ll = Array.length left and lr = Array.length right in
   let l = max ll lr in
   let res = Array.create (2*l+1) elt in 
   Array.blit left 0 res 1 ll ;
   Array.blit right 0 res (ll+1) lr ;
   res  ;;
val node : 'a -> 'a array -> 'a array -> 'a array = <fun>

Écrire une fonction de conversion du type 'a arbre_bin en un tableau.
```
# let rec make_array empty = function 
     Empty -> leaf empty
   | Node (l,e,r) -> node e (make_array empty l) (make_array empty r) ;;
val make_array : 'a -> 'a arbre_bin -> 'a array = <fun>
```

Écrire une fonction de parcours infixe de tels arbres.


# let infixe tab empty f = 
   let rec aux i p = 
     if tab.(i)<>empty then ( aux (i+1) (p/2) ; f tab.(i) ; aux (i+p) (p/2) )
   in aux 0 (((Array.length tab)+1)/2) ;;
val infixe : 'a array -> 'a -> ('a -> 'b) -> unit = <fun>

L'utiliser pour l'affichage .
```
# let print_tab_int tab empty = 
   infixe tab empty (fun x -> print_int x ; print_string " - ") ;;
val print_tab_int : int array -> int -> unit = <fun>
```
Que dire du parcours préfixe de tels arbres?
Le parcours préfice correspond au parcours simple du tableau.
```
# let prefixe tab empty f = 
   for i=0 to (Array.length tab)-1 do if tab.(i)<>empty then f tab.(i) done ;;
val prefixe : 'a array -> 'a -> ('a -> unit) -> unit = <fun>
```

Correcteur orthographique

Cet exercice reprend les arbres lexicaux, exercice du chapitre 2, page ??, pour construire un correcteur orthographique.

Construire un dictionnaire à partir d'un fichier en ASCII où chaque ligne contient un mot. On écrira pour cela une fonction qui prend un nom de fichier et retourne le dictionnaire correspondant.


# type noeud_lex = Lettre of char * bool * arbre_lex 
 and arbre_lex = noeud_lex  list;;
type noeud_lex = | Lettre of char * bool * arbre_lex
type arbre_lex = noeud_lex list
# type mot = string;;
type mot = string
# let rec  existe m d = 
   let  aux sm i n = 
     match d with
       [] -> false
     | (Lettre (c,b,l))::q -> 
          if c = sm.[i] then 
            if n = 1 then b 
            else existe (String.sub sm (i+1) (n-1)) l       
          else existe sm q
   in aux m 0 (String.length m);;
val existe : string -> arbre_lex -> bool = <fun>

# let rec ajoute m d = 
   let aux sm i n = 
     if n = 0 then d else 
     match d with 
       [] -> [Lettre (sm.[i], n = 1, ajoute (String.sub sm (i+1) (n-1)) [])]
     | (Lettre(c,b,l))::q -> 
         if c = sm.[i] then
            if n = 1 then (Lettre(c,true,l))::q
            else Lettre(c,b,ajoute (String.sub sm (i+1) (n-1)) l)::q
         else (Lettre(c,b,l))::(ajoute sm q)
   in aux m 0 (String.length m);;
val ajoute : string -> arbre_lex -> arbre_lex = <fun>

# let rec verifie l d = match l with 
   [] -> []
 | t::q -> if existe t d then t::(verifie q d) 
           else verifie q d
 ;;
val verifie : string list -> arbre_lex -> string list = <fun>

# let string_of_char c = String.make 1 c;;
val string_of_char : char -> string = <fun>

# let rec filter p l = match l with 
   [] -> []
 | t::q -> if p t then t::(filter p q)
           else filter p q;;
val filter : ('a -> bool) -> 'a list -> 'a list = <fun>


# let rec selecte n d = 
   match d with 
     [] -> []
   | (Lettre(c,b,l))::q -> 
        if n = 1 then
          filter (function x -> x <> "!")  
           (List.map  (function (Lettre(c,b,_)) ->  if b then string_of_char c else "!") d)
        else 
          let r = selecte (n-1) l 
          and r2 = selecte n q  in
            let pr = List.map (function s -> (string_of_char c)^s) r 
            in pr@r2;;
val selecte : int -> arbre_lex -> string list = <fun>


# let lire_fichier nom_fichier = 
   let dico = ref [] 
   and canal = open_in nom_fichier in
   try 
     while true do dico := ajoute (input_line canal) !dico done ;
     failwith "cas impossible"
    with 
        End_of_file -> close_in canal ; !dico
      |  x -> close_in canal ; raise x  ;;
val lire_fichier : string -> arbre_lex = <fun>

Écrire une fonction mots qui prend une chaîne de caractères et construit la liste des mots de cette chaîne. Les séparateurs de mots sont l'espace, la tabulation, l'apostrophe et les guillemets.


# let mots s = 
   let est_sep = function ' '|'\t'|'\''|'"' -> true  |  _ -> false in
   let res = ref [] and p = ref ((String.length s)-1) in 
   let n = ref !p in
   while !p>=0 && est_sep s.[!p] do decr p done ;
   n := !p ;
   while (!n>=0) do
     while !n>=0 && not (est_sep s.[!n]) do decr n  done ;
     res := String.sub s ( !n +1) (!p - !n) :: !res ;
     while !n>=0 && est_sep s.[!n] do decr n done ;
     p := !n 
   done ;
   !res ;;
val mots : string -> string list = <fun>

Écrire une fonction verifie qui prend un dictionnaire, une liste de mots et retourne la liste des mots qui n'apparaissent pas dans le dictionnaire.
```
# let rec verifie dico = function 
     [] -> []
   | m::l -> if existe m dico then verifie dico l else m::(verifie dico l) ;;
val verifie : arbre_lex -> string list -> string list = <fun>
```

Écrire une fonction occurrences qui prend une liste de mots et retourne une liste de couples associant chaque mot de la liste à son nombre d'occurrences.


# let rec ajoute x = function 
     [] -> [(x,1)]
   | ((y,n) as p)::l -> if x=y then (y,n+1)::l else p::(ajoute x l) ;;
val ajoute : 'a -> ('a * int) list -> ('a * int) list = <fun>

# let rec ajoute_liste ld = function 
     [] -> ld
   | n::l -> let res = ajoute_liste ld l in ajoute n res ;;
val ajoute_liste : ('a * int) list -> 'a list -> ('a * int) list = <fun>

# let occurences l = ajoute_liste [] l ;;
val occurences : 'a list -> ('a * int) list = <fun>

Écrire une fonction orthographe qui prend un dictionnaire, un nom de fichier contenant le texte à analyser, et retourne la liste des mots incorrects avec leur nombre d'apparitions.


# let orthographe dico nom = 
   let f = open_in nom  and res = ref [] in
   try  
     while true do 
       let s = input_line f in 
       let ls = mots s in 
       let lv = verifie dico ls in 
       res := ajoute_liste !res lv 
     done ;
     failwith "cas impossible"
   with 
       End_of_file -> close_in f ; !res
     | x -> close_in f ; raise x  ;;
val orthographe : arbre_lex -> string -> (string * int) list = <fun>

Ensemble des nombres premiers

On cherche à construire l'ensemble infini des nombres premiers sans le calculer complètement à la manière des structures de données paresseuses.

Définir le prédicat est_divisible qui prend un entier et une liste initiale de nombres premiers et qui détermine si le nombre est divisible par un des entiers de la liste.
On sait que si un nombre x possède un diviseur supérieur à racine_carrée(x) alors il en possède inférieur à racine_carrée(x). Nous nous contentons donc de ne tester que les éléments de la liste qui sont inférieurs à la racine carrée de l'argument.
```
# let rec est_divisible x = function 
     [] -> false
   | n::l ->  (x mod n)=0 || ( (n*n<=x) && (est_divisible x l)) ;;
val est_divisible : int -> int list -> bool = <fun>
```

Possédant une liste initiale de nombres premiers, écrire la fonction suivant qui renvoie le plus petit nombre premier qui n'est pas dans cette liste. On calcule le dernier élément de la liste.


# let rec dernier = function 
     [] -> failwith "liste vide"
   | [x] -> x 
   | _::l -> dernier l ;;
val dernier : 'a list -> 'a = <fun>

On cherche le premier nombre premier à partir d'un certain entier en les testant de deux en deux.


# let rec plus_petit_premier l n = 
   if est_divisible n l then plus_petit_premier l (n+2) else n ;;
val plus_petit_premier : int list -> int -> int = <fun>

Et on assemble.


# let suivant = function 
     []  -> 2
   | [2] -> 3
   |  l  -> let pg = dernier l in plus_petit_premier l (pg+2) ;;
val suivant : int list -> int = <fun>

Définir la valeur ensprem représentant l'ensemble des nombres premiers en s'inspirant du type 'a enum donné page ??. Il sera utile pour cet ensemble de conserver les nombres entiers déjà trouvés.


# type 'a ens = {mutable i:'a ; f : 'a -> 'a } ;;
type 'a ens = { mutable i: 'a; f: 'a -> 'a }
# let next e = let x = e.i in e.i <- (e.f e.i) ; x ;;
val next : 'a ens -> 'a = <fun>


# let ensprem = 
   let prec = ref [2] in 
   let fonct _ = let n = suivant !prec in prec := !prec @ [n] ;  n 
   in { i = 2 ; f = fonct } ;;
val ensprem : int ens = {i=2; f=<fun>}