program prog_arbol;
uses crt, dos;

type Sentido = (IZQUIERDA, CENTRO, DERECHA);

type Arbol = ^TDAArbol;
TDAArbol = record
    izq, der : Arbol;
    cadena : string;
end;

function arbol_insertar (nodo : Arbol; cadena : string) : Arbol;
    begin
        if nodo = nil then
            begin
                new (nodo);
                nodo^.izq := nil;
                nodo^.der := nil;
                nodo^.cadena := cadena;
            end
        else
            if cadena < nodo^.cadena then
                nodo^.izq := arbol_insertar (nodo^.izq, cadena)
            else
                nodo^.der := arbol_insertar (nodo^.der, cadena);
        arbol_insertar := nodo;
    end;

function arbol_quitar_y_rotar (nodo : Arbol; cadena : string; rotacion : Sentido) : Arbol;
    var pivote : Arbol;
    begin
        if nodo <> nil then
            begin
                if nodo^.cadena = cadena then
                    begin
                        if nodo^.izq = nil then
                            pivote := nodo^.der
                        else if nodo^.der = nil then
                            pivote := nodo^.izq
                        else if rotacion = IZQUIERDA then
                            begin
                                pivote := nodo^.izq;
                                while pivote^.der <> nil do
                                    pivote := pivote^.der;
                                pivote^.der := nodo^.der;
                                pivote := nodo^.izq;
                            end
                        else
                            begin
                                pivote := nodo^.der;
                                while pivote^.izq <> nil do
                                    pivote := pivote^.izq;
                                pivote^.izq := nodo^.izq;
                                pivote := nodo^.der;
                            end;
                        dispose (nodo);
                        nodo := pivote;
                    end
                else if cadena < nodo^.cadena then
                    nodo^.izq := arbol_quitar_y_rotar (nodo^.izq, cadena, rotacion)
                else
                    nodo^.der := arbol_quitar_y_rotar (nodo^.der, cadena, rotacion);
            end;
        arbol_quitar_y_rotar := nodo;
    end;

function arbol_quitar (nodo : Arbol; cadena : string) : Arbol;
    begin
        arbol_quitar := arbol_quitar_y_rotar (nodo, cadena, IZQUIERDA);
    end;

procedure arbol_preorden (raiz : Arbol; nodo : Arbol);
    var pivote : Arbol;
    var hermanos : integer;
    var direccion : Sentido;
    var borde1, borde2 : char;
    begin
        if nodo <> nil then
            begin
                hermanos := 0;
                direccion := CENTRO;
                pivote := raiz;
                while pivote <> nodo do
                    begin
                        if (hermanos = 2) and (direccion = IZQUIERDA) then
                            write (#179' ')
                        else
                            write ('  ');
                        hermanos := 0;
                        if pivote^.izq <> nil then
                            inc (hermanos);
                        if pivote^.der <> nil then
                            inc (hermanos);
                        if nodo^.cadena < pivote^.cadena then
                            begin
                                pivote := pivote^.izq;
                                direccion := IZQUIERDA;
                            end
                        else
                            begin
                                pivote := pivote^.der;
                                direccion := DERECHA;
                            end;
                    end;
                if direccion = CENTRO then
                    borde1 := #196
                else if (hermanos = 1) or (direccion = DERECHA) then
                    borde1 := #192
                else
                    borde1 := #195;
                if (nodo^.izq <> nil) or (nodo^.der <> nil) then
                    borde2 := #194
                else
                    borde2 := #196;
                writeln (borde1, #196, borde2, nodo^.cadena);
                arbol_preorden (raiz, nodo^.izq);
                arbol_preorden (raiz, nodo^.der);
            end;
    end;

procedure arbol_inorden (raiz : Arbol; nodo : Arbol);
    var pivote : Arbol;
    var direccion : Sentido;
    var borde1, borde2: char;
    begin
        if nodo <> nil then
            begin
                direccion := CENTRO;
                arbol_inorden (raiz, nodo^.izq);
                pivote := raiz;
                while pivote <> nodo do
                    if nodo^.cadena < pivote^.cadena then
                        begin
                            if direccion = DERECHA then
                                write (#179' ')
                            else
                                write ('  ');
                            pivote := pivote^.izq;
                            direccion := IZQUIERDA;
                        end
                    else
                        begin
                            if direccion = IZQUIERDA then
                                write (#179' ')
                            else
                                write ('  ');
                            pivote := pivote^.der;
                            direccion := DERECHA;
                        end;
                case direccion of
                    IZQUIERDA: borde1 := #218;
                    CENTRO   : borde1 := #196;
                    DERECHA  : borde1 := #192;
                end;
                if (nodo^.izq <> nil) and (nodo^.der <> nil) then
                    borde2 := #197
                else if nodo^.izq <> nil then
                    borde2 := #193
                else if nodo^.der <> nil then
                    borde2 := #194
                else
                    borde2 := #196;
                writeln (borde1, #196, borde2, nodo^.cadena);
                arbol_inorden (raiz, nodo^.der);
            end;
    end;

procedure arbol_postorden (raiz : Arbol; nodo : Arbol);
    var pivote : Arbol;
    var hermanos : integer;
    var direccion : Sentido;
    var borde1, borde2 : char;
    begin
        if nodo <> nil then
            begin
                arbol_postorden (raiz, nodo^.izq);
                arbol_postorden (raiz, nodo^.der);
                hermanos := 0;
                direccion := CENTRO;
                pivote := raiz;
                while pivote <> nodo do
                    begin
                        if (hermanos = 2) and (direccion = DERECHA) then
                            write (#179' ')
                        else
                            write ('  ');
                        hermanos := 0;
                        if pivote^.izq <> nil then
                            inc (hermanos);
                        if pivote^.der <> nil then
                            inc (hermanos);
                        if nodo^.cadena < pivote^.cadena then
                            begin
                                pivote := pivote^.izq;
                                direccion := IZQUIERDA;
                            end
                        else
                            begin
                                pivote := pivote^.der;
                                direccion := DERECHA;
                            end;
                    end;
                    if direccion = CENTRO then
                        borde1 := #196
                    else if (hermanos = 1) or (direccion = IZQUIERDA) then
                        borde1 := #218
                    else
                        borde1 := #195;
                    if (nodo^.izq <> nil) or (nodo^.der <> nil) then
                        borde2 := #193
                    else
                        borde2 := #196;
                writeln (borde1, #196, borde2, nodo^.cadena);
            end;
    end;

function arbol_altura (nodo : Arbol) : integer;
    var izq, der : integer;
    begin
        if nodo = nil then
            arbol_altura := 0
        else
            begin
                izq := arbol_altura (nodo^.izq);
                der := arbol_altura (nodo^.der);
                if izq > der then
                    arbol_altura := 1 + izq
                else
                    arbol_altura := 1 + der;
            end;
    end;

function arbol_balancear (nodo : Arbol) : Arbol;
    var diferencia : integer;
    var cadena : string;
    begin
        if nodo <> nil then
            begin
                nodo^.izq := arbol_balancear (nodo^.izq);
                nodo^.der := arbol_balancear (nodo^.der);
                diferencia := arbol_altura(nodo^.izq) - arbol_altura(nodo^.der);
                if (diferencia > 1) or (diferencia < -1) then
                    begin
                        cadena := nodo^.cadena;
                        if diferencia > 1 then
                            nodo := arbol_quitar_y_rotar (nodo, cadena, DERECHA)
                        else
                            nodo := arbol_quitar_y_rotar (nodo, cadena, IZQUIERDA);
                        nodo := arbol_balancear (arbol_insertar (nodo, cadena));
                    end;
            end;
        arbol_balancear := nodo;
    end;

function arbol_nodos (nodo : Arbol) : integer;
    begin
        if nodo = nil then
            arbol_nodos := 0
        else
            arbol_nodos := 1 + arbol_nodos (nodo^.izq) + arbol_nodos (nodo^.der);
    end;

function arbol_completo (nodo : Arbol) : boolean;
    begin
        arbol_completo := (nodo = nil) or (
            (arbol_nodos (nodo^.izq) = arbol_nodos (nodo^.der)) and
            arbol_completo (nodo^.izq) and
            arbol_completo (nodo^.der));
    end;

function arbol_balanceado (nodo : Arbol) : boolean;
    var diferencia : integer;
    begin
        if nodo = nil then
            arbol_balanceado := true
        else
            begin
                diferencia := arbol_altura (nodo^.izq) - arbol_altura (nodo^.der);
                arbol_balanceado := (diferencia >= -1) and (diferencia <= 1) and
                    arbol_balanceado (nodo^.izq) and arbol_balanceado (nodo^.der);
            end;
    end;

var raiz : Arbol;
var opcion, tecla : char;
var cadena : string;
begin
    raiz := nil;
    repeat
        clrscr;
        writeln ('MEN'#233);
        writeln ('1.- Insertar cadena');
        writeln ('2.- Quitar cadena');
        writeln ('3.- Listado en preorden');
        writeln ('4.- Listado en inorden');
        writeln ('5.- Listado en postorden');
        writeln ('6.- Balancear');
        writeln ('7.- Consultar propiedades');
        writeln ('8.- Salir'#10#13);
        write ('Seleccione una opci'#162'n: ');
        repeat
            opcion := readkey;
        until (opcion >= '1') and (opcion <= '8');
        writeln (opcion, #10#13);
        if (raiz = nil) and (opcion <> '1') and (opcion <> '7')  and (opcion <> '8') then
            writeln ('El '#160'rbol est'#160' vac'#161'o.')
        else case opcion of
            '1':
                begin
                    write ('Ingrese el cadena a insertar: ');
                    readln (cadena);
                    raiz := arbol_insertar (raiz, cadena);
                    writeln (#10#13'Cadena agregada correctamente.');
                end;
            '2':
                begin
                    write ('Ingrese el cadena a quitar: ');
                    readln (cadena);
                    raiz := arbol_quitar (raiz, cadena);
                    writeln (#10#13'Cadena borrada correctamente.');
                end;
            '3': arbol_preorden  (raiz, raiz);
            '4': arbol_inorden   (raiz, raiz);
            '5': arbol_postorden (raiz, raiz);
            '6':
                begin
                    writeln (#181'rbol balanceado correctamente.');
                    raiz := arbol_balancear (raiz);
                end;
            '7':
                begin
                    writeln ('Altura    : ', arbol_altura(raiz));
                    writeln ('Nodos     : ', arbol_nodos (raiz));
                    writeln ('Completo  : ', arbol_completo  (raiz));
                    writeln ('Balanceado: ', arbol_balanceado(raiz));
                end;
        end;
        if opcion <> '8' then
            begin
                write (#10#13'Presione una tecla para continuar . . . ');
                tecla := readkey;
            end
    until opcion = '8';
end.