API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Apr 29th, 2016
88
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
OCaml 26.88 KB | None | 0 0
raw download clone embed print report
  1. (* Type *)
  2. type 'a element = 'a;;
  3.  
  4. (* Type Arbre 2-3-4 *)
  5. type ab234 = Vide234 | Noeud1 of ((int element)) * ab234 * ab234
  6.     | Noeud2 of ((int element) * (int element)) * ab234 * ab234 * ab234
  7.     | Noeud3 of ((int element) * (int element) * (int element)) * ab234 * ab234 * ab234 * ab234;;
  8.  
  9. (* Type Arbre Bicolore *)
  10. type couleur = Rouge | Noir | DoubleNoir;;
  11. type ab = Videbic | VideNoir | Noeud of couleur * int element * ab * ab;;
  12.  
  13. (* Fonctions de transformations abic <=> a234 *)
  14.  
  15. (* Arbre d'exemple *)
  16. let arbrebic = Noeud(Noir,5,
  17.         Noeud(Noir,2, Videbic, Videbic),
  18.         Noeud(Rouge,14,
  19.             Noeud(Noir,13, Videbic, Videbic),
  20.             Noeud(Noir,20,
  21.                 Noeud(Rouge,16, Videbic, Videbic),
  22.                 Noeud(Rouge,21, Videbic, Videbic))));;
  23.  
  24. (* abic -> a234 *)
  25. let rec abic_vers_a234 a =
  26.     match a with
  27.     | Videbic -> Vide234
  28.     | Noeud(Noir, e2, Noeud(Rouge, e1, b1, b2), Noeud(Rouge, e3, b3, b4)) -> Noeud3((e1, e2, e3), (abic_vers_a234 b1),
  29.                 (abic_vers_a234 b2),
  30.                 (abic_vers_a234 b3),
  31.                 (abic_vers_a234 b4))
  32.     | Noeud(Noir, e2, Noeud(Rouge, e1, b1, b2), b3) -> Noeud2((e1, e2), (abic_vers_a234 b1),
  33.                 (abic_vers_a234 b2),
  34.                 (abic_vers_a234 b3))
  35.     | Noeud(Noir, e1, b1, Noeud(Rouge, e2, b2, b3)) -> Noeud2((e1, e2), (abic_vers_a234 b1),
  36.                 (abic_vers_a234 b2),
  37.                 (abic_vers_a234 b3))
  38.     | Noeud(Noir, e, b1, b2) -> Noeud1((e), (abic_vers_a234 b1), (abic_vers_a234 b2))
  39.     | _ -> failwith"";;
  40.  
  41. (* Test *)
  42. let arbre234 = (abic_vers_a234 arbrebic);;
  43.  
  44. (* a234 -> abic *)
  45. let rec a234_vers_abic a =
  46.     match a with
  47.     | Vide234 -> Videbic
  48.     | Noeud1((e), a1, a2) -> Noeud(Noir, e, (a234_vers_abic a1), (a234_vers_abic a2))
  49.     | Noeud2((e1, e2), a1, a2, a3) -> Noeud(Noir, e2,
  50.                 Noeud(Rouge, e1, (a234_vers_abic a1), (a234_vers_abic a2)), (a234_vers_abic a3))
  51.     | Noeud3((e1, e2, e3), a1, a2, a3, a4) -> Noeud(Noir, e2,
  52.                 Noeud(Rouge, e1, (a234_vers_abic a1), (a234_vers_abic a2)),
  53.                 Noeud(Rouge, e3, (a234_vers_abic a3), (a234_vers_abic a4)));;
  54.  
  55. (* Test *)
  56. let arbrebic2 = (a234_vers_abic arbre234);;
  57.  
  58. (* -------------------------------- Insertion a234                         *)
  59. (* -------------------------------- Fonction temporaire pour usurper       *)
  60. (* foncteur/module                                                         *)
  61. let est_plus_petit a b = a < b;;
  62. let inf = est_plus_petit;;
  63. let eq a b = not (est_plus_petit a b) && not (est_plus_petit b a);;
  64.  
  65. (* Prend la direction vers l'élément e dans l'arbre *)
  66. let get_direction e = function
  67.     | Noeud1((x), _, _) | Noeud2((x, _), _, _, _) | Noeud3((x, _, _), _, _, _, _) when (inf e x) -> 1
  68.     | Noeud1((x), _, _) when (inf x e) -> 2
  69.     | Noeud2((x, y), _, _, _) | Noeud3((x, y, _), _, _, _, _) when (inf x e) && (inf e y) -> 2
  70.     | Noeud2((x, y), _, _, _) when (inf y e) -> 3
  71.     | Noeud3((x, y, z), _, _, _, _) when (inf y e) && (inf e z) -> 3
  72.     | Noeud3((x, y, z), _, _, _, _) when (inf z e) -> 4
  73.     (* e présent dans les étiquettes *)
  74.     | _ -> 0;;
  75.  
  76. (* Remplace le fils dans la direction "dir" par l'arbre "t", si la         *)
  77. (* direction existe                                                        *)
  78. let set_subtree dir t = function
  79.     | Vide234 -> failwith "error set_subtree1"
  80.     | Noeud1(e, a, b) ->
  81.             (match dir with
  82.                 | 1 -> Noeud1(e, t, b)
  83.                 | 2 -> Noeud1(e, a, t)
  84.                 | _ -> failwith "error set_subtree2")
  85.     | Noeud2(e, a, b, c) ->
  86.             (match dir with
  87.                 | 1 -> Noeud2(e, t, b, c)
  88.                 | 2 -> Noeud2(e, a, t, c)
  89.                 | 3 -> Noeud2(e, a, b, t)
  90.                 | _ -> failwith "error set_subtree3")
  91.     | Noeud3(e, a, b, c, d) ->
  92.             (match dir with
  93.                 | 1 -> Noeud3(e, t, b, c, d)
  94.                 | 2 -> Noeud3(e, a, t, c, d)
  95.                 | 3 -> Noeud3(e, a, b, t, d)
  96.                 | 4 -> Noeud3(e, a, b, c, t)
  97.                 | _ -> failwith "error set_subtree4");;
  98.  
  99. (* Retourne le fils dans la direction "dir" si il existe *)
  100. let get_subtree dir = function
  101.     | Vide234 -> failwith "error get_subtree1"
  102.     | Noeud1((_), a, b) ->
  103.             (match dir with
  104.                 | 1 -> a
  105.                 | 2 -> b
  106.                 | _ -> failwith "error get_subtree2")
  107.     | Noeud2((_), a, b, c) ->
  108.             (match dir with
  109.                 | 1 -> a
  110.                 | 2 -> b
  111.                 | 3 -> c
  112.                 | _ -> failwith "error get_subtree3")
  113.     | Noeud3((_), a, b, c, d) ->
  114.             (match dir with
  115.                 | 1 -> a
  116.                 | 2 -> b
  117.                 | 3 -> c
  118.                 | 4 -> d
  119.                 | _ -> failwith "error get_subtree4");;
  120. let is_present e t =
  121.     let rec aux t =
  122.         match t, (get_direction e t) with
  123.         | Vide234, _ -> false
  124.         | _, 0 -> true
  125.         | _, dir -> aux (get_subtree dir t)
  126.     in aux t
  127. ;;
  128.  
  129. let third (a,b,c) = c;;
  130. (* Gestion des explosions *)
  131. let a234_explode dir t =
  132.     match dir, t with
  133.     | 1, Noeud1((e1), Noeud3((e2, e3, e4), a1, a2, a3, a4), a5) ->
  134.             (true, 2, Noeud2((e3, e1), Noeud1((e2), a1, a2), Noeud1((e4), a3, a4), a5))
  135.     | 2, Noeud1((e1), a1, Noeud3((e2, e3, e4), a2, a3, a4, a5)) ->
  136.             (true, 3, Noeud2((e1, e3), a1, Noeud1((e2), a2, a3), Noeud1((e4), a4, a5)))
  137.     | 1, Noeud2((e1, e2), Noeud3((e3, e4, e5), a3, a4, a5, a6), a1, a2) ->
  138.             (true, 1, Noeud3((e4, e1, e2), Noeud1((e3), a3, a4), Noeud1((e5), a5, a6), a1, a2))
  139.     | 2, Noeud2((e1, e2), a1, Noeud3((e3, e4, e5), a3, a4, a5, a6), a2) ->
  140.             (true, 3, Noeud3((e1, e4, e2), a1, Noeud1((e3), a3, a4), Noeud1((e5), a5, a6), a2))
  141.     | 3, Noeud2((e1, e2), a1, a2, Noeud3((e3, e4, e5), a3, a4, a5, a6)) ->
  142.             (true, 4, Noeud3((e1, e2, e4), a1, a2, Noeud1((e3), a3, a4), Noeud1((e5), a5, a6)))
  143.     | _, _ -> (false, dir, t);;
  144.  
  145. let root t =
  146.     match t with
  147.     |  Noeud3((e1, e2, e3), a1, a2, a3, a4)  ->
  148.             (Noeud1((e2), Noeud1((e1), a1, a2), Noeud1((e3), a3, a4)))
  149.     | _ -> t;;
  150. (* Gestion insertion *)
  151. let a234_insert x t =
  152.     match is_present x t with
  153.     | true -> t
  154.   | false ->
  155.             let rec aux x = function
  156.         | Vide234 -> Noeud1((x), Vide234, Vide234)
  157.         | Noeud1((y), Vide234, Vide234) as t when (eq y x) -> t
  158.         | Noeud1((y), Vide234, Vide234) when (inf y x) -> Noeud2((y, x), Vide234, Vide234, Vide234)
  159.         | Noeud1((y), Vide234, Vide234) when (inf x y) -> Noeud2((x, y), Vide234, Vide234, Vide234)
  160.         | Noeud2((y1, y2), Vide234, Vide234, Vide234) as t when (eq x y1) || (eq x y2) -> t
  161.         | Noeud2((y1, y2), Vide234, Vide234, Vide234) when (inf x y1) -> Noeud3((x, y1, y2), Vide234, Vide234, Vide234, Vide234)
  162.         | Noeud2((y1, y2), Vide234, Vide234, Vide234) when (inf x y2) -> Noeud3((y1, x, y2), Vide234, Vide234, Vide234, Vide234)
  163.         | Noeud2((y1, y2), Vide234, Vide234, Vide234) -> Noeud3((y1, y2, x), Vide234, Vide234, Vide234, Vide234)
  164.         | _ as tt ->
  165.                 let dir = get_direction x tt in
  166.                 if dir = 0 then
  167.                     tt
  168.                 else
  169.                     let (flag, new_dir, exploded) = a234_explode dir tt in
  170.                     if flag then
  171.                         (aux x exploded)
  172.                     else
  173.                         (set_subtree new_dir (aux x (get_subtree new_dir exploded)) exploded)
  174.     in aux x (root t);;
  175.  
  176.  
  177. (* Test *)
  178. let test =
  179.     let rec aux t i =
  180.         let ii = (Random.int 20) in
  181.         print_string "ii: "; print_int ii;print_string "\n";
  182.         if i > 20 then
  183.             t
  184.         else
  185.             aux (a234_insert ii t) (i +1)
  186.     in aux Vide234 0;;
  187.  
  188. (* -------------------------------- Suppression a234                       *)
  189. (* --------------------------------                                        *)
  190.  
  191. (* Outils *)
  192. let is_vide = function
  193.     | Vide234 -> true
  194.     | _ -> false;;
  195.  
  196. let get_element_at_i i t =
  197.     match i, t with
  198.     | 1, Noeud3((e1,e2,e3), _,_,_,_) -> e1
  199.     | 2, Noeud3((e1,e2,e3), _,_,_,_) -> e2
  200.     | 3, Noeud3((e1,e2,e3), _,_,_,_) -> e3
  201.     | 1, Noeud2((e1,e2), _,_,_) -> e1
  202.     | 2, Noeud2((e1,e2), _,_,_) -> e2
  203.     | _ -> failwith "yolo";;
  204.  
  205. (* Retourne le maximum, et l'arbre maximum exclu d'un arbre *)
  206. let get_max = function
  207.     | Vide234 -> failwith "error get_max"
  208.     | Noeud1((x), a, b) -> (x, b, a)
  209.     | Noeud2((x, y), a, b, c) -> (y, c, Noeud1((x), a, b))
  210.     | Noeud3((x, y, z), a, b, c, d) -> (z, d, Noeud2((x, y), a, b, c));;
  211.  
  212. (* Retourne le minimum, et l'arbre minimum exclu d'un arbre *)
  213. let get_min = function
  214.     | Vide234 -> failwith "error get_min"
  215.     | Noeud1((x), a, b) -> (x, a, b)
  216.     | Noeud2((x, y), a, b, c) -> (x, a, Noeud1((y), b, c))
  217.     | Noeud3((x, y, z), a, b, c, d) -> (x, a, Noeud2((y, z), b, c, d));;
  218.  
  219. (* Passe le maximum du frère gauche de la cible sur celle-ci + : Avec les  *)
  220. (* sous enfants gérés                                                      *)
  221. let pop_from_left (maxE, maxA, remain) origin = function
  222.     | Noeud1((x), a, Noeud1((b), e, f)) ->
  223.             Noeud1((maxE), remain, Noeud2((x, b), maxA, e, f))
  224.     | Noeud2(_, _, _, _) as t ->
  225.             (match origin, t with
  226.                 | 1, Noeud2((x, y), a, Noeud1((b), e, f), c) ->
  227.                         Noeud2((maxE, y), remain, Noeud2((x, b), maxA, e, f), c)
  228.                 | 2, Noeud2((x, y), a, b, Noeud1((c), e, f)) ->
  229.                         Noeud2((x, maxE), a, remain, Noeud2((y, c), maxA, e, f))
  230.                 | _, _ -> failwith "error pop_from_left1")
  231.     | Noeud3(_, _, _, _, _) as t ->
  232.             (match origin, t with
  233.                 | 1, Noeud3((x, y, z), a, Noeud1((b), e, f), c, d) ->
  234.                         Noeud3((maxE, y, z), remain, Noeud2((x, b), maxA, e, f), c, d)
  235.                 | 2, Noeud3((x, y, z), a, b, Noeud1((c), e, f), d) ->
  236.                         Noeud3((x, maxE, z), a, remain, Noeud2((y, c), maxA, e, f), d)
  237.                 | 3, Noeud3((x, y, z), a, b, c, Noeud1((d), e, f)) ->
  238.                         Noeud3((x, y, maxE), a, b, remain, Noeud2((z, d), maxA, e, f))
  239.                 | _, _ -> failwith "pop_from_left2")
  240.     | _ -> failwith "pop_from_left3";;
  241.  
  242. (* Passe le minimum du frère droit de la cible sur celle-ci + : Avec les   *)
  243. (* sous enfants gérés                                                      *)
  244. let pop_from_right (minE, minA, remain) origin = function
  245.     | Noeud1((x), Noeud1((a), e, f), b) ->
  246.             Noeud1((minE), Noeud2((a, x), e, f, minA), remain)
  247.     | Noeud2(_, _, _, _) as t ->
  248.             (match origin, t with
  249.                 | 2, Noeud2((x, y), Noeud1((a), e, f), b, c) ->
  250.                         Noeud2((minE, y), Noeud2((a, x), e, f, minA), remain, c)
  251.                
  252.                 | 3, Noeud2((x, y), a, Noeud1((b), e, f), c) ->
  253.                         Noeud2((x, minE), a, Noeud2((b, y), e, f, minA), remain)
  254.                 | _, _ -> failwith "error pop_from_right1")
  255.     | Noeud3(_, _, _, _, _) as t ->
  256.             (match origin, t with
  257.                 | 2, Noeud3((x, y, z), Noeud1((a), e, f), b, c, d) ->
  258.                         Noeud3((minE, y, z), Noeud2((a, x), e, f, minA), remain, c, d)
  259.                
  260.                 | 3, Noeud3((x, y, z), a, Noeud1((b), e, f), c, d) ->
  261.                         Noeud3((x, minE, z), a, Noeud2((b, y), e, f, minA), remain, d)
  262.                
  263.                 | 4, Noeud3((x, y, z), a, b, Noeud1((c), e, f), d) ->
  264.                         Noeud3((x, y, minE), a, b, Noeud2((c, z), e, f, minA), remain)
  265.                 | _, _ -> failwith "pop_from_right2")
  266.     | _ -> failwith "pop_from_right3";;
  267.  
  268. (* Retourne le nombre d'enfant d'un arbre *)
  269. let nbChild = function
  270.     | Vide234 -> 0
  271.     | Noeud1(_, _, _) -> 2
  272.     | Noeud2(_, _, _, _) -> 3
  273.     | Noeud3(_, _, _, _, _) -> 4;;
  274.  
  275. (* Retourne le nombre d'élément d'un arbre *)
  276. let nbElem a = (nbChild a) - 1;;
  277.  
  278. (* Retourne si un frère à plus d'un élément existe, et sa position *)
  279. let closest_brother source tree =
  280.     let rec aux source add =
  281.         let iright = source + add and ileft = source - add in
  282.         if iright <= (nbChild tree) && (nbElem (get_subtree iright tree)) > 1 then
  283.             (true, iright)
  284.         else if ileft >= 1 && (nbElem (get_subtree ileft tree)) > 1 then
  285.             (true, ileft)
  286.         else
  287.         if (iright +1 > (nbChild tree) && (ileft +1) < 1) then
  288.             (false, 0)
  289.         else
  290.             aux source (add +1)
  291.     in
  292.     aux source 1;;
  293.  
  294. let setup_dir2 dir t =
  295.     match (get_subtree dir t) with
  296.     | Noeud1(_, _, _) ->
  297.             let (found, i_brother) = closest_brother dir t in
  298.             (* Au mois un sous arbre n'est pas Noeud1 *)
  299.             if found then
  300.                 let rec aux i_brother last_t =
  301.                     if i_brother = dir then
  302.                         (dir, last_t)
  303.                     else
  304.                     if i_brother < dir then
  305.                        
  306.                         let maxs = get_max (get_subtree i_brother last_t) in
  307.                         let new_t = (pop_from_left maxs i_brother last_t) in
  308.                         aux (i_brother + 1) new_t
  309.                     else
  310.                         let mins = get_min (get_subtree i_brother last_t) in
  311.                         let new_t = (pop_from_right mins i_brother last_t) in
  312.                         aux (i_brother -1) new_t
  313.                 in aux i_brother t
  314.             else
  315.                 (* Cas des enfants Noeud1 *)
  316.                 (match t with
  317.                     | Noeud2((e1, e2), Noeud1((e3), a, b), Noeud1((e4), c, d), Noeud1((e5), e, f)) ->
  318.                             (match dir with
  319.                                 | 1 | 2 -> (1, Noeud1((e2), Noeud3((e3, e1, e4), a, b, c, d), Noeud1((e5), e, f)))
  320.                                 (* 2, 3 *)
  321.                                 | _ -> (2, Noeud1((e1), Noeud1((e3), a, b), Noeud3((e4, e2, e5), c, d, e, f)))
  322.                             )
  323.                     | Noeud3((e1, e2, e3), Noeud1((e4), a, b), Noeud1((e5), c, d), Noeud1((e6), e, f), Noeud1((e7), g, h)) ->
  324.                             (match dir with
  325.                                 | 1 -> (1, Noeud2((e2, e3), Noeud3((e4, e1, e5), a, b, c, d), Noeud1((e6), e, f), Noeud1((e7), g, h)))
  326.                                 | 4 -> (3, Noeud2((e1, e2), Noeud1((e4), a, b), Noeud1((e5), c, d), Noeud3((e6, e3, e7), e, f, g, h)))
  327.                                 (* 2, 3 *)
  328.                                 | _ -> (2, Noeud2((e1, e3), Noeud1((e4), a, b), Noeud3((e5, e2, e6), c, d, e, f), Noeud1((e7), g, h))))
  329.                     | _ -> failwith "error setup_dir"
  330.                 )
  331.     | _ -> (dir, t);;
  332.  
  333. (* Prépare une direction à la fonction de suppression -> Fait en sorte que *)
  334. (* la racine de la direction est + d'un élément                            *)
  335. let setup_dir dir t =
  336.     match (get_subtree dir t) with
  337.     | Noeud1(_, _, _) ->
  338.             let (found, i_brother) = closest_brother dir t in
  339.             (* Au mois un sous arbre n'est pas Noeud1 *)
  340.             if found then
  341.                 let rec aux i_brother last_t =
  342.                     if i_brother = dir then
  343.                         (dir, last_t)
  344.                     else
  345.                     if i_brother < dir then
  346.                        
  347.                         let maxs = get_max (get_subtree i_brother last_t) in
  348.                         let new_t = (pop_from_left maxs i_brother last_t) in
  349.                         aux (i_brother + 1) new_t
  350.                     else
  351.                         let mins = get_min (get_subtree i_brother last_t) in
  352.                         let new_t = (pop_from_right mins i_brother last_t) in
  353.                         aux (i_brother -1) new_t
  354.                 in aux i_brother t
  355.             else
  356.                 (* Cas des enfants Noeud1 *)
  357.                 (match t with
  358.                     | Noeud2((e1, e2), Noeud1((e3), a, b), Noeud1((e4), c, d), Noeud1((e5), e, f)) ->
  359.                             (match dir with
  360.                                 | 1 -> (1, Noeud1((e2), Noeud3((e3, e1, e4), a, b, c, d), Noeud1((e5), e, f)))
  361.                                 (* 2, 3 *)
  362.                                 | _ -> (2, Noeud1((e1), Noeud1((e3), a, b), Noeud3((e4, e2, e5), c, d, e, f)))
  363.                             )
  364.                     | Noeud3((e1, e2, e3), Noeud1((e4), a, b), Noeud1((e5), c, d), Noeud1((e6), e, f), Noeud1((e7), g, h)) ->
  365.                             (match dir with
  366.                                 | 1 ->  (1, Noeud2((e2, e3), Noeud3((e4, e1, e5), a, b, c, d), Noeud1((e6), e, f), Noeud1((e7), g, h)))
  367.                                 | 4 ->  (3, Noeud2((e1, e2), Noeud1((e4), a, b), Noeud1((e5), c, d), Noeud3((e6, e3, e7), e, f, g, h)))
  368.                                 (* 2, 3 *)
  369.                                 | _ ->  (2, Noeud2((e1, e3), Noeud1((e4), a, b), Noeud3((e5, e2, e6), c, d, e, f), Noeud1((e7), g, h))))
  370.                     | _ ->  failwith "error setup_dir"
  371.                 )
  372.     | _ -> (dir, t);;
  373.  
  374.  
  375.  
  376.  
  377. (* Récupère le minimum de l'arbre t, tout en raffinant pour garder l'arbre *)
  378. (* parfait                                                                 *)
  379. let rec find_min t =
  380.     let pop_min = function
  381.         | Noeud2((x, y), Vide234, Vide234, Vide234) -> (x, Noeud1((y), Vide234, Vide234))
  382.         | Noeud3((x, y, z), Vide234, Vide234, Vide234, Vide234) -> (x, Noeud2((y, z), Vide234, Vide234, Vide234))
  383.         | _ -> failwith "error find_min" in
  384.     let left_tree = get_subtree 1 t in
  385.     if (is_vide left_tree) then
  386.         let (min, new_current) = (pop_min t) in
  387.         (min, new_current)
  388.     else
  389.         (* new_dir inutile *)
  390.         let (new_dir, new_racine) = (setup_dir 1 t) in
  391.         let (min, new_left) = find_min (get_subtree 1 new_racine) in
  392.         (min, (set_subtree 1 new_left new_racine));;
  393.  
  394. let rec find_max t =
  395.     let pop_max = function
  396.         | Noeud2((x, y), Vide234, Vide234, Vide234) -> (y, Noeud1((x), Vide234, Vide234))
  397.         | Noeud3((x, y, z), Vide234, Vide234, Vide234, Vide234) -> (z, Noeud2((x, y), Vide234, Vide234, Vide234))
  398.         | _ -> failwith "error find_max" in
  399.     let right_tree = get_subtree (nbChild t) t in
  400.     if (is_vide right_tree) then
  401.         let (max, new_current) = (pop_max t) in
  402.         (max, new_current)
  403.     else
  404.         (* new_dir inutile *)
  405.         let (new_dir, new_racine) = (setup_dir (nbChild t) t) in
  406.         let (max, new_left) = find_max (get_subtree (nbChild new_racine) new_racine) in
  407.         (max, (set_subtree (nbChild new_racine) new_left new_racine));;
  408.  
  409. let rec setup_root dir t =
  410.     match dir, t with
  411.     | _, Noeud1((e1), Noeud1((e2), a1, a2), Noeud1((e3), a3, a4)) ->
  412.             Noeud3((e2, e1, e3), a1, a2, a3, a4)
  413.     | 0, Noeud1(_, Vide234, Vide234) -> Vide234
  414.     | 0, Noeud1((e1), Noeud2((e2, e3), a1, a2, a3), Noeud1((e4), a4, a5)) -> Noeud1((e3), Noeud1((e2), a1, a2), Noeud2((e1, e4), a3, a4, a5))
  415.     | 0, Noeud1(_, a, b) -> t
  416.     | _, Noeud1((e1), a, b) ->
  417.             let (new_dir, new_root ) = setup_dir dir t in new_root
  418.     | _, _ -> t
  419. ;;
  420.  
  421.  
  422. let noeud2_eq_x t =
  423.     match t with
  424.     | Noeud2((e1,e2), a1, (Noeud2(_,_,_,_) | Noeud3(_,_,_,_,_) as a2), a3) ->
  425.         let (min, new_sub) = find_min a2 in Noeud2((min, e2),a1 , new_sub,a3)
  426.     |Noeud2((e1,e2),(Noeud2(_,_,_,_) | Noeud3(_,_,_,_,_) as a1), (Noeud1(_,_,_) as a2), (Noeud1(_,_,_) as a3)) ->
  427.         let (max, new_sub) = find_max a1 in Noeud2((max, e2), new_sub, a2, a3)
  428.     |Noeud2((e1,e2),(Noeud1(_,_,_)), (Noeud1(_,_,_)), (Noeud2(_,_,_,_) | Noeud3(_,_,_,_,_))) ->
  429.         let (new_dir, new_t) = setup_dir 2 t in
  430.             let ou_chercher_min = (get_subtree new_dir new_t) in
  431.                     let (min, new_sub) = (find_min ou_chercher_min ) in
  432.                             Noeud2((min,(get_element_at_i 2 new_t)), (get_subtree 1 new_t), new_sub, (get_subtree 3 new_t))
  433.     | Noeud2((e1,e2),(Noeud2(_,_,_,_) | Noeud3(_,_,_,_,_)), (Noeud1(_,_,_)), (Noeud2(_,_,_,_) | Noeud3(_,_,_,_,_))) ->
  434.         let (new_dir, new_t) = setup_dir 1 t in
  435.             let ou_chercher_max = (get_subtree new_dir new_t) in
  436.                     let (max, new_sub) = (find_max ou_chercher_max ) in
  437.                             Noeud2((max,(get_element_at_i 2 new_t)), new_sub, (get_subtree 2 new_t), (get_subtree 3 new_t))
  438.     |_ ->failwith "error noeud2_eq_x";;
  439.    
  440.        
  441.  
  442. let noeud2_eq_y t=
  443.     match t with
  444.     | Noeud2((e1,e2), a1, a2, (Noeud2(_,_,_,_) as a3)) ->
  445.         let (min, new_sub) = find_min a3 in Noeud2((e1, min), a1, a2,new_sub)
  446.     | Noeud2((e1,e2), a1, a2, _) ->
  447.         let (new_dir, new_t) = setup_dir 2 t in
  448.             let ou_chercher_min = (get_subtree new_dir new_t) in
  449.                             let (min, new_sub) = (find_min ou_chercher_min ) in
  450.                             Noeud2(((get_element_at_i 1 new_t), min), (get_subtree 1 new_t), new_sub, (get_subtree 3 new_t))
  451.     | _ -> failwith "noeud2_eq_y";;
  452.  
  453. let noeud3_eq_x t =
  454.     match t with
  455.     | Noeud3((e1,e2,e3), (Noeud2(_,_,_,_) | Noeud3(_,_,_,_,_) as a1), a2,a3, a4) ->
  456.                     let (max, new_sub) = find_max a1 in Noeud3((max, e2, e3), new_sub, a2,a3,a4)
  457.     | Noeud3((e1,e2,e3), a1, a2, a3, a4) ->
  458.         let (new_dir, new_t) = setup_dir 2 t in
  459.             let ou_chercher_min = (get_subtree new_dir new_t) in
  460.                             let (min, new_sub) = (find_min ou_chercher_min ) in
  461.                             Noeud3((min,(get_element_at_i 2 new_t), (get_element_at_i 3 new_t)), (get_subtree 1 new_t), new_sub, (get_subtree 3 new_t), (get_subtree 4 new_t) )
  462.     | _ -> failwith "error noeud3_eq_x";;
  463.  
  464.  
  465. let noeud3_eq_y t =
  466.     match t with
  467.     | Noeud3((e1,e2,e3), a1, a2, (Noeud2(_,_,_,_) | Noeud3(_,_,_,_,_) as a3), a4) ->
  468.                 let (min, new_sub) = find_min a3 in Noeud3((e1, min, e3), a1, a2,new_sub,a4)
  469.                
  470.     |Noeud3((e1,e2,e3), Noeud1(_,_,_), Noeud1(_,_,_), Noeud1(_,_,_) ,(Noeud2(_,_,_,_) | Noeud3(_,_,_,_,_))) ->
  471.                 let (new_dir, new_t) = setup_dir 3 t in
  472.                     let ou_chercher_min = (get_subtree new_dir new_t) in
  473.                             let (min, new_sub) = (find_min ou_chercher_min ) in
  474.                             Noeud3(((get_element_at_i 1 new_t), min, (get_element_at_i 3 new_t)), (get_subtree 1 new_t),  (get_subtree 2 new_t), new_sub, (get_subtree 4 new_t) )
  475.  
  476.     | Noeud3((e1,e2,e3),(Noeud2(_,_,_,_) | Noeud3(_,_,_,_,_)), (Noeud2(_,_,_,_) | Noeud3(_,_,_,_,_)), Noeud1(_,_,_),( Noeud1(_,_,_))) ->
  477.         let (new_dir, new_t) = setup_dir 2 t in
  478.             let ou_chercher_max = (get_subtree new_dir new_t) in
  479.                             let (max, new_sub) = (find_max ou_chercher_max ) in
  480.                             Noeud3(((get_element_at_i 1 new_t), max, (get_element_at_i 3 new_t)), (get_subtree 1 new_t), new_sub,  (get_subtree 3 new_t), (get_subtree 4 new_t))
  481.    
  482.     | Noeud3((e1,e2,e3),(Noeud2(_,_,_,_) | Noeud3(_,_,_,_,_)),  Noeud1(_,_,_), Noeud1(_,_,_), (Noeud1(_,_,_))) ->
  483.             let (new_dir, new_t) = setup_dir 2 t in
  484.             let ou_chercher_max = (get_subtree new_dir new_t) in
  485.                             let (max, new_sub) = (find_max ou_chercher_max ) in
  486.                             Noeud3(((get_element_at_i 1 new_t), max, (get_element_at_i 3 new_t)), (get_subtree 1 new_t), new_sub,  (get_subtree 3 new_t), (get_subtree 4 new_t))
  487.    
  488.     | Noeud3((e1,e2,e3), Noeud1(_,_,_), (Noeud2(_,_,_,_) | Noeud3(_,_,_,_,_)), Noeud1(_,_,_), (Noeud1(_,_,_))) ->
  489.             let (new_dir, new_t) = setup_dir 2 t in
  490.             let ou_chercher_max = (get_subtree new_dir new_t) in
  491.                             let (max, new_sub) = (find_max ou_chercher_max ) in
  492.                             Noeud3(((get_element_at_i 1 new_t), max, (get_element_at_i 3 new_t)), (get_subtree 1 new_t), new_sub,  (get_subtree 3 new_t), (get_subtree 4 new_t))
  493.  
  494.         | Noeud3((e1,e2,e3), (Noeud2(_,_,_,_) | Noeud3(_,_,_,_,_)), Noeud1(_,_,_), Noeud1(_,_,_), (Noeud2(_,_,_,_) | Noeud3(_,_,_,_,_))) ->
  495.                          let (new_dir, new_t) = setup_dir 3 t in
  496.                     let ou_chercher_min = (get_subtree new_dir new_t) in
  497.                             let (min, new_sub) = (find_min ou_chercher_min ) in
  498.                             Noeud3(((get_element_at_i 1 new_t), min, (get_element_at_i 3 new_t)), (get_subtree 1 new_t),  (get_subtree 2 new_t), new_sub, (get_subtree 4 new_t) )
  499.    
  500.     |   Noeud3((e1,e2,e3), (Noeud2(_,_,_,_) | Noeud3(_,_,_,_,_)), (Noeud2(_,_,_,_) | Noeud3(_,_,_,_,_)), Noeud1(_,_,_), (Noeud2(_,_,_,_) | Noeud3(_,_,_,_,_))) ->
  501.             let (new_dir, new_t) = setup_dir 3 t in
  502.                     let ou_chercher_min = (get_subtree new_dir new_t) in
  503.                             let (min, new_sub) = (find_min ou_chercher_min ) in
  504.                             Noeud3(((get_element_at_i 1 new_t), min, (get_element_at_i 3 new_t)), (get_subtree 1 new_t),  (get_subtree 2 new_t), new_sub, (get_subtree 4 new_t) )
  505.    
  506.     | Noeud3((e1,e2,e3), Noeud1(_,_,_),(Noeud2(_,_,_,_) | Noeud3(_,_,_,_,_)), Noeud1(_,_,_), (Noeud2(_,_,_,_) | Noeud3(_,_,_,_,_))) ->
  507.          let (new_dir, new_t) = setup_dir 3 t in
  508.                     let ou_chercher_min = (get_subtree new_dir new_t) in
  509.                             let (min, new_sub) = (find_min ou_chercher_min ) in
  510.                             Noeud3(((get_element_at_i 1 new_t), min, (get_element_at_i 3 new_t)), (get_subtree 1 new_t),  (get_subtree 2 new_t), new_sub, (get_subtree 4 new_t) )
  511.     | _ -> failwith "noeud3_eq_y t";;
  512.  
  513. let noeud3_eq_z t =
  514.     match t with
  515.     | Noeud3((e1,e2,e3), a1, a2,a3, (Noeud2(_,_,_,_) | Noeud3(_,_,_,_,_) as a4)) ->
  516.                     let (min, new_sub) = find_min a4 in Noeud3((e2, e3, min), a1, a2,a3,new_sub)
  517.     | Noeud3((e1,e2,e3), a1, a2, a3, a4) ->
  518.         let (new_dir, new_t) = setup_dir 3 t in
  519.             let ou_chercher_max = (get_subtree new_dir new_t) in
  520.                             let (max, new_sub) = (find_max ou_chercher_max ) in
  521.                             Noeud3(((get_element_at_i 1 new_t), (get_element_at_i 2 new_t), max), (get_subtree 1 new_t),  (get_subtree 2 new_t), (get_subtree 3 new_t), new_sub)
  522.     | _ -> failwith "error noeud3_eq_z";;
  523.        
  524.                        
  525. let keep_setup dir t =
  526.     let (new_dir, new_t) = (setup_dir dir t) in
  527.     let new_sub = get_subtree new_dir new_t in
  528.     new_sub, new_t
  529. ;;
  530.  
  531. let is_noeud1 = function
  532.     | Noeud1(_, _, _) -> true
  533.     | _ -> false;;
  534.  
  535. (* Applique la suppression avec les fonctions précédentes + les cas        *)
  536. (* particuliés sur la racine                                               *)
  537. let remove e t =
  538.     if (not (is_present e t)) then
  539.         t
  540.     else
  541.         let rec aux e t =
  542.            
  543.             if is_vide t then
  544.                 Vide234
  545.             else
  546.                 let dir = (get_direction e t) in
  547.                 if dir = 0 then
  548.                    
  549.                     match t with
  550.                     | Noeud2((x, y), Vide234, Vide234, Vide234) when x = e -> Noeud1((y), Vide234, Vide234)
  551.                     | Noeud2((x, y), Vide234, Vide234, Vide234) when y = e -> Noeud1((x), Vide234, Vide234)
  552.                     | Noeud3((x, y, z), Vide234, Vide234, Vide234, Vide234) when x = e -> Noeud2((y, z), Vide234, Vide234, Vide234)
  553.                     | Noeud3((x, y, z), Vide234, Vide234, Vide234, Vide234) when y = e -> Noeud2((x, z), Vide234, Vide234, Vide234)
  554.                     | Noeud3((x, y, z), Vide234, Vide234, Vide234, Vide234) when z = e -> Noeud2((x, y), Vide234, Vide234, Vide234)
  555.                    
  556.                     (* Subsitituer par le plus petit supérieur *)
  557.                    
  558.                     (* Cas racine uniquement *)
  559.                     | Noeud1((x), a, b) ->
  560.                             let (min, new_sub) = (find_min (get_subtree 2 (setup_root dir t))) in Noeud1((min), a, new_sub )
  561.                    
  562.                     | Noeud2((x, y), a, b, c) when (is_noeud1 a) && (is_noeud1 b) && (is_noeud1 c) && eq x e ->
  563.                             let (new_dir, new_t) = setup_dir 2 t in
  564.                             let (min, new_sub) = (find_min (get_subtree new_dir new_t)) in
  565.                             Noeud1((min), (get_subtree 1 new_t), new_sub)
  566.                    
  567.                     | Noeud2((x, y), a, b, c) when (is_noeud1 a) && (is_noeud1 b) && (is_noeud1 c) && eq y e ->
  568.                             let (new_dir, new_t) = setup_dir2 2 t in
  569.                             let (max, new_sub) = (find_max (get_subtree new_dir new_t)) in
  570.                             Noeud1((max), new_sub, (get_subtree 2 new_t))
  571.                    
  572.                     | Noeud3((x, y, z), a, b, c, d) when (is_noeud1 a) && (is_noeud1 b) && (is_noeud1 c) && (is_noeud1 d) && eq x e ->
  573.                             let (new_dir, new_t) = setup_dir 2 t in
  574.                             let (min, new_sub) = (find_min (get_subtree new_dir new_t)) in
  575.                             Noeud2((min, z), (get_subtree 1 new_t), new_sub, (get_subtree 3 new_t))
  576.                    
  577.                     | Noeud3((x, y, z), a, b, c, d) when (is_noeud1 a) && (is_noeud1 b) && (is_noeud1 c) && (is_noeud1 d) && eq y e ->
  578.                             let (new_dir, new_t) = setup_dir 4 t in
  579.                             let (min, new_sub) = (find_min (get_subtree new_dir new_t)) in
  580.                             Noeud2((x, min), (get_subtree 1 new_t), (get_subtree 3 new_t), new_sub)
  581.                    
  582.                     | Noeud3((x, y, z), a, b, c, d) when (is_noeud1 a) && (is_noeud1 b) && (is_noeud1 c) && (is_noeud1 d) && eq z e ->
  583.                             let (new_dir, new_t) = setup_dir 1 t in
  584.                             let (min, new_sub) = (find_min (get_subtree new_dir new_t)) in
  585.                             Noeud2((x, min), new_sub, (get_subtree 2 new_t), (get_subtree 3 new_t))
  586.                    
  587.                     | Noeud2((x, y), a, b, c) when eq x e -> noeud2_eq_x t
  588.                     | Noeud2((x, y), a, b, c) when eq y e -> noeud2_eq_y t
  589.                    
  590.                     | Noeud3((x, y, z), a, b, c, d) when eq x e -> noeud3_eq_x t
  591.                     | Noeud3((x, y, z), a, b, c, d) when eq y e -> noeud3_eq_y t
  592.                     | Noeud3((x, y, z), a, b, c, d) when eq z e -> noeud3_eq_z t
  593.                     | _ -> failwith "error remove"
  594.                
  595.                 else
  596.                     let (new_dir, new_racine) = (setup_dir dir t) in
  597.                     let new_subtree = (aux e (get_subtree new_dir new_racine)) in
  598.                     (set_subtree new_dir new_subtree new_racine)
  599.         in aux e (setup_root (get_direction e t) t)
  600. ;;
  601.  
  602. let b = Noeud1 (100,
  603.         Noeud3((30,50,70),
  604.             Noeud2((20,25),
  605.                 Noeud1 (5, Vide234, Vide234),
  606.                 Noeud1 (22, Vide234, Vide234),
  607.                 Noeud1 (26, Vide234, Vide234)),
  608.             Noeud1((33),
  609.                 Noeud1(31, Vide234, Vide234),
  610.                 Noeud1(37, Vide234, Vide234)),
  611.             Noeud1((55),
  612.                 Noeud1 (51, Vide234, Vide234),
  613.                 Noeud1 (66, Vide234, Vide234)),
  614.             Noeud2((80,85),
  615.                 Noeud1(75, Vide234, Vide234),
  616.                 Noeud1(83 ,Vide234, Vide234),
  617.                 Noeud1(86, Vide234, Vide234))),
  618.         Noeud2 ((150, 200),
  619.             Noeud1 (110, Noeud1 (105, Vide234, Vide234), Noeud1 (115, Vide234, Vide234)),
  620.             Noeud2 ((160,190),
  621.                 Noeud1 (155, Vide234, Vide234),
  622.                 Noeud1 (170, Vide234, Vide234),
  623.                 Noeud1 (195, Vide234, Vide234)),
  624.             Noeud1 (250, Noeud1 (230, Vide234, Vide234),
  625.                 Noeud1 (260, Vide234, Vide234))));;
  626.  
  627.  
  628.  
  629.  
  630.  
  631. let test2 =
  632.     let rec aux t i =
  633.         let ii = (Random.int 100000) in
  634.         if i > 100000 then
  635.             t
  636.         else
  637.             aux (a234_insert ii t) (i +1)
  638.     in aux Vide234 0;;
  639.  
  640.  
  641. let test_supr =
  642.     let rec aux t i =
  643.         let ii = (Random.int 100000) in
  644.         if i > 100000 then
  645.             t
  646.         else
  647.             (aux (remove ii t) (i +1))
  648.     in aux test2 0;;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!