abo_ab.pas

   1 unit ABO_AB;\r
   2 \r
   3 interface\r
   4 \r
   5  uses\r
   6    AB, GRAL;\r
   7 \r
   8  type\r
   9    ABO_ARBOL = record\r
  10                   arbol: AB_ARBOL;\r
  11                end;\r
  12 \r
  13    ABO_MOVIMIENTO = ( ABO_raiz, ABO_izquierda, ABO_derecha, ABO_padre );\r
  14 \r
  15  { Crea e inicializa el arbol }\r
  16  PROCEDURE ABO_crear( VAR a: ABO_ARBOL );\r
  17  { PRE: Arbol no creado }\r
  18  { POS: Arbol creado y vacio }\r
  19 \r
  20  { Se fija si el arbol esta vacio }\r
  21  FUNCTION  ABO_vacio( a: ABO_ARBOL): BOOLEAN;\r
  22  { PRE: Arbol creado }\r
  23  { POS: Devuelve true si el arbol esta vacio, false si no lo esta }\r
  24 \r
  25  { Devuelve el elemento corriente }\r
  26  PROCEDURE ABO_elem_cte( a: ABO_ARBOL; VAR e: T_REGISTRO);\r
  27  { PRE: Arbol creado y no vacio }\r
  28  { POS: en e esta almacenado el elemento corriente }\r
  29 \r
  30  { Modifica el elemento corriente }\r
  31  PROCEDURE ABO_modif_cte( VAR a: ABO_ARBOL; e: T_REGISTRO; VAR error: boolean );\r
  32  { PRE: Arbol creado y no vacio }\r
  33  { POS: Si la clave del elemento modificado ya estaba en el arbol (sin contar el\r
  34         elemento a modificar), devuelve error = true y no modifica el arbol.\r
  35         Si no estaba en el arbol, error es false y se modifica el elemento corriente }\r
  36 \r
  37  { Moueve el elemento corriente }\r
  38  PROCEDURE ABO_mover_cte( VAR a: ABO_ARBOL; m: ABO_MOVIMIENTO; VAR error: BOOLEAN );\r
  39  { PRE: Arbol creado y no vacio }\r
  40  { POS: ABO_raiz: el corriente es el elemento raiz, error es false }\r
  41  {      ABO_padre: si el corriente es el elemento raiz, error es true y el corriente no cambia }\r
  42  {      ABO_izquierda: si el corriente no tiene un elemento a izquierda, error es true y el corriente no cambia }\r
  43  {                     si el corriente tiene un elemento a izquierda, error es false y el corriente cambia }\r
  44  {      ABO_derecha: si el corriente no tiene un elemento a derecha, error es true y el corriente no cambia }\r
  45  {                   si el corriente tiene un elemento a derecha, error es false y el corriente cambia }\r
  46 \r
  47  { Borra el elemento corriente }\r
  48  PROCEDURE ABO_borrar_cte( VAR a: ABO_ARBOL );\r
  49  { PRE: Arbol creado y no vacio }\r
  50  { POS: el elemento corriente fue borrado y el corriente nuevo es la raiz }\r
  51 \r
  52  { Inserta el elemento e en el arbol }\r
  53  PROCEDURE ABO_insertar( VAR a: ABO_ARBOL; e: T_REGISTRO; VAR error: BOOLEAN );\r
  54  { PRE: Arbol creado }\r
  55  { POS: si la clave del elemento e no estaba en el arbol, el registro e se inserto y error es false,\r
  56         si la clave del elemento estaba en el arbol, el registro no se inserto y error es true }\r
  57 \r
  58  { Vacia el arbol }\r
  59  PROCEDURE ABO_vaciar( VAR a: ABO_ARBOL );\r
  60  { PRE: Arbol creado }\r
  61  { POS: El arbol esta vacio }\r
  62 \r
  63  { Copia el arbol a en el b }\r
  64  PROCEDURE ABO_copiar( a: ABO_ARBOL; VAR b: ABO_ARBOL );\r
  65  { PRE: Arbol a creado y no vacio, arbol b creado }\r
  66  { POS: el arbol b es una copia del arbol a }\r
  67 \r
  68  { Busca el elemento con la clave c en el arbol }\r
  69  PROCEDURE ABO_buscar( var a: ABO_ARBOL; c: T_CLAVE; VAR error: boolean );\r
  70  { PRE: Arbol creado y no vacio }\r
  71  { POS: si habia un elemento con la clave c en el arbol, error es false y el elemento corriente es el de clave c\r
  72         si no habia un elemento con la clave c en el arbol, error es true y el elemento corriente no cambia }\r
  73 \r
  74 \r
  75 implementation\r
  76 {-----------------------------------}\r
  77 { Funciones "privadas" de la unidad }\r
  78 {-----------------------------------}\r
  79 \r
  80 { Convierte un movimiento del ABO a uno del AB, para mantener los tipos abstractos }\r
  81 FUNCTION movABO2AB( m: ABO_MOVIMIENTO ): AB_MOVIMIENTO;\r
  82 \r
  83  begin\r
  84    case ( m ) OF\r
  85      ABO_raiz: begin\r
  86         movABO2AB := AB_raiz;\r
  87         end;\r
  88      ABO_izquierda: begin\r
  89         movABO2AB := AB_izquierda;\r
  90         end;\r
  91      ABO_derecha: begin\r
  92         movABO2AB := AB_derecha;\r
  93         end;\r
  94      ABO_padre: begin\r
  95         movABO2AB := AB_padre;\r
  96         end;\r
  97    end;\r
  98  end;\r
  99 \r
 100 \r
 101 {-----------------------------------}\r
 102 { Funciones "públicas" de la unidad }\r
 103 {-----------------------------------}\r
 104 \r
 105 PROCEDURE ABO_crear( VAR a: ABO_ARBOL );\r
 106 \r
 107  begin\r
 108    AB_crear( a.arbol );\r
 109  end; { Procedimiento o Función }\r
 110 \r
 111 \r
 112  FUNCTION  ABO_vacio( a: ABO_ARBOL ): BOOLEAN;\r
 113 \r
 114  begin\r
 115    ABO_vacio := AB_vacio( a.arbol );\r
 116  end; { Procedimiento o Función }\r
 117 \r
 118 \r
 119 PROCEDURE ABO_elem_cte( a: ABO_ARBOL; VAR e: T_REGISTRO );\r
 120 \r
 121  begin\r
 122    AB_elem_cte( a.arbol, e );\r
 123  end; { Procedimiento o Función }\r
 124 \r
 125 { error es true si se modifica a una clave que ya existia }\r
 126 PROCEDURE ABO_modif_cte( VAR a: ABO_ARBOL; e: T_REGISTRO; VAR error: boolean );\r
 127  var\r
 128    r:  T_REGISTRO;\r
 129    er: boolean;\r
 130 \r
 131  begin\r
 132    ABO_elem_cte( a, r );\r
 133    if ( T_GRAL_Devolver_Clave_Elem( r ) = T_GRAL_Devolver_Clave_Elem( e ) ) then  { si la clave no cambia }\r
 134       AB_modif_cte( a.arbol, e )    { se modifica con la primitiva de AB }\r
 135    else begin                       { Si la clave cambia ...    }\r
 136       ABO_borrar_cte( a );          { Borra el corriente        }\r
 137       ABO_insertar( a, e, error );  { Inserta el nuevo elemento }\r
 138       end;\r
 139  end; { Procedimiento o Función }\r
 140 \r
 141 \r
 142 PROCEDURE ABO_mover_cte( VAR a: ABO_ARBOL; m: ABO_MOVIMIENTO; VAR error: BOOLEAN );\r
 143 \r
 144  begin\r
 145    AB_mover_cte( a.arbol, movABO2AB( m ), error );\r
 146  end; { Procedimiento o Función }\r
 147 \r
 148 \r
 149 PROCEDURE ABO_borrar_cte( VAR a: ABO_ARBOL );\r
 150   PROCEDURE insertar_rama_de_ABO_a_ABO( VAR origen: ABO_ARBOL; VAR destino: ABO_ARBOL );\r
 151    var\r
 152       r:  T_REGISTRO;\r
 153       er: boolean;\r
 154    begin\r
 155       ABO_elem_cte( origen, r );\r
 156       ABO_insertar( destino, r, er ); { No debe haber error porque no hay ninguno repetido }\r
 157       ABO_mover_cte( origen, ABO_izquierda, er );\r
 158       if ( not er ) then begin\r
 159          insertar_rama_de_ABO_a_ABO( origen, destino );\r
 160          ABO_mover_cte( origen, ABO_padre, er );\r
 161          end;\r
 162       ABO_mover_cte( origen, ABO_derecha, er );\r
 163       if ( not er ) then begin\r
 164          insertar_rama_de_ABO_a_ABO( origen, destino );\r
 165          ABO_mover_cte( origen, ABO_padre, er );\r
 166          end;\r
 167    end;\r
 168 \r
 169  var\r
 170    abo: ABO_ARBOL;\r
 171    er:  boolean;\r
 172    ro,\r
 173    rn:  T_REGISTRO;\r
 174    m:   AB_MOVIMIENTO;\r
 175 \r
 176  begin\r
 177    AB_elem_cte( a.arbol, ro ); { obtengo el elemento corriente }\r
 178    ABO_crear( abo );                          {}\r
 179    AB_mover_cte( a.arbol, AB_izquierda, er ); {}\r
 180    if ( not er ) then begin                   {}\r
 181       insertar_rama_de_ABO_a_ABO( a, abo );   {}\r
 182       AB_mover_cte( a.arbol, AB_padre, er );  { Copia todos los registros de las subramas }\r
 183       end;                                    { del registro a borrar en un nuevo ABO     }\r
 184    AB_mover_cte( a.arbol, AB_derecha, er );   { para luego insertarlos en el lugar del    }\r
 185    if ( not er ) then begin                   { registro borrado                          }\r
 186       insertar_rama_de_ABO_a_ABO( a, abo );   {}\r
 187       AB_mover_cte( a.arbol, AB_padre, er );  {}\r
 188       end;                                    {}\r
 189    { En este punto tengo todos los registros de la subrama en mi nuevo ABO }\r
 190    AB_mover_cte( a.arbol, AB_padre, er );\r
 191    if ( er ) then          { es la raiz }\r
 192       AB_vaciar( a.arbol ) { se vacia el arbol entero }\r
 193    else begin              { no es la raiz }\r
 194       AB_mover_cte( a.arbol, AB_izquierda, er ); { Ahora se fija si la subrama a borrar es la de         }\r
 195                                                  { la derecha o la de la izquierda (prueba la izquierda) }\r
 196       if ( er ) then                             { No hay un elemento a la izquierda }\r
 197          m := AB_derecha                         { Indica que hay que borrar la de la derecha }\r
 198       else begin                                 { Hay un elemento a la izquierda }\r
 199          AB_elem_cte( a.arbol, rn );             { Extrae el elemento para compararlo con el que hay que borrar }\r
 200          if ( T_GRAL_Devolver_Clave_Elem( ro ) = T_GRAL_Devolver_Clave_Elem( rn ) ) then { si es la misma }\r
 201             m := AB_izquierda  { Son iguales las claves entonces hay que borrar el de la izquierda }\r
 202          else\r
 203             m := AB_derecha;   { Son distintas las claves entonces hay que borrar el de la derecha }\r
 204          AB_mover_cte( a.arbol, AB_padre, er );\r
 205          end;\r
 206       AB_borrar_sub( a.arbol, m );\r
 207       end;\r
 208    { En este punto tengo borrada la rama con el elemento a borrar, }\r
 209    { solo queda insertar los elementos del ABO creado              }\r
 210    if ( not ABO_vacio( abo ) ) then begin   { Si no esta vacio }\r
 211       ABO_mover_cte( abo, ABO_raiz, er );   { Mueve el corriente a la raiz }\r
 212       insertar_rama_de_ABO_a_ABO( abo, a ); { Inserta la subrama almacenada en ABO en el arbol original }\r
 213       end;\r
 214    ABO_mover_cte( a, ABO_raiz, er );        { deja el corriente en la raiz }\r
 215  end; { Procedimiento o Función }\r
 216 \r
 217 \r
 218 PROCEDURE ABO_insertar( VAR a: ABO_ARBOL; e: T_REGISTRO; VAR error: BOOLEAN );\r
 219   FUNCTION buscar_lugar_desde_elem_cte( VAR a: ABO_ARBOL; e: T_REGISTRO ): AB_MOVIMIENTO;\r
 220    var\r
 221       r:  T_REGISTRO;\r
 222       er: boolean;\r
 223 \r
 224    begin\r
 225       { devuelve AB_raiz si el elemento ya existe en el arbol\r
 226         devuelve AB_izquierda si hay que insertarlo a izquiera del corriente\r
 227         devuelve AB_derecha si hay que insertarlo a derecha del corriente }\r
 228       AB_elem_cte( a.arbol, r );\r
 229       if ( T_GRAL_Devolver_Clave_Elem( e ) = T_GRAL_Devolver_Clave_Elem( r ) ) then\r
 230          buscar_lugar_desde_elem_cte := AB_raiz\r
 231       else\r
 232          if ( T_GRAL_Devolver_Clave_Elem( e ) < T_GRAL_Devolver_Clave_Elem( r ) ) then begin\r
 233             AB_mover_cte( a.arbol, AB_izquierda, er );\r
 234             if ( not er ) then\r
 235                buscar_lugar_desde_elem_cte := buscar_lugar_desde_elem_cte( a, e )\r
 236             else\r
 237                buscar_lugar_desde_elem_cte := AB_izquierda;\r
 238             end\r
 239          else begin\r
 240             AB_mover_cte( a.arbol, AB_derecha, er );\r
 241             if ( not er ) then\r
 242                buscar_lugar_desde_elem_cte := buscar_lugar_desde_elem_cte( a, e )\r
 243             else\r
 244                buscar_lugar_desde_elem_cte := AB_derecha;\r
 245             end;\r
 246    end;\r
 247 \r
 248  var\r
 249    r:  T_REGISTRO;\r
 250    m:  AB_MOVIMIENTO;\r
 251    co,\r
 252    ct: T_CLAVE;\r
 253 \r
 254  begin\r
 255    error := false;\r
 256    if ( AB_vacio( a.arbol ) ) then\r
 257       AB_insertar( a.arbol, AB_raiz, e, error )\r
 258    else begin\r
 259       AB_mover_cte( a.arbol, AB_raiz, error );\r
 260       m := buscar_lugar_desde_elem_cte( a, e );\r
 261       if ( m <> AB_raiz ) then\r
 262          AB_insertar( a.arbol, m, e, error )\r
 263       else\r
 264          error := true;\r
 265       end;\r
 266  end; { Procedimiento o Función }\r
 267 \r
 268 \r
 269 PROCEDURE ABO_vaciar( VAR a: ABO_ARBOL );\r
 270 \r
 271  begin\r
 272    AB_vaciar( a.arbol );\r
 273  end; { Procedimiento o Función }\r
 274 \r
 275 \r
 276 PROCEDURE ABO_copiar( a: ABO_ARBOL; VAR b: ABO_ARBOL );\r
 277 \r
 278  begin\r
 279    AB_copiar( a.arbol, b.arbol );\r
 280  end; { Procedimiento o Función }\r
 281 \r
 282 \r
 283 PROCEDURE ABO_buscar( var a: ABO_ARBOL; c: T_CLAVE; VAR error: boolean );\r
 284    { baja un nivel por el camino correcto y compara:                               }\r
 285    {   c1 = c2 : Termina, error es false porque fue encontrada                     }\r
 286    {   c1 > c2 : Se mueve a la derecha y llama al procedimiento recursivamente     }\r
 287    {   c1 < c2 : Se mueve a la izquierda y llama al procedimiento recursivamente   }\r
 288    { Si hay movimiento y este da error, quiere decir que la clave no fue encontrada}\r
 289    { (se llego a una hoja, o "semihoja"). De esta forma devuelve error como true   }\r
 290    PROCEDURE buscar( var a: ABO_ARBOL; c: T_CLAVE; VAR error: boolean );\r
 291     var\r
 292       e:  T_REGISTRO;\r
 293       co: T_CLAVE;\r
 294     begin\r
 295       AB_elem_cte( a.arbol, e );\r
 296       co := T_GRAL_Devolver_Clave_Elem( e );\r
 297       if ( c = co ) then\r
 298          error := false\r
 299       else begin\r
 300          if ( c < co ) then\r
 301             AB_mover_cte( a.arbol, AB_izquierda, error )\r
 302          else\r
 303             AB_mover_cte( a.arbol, AB_derecha, error );\r
 304          if ( not error ) then\r
 305             buscar( a, c, error );\r
 306       end;\r
 307     end;\r
 308 \r
 309  var\r
 310    r: T_REGISTRO;\r
 311 \r
 312  begin\r
 313    AB_elem_cte( a.arbol, r );                { Guarda el elemento corriente por si no se encuentra el buscado }\r
 314    AB_mover_cte( a.arbol, AB_raiz, error );  { Se mueve a la raiz }\r
 315    if ( not error ) then begin               { Si no hubo error (no debería haberlo) ... }\r
 316       buscar( a, c, error );                 { Comienza la busqueda }\r
 317       if ( error ) then begin                { Si no se encontro la clave buscada ... }\r
 318          { Buscamos la clave original (nunca deberia devolver error = true porque sabemos que existe }\r
 319          ABO_buscar( a, T_GRAL_Devolver_Clave_Elem( r ), error );\r
 320          error := true;                      { Volvemos a poner error en true porque no se habia encontrado }\r
 321       end;                                   {   la clave deseada }\r
 322    end;\r
 323  end; { Procedimiento o Función }\r
 324 \r
 325 end.