type 'a avl = Empty | Node of int * 'a avl * 'a * 'a avl
                            
let depth tree = 
    match tree with
        Node (d, _, _, _) -> d
      | Empty -> 0

let value tree = 
    match tree with
        Node (_, _, x, _) -> x
      | Empty -> failwith "Impossible"
                   

 let balanceLL node = 
    match node with 
        (Node (d, Node (lmax, ll, xl, rl), x, r)) ->
          let rmax = max (depth rl) (depth r) + 1 
          in let cmax = max rmax (depth ll) + 1
          in Node (cmax, ll, xl, Node (rmax, rl, x, r))
      | _ -> failwith "Impossible"

  let balanceLR node =
    match node with 
        (Node (d, Node (dl, ll, y, Node (dlr, lrl, z, lrr)), x, r)) -> 
          let lmax = max (depth ll) (depth lrl) + 1
          in let rmax = max (depth lrr) (depth r) + 1
          in let cmax = max lmax rmax + 1
          in Node (cmax, Node (lmax, ll, y, lrl), z, Node (rmax, lrr, x, r))
      | _ -> failwith "Impossible"

  let balanceRR node = match node with
      (Node (d, l, x, Node (dr, lr, xr, rr))) ->
        let lmax = max (depth l) (depth lr) + 1
        in let cmax = max lmax (depth rr) + 1
        in Node (cmax, Node (lmax, l, x, lr), xr, rr)
    | _ -> failwith "Impossible"

  let balanceRL node =
    match node with 
        (Node (d, l, x, Node (dr, Node (drl, rll, z, rlr), y, rr))) ->
          let lmax = max (depth l) (depth rll) + 1
          in let rmax = max (depth rlr) (depth rr) + 1
          in let cmax = max lmax rmax + 1
          in Node (cmax, Node (lmax, l, x, rll), z, Node (rmax, rlr, y, rr)) 
    | _ -> failwith "Impossible"
             
(* alínea 9 *)


let rec min tree = 
    match tree with
        Node (_, Empty, x, _) -> x
      | Node (_, l, _, _) -> min l
      | Empty -> failwith "Impossible"
  
  let left tree = 
    match tree with
        Node (_, l, _, _) -> l
      | Empty -> failwith "Impossible"  

  let rigth tree =
    match tree with
        Node (_, _, _, r) -> r
      | Empty -> failwith "Impossible"

  let rec delete comp e t = 
    match t with
        Node (_, l, x, r) ->
          (match comp e x with
               0 -> 
                 (match (l, r) with
                      (Empty, Empty) -> Empty
                    | (Empty, _) -> r
                    | (_, Empty) -> l
                    | (_, _) -> 
                        let m = min r
                        in let del = delete comp m r
                        in let bal = depth l - depth del
                        in if bal < 2
                          then Node ((max (depth l) (depth del)) + 1, l, m, del)
                          else 
                            let balL = depth (left l) - depth (rigth l)
                            in if balL > 0
                              then balanceLL (Node (((max (depth l) (depth del)) + 1, l, m, del)))
                              else balanceLR (Node (((max (depth l) (depth del)) + 1, l, m, del))))
             | -1 ->  
                 let delL = delete comp e l
                 in let dl = depth delL
                 in let dr = depth r
                 in let bal = dl - dr
                 in
                   if abs bal < 2
                   then Node ((max dl dr) + 1, delL, x, r)
                   else 
                     let balR = depth (left r) - depth (rigth r)
                     in if balR < 0
                       then balanceRR (Node ((max dl dr) + 1, delL, x, r))
                       else balanceRL (Node ((max dl dr) + 1, delL, x, r))
             | _ ->
                 let delR = delete comp e r
                 in let dl = depth l
                 in let dr = depth delR
                 in let bal = dl - dr
                 in
                   if abs bal < 2
                   then Node ((max dl dr) + 1, l, x, delR)
                   else
                     let balL = depth (left l) - depth (rigth l)
                     in if balL > 0
                       then balanceLL (Node ((max dl dr) + 1, l, x, delR))
                       else balanceLR (Node ((max dl dr) + 1, l, x, delR)))
    | Empty -> Empty

This document was generated using caml2html