--|::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--| Solucion practica 5 de EDA del curso 98/99 (modulo de implementacion)
--|::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
--| Version: 1.0
--| Fecha: 7-XII-98
--| Autor: Javier Campos

with ada.strings.unbounded, ustrings, unchecked_deallocation;
use ada.strings.unbounded, ustrings;
package body dicc is

--  type tipoNodo is (hoja,interior);
--  type nodo;
--  type ptNodo is access nodo;
--  type nodo(tipo:tipoNodo) is record
--                                case tipo is
--                                  when hoja => 
--                                    clave:ustring; 
--                                    info:ustring;
--                                  when interior => 
--                                    pri,seg,ter:ptNodo;
--                                    minseg,minter:ustring;
--                                end case;
--                              end record;
--  type diccionario is record
--                        numpal:integer;
--                        nodos:ptNodo;
--                      end record;

  procedure disponer is new unchecked_deallocation(nodo,ptNodo);

  procedure vacio(d:out diccionario) is
  begin
    d.numpal:=0;
    d.nodos:=null;
  end vacio;

  procedure busca_rec(p:in ptNodo; palabra:in ustring; definicion:out ustring) is
  -- es la busqueda en el arbol (la pongo aqui porque se usa tambien en "=")
  begin
    if p.tipo=hoja then
      if palabra=p.clave then --palabra encontrada
        definicion:=p.info;
      else --palabra no encontrada
        definicion:=null_unbounded_string;
      end if;
    else --p.tipo=interior
      if palabra<p.minseg then --buscar en el primer subarbol
        busca_rec(p.pri,palabra,definicion);
      else --buscar en el segundo o en el tercero
        if (p.ter=null) or 
           (p.ter/=null and then palabra<p.minter) then --buscar en el segundo subarbol
          busca_rec(p.seg,palabra,definicion);
        else --buscar en el tercer subarbol
          busca_rec(p.ter,palabra,definicion);
        end if;
      end if;
    end if;
  end busca_rec;

  procedure busca(d:in diccionario; palabra:in ustring; definicion:out ustring) is
  begin
    if d.numpal=0 then  --diccionario vacio
      definicion:=null_unbounded_string;
    else  --diccionario no vacio
      busca_rec(d.nodos,palabra,definicion);
    end if;
  end busca;

  procedure inserta(d:in out diccionario; palabra,definicion:in ustring) is
    pAtras:ptNodo; --puntero al nuevo nodo devuelto por inserta_rec
    menorAtras:ustring; --menor valor en el subarbol pAtras
    hayInsercion:boolean; --para saber si la palabra no estaba en el diccionario
    pAux:ptNodo;

    procedure inserta_rec(p:in ptNodo; --aqui hay que insertar
                          palabra,definicion:in ustring; --esto es lo que hay que insertar
                          pNuevo:out ptNodo; --pt. al nodo recien creado a la derecha de p
                          menor:out ustring; --palabra minima del subarbol pNuevo
                          hayInsercion:in out boolean) is --dice si la palabra no estaba
    --inserta 'palabra' en 'p';
    --'hayInsercion' vale verdad si el num. de palabras ha aumentado (se usa para aumentar
    --el numero de palabras en 'inserta' solo cuando sea necesario);
    --'pNuevo' devuelve o null o un puntero a un arbol creado a la derecha de 'p' y
    --que hay que enganchar al padre de 'p';
    --si 'pNuevo' es distinto de null, 'menor' es la menor palabra del arbol 'pNuevo'
      pAtras:ptNodo;
      menorAtras:ustring;
      hijo:natural; --en realidad es 1..3; indica que hijo de p se sigue en la llamada 
                    --recursiva (relacionado con la variable w que sigue)
      w:ptNodo; --puntero al hijo de p en que se va a hacer la insercion
    begin
      pNuevo:=null;
      if p.tipo=hoja then
        if p.clave=palabra then --la palabra ya estaba; se cambia la definicion y ya esta
          p.info:=definicion;
        else --crea una hoja nueva que contiene la palabra y devuelve este nodo
          hayInsercion:=true;
          pNuevo:=new nodo'(hoja,null_unbounded_string,null_unbounded_string);
          if p.clave<palabra then --pone la palabra en el nuevo nodo a la dcha del actual
            pNuevo.clave:=palabra;
            pNuevo.info:=definicion;
            menor:=palabra;
          else --la palabra esta a la izq del elmto en el nodo actual
            pNuevo.clave:=p.clave;
            pNuevo.info:=p.info;
            p.clave:=palabra;
            p.info:=definicion;
            menor:=pNuevo.clave;
          end if;
        end if;
      else -- p es un nodo interno
        --selecciona el hijo de p que se debe seguir
        if palabra<p.minseg then
          hijo:=1;
          w:=p.pri;
        elsif p.ter=null or else palabra<p.minter then --esta en el segundo
          hijo:=2;
          w:=p.seg;
        else --la palabra esta en el tercer subarbol
          hijo:=3;
          w:=p.ter;
        end if;
        inserta_rec(w,palabra,definicion,pAtras,menorAtras,hayInsercion);
        if pAtras/=null then --debe insertarse un nuevo hijo de nodo
          if p.ter=null then --p tiene 2 hijos, se inserta el nuevo en su lugar
            if hijo=2 then
              p.ter:=pAtras;
              p.minter:=menorAtras;
            else --hijo=1
              p.ter:=p.seg;
              p.minter:=p.minseg;
              p.seg:=pAtras;
              p.minseg:=menorAtras;
            end if;
          else --p ya tiene 3 hijos
            pNuevo:=new nodo'(interior,null,null,null,
                              null_unbounded_string,null_unbounded_string);
            if hijo=3 then --pAtras y el 3 hijo se convierten en hijos del nuevo nodo
              pNuevo.pri:=p.ter;
              pNuevo.seg:=pAtras;
              pNuevo.minseg:=menorAtras;
              menor:=p.minter;
              p.ter:=null;
            else --hijo<=2; pasa el 3 hijo de p a pNuevo
              pNuevo.seg:=p.ter;
              pNuevo.minseg:=p.minter;
              p.ter:=null;
              if hijo=2 then --pAtras se convierte en el primer hijo de pNuevo
                pNuevo.pri:=pAtras;
                menor:=menorAtras;
              else--hijo=1; el 2 hijo de p pasa a pNuevo; pAtras pasa a ser 2 hijo de p
                pNuevo.pri:=p.seg;
                menor:=p.minseg;
                p.seg:=pAtras;
                p.minseg:=menorAtras;
              end if;
            end if; --de if hijo=3
          end if; --de if p.ter=null
        end if; --de if pAtras/=null
      end if; --de if p.tipo=hoja
    end inserta_rec;

  begin --de inserta
    if d.numpal=0 then --era vacio; se crea con una sola palabra
      d.numpal:=1;
      d.nodos:=new nodo'(hoja,palabra,definicion);
    elsif d.numpal=1 then --era solo una hoja
      if d.nodos.clave=palabra then --la palabra es igual que la que habia
        d.nodos.info:=definicion;
      else --hay que crear una nueva hoja para la nueva palabra
        d.numpal:=2;
        pAux:=new nodo'(hoja,palabra,definicion);
        if palabra<d.nodos.clave then --la nueva es menor que la que habia
          d.nodos:=new nodo'(interior,pAux,d.nodos,null,d.nodos.clave,null_unbounded_string);
        else --la nueva es mayor que la que habia
          d.nodos:=new nodo'(interior,d.nodos,pAux,null,palabra,null_unbounded_string);
        end if;
      end if;
    else --tenia al menos dos palabras (insercion con el algoritmo recursivo)
      hayInsercion:=false;
      inserta_rec(d.nodos,palabra,definicion,pAtras,menorAtras,hayInsercion);
      if pAtras/=null then --crea la nueva raiz; sus hijos estan ahora apuntados por d y pAtras
        d.nodos:=new nodo'(interior,d.nodos,pAtras,null,menorAtras,null_unbounded_string);
      end if;
      if hayInsercion then
        d.numpal:=d.numpal+1;
      end if;
    end if;
  end inserta;

  procedure borra(d:in out diccionario; palabra:in ustring) is
    unHijo:boolean; 
    hayBorrado:boolean;
    pAux:ptNodo;
    menor:ustring;
    
    procedure borra_rec(p:in ptNodo; palabra:in ustring; 
                        unHijo:out boolean; menor:out ustring; hayBorrado:in out boolean) is
    --borra 'palabra' de 'p';
    --si 'p' se queda con un solo hijo devuelve verdad en 'unHijo';
    --si 'palabra' es la menor de p entonces 'menor' devuelve la siguiente mas peque~na;
    --'hayBorrado' devuelve verdad si se ha borrado la palabra 
    --(sirve solo para disminuir el contador de numero de palabras)
      soloUno:boolean; w:ptNodo; hijo:natural;
    begin
      hayBorrado:=false;
      unHijo:=false;
      if p.pri.tipo=hoja then --los hijos de p son hojas
        if p.pri.clave=palabra then --la palabra a borrar es el primer hijo de p
          hayBorrado:=true;
          disponer(p.pri); --se borra
          p.pri:=p.seg;    --y se desplaza el segundo hacia la izquierda
          menor:=p.pri.clave; --se ha borrado la mas peque~na; esta es la nueva mas peque~na
          if p.ter=null then --ahora p tiene un solo hijo
            unHijo:=true;
            p.seg:=null;
          else --se desplaza el tercero hacia su izquierda
            p.seg:=p.ter;
            p.ter:=null;
            p.minseg:=p.minter;
          end if;
        elsif p.seg.clave=palabra then --la palabra a borrar es el segundo hijo de p
          hayBorrado:=true;
          disponer(p.seg);
          if p.ter=null then --ahora p tiene un solo hijo
            unHijo:=true;
            p.seg:=null;
          else --se desplaza el tercero hacia su izquierda
            p.seg:=p.ter;
            p.ter:=null;
            p.minseg:=p.minter;
          end if;
        elsif p.ter/=null and then p.ter.clave=palabra then --es el tercer hijo de p
          hayBorrado:=true;
          disponer(p.ter); --se borra
          p.ter:=null;
        end if;
      else --los hijos de p no son hojas
        --se selecciona el hijo de p en que hay que borrar
        if palabra<p.minseg then --si esta, esta en el primer subarbol
          hijo:=1;
          w:=p.pri;
        elsif p.ter=null or else palabra<p.minter then --si esta, esta en el segundo
          hijo:=2;
          w:=p.seg;
        else --si esta, esta en el tercer subarbol
          hijo:=3;
          w:=p.ter;
        end if;
        borra_rec(w,palabra,soloUno,menor,hayBorrado);
        if soloUno then --arreglar los hijos de p (para que ninguno tenga menos de dos hijos)
          if hijo=1 then --el primer hijo de p solo tiene un hijo
            if p.seg.ter/=null then --el segundo hijo de p tiene tres hijos
              --se pasa el primer hijo del segundo hijo de p a segundo hijo del primero de p
              p.pri.seg:=p.seg.pri;
              p.pri.minseg:=p.minseg;
              p.minseg:=p.seg.minseg;
              p.seg.pri:=p.seg.seg;
              p.seg.seg:=p.seg.ter;
              p.seg.minseg:=p.seg.minter;
              p.seg.ter:=null;
            else --el segundo hijo de p tiene dos hijos
              --se pasa el hijo de p.pri como primer hijo del segundo hijo de p
              --y se elimina el primer hijo de p
              w:=p.pri; --se hace una copia para eliminarlo luego
              p.pri:=p.seg;
              p.seg:=p.ter;
              p.ter:=null;
              p.pri.ter:=p.pri.seg;
              p.pri.minter:=p.pri.minseg;
              p.pri.seg:=p.pri.pri;
              p.pri.minseg:=p.minseg;
              p.pri.pri:=w.pri;
              disponer(w);
              p.minseg:=p.minter;
              if p.seg=null then --ahora p solo tiene un hijo
                unHijo:=true; 
              end if;
            end if;
          elsif hijo=2 then --el segundo hijo de p solo tiene un hijo
            if p.pri.ter/=null then --el primer hijo de p tiene tres hijos
              --se pasa el tercer hijo del primer hijo de p como primer hijo de p.seg
              p.seg.seg:=p.seg.pri;
              if p.minseg=palabra then --se ha borrado la palabra menor de p.seg
                p.seg.minseg:=menor;
              else --no ha cambiado la palabra menor de p.seg
                p.seg.minseg:=p.minseg;
              end if;
              p.seg.pri:=p.pri.ter;
              p.minseg:=p.pri.minter;
              p.pri.ter:=null;
            else --el primer hijo de p tiene dos hijos
              if p.ter/=null and then p.ter.ter/=null then --el tercer hijo de p
                                                           --existe y tiene tres hijos
                --se pasa el primer hijo del tercero de p como segundo de p.seg
                p.seg.seg:=p.ter.pri;
                p.seg.minseg:=p.minter;
                p.minter:=p.ter.minseg;
                if p.minseg=palabra then --se ha borrado la menor palabra de p.seg
                  p.minseg:=menor;
                end if;
                p.ter.pri:=p.ter.seg;
                p.ter.seg:=p.ter.ter;
                p.ter.ter:=null;
                p.ter.minseg:=p.ter.minter;
              else --ningun otro hijo de p tiene tres hijos
                --el hijo de p.seg pasa a ser el tercero del primero de p
                p.pri.ter:=p.seg.pri;
                if p.minseg=palabra then --se ha borrado la menor palabra de p.seg
                  p.pri.minter:=menor;
                else
                  p.pri.minter:=p.minseg;
                end if;
                disponer(p.seg);
                p.seg:=p.ter;
                p.ter:=null;
                p.minseg:=p.minter;
                if p.seg=null then --p se ha quedado con un solo hijo
                  unHijo:=true;
                end if;
              end if;  
            end if;
          else --hijo=3; el tercer hijo de p solo tiene un hijo
            if p.seg.ter/=null then --el segundo hijo de p tiene tres hijos
              --se pasa el tercer hijo del segundo de p como primero de p.ter
              p.ter.seg:=p.ter.pri;
              if p.minter=palabra then --se ha borrado la menor palabra de p.ter
                p.ter.minseg:=menor;
              else
                p.ter.minseg:=p.minter;
              end if;
              p.ter.pri:=p.seg.ter;
              p.minter:=p.seg.minter;
              p.seg.ter:=null;
            else --el segundo hijo de p tiene dos hijos
              --el hijo de p.ter pasa como tercero del segundo de p
              p.seg.ter:=p.ter.pri;
              if p.minter=palabra then --se ha borrado la menor palabra de p.ter
                p.seg.minter:=menor;
              else
                p.seg.minter:=p.minter;
              end if;
              disponer(p.ter);
              p.ter:=null;
            end if;
          end if;
        else --soloUno=falso; todos los hijos de p tiene dos o tres hijos
          --falta ver si hay que cambiar p.minseg o p.minter
          if hijo=2 then
            if p.minseg=palabra then p.minseg:=menor; end if;
          elsif hijo=3 then
            if p.minter=palabra then p.minter:=menor; end if;
          end if; --si hijo=1 no cambian minsec ni minter
        end if;
      end if;
    end borra_rec;
    
  begin --de borra
    if d.numpal>0 then --caso contrario el diccionario sigue vacio
      if d.numpal=1 then --el diccionario es una sola hoja
        if d.nodos.clave=palabra then --hay que borrarla
          disponer(d.nodos);
          d.nodos:=null;
          d.numpal:=0;
        end if;
      else --el diccionario tiene mas de un elemento
        borra_rec(d.nodos,palabra,unHijo,menor,hayBorrado);
        if hayBorrado then 
          d.numpal:=d.numpal-1;
        end if;
        if unHijo then --la raiz solo tiene un hijo; hay que eliminar la raiz
          pAux:=d.nodos;
          d.nodos:=d.nodos.pri;
          disponer(pAux);
        end if;
      end if;
    end if;
  end borra;
  
  procedure asignar(dout:out diccionario; din:in diccionario) is
  
    procedure asignar_rec(pout:out ptNodo; pin:in ptNodo) is
      a1,a2,a3:ptNodo;
    begin
      if pin=null then  --es vacio
        pout:=null;
      elsif pin.tipo=hoja then --un solo nodo
        pout:=new nodo'(hoja,pin.clave,pin.info);
      else --la raiz es un nodo interior
        asignar_rec(a1,pin.pri);
        asignar_rec(a2,pin.seg);
        if pin.ter/=null then
          asignar_rec(a3,pin.ter);
        end if;
        pout:=new nodo'(interior,a1,a2,a3,pin.minseg,pin.minter);
      end if;
    end asignar_rec;

  begin
    dout.numpal:=din.numpal;
    asignar_rec(dout.nodos,din.nodos);
  end asignar;
  
  function "="(d1,d2:in diccionario) return boolean is
  
    function incluido(p1,p2: ptNodo) return boolean is
    --devuelve verdad si y solo si todas las palabras de p1 estan en p2 (con iguales def.)
      def:ustring; aux:boolean;
    begin
      if p1=null then
        return true; --trivialmente
      elsif p1.tipo=hoja then
        busca_rec(p2,p1.clave,def);
        return def=p1.info; --solo hay una palabra en p1 y esta en p2
      else --p1 es un nodo interior
        aux:=incluido(p1.pri,p2);
        if not aux then
          return false;
        else
          aux:=incluido(p1.seg,p2);
          if not aux then
            return false;
          elsif p1.ter/=null then
            aux:=incluido(p1.ter,p2);
            return aux;
          else
            return true;
          end if;
        end if;
      end if;
    end incluido;

  begin
    if d1.numpal/=d2.numpal then
      return false;
    else
      return incluido(d1.nodos,d2.nodos);
    end if;
  end "=";
  
  procedure liberar(d:in out diccionario) is
  
    procedure liberar_rec(p:in out ptNodo) is
    begin
      if p/=null then  --hay algo que liberar
        if p.tipo=hoja then --solo una hoja
          disponer(p);
          p:=null;
        else --la raiz es un nodo interior
          liberar_rec(p.pri);
          liberar_rec(p.seg);
          liberar_rec(p.ter);
          disponer(p);
          p:=null;
        end if;
      end if;
    end liberar_rec;

  begin
    liberar_rec(d.nodos);
    d.numpal:=0; 
  end liberar;
  
  procedure listado(d:in diccionario) is
  
    procedure listado_rec(p:in ptNodo) is
    begin
      if p/=null then  --hay algo que listar
        if p.tipo=hoja then --un solo nodo
          put_line(p.clave);
          put_line(p.info);
        else
          listado_rec(p.pri);
          listado_rec(p.seg);
          listado_rec(p.ter);
        end if;
      end if;
    end listado_rec;

  begin
    listado_rec(d.nodos);
  end listado;


end dicc;