ab.pas

   1 unit AB;\r
   2 \r
   3 {\r
   4    IMPLEMENTACION : ARBOLES BINARIOS\r
   5    ALMACENAMIENTO : PUNTEROS\r
   6 \r
   7 }\r
   8 interface\r
   9 \r
  10 { usa las funciones generales de TDAs }\r
  11 uses GRAL;\r
  12 \r
  13 { tipos propios del arbol binario }\r
  14 type\r
  15    AB_MOVIMIENTO = ( AB_raiz, AB_izquierda, AB_derecha, AB_padre );\r
  16 \r
  17    AB_PUNTERO = ^AB_NODO;\r
  18 \r
  19    AB_NODO = record\r
  20       Elem : T_REGISTRO;\r
  21       Izquierda,\r
  22       Derecha : AB_PUNTERO;\r
  23    end;\r
  24 \r
  25    AB_ARBOL = record\r
  26       Raiz,\r
  27       Corriente: AB_PUNTERO;\r
  28    END;\r
  29 \r
  30 PROCEDURE AB_crear( VAR a: AB_ARBOL );\r
  31 FUNCTION  AB_vacio( a: AB_ARBOL): boolean;\r
  32 PROCEDURE AB_elem_cte( a: AB_ARBOL; VAR e: T_REGISTRO);\r
  33 PROCEDURE AB_modif_cte( VAR a: AB_ARBOL; e: T_REGISTRO);\r
  34 PROCEDURE AB_mover_cte( VAR a: AB_ARBOL; m: AB_MOVIMIENTO; VAR error: boolean );\r
  35 PROCEDURE AB_borrar_sub( VAR a: AB_ARBOL; m: AB_MOVIMIENTO );\r
  36 PROCEDURE AB_insertar( VAR a: AB_ARBOL; m: AB_MOVIMIENTO; e: T_REGISTRO; VAR error: boolean );\r
  37 PROCEDURE AB_vaciar( VAR a: AB_ARBOL );\r
  38 PROCEDURE AB_copiar( a: AB_ARBOL; VAR b: AB_ARBOL );\r
  39 \r
  40 implementation\r
  41 \r
  42 \r
  43 { Estas son los dos procedimientos principales de la aplicación }\r
  44 \r
  45 PROCEDURE AB_crear( VAR a: AB_ARBOL );\r
  46  begin\r
  47    a.Raiz := nil;\r
  48    a.Corriente := nil;\r
  49  end;\r
  50 \r
  51 FUNCTION AB_vacio( a: AB_ARBOL): BOOLEAN;\r
  52  begin\r
  53    AB_vacio := ( a.Raiz = nil);\r
  54  end;\r
  55 \r
  56 PROCEDURE AB_elem_cte( a: AB_ARBOL; VAR e: T_REGISTRO);\r
  57  begin\r
  58    e := a.Corriente^.Elem;\r
  59  end;\r
  60 \r
  61 PROCEDURE AB_modif_cte( VAR a: AB_ARBOL; e: T_REGISTRO);\r
  62  begin\r
  63    a.Corriente^.Elem := e;\r
  64  end;\r
  65 \r
  66 PROCEDURE AB_mover_cte( VAR a: AB_ARBOL; m: AB_MOVIMIENTO; VAR error: BOOLEAN );\r
  67   FUNCTION buscar_padre( p: AB_PUNTERO; h: AB_PUNTERO ) : AB_PUNTERO;\r
  68    var\r
  69       ret : AB_PUNTERO;\r
  70    begin\r
  71       ret := NIL;\r
  72       if ( p^.Izquierda = h ) or ( p^.Derecha = h ) then\r
  73          ret := p;\r
  74       if ( ret = nil ) and ( p^.Izquierda <> nil ) then\r
  75          ret := buscar_padre( p^.Izquierda, h );\r
  76       if ( ret = nil ) and ( p^.Derecha <> nil ) then\r
  77          ret := buscar_padre( p^.Derecha, h );\r
  78       buscar_padre := ret;\r
  79    end;\r
  80  begin\r
  81    error := false;\r
  82    case m of\r
  83       ab_raiz:\r
  84          A.Corriente := a.Raiz;\r
  85       AB_izquierda:\r
  86          if a.Corriente^.Izquierda = nil then\r
  87             error := true\r
  88          else\r
  89             a.Corriente := A.Corriente^.Izquierda;\r
  90       AB_derecha:\r
  91          if a.Corriente^.Derecha = nil then\r
  92             error := true\r
  93          else\r
  94             a.Corriente := A.Corriente^.Derecha;\r
  95       AB_padre:\r
  96          if a.Corriente = A.Raiz then\r
  97             error := true\r
  98          else\r
  99             a.Corriente := buscar_padre( a.Raiz, a.Corriente );\r
 100       end;\r
 101 end;\r
 102 \r
 103 PROCEDURE AB_borrar_sub( VAR a: AB_ARBOL; m: AB_MOVIMIENTO );\r
 104   PROCEDURE liberar_subarbol( VAR p : AB_PUNTERO );\r
 105    begin\r
 106       if p <> nil then begin\r
 107          liberar_subarbol( p^.Izquierda );\r
 108          liberar_subarbol( p^.Derecha );\r
 109          dispose( p );\r
 110          p := nil;\r
 111       end;\r
 112    end;\r
 113  begin\r
 114    case m of\r
 115       AB_izquierda:\r
 116          liberar_subarbol( a.Corriente^.Izquierda );\r
 117       AB_derecha:\r
 118          liberar_subarbol( a.Corriente^.Derecha );\r
 119       end;\r
 120  end;\r
 121 \r
 122 PROCEDURE AB_insertar( VAR a: AB_ARBOL; m: AB_MOVIMIENTO; e: T_REGISTRO; VAR error: BOOLEAN );\r
 123  var\r
 124    p : AB_PUNTERO;\r
 125  begin\r
 126    error := false;\r
 127    new( p );\r
 128    p^.Izquierda := nil;\r
 129    p^.Derecha := nil;\r
 130    p^.Elem := e;\r
 131    case m of\r
 132       AB_raiz:\r
 133          if a.Raiz = nil then\r
 134             a.Raiz := p\r
 135          else\r
 136             error := true;\r
 137       AB_izquierda:\r
 138          if a.Corriente^.Izquierda = nil then\r
 139             a.Corriente^.Izquierda := p\r
 140          else\r
 141             error := true;\r
 142       AB_derecha:\r
 143          if a.Corriente^.Derecha = nil then\r
 144             a.Corriente^.Derecha := p\r
 145          else\r
 146             error := true;\r
 147       AB_padre:\r
 148          error := true\r
 149       end;\r
 150 \r
 151    if error = false then\r
 152    a.Corriente := p\r
 153    else\r
 154       dispose( p );\r
 155 \r
 156 end;\r
 157 \r
 158 PROCEDURE AB_vaciar( VAR a: AB_ARBOL );\r
 159   PROCEDURE liberar_subarbol( VAR p : AB_PUNTERO );\r
 160    begin\r
 161       if p <> nil then begin\r
 162          liberar_subarbol( p^.Izquierda );\r
 163          liberar_subarbol( p^.Derecha );  { ARREGLADO, decía p^.Izquierda }\r
 164          DISPOSE ( p );\r
 165          p := nil;\r
 166       end;\r
 167    end;\r
 168  begin\r
 169    liberar_subarbol( a.Raiz );\r
 170    a.Corriente := nil;\r
 171  end;\r
 172 \r
 173 PROCEDURE AB_copiar( a : AB_ARBOL; VAR b : AB_ARBOL );\r
 174   PROCEDURE copiar_subarbol( o : AB_PUNTERO; VAR d : AB_PUNTERO );\r
 175    begin\r
 176       if o <> nil then begin\r
 177          { tengo que copiar el nodo y llamar a la copia de los hijos }\r
 178          { el procedimiento va modificando el d como viene por referencia }\r
 179          new( d );\r
 180          d^.Elem := o^.Elem;\r
 181          d^.Izquierda := nil;\r
 182          d^.Derecha := nil;\r
 183          copiar_subarbol( o^.Izquierda, d^.Izquierda );\r
 184          copiar_subarbol( o^.Derecha , d^.Derecha );\r
 185       end;\r
 186    end;\r
 187  begin\r
 188    { tenemos que vaciar primero el arbol b (destino) }\r
 189    AB_vaciar( b );\r
 190    { ahora copiamos todo el arbol origen }\r
 191    copiar_subarbol( a.Raiz, b.Raiz );\r
 192    a.Corriente := a.Raiz;\r
 193  end;\r
 194 \r
 195 end.