arboles/arbol_bin.pas

   1 unit arbol_bin;\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 tda_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 : Tipo_Elem;\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: Tipo_Elem);\r
  33 PROCEDURE AB_modif_cte( VAR a: AB_arbol; e: Tipo_Elem);\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: Tipo_Elem; 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: Tipo_Elem);\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: Tipo_Elem);\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 )\r
  73                 THEN\r
  74                         ret := p;\r
  75                 IF ( ret = NIL ) AND ( p^.Izquierda <> NIL )\r
  76                 THEN\r
  77                         ret := buscar_padre ( p^.Izquierda, h );\r
  78                 IF ( ret = NIL ) AND ( p^.Derecha <> NIL )\r
  79                 THEN\r
  80                         ret := buscar_padre ( p^.Derecha, h );\r
  81                 buscar_padre := ret;\r
  82         END;\r
  83 BEGIN\r
  84         error := FALSE;\r
  85         CASE m OF\r
  86                 AB_raiz:\r
  87                         A.Corriente := a.Raiz;\r
  88                 AB_izquierda:\r
  89                         IF a.Corriente^.Izquierda = NIL\r
  90                         THEN\r
  91                                 error := TRUE\r
  92                         ELSE\r
  93                                 a.Corriente := A.Corriente^.Izquierda;\r
  94                 AB_derecha:\r
  95                         IF A.Corriente^.Derecha = NIL\r
  96                         THEN\r
  97                                 error := TRUE\r
  98                         ELSE\r
  99                                 a.Corriente := A.Corriente^.Derecha;\r
 100                 AB_padre:\r
 101                         IF a.Corriente = A.Raiz\r
 102                         THEN\r
 103                                 error := TRUE\r
 104                         ELSE\r
 105                                 a.Corriente := buscar_padre( a.Raiz, a.Corriente );\r
 106                 END;\r
 107 END;\r
 108 \r
 109 PROCEDURE AB_borrar_sub( VAR a: AB_arbol; m: AB_movimiento );\r
 110         PROCEDURE liberar_subarbol( VAR p : AB_puntero );\r
 111   BEGIN\r
 112                 IF p <> NIL\r
 113                 THEN BEGIN\r
 114                         liberar_subarbol( p^.Izquierda );\r
 115                         liberar_subarbol( p^.Izquierda );\r
 116                         DISPOSE ( p );\r
 117                         p := NIL;\r
 118                 END;\r
 119   END;\r
 120 BEGIN\r
 121         CASE m OF\r
 122                 AB_izquierda:\r
 123                         liberar_subarbol( a.Corriente^.Izquierda );\r
 124                 AB_derecha:\r
 125                         liberar_subarbol( a.Corriente^.Derecha );\r
 126                 END;\r
 127 END;\r
 128 \r
 129 PROCEDURE AB_insertar( VAR a: AB_arbol; m: AB_movimiento; e: Tipo_Elem; VAR error: BOOLEAN );\r
 130 VAR\r
 131         p : AB_puntero;\r
 132 BEGIN\r
 133         error := FALSE;\r
 134         NEW( p );\r
 135         p^.Izquierda := NIL;\r
 136         p^.Derecha := NIL;\r
 137         p^.Elem := e;\r
 138         CASE m OF\r
 139                 AB_raiz:\r
 140                         IF a.Raiz = NIL\r
 141                         THEN\r
 142                                 a.Raiz := p\r
 143                         ELSE\r
 144                                 error := TRUE;\r
 145                 AB_izquierda:\r
 146                         IF a.Corriente^.Izquierda = NIL\r
 147                         THEN\r
 148                                 a.Corriente^.Izquierda := p\r
 149                         ELSE\r
 150                                 error := TRUE;\r
 151                 AB_derecha:\r
 152                         IF a.Corriente^.Derecha = NIL\r
 153                         THEN\r
 154                                 a.Corriente^.Derecha := p\r
 155                         ELSE\r
 156                                 error := TRUE;\r
 157                 AB_padre:\r
 158                         error := TRUE\r
 159                 END;\r
 160 \r
 161         IF error = FALSE\r
 162         THEN\r
 163         a.Corriente := p\r
 164         ELSE\r
 165                 dispose( p );\r
 166 \r
 167 END;\r
 168 \r
 169 PROCEDURE AB_vaciar( VAR a: AB_arbol );\r
 170         PROCEDURE liberar_subarbol( VAR p : AB_puntero );\r
 171         BEGIN\r
 172                 IF p <> NIL\r
 173                 THEN BEGIN\r
 174                         liberar_subarbol( p^.Izquierda );\r
 175                         liberar_subarbol( p^.Derecha );\r
 176                         DISPOSE ( p );\r
 177                         p := NIL;\r
 178                 END;\r
 179         END;\r
 180 BEGIN\r
 181         liberar_subarbol( a.Raiz );\r
 182         a.Corriente := NIL;\r
 183 END;\r
 184 \r
 185 PROCEDURE AB_copiar( a : AB_arbol; VAR b : AB_arbol );\r
 186         PROCEDURE copiar_subarbol( o : AB_puntero; VAR d : AB_puntero );\r
 187         BEGIN\r
 188                 IF o <> NIL\r
 189                 THEN BEGIN\r
 190                         { tengo que copiar el nodo y llamar a la copia de los hijos }\r
 191                         { el procedimiento va modificando el d como viene por referencia }\r
 192                         NEW ( d );\r
 193                         d^.Elem := o^.Elem;\r
 194                         d^.Izquierda := NIL;\r
 195                         d^.Derecha := NIL;\r
 196                         copiar_subarbol( o^.Izquierda, d^.Izquierda );\r
 197                         copiar_subarbol( o^.Derecha , d^.Derecha );\r
 198                 END;\r
 199         END;\r
 200 BEGIN\r
 201         { tenemos que vaciar primero el arbol b (destino) }\r
 202         AB_vaciar( b );\r
 203         { ahora copiamos todo el arbol origen }\r
 204         copiar_subarbol( a.Raiz, b.Raiz );\r
 205         a.Corriente := a.Raiz;\r
 206 END;\r
 207 \r
 208 end.