program myBarbres;
(* Mlles Beau et Delburg *)
	(* representation d'un noeud *)
	Unit noeud : class;
	Var pere       : noeud,
		 nb         : integer,
		 IG, IM     : integer,
		 FG, FM, FD : noeud;
		 (* 
			 pere est le pere
			 nb est le nombre de fils
			 IG est l'information de gauche
			 IM est l'information de droite
			 FG est le fils de gauche
			 FM est le fils du milieu
			 FD est le fils de droite
		 *)
	begin
		(* initialisation des variables *)
		pere := none;
		nb := 0;
		IG := -1;
		IM := -1;
		FG := none;
		FM := none;
		FD := none;
	end noeud;



	Unit barbre : class;
	Var racine : noeud;

		unit afficher : procedure(inout courant : noeud);
		begin
			if courant.IM = -1
			then
				(* courant pointe sur une feuille *)
				writeln(courant.IG:1);
			else
				(* courant pointe sur un noeud *)
				writeln(courant.IG:1, ":", courant.IM:1);
			fi;
			
			if courant.FG =/= none
			then
				(* courant a 1, 2 ou 3 fils *)   
				if courant.FG.FG =/= none
				then
					(* courant a 2 ou 3 petits fils *)
					(* appel de la procedure afficher avec le fils gauche de courant *)
					call afficher(courant.FG);
					if courant.FM =/= none
					then
						(* courant a 2 ou 3 fils *)
						(* appel de la procedure afficher avec le fils milieu de courant *)
						call afficher(courant.FM);
						if courant.FD =/= none
						then
							(* courant a 3 fils *)
							(* appel de la procedure afficher avec le fils droit de courant *)
							call afficher(courant.FD);
						fi;
					fi;
				else
					(* courant n'a pas de petits fils 
						i.e. les fils de courant sont des feuilles *)
					(* affichage de la feuille de gauche *)
					write(courant.FG.IG:1);
					if courant.FM =/= none
					then
						(* courant a 2 ou 3 fils *)
						(* affichage de la feuille du milieu *)
						write(" ", courant.FM.IG:1);
						if courant.FD =/= none
						then
							(* courant a 3 fils *)
							(* affichage de la feuille de droite *)
							writeln(" ", courant.FD.IG:1);
						else
							(* il n'y a pas de fils droit *)
							writeln;
						fi;
					else
						(* il n'y a pas de fils milieu *)
						writeln;
					fi;
				fi;
			fi;
		end;

		unit reorganiser : procedure(inout courant,bidon : noeud);
		begin
					if courant.FG =/= none
					then
						(* courant a 1, 2 ou 3 fils *)
						if courant.FG.FG =/= none
						then
							(* courant a 2 ou 3 petits fils *)
							(* appel de la procedure reorganiser avec le fils gauche *)
							call reorganiser(courant.FG, bidon);
							(* appel de la procedure reorganiser avec le fils milieu *)
							call reorganiser(courant.FM, bidon);
							if courant.FD =/= none
							then
								(* courant a 3 fils *)
								(* appel de la procedure reorganiser avec le fils droit *)
								call reorganiser(courant.FD, bidon);
							fi;

							(* recherche du plus grand element dans le sous arbre 
							gauche de courant pour recuperer le IG de courant *)
							bidon := courant.FG;
							do
								case bidon.nb
									when 0 : courant.IG := bidon.IG;
												exit;
									when 1 : bidon := bidon.FG;

									when 2 : bidon := bidon.FM;

									when 3 : bidon := bidon.FD;
								esac;
							od;
							
							(* recherche du plus grand element dans le sous arbre 
							du milieu de courant pour recuperer le IM de courant *)
							bidon := courant.FM;
							do
								case bidon.nb
									when 0 : courant.IM := bidon.IG;
												exit;
									when 1 : bidon := bidon.FG;

									when 2 : bidon := bidon.FM;

									when 3 : bidon := bidon.FD;
								esac;
							od;
						else
							(* courant n'a pas de petis fils *)
							(* recuperation de IG pour courant *)
							courant.IG := courant.FG.IG;
							if courant.nb =/= 1
							then
								(* recuperation de IM pour courant *)
								(* courant a 2 ou 3 fils *)
								courant.IM := courant.FM.IG;
							fi;
						fi;
					fi;
				end reorganiser;

		Unit vide : function : boolean;
		begin
			result := (racine.nb = 0);
		end vide;

		Unit minimum : function : integer;
		var courant : noeud;
		begin
			courant := racine;
			do
				if courant.FG = none
				then
					(* result contient le plus petit element de l'arbre *)
					result := courant.IG;
					exit;
				else
					(* descendre a gauche *)
					courant := courant.FG;
				fi;
			od;
		end minimum;

		Unit maximum : function : integer;
		var courant : noeud;
		begin
			courant := racine;
			do
				(* suivant le nombre de fils de courant *)
				case courant.nb
					when 0 : (* result contient le plus grand element de l'arbre *)
								result := courant.IG;
								exit;
					when 1 : (* le plus grand element se trouve 
								dans le sous arbre de gauche *)
								courant := courant.FG;

					when 2 : (* le plus grand element se trouve
								dans le sous arbre du milieu *)
								courant := courant.FM;

					when 3 : (* le plus grand element se trouve
								dans le sous arbre de droite *)
								courant := courant.FD;
				esac;
			od;
		end maximum;
	 
		unit present : function(v : integer; inout courant : noeud) : boolean;
		begin
			do
				(* suivant le nombre de fils de courant *)
				case courant.nb
					when 0 : (* 0 fils donc c'est une feuille *)
								if courant.IG = v
								then result := true;
								else result := false;
								fi;
								exit;
					when 1 : (* 1 fils donc le pere est la racine *)
								courant := courant.FG;
								if courant.IG = v
								then result := true;
								else result := false;
								fi;
								exit;
					when 2 : (* 2 fils *)
								if courant.IG > v
								then
									(* v se trouve a gauche, si il existe *) 
									courant := courant.FG;
								else
									if courant.IG = v
									then
										if courant.nb =/= 0
										then
											courant := courant.FG;
										fi;
									else
										(* v ne se trouve pas a gauche, si il existe *)
										if courant.IM > v
										then
											(* v se trouve au milieu, si il existe *)
											courant := courant.FM;
										else
											if courant.IM = v
											then
												if courant.nb =/= 0
												then
													courant := courant.FM;
												fi;
											else
												courant := courant.FM;
											fi;
										fi;
									fi;
								fi;
					when 3 : (* 3 fils *)
								if courant.IG > v
								then
									(* v se trouve a gauche, si il existe *)
									courant := courant.FG;
								else
									if courant.IG = v
									then
										if courant.nb =/= 0
										then
											courant := courant.FG;
										fi;
									else                            
										(* v ne se trouve pas a gauche, si il existe *)
										if courant.IM > v
										then
											(* v se trouve au milieu, si il existe *)
											courant := courant.FM;
										else
											if courant.IM = v
											then
												if courant.nb =/= 0
												then
													courant := courant.FM;
												fi;
											else
												(* v ne se trouve pas a gauche, si il existe *)
												if courant.IM < v
												then 
													(* v se trouve a droite, si il existe *)
													courant := courant.FD;
												fi;
											fi;
										fi;
									fi;
								fi;
				esac;
			od;
		end present;





		unit supprimer : function(v: integer) : barbre;
		var courant, p : noeud,
			 b : barbre;
		begin
			b := new barbre;
			courant := racine;
			if present(v, courant)
			then
				(* l'element est present dans l'arbre donc on peut le supprimer *)
				p := courant.pere;
				if p.pere = none
				then
					(* p pointe sur la racine *)
					case p.nb
						when 1 : (* p a 1 fils *)
									courant := p;
									courant.FG := none;
									courant.nb := 0;
									courant.IG := -1;

						when 2 : (* p a 2 fils *)
									if p.FG.IG = courant.IG
									then
										p.FG := p.FM;
										p.IG := p.FG.IG;
									fi;
									p.FM := none;
									p.nb := p.nb - 1;
									p.IM := -1;
						when 3 : (* p a 3 fils *)
									if p.IG = courant.IG
									then
										p.FG := p.FM;
										p.FM := p.FD;
										p.IG := p.FG.IG;
										p.IM := p.FM.IG;
									else
										if p.FM.IG = courant.IG
										then
											p.FM := p.FD;
											p.IM := p.FM.IG;
										fi;
									fi;
									p.FD := none;
									p.nb := p.nb - 1;
					esac;
				else
					(* p ne pointe pas sur le racine *)
					case p.nb
						when 2 : (* p a 2 fils *)
									writeln("Le cas ou l'on veut supprimer une feuille");
									writeln("dont le pere a 2 fils n'a pas ete gere.");
						
						when 3 : (* p a 3 fils *)
									if p.FG.IG = courant.IG
									then
										p.FG := p.FM;
										p.FM := p.FD;
										p.IG := p.FG.IG;
										p.IM := p.FM.IG;
									else
										if p.FM.IG = courant.IG
										then
											p.FM := p.FD;
											p.IM := p.FM.IG;
										fi;
									fi;
										
									p.FD := none;
									p.nb := p.nb - 1 ;
					esac;
				fi;
			else
				writeln("On ne peut pas supprimer cet element"); 
				writeln("car il n'est pas dans l'arbre");
			fi;
			b.racine := racine;
			result := b;
		end supprimer;

		unit inserer : function(v : integer) : barbre;

			unit refaire : procedure(inout p, f1, f2, j, r : noeud);
			begin
				(* suivant le nombre de fils de p *)
				case p.nb
					when 3 : (* p a 3 fils *)
								if p.FG = f1
								then
									p.FD := p.FM;
									p.FM := j;
								else
									p.FD := j;
								fi;

					when 4 : (* p a 4 fils *)
								(* et creer un nouveau noeud *)
								j := new noeud;
								if p.FG = f1
								then
									j.FG := p.FM;
									j.FM := p.FD;
									p.FM := f2;
								else
									if p.FM = f1
									then
										j.FG := f2;
										j.FM := p.FD;
									else
										j.FG := f1;
										j.FM := f2;
									fi;
								fi;
												
								j.FG.pere := j;
								j.FM.pere := j;
								j.nb := 2;
								p.FD := none;
								p.nb := 2;
												
								if p.pere =/= none
								then
									(* le pere de p n'est pas la racine *)
									(* il faut repeter la procedure refaire *)
									j.pere := p.pere;
									p.pere.nb := p.pere.nb + 1;
									call refaire(p.pere, p, j, j, r);
								else
									(* le pere de p est la racine *)
									(* donc il faut creer une nouvelle racine *)
									r := new noeud;
									r.nb := 2;
									r.FG := p;
									r.FM := j;
									p.pere := r;
									j.pere := r;
									racine := r;
								fi;
				esac;
			end refaire;


		var bidon, courant, i, f1, f2, j, p, r : noeud,
			 b : barbre,
			 pos : integer;
		begin
			b := new barbre;

			bidon := new noeud;
			courant := new noeud;
			r := new noeud;
			i:= new noeud;
			f1 := new noeud;
			f2 := new noeud;
			j := new noeud;
			p:= new noeud;

			if vide
			then
				(* l'arbre est vide *)
				(* creer la feuille qui contiendra l'element a inserer *)
				courant := new noeud;
				courant.pere := racine;
				courant.IG := v;
				racine.IG := v;
				racine.nb := 1;
				racine.FG := courant;

				b.racine := racine;
				result := b;

			else
				(* l'arbre n'est pas vide *)
				courant := racine;
				if present(v,courant)
				then
					writeln("L'element ne peut etre inserer puisqu'il appartient deja a l'arbre.");
				else
					(* l'element n'existe pas dans l'arbre *)
					
					pos := 0;

					i := new noeud;
					p := new noeud;
					i := courant;
					i.pere := courant.pere;
					p := courant.pere;

					(* creer le noeud qui contiendra l'element a inserer *)
					courant := new noeud;
					courant.IG := v;
					courant.pere := p;
					p.nb := p.nb + 1;

					(* determination de la position ou inserer l'element *)
					if i.IG = p.FG.IG
					then
						pos := 1;
					else
						if p.FM =/= none
						then
							if i.IG = p.FM.IG
							then
								pos := 2;
							else
								if p.FD =/= none
								then
									if i.IG = p.FD.IG
									then
										pos := 3;
									fi;
								fi;
							fi;
						fi;
					fi;

					(* suivant le nombre de fils de p *)
					case p.nb
						when 2 : (* p a 2 fils *)
									if courant.IG > i.IG
									then pos := pos + 1;
									fi;
									
									(* suivant la position de l'element *)
									case pos
										when 1 : p.FM := p.FG;
													p.FG := courant;
										when 2 : p.FM := courant;
									esac;
						when 3 : (* p a 3 fils *)
									if courant.IG > i.IG
									then pos := pos + 1;
									fi;
									
									(* suivant la position de l'element *)
									case pos
										when 1 : p.FD := p.FM;
													p.FM := p.FG;
													p.FG := courant;
										when 2 : p.FD := p.FM;
													p.FM := courant;
										when 3 : p.FD := courant;
									esac;
						when 4 : (* p a 4 fils *)
									if courant.IG > i.IG
									then pos := pos + 1;
									fi;

									f1 := new noeud;
									f2 := new noeud;
									
									(* suivant la position de l'element *)
									case pos
										when 1 : f1 := p.FM;
													f2 := P.FD;
													p.FD := none;
													p.FM := p.FG;
													p.FG := courant;
													(**)
										when 2 : f1 := p.FM;
													f2 := p.FD;
													p.FD := none;
													p.FM := courant;
													(**)
										when 3 : f1 := courant;
													f2 := p.FD;
													p.FD := none;
													(**)
										when 4 : f1 := p.FD;
													f2 := courant;
													p.FD := none;
													(**)
									esac;

									j := new noeud;

									j.FG := f1;
									j.FM := f2;
									j.FG.pere := j;
									j.FM.pere := j;
									j.nb := 2;
									p.nb := 2;

									if p.pere =/= none
									then
										(* p a un pere *)
										(* il faut repeter la procedure refaire *)
										j.pere := p.pere;
										p.pere.nb := p.pere.nb + 1;
										call refaire(p.pere, p, j, j, r);
									else
										(* p est la racine *)
										(* donc il faut creer une nouvelle racine *)
										r := new noeud;
										r.nb := 2;
										r.FG := p;
										r.FM := j;
										p.pere := r;
										j.pere := r;
										racine := r;
									fi;
					esac;
				fi;

				courant := racine;
				b.racine := courant;
				result := b;
			fi;
		end inserer;

	begin
		racine := new noeud;
	end barbre;


var ba : barbre,
	 e : integer,
	 bidon, courant, a, b : noeud,
	 choix : integer;

begin
	ba := new barbre;
	courant := new noeud;
	courant := ba.racine;

	do
		(* affichage du menu *)
		writeln;
		writeln;
		writeln;
		writeln;
		writeln("1 -> ajouter un element       :");
		writeln("2 -> supprimer un element     :");
		writeln("3 -> existence d'un element ? :");
		writeln("4 -> minimum de l'arbre       :");
		writeln("5 -> maximum de l'arbre       :");
		writeln("6 -> arbre vide ?             :");
		writeln("7 -> afficher l'arbre         :");
		writeln("8 -> fin.");

		write("choix =");
		read(choix);
		writeln;
		writeln("-------------------------------------------");
		writeln;
		
		(* selon le choix *)
		case choix
			when 1 : (* inserer un element *)
						write("          element = ");
						read(e);

						courant := ba.racine;
						ba := ba.inserer(e);
						courant := ba.racine;
						call ba.reorganiser(courant, bidon);
						writeln;

			when 2 : (* supprimer un element *)
						if ba.vide
						then
							writeln("L'arbre est vide. Impossible de faire supprimer.");
						else
							write("          element = ");
							read(e);
							
							courant := ba.racine;
							ba := ba.supprimer(e);
							courant := ba.racine;
							call ba.reorganiser(courant, bidon);
							writeln;
						fi;

			when 3 : (* determiner si l'element est present dans l'arbre *)
						if ba.vide
						then
							writeln("L'arbre est vide. Impossible de faire present.");
						else
							write("          element = ");
							read(e);
							writeln;
							courant := ba.racine;
							if ba.present(e,courant)
							then
								writeln("          -> present");
							else
								writeln("          -> absent");
							fi;
						fi;

			when 4 : (* determiner l'element minimum *)
						if ba.vide
						then
							writeln("L'arbre est vide. Impossible de faire minimum.");
						else
							writeln("         minimum = ", ba.minimum);
						fi;

			when 5 : (* determiner l'element maximum *)
						if ba.vide
						then
							writeln("L'arbre est vide. Impossible de faire maximum.");
						else
							writeln("         maximum = ", ba.maximum);
						fi;

			when 6 : (* determiner si l'arbre est vide *)
						if ba.vide then writeln("         -> vide");
									  else writeln("         -> pas vide");
						fi;
			
			when 7 : (* affichage de l'arbre *)
						if ba.vide
						then
							writeln("L'arbre est vide.");
						else
							courant := ba.racine;
							call ba.afficher(courant);
						fi;

			when 8 : (* fin du programme *)
						exit;
		esac;
	 od;
end mybarbre.