let print = Printf.printf;;
Sys.command "ocaml -version";;
val print : ('a, out_channel, unit) format -> 'a = <fun>
The OCaml toplevel, version 4.04.2
- : int = 0
taille
¶let rec taille (liste : 'a list) : int =
match liste with
| [] -> 0
| _ :: q -> (taille q) + 1
;;
taille [];;
taille [1; 2; 3];;
val taille : 'a list -> int = <fun>
- : int = 0
- : int = 3
Pas sûr qu'elle soit récursive terminale, alors que celle là oui :
let taille (liste : 'a list) : int =
let rec aux acc = function
| [] -> acc
| _ :: q -> aux (acc + 1) q
in
aux 0 liste
;;
taille [];;
taille [1; 2; 3];;
val taille : 'a list -> int = <fun>
- : int = 0
- : int = 3
Solution plus ésotérique :
let taille = List.fold_left (fun acc _ -> acc + 1) 0;;
taille [];;
taille [1; 2; 3];;
val taille : '_a list -> int = <fun>
- : int = 0
- : int = 3
List.length [];;
List.length [1; 2; 3];;
- : int = 0
- : int = 3
concat
¶let rec concatene (liste1 : 'a list) (liste2 : 'a list) : 'a list =
match liste1 with
| [] -> liste2
| h :: q -> h :: (concatene q liste2)
;;
concatene [1; 2] [3; 4];;
val concatene : 'a list -> 'a list -> 'a list = <fun>
- : int list = [1; 2; 3; 4]
Autre approche, moins simple mais de même complexité en $\mathcal{O}(n)$.
let miroir (liste : 'a list) : 'a list =
let rec aux acc = function
| [] -> acc
| h :: q -> aux (h :: acc) q
in aux [] liste
;;
val miroir : 'a list -> 'a list = <fun>
let concatene (liste1 : 'a list) (liste2 : 'a list) : 'a list =
let rec aux acc l1 l2 =
match l1 with
| [] when l2 = [] -> acc
| [] -> aux acc l2 []
| h :: q -> aux (h :: acc) q l2
in
miroir (aux [] liste1 liste2)
;;
val concatene : 'a list -> 'a list -> 'a list = <fun>
concatene [1; 2] [3; 4];;
- : int list = [1; 2; 3; 4]
List.append [1; 2] [3; 4];;
- : int list = [1; 2; 3; 4]
appartient
¶let rec appartient x = function
| [] -> false
| h :: _ when h = x -> true
| _ :: q -> appartient x q
;;
appartient 1 [];;
appartient 1 [1];;
appartient 1 [1; 2; 3];;
appartient 4 [1; 2; 3];;
val appartient : 'a -> 'a list -> bool = <fun>
- : bool = false
- : bool = true
- : bool = true
- : bool = false
List.mem 1 [];;
List.mem 1 [1];;
List.mem 1 [1; 2; 3];;
List.mem 4 [1; 2; 3];;
- : bool = false
- : bool = true
- : bool = true
- : bool = false
miroir
¶let miroir (liste : 'a list) : 'a list =
let rec aux acc = function
| [] -> acc
| h :: q -> aux (h :: acc) q
in aux [] liste
;;
val miroir : 'a list -> 'a list = <fun>
miroir [2; 3; 5; 7; 11];;
List.rev [2; 3; 5; 7; 11];;
- : int list = [11; 7; 5; 3; 2]
- : int list = [11; 7; 5; 3; 2]
alterne
¶La sémantique n'était pas très claire, mais on peut imaginer quelque chose comme ça :
let alterne (liste1 : 'a list) (liste2 : 'a list) : 'a list =
let rec aux acc l1 l2 =
match (l1, l2) with
| [], [] -> acc
| [], ll2 -> acc @ ll2
| ll1, [] -> acc @ ll1
| h1 :: q1, h2 :: q2 -> aux (h1 :: h2 :: acc) q1 q2
in List.rev (aux [] liste1 liste2)
;;
val alterne : 'a list -> 'a list -> 'a list = <fun>
alterne [1; 3; 5] [2; 4; 6];;
- : int list = [2; 1; 4; 3; 6; 5]
La complexité est linéaire en $\mathcal{O}(\max(|\text{liste 1}|, |\text{liste 2}|)$.
Mais on manque souvent la version la plus simple :
let rec alterne (l1 : 'a list) (l2 : 'a list) : 'a list =
match l1 with
| [] -> l2
| t::q -> t::(alterne l2 q)
;;
val alterne : 'a list -> 'a list -> 'a list = <fun>
nb_occurrences
¶let nb_occurrences (x : 'a) (liste : 'a list) : int =
let rec aux acc x = function
| [] -> acc
| h :: q when h = x -> aux (acc + 1) x q
| _ :: q -> aux acc x q
in aux 0 x liste
;;
nb_occurrences 0 [1; 2; 3; 4];;
nb_occurrences 2 [1; 2; 3; 4];;
nb_occurrences 2 [1; 2; 2; 3; 3; 4];;
nb_occurrences 5 [1; 2; 3; 4];;
val nb_occurrences : 'a -> 'a list -> int = <fun>
- : int = 0
- : int = 1
- : int = 2
- : int = 0
Autre approche, avec un List.fold_left
bien placé :
let nb_occurrences (x : 'a) : 'a list -> int =
List.fold_left (fun acc y -> if x = y then (acc + 1) else acc) 0
;;
nb_occurrences 0 [1; 2; 3; 4];;
nb_occurrences 2 [1; 2; 3; 4];;
nb_occurrences 2 [1; 2; 2; 3; 3; 4];;
nb_occurrences 5 [1; 2; 3; 4];;
val nb_occurrences : 'a -> 'a list -> int = <fun>
- : int = 0
- : int = 1
- : int = 2
- : int = 0
pairs
¶C'est un filtrage :
let pairs = List.filter (fun x -> x mod 2 = 0);;
val pairs : int list -> int list = <fun>
pairs [1; 2; 3; 4; 5; 6];;
pairs [1; 2; 3; 4; 5; 6; 7; 100000];;
pairs [1; 2; 3; 4; 5; 6; 7; 100000000000];;
pairs [1; 2; 3; 4; 5; 6; 7; 1000000000000000000];;
- : int list = [2; 4; 6]
- : int list = [2; 4; 6; 100000]
- : int list = [2; 4; 6; 100000000000]
- : int list = [2; 4; 6; 1000000000000000000]
range
¶let range (n : int) : int list =
let rec aux acc = function
| 0 -> acc
| n -> aux (n :: acc) (n - 1)
in aux [] n
;;
val range : int -> int list = <fun>
range 30;;
- : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; 19; 20; 21; 22; 23; 24; 25; 26; 27; 28; 29; 30]
(* Vous avez parfois eu du mal à construire la liste des entiers de a à b
ca serait bon de savoir le faire car ca peut vous donner des exemples
d'entree pour vos algos *)
let entiers a b =
let rec construit x =
if x > b
then []
else x::(construit (x + 1))
in construit a
;;
val entiers : int -> int -> int list = <fun>
let premiers_entiers = entiers 0;; (* Bel exemple de currification *)
entiers 4 10;;
premiers_entiers 7;;
val premiers_entiers : int -> int list = <fun>
- : int list = [4; 5; 6; 7; 8; 9; 10]
- : int list = [0; 1; 2; 3; 4; 5; 6; 7]
premiers
¶Plusieurs possibilités. Un filtre d'Erathosthène marche bien, ou une filtration. Je ne vais pas utiliser de tableaux donc on est un peu réduit d'utiliser une filtration (filtrage ? pattern matching)
let racine (n : int) : int =
int_of_float (floor (sqrt (float_of_int n)))
;;
racine 17;;
val racine : int -> int = <fun>
- : int = 4
let estDivisible (a : int) (b : int) : bool =
(a mod b) = 0
;;
estDivisible 10 2;;
estDivisible 10 6;;
estDivisible 10 5;;
val estDivisible : int -> int -> bool = <fun>
- : bool = true
- : bool = false
- : bool = true
let range2 (debut : int) (fin : int) (taille : int) : int list =
let rec aux acc = function
| n when n > fin -> acc
| n -> aux (n :: acc) (n + taille)
in
List.rev (aux [] debut)
;;
val range2 : int -> int -> int -> int list = <fun>
range2 2 12 3;;
- : int list = [2; 5; 8; 11]
Une version purement fonctionnelle est moins facile qu'une version impérative avec une référence booléenne (rappel : pas de break
dans les boucles for
en OCaml...).
let estPremier (n : int) : bool =
List.fold_left (fun b k -> b && (not (estDivisible n k))) true (range2 2 (racine n) 1)
;;
val estPremier : int -> bool = <fun>
let premiers (n : int) : int list =
List.filter estPremier (range2 2 n 1)
;;
val premiers : int -> int list = <fun>
premiers 10;;
- : int list = [2; 3; 5; 7]
premiers 100;;
- : int list = [2; 3; 5; 7; 11; 13; 17; 19; 23; 29; 31; 37; 41; 43; 47; 53; 59; 61; 67; 71; 73; 79; 83; 89; 97]
On fera les tris en ordre croissant.
let test = [3; 1; 8; 4; 5; 6; 1; 2];;
val test : int list = [3; 1; 8; 4; 5; 6; 1; 2]
let rec insere (x : 'a) : 'a list -> 'a list = function
| [] -> [x]
| t :: q ->
if x <= t then
x :: t :: q
else
t :: (insere x q)
;;
val insere : 'a -> 'a list -> 'a list = <fun>
let rec tri_insertion : 'a list -> 'a list = function
| [] -> []
| t :: q -> insere t (tri_insertion q)
;;
val tri_insertion : 'a list -> 'a list = <fun>
tri_insertion test;;
- : int list = [1; 1; 2; 3; 4; 5; 6; 8]
Complexité en temps $\mathcal{O}(n^2)$.
let rec insere2 (ordre : 'a -> 'a -> bool) (x : 'a) : 'a list -> 'a list = function
| [] -> [x]
| t :: q ->
if ordre x t then
x :: t :: q
else
t :: (insere2 ordre x q)
;;
val insere2 : ('a -> 'a -> bool) -> 'a -> 'a list -> 'a list = <fun>
let rec tri_insertion2 (ordre : 'a -> 'a -> bool) : 'a list -> 'a list = function
| [] -> []
| t :: q -> insere2 ordre t (tri_insertion2 ordre q)
;;
val tri_insertion2 : ('a -> 'a -> bool) -> 'a list -> 'a list = <fun>
let ordre_croissant a b = a <= b;;
val ordre_croissant : 'a -> 'a -> bool = <fun>
tri_insertion2 ordre_croissant test;;
- : int list = [1; 1; 2; 3; 4; 5; 6; 8]
let ordre_decroissant = (>=);;
val ordre_decroissant : 'a -> 'a -> bool = <fun>
tri_insertion2 ordre_decroissant test;;
- : int list = [8; 6; 5; 4; 3; 2; 1; 1]
let selectionne_min (l : 'a list) : ('a * 'a list) =
let rec cherche_min min autres = function
| [] -> (min, autres)
| t :: q ->
if t < min then
cherche_min t (min :: autres) q
else
cherche_min min (t :: autres) q
in
match l with
| [] -> failwith "Selectionne_min sur liste vide"
| t :: q -> cherche_min t [] q
;;
val selectionne_min : 'a list -> 'a * 'a list = <fun>
selectionne_min test;;
- : int * int list = (1, [2; 1; 6; 5; 4; 8; 3])
let rec tri_selection : 'a list -> 'a list = function
| [] -> []
| l ->
let (min, autres) = selectionne_min l in
min :: (tri_selection autres)
;;
val tri_selection : 'a list -> 'a list = <fun>
tri_selection test;;
- : int list = [1; 1; 2; 3; 4; 5; 6; 8]
Complexité en temps : $\mathcal{O}(n^2)$.
let print_list (liste : int list) : unit =
print_string "[";
List.iter (fun i -> print_int i; print_string "; " ) liste;
print_endline "]";
;;
val print_list : int list -> unit = <fun>
test;;
print_list test;;
- : int list = [3; 1; 8; 4; 5; 6; 1; 2]
- : unit = ()
[3; 1; 8; 4; 5; 6; 1; 2; ]
let rec separe : 'a list -> ('a list * 'a list) = function
| [] -> ([], [])
| [x] -> ([x], [])
| x :: y :: q ->
let (a, b) = separe q
in (x::a, y::b)
;;
separe test;;
val separe : 'a list -> 'a list * 'a list = <fun>
- : int list * int list = ([3; 8; 5; 1], [1; 4; 6; 2])
let rec fusion (l1 : 'a list) (l2 : 'a list) : 'a list =
match (l1, l2) with
| (l, []) | ([], l) -> l (* syntaxe concise pour deux cas identiques *)
| (x::a, y::b) ->
if x <= y then
x :: (fusion a (y :: b))
else
y :: (fusion (x :: a) b)
;;
fusion [1; 3; 7] [2; 3; 8];;
val fusion : 'a list -> 'a list -> 'a list = <fun>
- : int list = [1; 2; 3; 3; 7; 8]
let rec tri_fusion : 'a list -> 'a list = function
| [] -> []
| [x] -> [x] (* ATTENTION A NE PAS OUBLIER CE CAS *)
| l ->
let a, b = separe l in
fusion (tri_fusion a) (tri_fusion b)
;;
val tri_fusion : 'a list -> 'a list = <fun>
tri_fusion test;;
- : int list = [1; 1; 2; 3; 4; 5; 6; 8]
Complexité en temps $\mathcal{O}(n \log n)$.
applique
¶let rec applique f = function
| [] -> []
| h :: q -> (f h) :: (applique f q)
;;
val applique : ('a -> 'b) -> 'a list -> 'b list = <fun>
let premiers_carres_parfaits (n : int) : int list =
applique (fun x -> x * x) (entiers 1 n)
;;
val premiers_carres_parfaits : int -> int list = <fun>
premiers_carres_parfaits 12;;
- : int list = [1; 4; 9; 16; 25; 36; 49; 64; 81; 100; 121; 144]
itere
¶let rec itere (f : 'a -> unit) = function
| [] -> ()
| h :: q -> begin
f h;
itere f q
end
;;
val itere : ('a -> unit) -> 'a list -> unit = <fun>
let print = Printf.printf
let f x = print "%i\n" x;;
val print : ('a, out_channel, unit) format -> 'a = <fun>
val f : int -> unit = <fun>
let affiche_liste_entiers (liste : int list) =
print "Debut\n";
itere (print "%i\n") liste;
print "Fin\n";
flush_all ();
;;
affiche_liste_entiers [1; 2; 4; 5];;
val affiche_liste_entiers : int list -> unit = <fun>
- : unit = ()
Debut 1 2 4 5 Fin
qqsoit
et ilexiste
¶let rec qqsoit (pred : 'a -> bool) = function
| [] -> true (* piege ! *)
| h :: q -> (pred h) && (qqsoit pred q)
(* le && n'évalue pas le deuxième si le premier argument est false
donc ceci est efficace et récursif terminal.
*)
;;
val qqsoit : ('a -> bool) -> 'a list -> bool = <fun>
let rec ilexiste (pred : 'a -> bool) = function
| [] -> false
| h :: q -> (pred h) || (ilexiste pred q)
(* le || n'évalue pas le deuxième si le premier argument est true
donc ceci est efficace et récursif terminal.
*)
;;
val ilexiste : ('a -> bool) -> 'a list -> bool = <fun>
qqsoit (fun x -> (x mod 2) = 0) [1; 2; 3; 4; 5];;
ilexiste (fun x -> (x mod 2) = 0) [1; 2; 3; 4; 5];;
- : bool = false
- : bool = true
appartient
version 2¶let appartient x = ilexiste (fun y -> x = y);;
let appartient x = ilexiste ((=) x);; (* syntaxe simplifiée par curification *)
val appartient : 'a -> 'a list -> bool = <fun>
val appartient : 'a -> 'a list -> bool = <fun>
let toutes_egales x = qqsoit ((=) x);;
val toutes_egales : 'a -> 'a list -> bool = <fun>
appartient 1 [1; 2; 3];;
appartient 5 [1; 2; 3];;
toutes_egales 1 [1; 2; 3];;
toutes_egales 2 [2; 2; 2];;
- : bool = true
- : bool = false
- : bool = false
- : bool = true
filtre
¶let rec filtre (pred : 'a -> bool) : 'a list -> 'a list = function
| [] -> []
| h :: q when pred h -> h :: (filtre pred q)
| _ :: q -> filtre pred q
;;
val filtre : ('a -> bool) -> 'a list -> 'a list = <fun>
filtre (fun x -> (x mod 2) = 0) [1; 2; 3; 4; 5];;
filtre (fun x -> (x mod 2) != 0) [1; 2; 3; 4; 5];;
filtre (fun x -> (x mod 2) <> 0) [1; 2; 3; 4; 5];; (* syntaxe non conseillée *)
- : int list = [2; 4]
- : int list = [1; 3; 5]
- : int list = [1; 3; 5]
Je vous laisse trouver pour premiers
.
let pairs = filtre (fun x -> (x mod 2) = 0);;
let impairs = filtre (fun x -> (x mod 2) != 0);;
val pairs : int list -> int list = <fun>
val impairs : int list -> int list = <fun>
reduit
¶let rec reduit (tr : 'a -> 'b -> 'a) (acc : 'a) (liste : 'b list) : 'a =
match liste with
| [] -> acc
| h :: q -> reduit tr (tr acc h) q
;;
val reduit : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a = <fun>
Très pratique pour calculer des sommes, notamment.
somme
, produit
¶let somme = reduit (+) 0;;
somme [1; 2; 3; 4; 5];;
List.fold_left (+) 0 [1; 2; 3; 4; 5];;
val somme : int list -> int = <fun>
- : int = 15
- : int = 15
let produit = reduit ( * ) 1;;
produit [1; 2; 3; 4; 5];;
List.fold_left ( * ) 1 [1; 2; 3; 4; 5];;
val produit : int list -> int = <fun>
- : int = 120
- : int = 120
miroir
version 2¶let miroir = reduit (fun a b -> b :: a) [];;
val miroir : '_a list -> '_a list = <fun>
miroir [2; 3; 5; 7; 11];;
List.rev [2; 3; 5; 7; 11];;
- : int list = [11; 7; 5; 3; 2]
- : int list = [11; 7; 5; 3; 2]
miroir [2.; 3.; 5.; 7.; 11.];;
File "[77]", line 1, characters 8-10:
Error: This expression has type float but an expression was expected of type
int
MMMMM# miroir [2.; 3.; 5.; 7.; 11.];;
type 'a arbre_bin0 = Feuille0 of 'a | Noeud0 of ('a arbre_bin0) * 'a * ('a arbre_bin0);;
type 'a arbre_bin0 = Feuille0 of 'a | Noeud0 of 'a arbre_bin0 * 'a * 'a arbre_bin0
let rec arbre_complet_entier (n : int) : int arbre_bin0 =
match n with
| n when n < 2 -> Feuille0 0
| n -> Noeud0((arbre_complet_entier (n / 2)), n, (arbre_complet_entier (n / 2)))
;;
arbre_complet_entier 4;;
val arbre_complet_entier : int -> int arbre_bin0 = <fun>
- : int arbre_bin0 = Noeud0 (Noeud0 (Feuille0 0, 2, Feuille0 0), 4, Noeud0 (Feuille0 0, 2, Feuille0 0))
Autre variante, plus simple :
type arbre_bin = Feuille | Noeud of arbre_bin * arbre_bin;;
type arbre_bin = Feuille | Noeud of arbre_bin * arbre_bin
let arbre_test = Noeud (Noeud (Noeud (Feuille, Feuille), Feuille), Feuille);;
val arbre_test : arbre_bin = Noeud (Noeud (Noeud (Feuille, Feuille), Feuille), Feuille)
Compte le nombre de feuilles et de sommets.
let rec taille : arbre_bin -> int = function
| Feuille -> 1
| Noeud(x, y) -> 1 + (taille x) + (taille y)
;;
val taille : arbre_bin -> int = <fun>
taille arbre_test;;
- : int = 7
let rec hauteur : arbre_bin -> int = function
| Feuille -> 0
| Noeud(x, y) -> 1 + (max (hauteur x) (hauteur y)) (* peut etre plus simple *)
;;
val hauteur : arbre_bin -> int = <fun>
hauteur arbre_test;;
- : int = 3
Bonus.
type element_parcours = F | N;;
type parcours = element_parcours list;;
type element_parcours = F | N
type parcours = element_parcours list
let rec parcours_prefixe : arbre_bin -> element_parcours list = function
| Feuille -> [F]
| Noeud (g, d) -> [N] @ (parcours_prefixe g) @ (parcours_prefixe d)
;;
parcours_prefixe arbre_test;;
val parcours_prefixe : arbre_bin -> element_parcours list = <fun>
- : element_parcours list = [N; N; N; F; F; F; F]
let rec parcours_postfixe : arbre_bin -> element_parcours list = function
| Feuille -> [F]
| Noeud(g, d) -> (parcours_postfixe g) @ (parcours_postfixe d) @ [N]
;;
parcours_postfixe arbre_test;;
val parcours_postfixe : arbre_bin -> element_parcours list = <fun>
- : element_parcours list = [F; F; N; F; N; F; N]
let rec parcours_infixe : arbre_bin -> element_parcours list = function
| Feuille -> [F]
| Noeud(g, d) -> (parcours_infixe g) @ [N] @ (parcours_infixe d)
;;
parcours_infixe arbre_test;;
val parcours_infixe : arbre_bin -> element_parcours list = <fun>
- : element_parcours list = [F; N; F; N; F; N; F]
Pourquoi ont-ils une complexité quadratique ? La concaténation (@
) ne se fait pas en temps constant mais linéaire dans la taille de la première liste.
On ajoute une fonction auxiliaire et un argument vus
qui est une liste qui stocke les élements observés dans l'ordre du parcours
let parcours_prefixe2 a =
let rec parcours vus = function
| Feuille -> F :: vus
| Noeud(g, d) -> parcours (parcours (N :: vus) g) d
in List.rev (parcours [] a)
;;
parcours_prefixe2 arbre_test;;
val parcours_prefixe2 : arbre_bin -> element_parcours list = <fun>
- : element_parcours list = [N; N; N; F; F; F; F]
let parcours_postfixe2 a =
let rec parcours vus = function
| Feuille -> F :: vus
| Noeud(g, d) -> N :: (parcours (parcours vus g) d)
in List.rev (parcours [] a)
;;
parcours_postfixe2 arbre_test;;
val parcours_postfixe2 : arbre_bin -> element_parcours list = <fun>
- : element_parcours list = [F; F; N; F; N; F; N]
let parcours_infixe2 a =
let rec parcours vus = function
| Feuille -> F :: vus
| Noeud(g, d) -> parcours (N :: (parcours vus g)) d
in List.rev (parcours [] a)
;;
parcours_infixe2 arbre_test;;
val parcours_infixe2 : arbre_bin -> element_parcours list = <fun>
- : element_parcours list = [F; N; F; N; F; N; F]
let parcours_largeur a =
let file = Queue.create () in
(* fonction avec effet de bord sur la file *)
let rec parcours () =
if Queue.is_empty file
then []
else match Queue.pop file with
| Feuille -> F :: (parcours ())
| Noeud(g, d) -> begin
Queue.push g file;
Queue.push d file;
N :: (parcours ())
end
in
Queue.push a file;
parcours ()
;;
parcours_largeur arbre_test;;
val parcours_largeur : arbre_bin -> element_parcours list = <fun>
- : element_parcours list = [N; N; F; N; F; F; F]
En remplaçant la file par une pile (Stack
), on obtient le parcours en profondeur, avec la même complexité.
let parcours_profondeur a =
let file = Stack.create () in
(* fonction avec effet de bord sur la file *)
let rec parcours () =
if Stack.is_empty file
then []
else match Stack.pop file with
| Feuille -> F :: (parcours ())
| Noeud(g, d) -> begin
Stack.push g file;
Stack.push d file;
N :: (parcours ())
end
in
Stack.push a file;
parcours ()
;;
parcours_profondeur arbre_test;;
val parcours_profondeur : arbre_bin -> element_parcours list = <fun>
- : element_parcours list = [N; F; N; F; N; F; F]
(* Reconstruction depuis le parcours prefixe *)
let test_prefixe = parcours_prefixe2 arbre_test;;
val test_prefixe : element_parcours list = [N; N; N; F; F; F; F]
(* L'idée de cette solution est la suivante :
j'aimerais une fonction récursive qui fasse le travail;
le problème c'est que si on prend un parcours prefixe, soit il commence
par F et l'arbre doit être une feuille; soit il est de la forme N::q
où q n'est plus un parcours prefixe mais la concaténation de DEUX parcours
prefixe, on ne peut donc plus appeler la fonction sur q.
On va donc écrire une fonction qui prend une liste qui contient plusieurs
parcours concaténé et qui renvoie l'arbre correspondant au premier parcours
et ce qui n'a pas été utilisé : *)
let reconstruit_prefixe parcours =
let rec reconstruit = function
| F :: p -> (Feuille, p)
| N :: p ->
let (g, q) = reconstruit p in
let (d, r) = reconstruit q in
(Noeud(g, d), r)
| [] -> failwith "pacours invalide"
in
match reconstruit parcours with
| (a, []) -> a
| _ -> failwith "parcours invalide"
;;
reconstruit_prefixe test_prefixe;;
reconstruit_prefixe (N :: F :: F :: test_prefixe);; (* échoue *)
val reconstruit_prefixe : element_parcours list -> arbre_bin = <fun>
- : arbre_bin = Noeud (Noeud (Noeud (Feuille, Feuille), Feuille), Feuille)
Exception: Failure "parcours invalide".
Raised at file "pervasives.ml", line 32, characters 22-33
Called from file "toplevel/toploop.ml", line 180, characters 17-56
(* Reconstruction depuis le parcours en largeur *)
(* Ce n'est pas évident quand on ne connait pas. L'idée est de se servir d'une file
pour stocker les arbres qu'on reconstruit peu à peu depuis les feuilles. La file
permet de récupérer les bons sous-arbres quand on rencontre un noeud *)
let largeur_test = parcours_largeur arbre_test;;
val largeur_test : element_parcours list = [N; N; F; N; F; F; F]
let reconstruit_largeur parcours =
let file = Queue.create () in
(* Fonction avec effets de bord *)
let lire_element = function
| F -> Queue.push Feuille file
| N ->
let d = Queue.pop file in
let g = Queue.pop file in
Queue.push (Noeud(g, d)) file
in
List.iter lire_element (List.rev parcours);
if Queue.length file = 1 then
Queue.pop file
else
failwith "parcours invalide"
;;
reconstruit_largeur largeur_test;;
val reconstruit_largeur : element_parcours list -> arbre_bin = <fun>
- : arbre_bin = Noeud (Noeud (Noeud (Feuille, Feuille), Feuille), Feuille)
(* Le même algorithme (enfin presque, modulo interversion de g et d)
avec une pile donne une autre version de la reconstruction du parcours prefixe *)
let reconstruit_prefixe2 parcours =
let pile = Stack.create () in
let lire_element = function
| F -> Stack.push Feuille pile
| N ->
let g = Stack.pop pile in
let d = Stack.pop pile in
Stack.push (Noeud(g, d)) pile
in
List.iter lire_element (List.rev parcours);
if Stack.length pile = 1 then
Stack.pop pile
else
failwith "parcours invalide"
;;
reconstruit_prefixe2 test_prefixe;;
val reconstruit_prefixe2 : element_parcours list -> arbre_bin = <fun>
- : arbre_bin = Noeud (Noeud (Noeud (Feuille, Feuille), Feuille), Feuille)