.
..
arbres_rouge_noir.ml (download) (view)

type 'a arbre = Nil | Node of 'a arbre * 'a * 'a arbre;;

let abr = Node(Node(Node(Nil, 1, Nil), 2, Node(Node(Node(Nil, 4, Nil), 5, Nil), 7, Node(Nil,8,Nil))), 11, Node(Nil, 14, Node(Nil,15,Nil)));;

let rec parcours_infixe fct = function
  Nil -> ()
  | Node(l, v, r) -> parcours_infixe fct l; fct v; parcours_infixe fct r
;;

let rec parcours_prefixe fct = function
  Nil -> ()
  | Node(l, v, r) -> fct v; parcours_prefixe fct l; parcours_infixe fct r
;;

let rec parcours_postfixe fct = function
  Nil -> ()
  | Node(l, v, r) -> parcours_postfixe fct l; parcours_infixe fct r; fct v
;;

parcours_infixe (fun a -> print_int a; print_string " ") abr;;
print_string "\n";;
parcours_prefixe (fun a -> print_int a; print_string " ") abr;;
print_string "\n";;
parcours_postfixe (fun a -> print_int a; print_string " ") abr;;
print_string "\n";;

let rec hauteur_arbre = function
  Nil -> 0
  | Node(l, v, r) ->  1 + max (hauteur_arbre l) (hauteur_arbre r)
  ;;
 
print_int (hauteur_arbre abr);;

open Graphics;;

open_graph ":0.0 500x300";;

let rien x = () ;;

let fct_display1 x y v =  draw_circle x y 10;
                          moveto (x - 5) (y - 5);
                          draw_string (string_of_int v);;


let rec dessine_arbre_rec xmin xmax ymax fct_display level h = function
  Nil -> ()
  | Node(l, c, r) ->  dessine_arbre_rec xmin ((xmax + xmin) / 2) ymax fct_display (level + 1) h l;
                      dessine_arbre_rec ((xmax + xmin) / 2) xmax ymax fct_display (level + 1) h r;
                      fct_display ((xmin + xmax) / 2) (ymax * (h - level + 1) / h ) c
;;

let dessine_arbre fct_display a =
  let r = 10 in
  dessine_arbre_rec (r*2) (size_x () - r) (size_y () - r) fct_display 1 (hauteur_arbre a) a;
  rien (read_key ());
  close_graph()
;;

clear_graph;;
(*dessine_arbre fct_display1 abr;;*)


(* fonction de test *)
let test label b =
    print_string label;
    if b then print_string ": ok !\n" else print_string ": failed !\n";
    flush stdout
;;

type 'a tree = Vide | Rouge of 'a tree * 'a * 'a tree | Noir of 'a tree * 'a * 'a tree;;

let rec verif4 = function
  Vide -> true
  | Rouge(Rouge(_, _, _), _, _) -> false
  | Rouge(_, _, Rouge(_, _, _)) -> false
  | Noir(a, x, b) -> verif4 a && verif4 b
  | Rouge(a, x, b) -> verif4 a && verif4 b
;;

let rec tree_height = function
  Vide -> 0
  | Rouge(a, _, b) ->  1 + max (tree_height a) (tree_height b)
  | Noir(a, _, b)  ->  1 + max (tree_height a) (tree_height b)
;;

let verif2 = function
  Noir(_, _, _) -> true
  | _ -> false
;;

(* verif_5*)
let rec hauteur_noire = function
  Vide -> 0
  | Rouge(a, _, b) ->
    let h = hauteur_noire a in
    if h = (hauteur_noire b) then
      h
    else
      failwith "erreur dans l'arbre"
  | Noir(a, _, b) ->
    let h = hauteur_noire a in
    if h = (hauteur_noire b) then
      h + 1
    else
      failwith "erreur dans l'arbre"
;;

let rec member x = function
  Vide -> false
  | Rouge(a, y, b) ->
    if x < y then member x a
    else if x > y then member x b
    else true
  | Noir(a, y, b) ->
    if x < y then member x a
    else if x > y then member x b
    else true
;;

let reorganise = function
    Noir(Rouge(Rouge(a, x, b), y, c), z, d) -> Rouge(Noir(a, x, b), y, Noir(c, z, d))
  | Noir(Rouge(a, x, Rouge(b, y, c)), z, d) -> Rouge(Noir(a, x, b), y, Noir(c, z, d))
  | Noir(a, x, Rouge(Rouge(b, y, c), z, d)) -> Rouge(Noir(a, x, b), y, Noir(c, z, d))
  | Noir(a, x, Rouge(b, y, Rouge(c, z, d))) -> Rouge(Noir(a, x, b), y, Noir(c, z, d))
  | t -> t
;;
 
let insert x t =
  let rec ins = function
    Vide -> Rouge(Vide, x, Vide)
    | Rouge(a, y, b) as tt ->
      if x < y then Rouge(ins a, y, b)
      else if x > y then Rouge(a, y, ins b)
      else tt
    | Noir(a, y, b) as tt ->
      if x < y then reorganise (Noir(ins a, y, b))
      else if x > y then reorganise (Noir(a, y, ins b))
      else tt in
  match ins t with
    Rouge(a, y, b) -> Noir(a, y, b)
    | t -> t
;;

let rec draw x y width t =
  match t with
    Vide -> ()
    | Rouge(a, n, b) -> draw_node a n b x y width Graphics.red
    | Noir(a, n, b)  -> draw_node a n b x y width Graphics.black
and
  draw_node a n b x y width color =
    draw_son (x + width / 2) y x (y - 40) (width / 2) a;
    draw_son (x + width / 2) y (x + width / 2) (y - 40) (width / 2) b;
    draw_label (x + width / 2) y n color
and
  draw_son x0 y0 x1 y1 width = function
    Vide -> ()
  | t ->
    Graphics.set_color Graphics.green;
    Graphics.moveto x0 y0;
    Graphics.lineto (x1 + width / 2) y1;
    draw x1 y1 width t
and
  draw_label x y value color =  
    let txt = string_of_int value in
    let (width, height) = Graphics.text_size txt in
      Graphics.set_color color;
      Graphics.fill_rect (x - width / 2 - 2) (y - 2) (width + 4) (height + 4);
      Graphics.set_color Graphics.white;
      Graphics.moveto (x - width / 2)  y;
      Graphics.draw_string txt
;;

let rien x = () ;;

let draw_tree t =
  clear_graph ();
  draw 0 (Graphics.size_y() - 20) (Graphics.size_x()) t;
  rien (read_key ())
;;

let rec build_random_int_tree n =
  let v = (Random.int 99) in
  if n <= 1 then
    Noir(Vide, v, Vide)
  else
    let c = build_random_int_tree (n - 1) in
(*      draw_tree c; *)
      insert v c
;;

open_graph ":0.0 640x480";;
let n = 23;;
let a = build_random_int_tree n;;
draw_tree a;;
test "tree_height" (tree_height a <= int_of_float (2.0 *. log(float_of_int n +. 1.0)));;
 
Webmaster : pierrefrancois.leon@laposte.net

Valid XHTML 1.0 Strict Valid CSS!