-- AUTOR: Elvira Mayordomo Cámara
-- PROYECTO: módulo de implementación del
-- TAD resultado del examen del 21-1-02
-- sólo con árboles
-- FICHERO: familiasimperiales2.adb
-- FECHA: 28-11-03

with Ada.text_io, Ada.Strings.Unbounded, ustrings, unchecked_deallocation;
use Ada.text_io, Ada.Strings.Unbounded, ustrings;
package body familiasimperiales2 is

	procedure disponer is new unchecked_deallocation(nodo,arbol);
	
	procedure buscar(a:in arbol; nombre:in
	ustring; resultado:in out arbol) is
	-- Post: resultado=posición de nombre en a
	-- tiempo O(n), donde n es el número de miembros
	aux:arbol; 
	begin
		aux:=a;
		resultado:=null;
		if aux/=null then
			if aux.nombre=nombre then 
				resultado:=aux;
			else
				if aux.primhijo/=null then
					buscar(aux.primhijo,nombre,resultado);
				elsif aux.primhija/=null then
					buscar(aux.primhija,nombre,resultado);
				end if;	
				if aux.sighermano/=null and
				resultado=null then
					buscar(aux.sighermano,nombre,resultado);
				end if;
			end if;
		end if;			
	end buscar;
	
	procedure buscaremperador(f:in out familia) is
	-- Post: devuelve el emperador en
	-- f.emperador
	-- tiempo O(n), donde n es el número de miembros
	-- paso un máximo de dos veces por cada nodo
	aux:arbol;
	begin
		aux:=f.raiz;
		while aux/=null and f.emperador=null loop
			if aux.vivo then
				f.emperador:=aux;
			elsif aux.primhijo/=null then
				aux:=aux.primhijo;
			elsif aux.primhija/=null then
				aux:=aux.primhija;
			elsif aux.sighermano/=null then
				aux:=aux.sighermano;
			else
				aux:=aux.padre;
				while aux/=null and then (aux.sighermano=null) loop
					aux:=aux.padre;
				end loop;
				if aux/=null then aux:=aux.sighermano; end if;
			end if;			
		end loop;
	end buscaremperador;

	procedure buscarregente(f:in out familia) is
	-- Post: devuelve el regente en
	-- f.regente
	-- tiempo O(n), donde n es el número de miembros
	-- paso un máximo de dos veces por cada nodo
	aux:arbol;
	begin
		aux:=f.raiz;
		while aux/=null and f.regente=null loop
			if aux.vivo and aux.anyo<1985 then
				f.regente:=aux;
			elsif aux.primhijo/=null then
				aux:=aux.primhijo;
			elsif aux.primhija/=null then
				aux:=aux.primhija;
			elsif aux.sighermano/=null then
				aux:=aux.sighermano;
			else
				aux:=aux.padre;
				while aux/=null and then (aux.sighermano=null) loop
					aux:=aux.padre;
				end loop;
				if aux/=null then aux:=aux.sighermano; end if;
			end if;			
		end loop;
	end buscarregente;
	
	procedure crearfamilia(nombre:in ustring; anyo:in positive; varon: boolean; vivo:
	boolean; f:out familia) is
	aux:arbol; 
	-- tiempo O(1) 
	begin 
		aux:=new nodo'(nombre,anyo,varon,vivo,null,null,null,null,null,null);
		f.raiz:=aux;
		if vivo then 
			f.emperador:=aux; 
			if anyo<1985 then
				f.regente:=aux;
			else
				f.regente:=null;
			end if;
		else 
			f.emperador:=null; 
			f.regente:=null;	
		end if;
	end crearfamilia;
	
	function lugar(f:familia; n:ustring) return integer is
	-- tiempo O(n), donde n es el número de miembros
	-- paso un máximo de dos veces por cada nodo
	l:integer; aux:arbol;
	begin
		l:=0;
		aux:=f.emperador;
		while aux/=null and then aux.nombre/=n loop
			if aux.vivo then
				l:=l+1;
			end if;	
			if aux.primhijo/=null then
				aux:=aux.primhijo;
			elsif aux.primhija/=null then
				aux:=aux.primhija;
			elsif aux.sighermano/=null then
				aux:=aux.sighermano;
			else
				aux:=aux.padre;
				while aux/=null and then (aux.sighermano=null) loop
					aux:=aux.padre;
				end loop;
				if aux/=null then aux:=aux.sighermano; end if;
			end if;			
		end loop;
		if aux=null then l:=0; else l:=l+1; end if;
		return(l);				
	end lugar;

	procedure anyadirhijo(aux:in out arbol) is
	-- aux acaba de ser creado y necesita ser
	-- enlazado con sus padres y hermanos.
	-- tiempo O(1)
	padre: arbol;
	begin
		padre:=aux.padre;
		if aux.esvaron then 
			aux.sighermano:=padre.primhija;
			if padre.ulthijo/=null then
				padre.ulthijo.sighermano:=aux;
			else
				padre.primhijo:=aux;
			end if;
			padre.ulthijo:=aux;
		else
			if padre.ulthija/=null then
				padre.ulthija.sighermano:=aux;
			else
				padre.primhija:=aux;
			end if;
			padre.ulthija:=aux;
		end if;
	end anyadirhijo;

	procedure nacer(nombrep,nombrem,nombre:in ustring; anyo:in positive; varon:in boolean; f:in out familia) is
	-- tiempo O(n), donde n es el número de miembros
	padre,madre,aux:arbol;
	lpadre,lmadre:integer;
	begin 
		buscar(f.raiz,nombrep,padre);
		buscar(f.raiz,nombrem,madre);
		if padre/=null and madre/=null then
			lpadre:=lugar(f,nombrep);
			lmadre:=lugar(f,nombrem);
			if lmadre<lpadre then
				padre:=madre;
			end if;
		else
			if padre=null then padre:=madre; end if;
		end if;	
		if padre/=null then 	
			aux:=new nodo'(nombre,anyo,varon,true,padre,null,null,null,null,null);
			anyadirhijo(aux);
		end if;		
	end nacer;
	
	procedure morir(nombre:in ustring; f:in out familia) is
	-- tiempo lineal O(n), donde n es el número de miembros
	aux:arbol;
	begin 
		buscar(f.raiz,nombre,aux);
		if aux/=null then
		
		aux.vivo:=false;
		if f.emperador=aux then
			f.emperador:=null; 
			buscaremperador(f); 
		end if;
		if f.regente=aux then 
			f.regente:=null;
			buscarregente(f); 
		end if;
		
		end if;		
	end morir;

	procedure borrarrec(f:in out familia; pos:in arbol) is
		aux,hijo,siguiente:arbol;
	-- No se preocupa de actualizar padres y hermanos de pos
	-- tiempo O(n), donde n es el número de miembros
	begin	
		-- recursivo:hijos
		if pos.primhijo=null then
			hijo:=pos.primhija;
		else	
			hijo:=pos.primhijo;
		end if;
		aux:=pos;
		disponer(aux);
		while hijo/=null loop
			siguiente:=hijo.sighermano;
			borrarrec(f,hijo);
			hijo:=siguiente;
		end loop;				
	end borrarrec;
	
	procedure desligar(aux:in out arbol) is
	-- aux/=null va a ser borrado y necesitamos
	-- desenlazarlo de su padre y hermanos
	-- tiempo O(1)
	herm:arbol;
	begin
		if aux=aux.padre.primhijo then
			if aux=aux.padre.ulthijo then 
				aux.padre.primhijo:=null;
				aux.padre.ulthijo:=null;
			else	
				aux.padre.primhijo:=aux.sighermano;
			end if;
		elsif aux=aux.padre.primhija then
			if aux.padre.ulthijo/=null then 
				aux.padre.ulthijo.sighermano:=aux.sighermano;
			end if;
			aux.padre.primhija:=aux.sighermano;
			if aux=aux.padre.ulthija then 
				aux.padre.ulthija:=null;
			end if;
		else			
			if aux.esvaron then
				herm:=aux.padre.primhijo;	
			else
				herm:=aux.padre.primhija;
			end if;
			while herm.sighermano/=aux loop
				herm:=herm.sighermano;
			end loop;				
			herm.sighermano:=aux.sighermano;	
			if aux.padre.ulthijo=aux then
				aux.padre.ulthijo:=herm;
			elsif aux.padre.ulthija=aux then
				aux.padre.ulthija:=herm;	
			end if;
		end if;	
	end desligar;	

	procedure borrar(nombre:in ustring; f:in out familia) is
	-- tiempo lineal O(n), donde n es el número de miembros
	aux:arbol;
	begin 
		buscar(f.raiz,nombre,aux);
		if aux/=null then
		
		desligar(aux);
		if f.regente.nombre=nombre then 
			f.regente:=null;
		end if;	
		if f.emperador.nombre=nombre then 
			f.emperador:=null;
		end if;	
		borrarrec(f,aux); -- borra aux y sus descendientes
		if f.regente=null then 
			buscarregente(f); 
		end if;	
		if f.emperador=null then 
			buscaremperador(f); 
		end if;	
		
		end if;	
	end borrar;
		
	procedure linea(f:in familia) is
	-- Post: Escribe por pantalla la línea de sucesión
	-- tiempo lineal O(n), donde n es el número de miembros
	aux:arbol;
	begin 
		aux:=f.emperador;
		while aux/=null loop
			if aux.vivo then
				put_line(aux.nombre);
			end if;	
			if aux.primhijo/=null then
				aux:=aux.primhijo;
			elsif aux.primhija/=null then
				aux:=aux.primhija;
			elsif aux.sighermano/=null then
				aux:=aux.sighermano;
			else
				aux:=aux.padre;
				while aux/=null and then (aux.sighermano=null) loop
					aux:=aux.padre;
				end loop;
				if aux/=null then aux:=aux.sighermano; end if;
			end if;			
		end loop;
	end linea;
	
	function esvacia(f:in familia) return boolean is
	begin 
		return(f.emperador=null);
	end esvacia;
	
	function emperador(f:in familia) return ustring is
	-- Pre: not esvacia(f)
	begin 
		return(f.emperador.nombre);
	end;
	
	function regente(f:in familia) return ustring is
	-- Pre: existe un miembro vivo mayor de edad.
	begin 
		return(f.regente.nombre);
	end;
	
end familiasimperiales2;