Salut,
Je n'ai très certainement pas fait de la meilleure façon mais ça fonctionne,
Si quelqu'un a fait différemment je suis preneur.
DULAU Idris
(* Abres quasi-parfaits *)
type 'a btree = Empty | Node of 'a * 'a btree * 'a btree;;
let rec btree_is_quasi_perfect t =
let rec perfect t h =
match t with
|Empty -> (h = -1)
|Node(a,l,r) -> (perfect l (h-1)) && (perfect r (h-1))
in
let rec quasi_perfect t h =
match t with
|Empty -> false
|Node(a,l,r) -> ((perfect l (h-1)) && (quasi_perfect r (h-1))) ||
((perfect l (h-1)) && (perfect r (h-2))) ||
((quasi_perfect l (h-1)) && (perfect r (h-2)))
in
let rec btree_height t =
match t with
|Empty -> -1
|Node(a,l,r) -> 1 + max (btree_height l) (btree_height r)
in
(perfect t (btree_height t)) || (quasi_perfect t (btree_height t))
val btree_is_quasi_perfect : 'a btree -> bool = <fun>
---------------------------------------------------------------------
(* Génération d'arbres quasi-parfaits *)
(* Fonction qui à x associe 2 à la puissance x *)
let rec pow2 x =
if x = 0
then 1
else 2 * pow2 (x-1)
val pow2 : int -> int = <fun>
(* Fonction qui prend une hauteur et renvoie le nombre de noeuds
de l'arbre parfait de même hauteur *)
let rec h_to_n h =
if h < 0
then 0
else pow2 (h+1) -1
val h_to_n : int -> int = <fun>
(* Fonction qui a x associe la partie entière du logarithme
en base 2 de x *)
let log2 x =
let rec aux x c =
if x < 1
then c - 1
else aux (x/2) (c+1)
in
aux x 0
val log2 : int -> int = <fun>
(* Fonction qui prend un nombre de noeuds et renvoie la hauteur
du plus grand arbre parfait que l'on peut former avec *)
let rec n_to_h n =
if n < 1
then -1
else log2 (n+1) -1
val n_to_h : int -> int = <fun>
(* Nombres de noeuds ne permettant pas de générer un
arbre parfait supplémentaire avec la Fonction n_to_h *)
let exced_of_nodes nodes = nodes - (h_to_n ( n_to_h nodes))
val exced_of_nodes : int -> int = <fun>
(* Genere un arbre parfait de hauteur h *)
let rec btree_perfect h =
let rec aux h t =
if h >= 0
then aux (h-1) (Node(0,t,t))
else t
in
aux h Empty
val btree_perfect : int -> int btree = <fun>
(* Retourne la hauteur d'un arbre *)
let rec btree_height t =
match t with
|Empty -> -1
|Node(a,l,r) -> 1 + max (btree_height l) (btree_height r)
val btree_height : 'a btree -> int = <fun>
(* Teste si l'arbre est parfait *)
let rec btree_is_perfect t =
let rec aux t h =
match t with
|Empty -> (h = -1)
|Node(a,l,r) -> (aux l (h-1))&&(aux r (h-1))
in
aux t (btree_height t)
val btree_is_perfect : 'a btree -> bool = <fun>
(* Arité d'un arbre *)
let rec arity t =
match t with
|Empty -> 0
|Node(a,l,r) when l=Empty && r=Empty -> 0
|Node(a,l,r) when l!=Empty && r!=Empty -> 2
|_ -> 1
val arity : 'a btree -> int = <fun>
(* Ajout d'un zéro aux feuilles *)
let rec add t =
match t with
|Empty -> Node(0,Empty,Empty)
|Node(a,l,r) when arity t = 1 -> Node(a, l, add r)
|Node(a,l,r) when (arity l = 2) && (arity l > arity r) -> Node(a, l, add r)
|Node(a,l,r) when (btree_is_perfect l) && (not(btree_is_perfect t)) && (btree_height l > 1) -> Node(a, l, add r)
|Node(a,l,r) -> Node(a, add l, r)
(* Genere un arbre quasi parfait à n noeuds *)
let rec btree_quasi_perfect n =
let rec aux n t c =
if c < 1
then t
else aux (n-1) (add t) (c-1)
in
aux n (btree_perfect (n_to_h n)) (exced_of_nodes n)