-- AUTOR: Elvira Mayordomo Cámara
-- PROYECTO: módulo de implementación del
-- TAD arboles AVL (árboles binarios de búsqueda
-- casi equilibrados)
-- FICHERO: avl.adb
-- FECHA: 14-11-03

with unchecked_deallocation;
with text_io;
use text_io;

package body avl is

procedure disponer is new unchecked_deallocation(nodo,arbin);

procedure reequilibrar(a:in arbin);
-- Pre: partiendo de un árbol AVL, 
-- uno de los hijos de la raiz a ha cambiado en altura
-- (sumando ó restando 1)
-- por lo que las alturas de a hacia arriba
-- deben ser recalculadas y posiblemente el árbol
-- reequilibrado.
-- Post: a tiene los mismos nodos y es
-- un AVL
-- coste en tiempo: para un árbol de n nodos tarda
-- O(log n)

procedure creaVacio(a:out arbin) is
-- Post: a=aVacío
-- coste en tiempo O(1)
begin
a:=null;
end creaVacio;

procedure insertarrec(a,nuevodato:in out arbin) is
-- Pre: a=a0
-- Post: a=insertar(a0,e) pero sin reequilibrado
-- resultado devuelve el punto de inserción del
-- nuevo nodo.
-- coste en tiempo: para un árbol de n nodos tarda
-- O(log n)
begin
	if a=null then 
		a:=nuevodato;
	elsif (nuevodato.dato<=a.dato) then
		nuevodato.padre:=a;
		insertarrec(a.izq,nuevodato);
	else
		nuevodato.padre:=a; 
		insertarrec(a.der,nuevodato);
	end if;
end insertarrec;

procedure insertar(a:in out arbin; e:in elemento) is
-- Pre: a=a0
-- Post: a=insertar(a0,e)
-- coste en tiempo: para un árbol de n nodos tarda
-- O(log n)
nuevodato: arbin;
begin
	nuevodato:=new nodo'(e,null,null,null,0);
	insertarrec(a,nuevodato);
	reequilibrar(nuevodato.padre);
end insertar;

function esta(a:arbin; e:elemento) return
boolean is
-- Post: esta(a,e)= está?(a,e)
-- coste en tiempo: para un árbol de n nodos tarda
-- O(log n)
resultado: boolean;
begin
	resultado:=false;
	if a/=null then 
		if (a.dato = e) then resultado:=true;
		elsif (e<=a.dato) then
		resultado:=esta(a.izq,e);
		else resultado:=esta(a.der,e);
		end if;
	end if;
	return resultado;	
end esta;

function min(a:arbin) return elemento is
-- Pre: not(esvacío(a))
-- Post: min(a)= min(a)
-- coste en tiempo: para un árbol de n nodos tarda
-- O(log n)
begin
	if a.izq=null then return a.dato;
	else return min(a.izq);
	end if;
end min;

function max(a:arbin) return elemento is
-- Pre: not(esvacío(a))
-- Post: max(a)= max(a)
-- coste en tiempo: para un árbol de n nodos tarda
-- O(log n)
begin
	if a.der=null then return a.dato;
	else return max(a.der);
	end if;
end max;

procedure borrarrec(a:in out arbin; e:in
elemento; lugar:out arbin) is
-- Pre: a=a0
-- Post: a=borrar(a0,e) sin reequilibrar
-- lugar tiene al padre del borrado
-- coste en tiempo: para un árbol de n nodos tarda
-- O(log n)
aux:arbin; 
nuevaraiz:elemento;
begin
	if a/=null then 
		if (a.dato = e) then 
			if a.der=null and a.izq=null then
				aux:=a;
				lugar:=a.padre; 					
				a:=null;
				disponer(aux);
			elsif a.izq/=null then
				nuevaraiz:=max(a.izq);
				a.dato:=nuevaraiz;
				borrarrec(a.izq,nuevaraiz,lugar);
			else
				nuevaraiz:=min(a.der);
				a.dato:=nuevaraiz;
				borrarrec(a.der,nuevaraiz,lugar);	
			end if;
		elsif (e<=a.dato) then
			borrarrec(a.izq,e,lugar);
		else borrarrec(a.der,e,lugar);
		end if;
	end if;
end borrarrec;

procedure borrar(a:in out arbin; e:in
elemento) is
-- Pre: a=a0
-- Post: a=borrar(a0,e)
-- coste en tiempo: para un árbol de n nodos tarda
-- O(log n)
lugar:arbin; 
begin
	borrarrec(a,e,lugar);
	if lugar/=null then 
		reequilibrar(lugar);
	end if;	
end borrar;

function altura(a:arbin) return integer is
-- calcula la altura de a a partir de las de
-- a.izq y a.der
-- coste en tiempo O(1)
altizq,altder: integer;
begin
	if a=null then 
		return -1; 
	else
		if a.der/=null then
			altder:=a.der.altura;
		else
			altder:=-1;
		end if;
		if a.izq/=null then
			altizq:=a.izq.altura;
		else
			altizq:=-1;
		end if;
		return(1+integer'Max(altizq,altder));
	end if;
end altura;

function factorequilibrio(a:arbin) return integer is
-- calcula el factor de equilibrio de a 
-- coste en tiempo O(1)
begin
	if a=null then 
		return 0; 
	else
		return altura(a.der)-altura(a.izq);
	end if;
end factorequilibrio;

procedure rotacionSder(a:in out arbin) is
-- Pre: a/=null y a.izq/=null
-- Post: realiza una rotación simple a dcha
-- sobre a
-- coste en tiempo O(1)
NA, NB: nodo;
begin
	NA:=a.all;
	NB:=a.izq.all;
	a.dato:=NB.dato;
	a.der:=a.izq;
	a.der.padre:=a;
	a.izq:=NB.izq;
	if a.izq/=null then a.izq.padre:=a; end if;
	a.der.dato:=NA.dato;
	a.der.izq:=NB.der;
	if a.der.izq/=null then
		a.der.izq.padre:=a.der; 
	end if;
	a.der.der:=NA.der;
	if a.der.der/=null then
		a.der.der.padre:=a.der; 
	end if;
	a.der.altura:=altura(a.der);
	a.altura:=altura(a);
end rotacionSder;

procedure rotacionSizq(a:in out arbin) is
-- Pre: a/=null y a.der/=null
-- Post: realiza una rotación simple a izda
-- sobre a
-- coste en tiempo O(1)
NA, NB: nodo;
begin
	NA:=a.all;
	NB:=a.der.all;
	a.dato:=NB.dato;
	a.izq:=a.der;
	a.izq.padre:=a;
	a.der:=NB.der;
	if a.der/=null then a.der.padre:=a; end if;
	a.izq.dato:=NA.dato;
	a.izq.der:=NB.izq;
	if a.izq.der/=null then
		a.izq.der.padre:=a.izq; 
	end if;
	a.izq.izq:=NA.izq;
	if a.izq.izq/=null then
		a.izq.izq.padre:=a.izq; 
	end if;
	a.izq.altura:=altura(a.izq);
	a.altura:=altura(a);
end rotacionSizq;

procedure rotacionDder(a:in out arbin) is
-- Pre: a/=null, a.izq/=null y a.izq.der/=null
-- Post: realiza una rotación doble a dcha
-- sobre a
-- coste en tiempo O(1)
NA, NB, NC: nodo;
begin
	NA:=a.all;
	NC:=a.der.all;
	NB:=NC.izq.all;
	a.dato:=NB.dato;
	a.izq:=NC.izq;
	a.izq.padre:=a;
	a.izq.dato:=NA.dato;
	a.izq.izq:=NA.izq;
	if a.izq.izq/=null then
		a.izq.izq.padre:=a.izq; 
	end if;
	a.izq.der:=NB.izq;
	if a.izq.der/=null then
		a.izq.der.padre:=a.izq; 
	end if;
	a.der.izq:=NB.der;
	if a.der.izq/=null then
		a.der.izq.padre:=a.der; 
	end if;
	a.izq.altura:=altura(a.izq);
	a.der.altura:=altura(a.der);
	a.altura:=altura(a);
end rotacionDder;

procedure rotacionDizq(a:in out arbin) is
-- Pre: a/=null, a.der/=null y a.der.izq/=null
-- Post: realiza una rotación doble a izda
-- sobre a
-- coste en tiempo O(1)
NA, NB, NC: nodo;
begin
	NC:=a.all;
	NA:=a.izq.all;
	NB:=NA.der.all;
	a.dato:=NB.dato;
	a.der:=NA.der;
	a.der.padre:=a;
	a.der.dato:=NC.dato;
	a.der.izq:=NB.der;
	if a.der.izq/=null then
		a.der.izq.padre:=a.der; 
	end if;
	a.der.der:=NC.der;
	if a.der.der/=null then
		a.der.der.padre:=a.der; 
	end if;
	a.izq.der:=NB.izq;
	if a.izq.der/=null then
		a.izq.der.padre:=a.izq; 
	end if;
	a.izq.altura:=altura(a.izq);
	a.der.altura:=altura(a.der);
	a.altura:=altura(a);
end rotacionDizq;

procedure rotar(a:in out arbin) is
-- Pre: a=a0 es un árbol en el que la raiz tiene factor de
-- equilibrio +2 ó -2 y el resto de los nodos entre -1 y +1.
-- Post: a es un árbol AVL con los mismos
-- valores que a0 y altura(a)=altura(a0)-1
-- coste en tiempo O(1)
begin
	if factorequilibrio (a)=-2 then
		if factorequilibrio (a.izq)= 1 then
			rotacionDizq(a);
		else 
			rotacionSder(a);
		end if;
	else
		if factorequilibrio (a.der)= -1 then
			rotacionDder(a);
		else 
			rotacionSizq(a);
		end if;
	end if;					
end rotar;

procedure reequilibrar(a:in arbin) is
-- uno de los hijos de a ha cambiado en altura
-- por lo que las alturas de a hacia arriba
-- deben ser recalculadas y posiblemente el árbol
-- reequilibrado.
-- coste en tiempo: para un árbol de n nodos tarda
-- O(log n)
aux: arbin;
fe: integer;
desequilibrado:boolean;
begin
	-- actualización de alturas
	aux:=a;
	desequilibrado:=false;	
	while aux/=null and not desequilibrado loop
		aux.altura:=altura(aux);
		fe:=factorequilibrio(aux);
		desequilibrado:=(fe=2) or(fe=-2);
		if not desequilibrado then aux:=aux.padre; end if;
	end loop;	
	if desequilibrado then rotar(aux); end if;
end reequilibrar;

procedure preOrden(a:in arbin) is
-- muestra por pantalla el preorden de a
begin 
	if a/=null then
		put(a.dato);
		preOrden(a.izq);
 		preOrden(a.der);
 	end if;
end preOrden;

procedure postOrden(a:in arbin) is
-- muestra por pantalla el preorden de a
begin 
	if a/=null then
		postOrden(a.izq);
 		postOrden(a.der);
		put(a.dato);
 	end if;
end postOrden;

procedure mostrar(a:in arbin) is
-- Muestra por pantalla preorden y postorden
begin
	put_line("El preorden es:");
	preOrden(a);
	put_line("");
	put_line("El postorden es:");
	postOrden(a);
	put_line("");
end mostrar;	

end avl;