program polynomes_creux; {polynomes creux a coefficients entiers}

	type
		pol = ^boite;
		boite = record
				coef: integer;
				degre: integer;
				suiv: pol
			end;

	var
		p, q, r: pol; {r vaudra p+q}

	function est_vide (p: pol): boolean;
{renvoie vraie si la liste est vide}
	begin
		est_vide := (p = nil);
	end;

	procedure creer_monome (var p: pol; x, n: integer);
{creation elementaire}
	begin
		new(p);
		p^.coef := x;
		p^.degre := n;
		p^.suiv := nil;
	end;

	procedure inserer_tete_pol (var p: pol; x, n: integer);
{insertion d'une boite en tete de la liste p}
		var
			q: pol;
	begin
		if est_vide(p) then
			creer_monome(p, x, n)
		else
			begin
				creer_monome(q, x, n);
				q^.suiv := p;
				p := q;
			end;
	end;

	procedure inserer_fin_pol (var p: pol; x, n: integer);
{insertion d'une boite en tete de la liste p}
		var
			q, aux: pol;
	begin
		if est_vide(p) then
			creer_monome(p, x, n)
		else
			begin
				creer_monome(q, x, n);
				aux := p;
				while (aux^.suiv <> nil) do
					aux := aux^.suiv; 	{aux pointe sur la dernier boite}
				aux^.suiv := q;
			end;
	end;


	procedure creation_polynome (var p: pol);
		var
			x, n: integer;
	begin
		writeln('Entrer (par degres croissants) successivement le coefficient et le degre');
		writeln('Separer par un blanc chaque entree. Terminer par return');
		p := nil; {on commence par vider p}
		repeat
			read(x, n);
			inserer_tete_pol(p, x, n)
		until eoln
	end;

	procedure afficher (p: pol);
	begin
		if est_vide(p) then
			writeln
		else if est_vide(p^.suiv) then
			writeln(p^.coef : 2, 'x^', p^.degre : 1)
		else
			begin
				while (p^.suiv <> nil) do
					begin
						write(p^.coef : 2, 'x^', p^.degre : 1, ' +');
						p := p^.suiv;
					end;
				writeln(p^.coef : 2, 'x^', p^.degre : 1);
			end;
	end;

	function retourne_pol_surplace (p: pol): pol;
{retourne la liste en changeant uniquement les champs de type pt; recursive}
	begin
		if est_vide(p) then
			retourne_pol_surplace := p
		else if est_vide(p^.suiv) then
			retourne_pol_surplace := p
		else {il y a au moins deux boites}
			begin
				retourne_pol_surplace := retourne_pol_surplace(p^.suiv);
				p^.suiv^.suiv := p;
				p^.suiv := nil;
			end;
	end;

	function milieu_inf (p: pol): pol;
{renvoie un pointeur sur le milieu inf de liste, c.a.d. un pointeur}
{sur la boite (n+1)/2 si n est impair et sur la boite n/2 si n est pair}
{n designe le nombre de boites de la liste}
		var
			q: pol;{q ira deux fois plus vite que p}
			b: boolean;
	begin
		if est_vide(p) then
			milieu_inf := p
		else if est_vide(p^.suiv) then
			milieu_inf := p
		else if est_vide(p^.suiv^.suiv) then
			milieu_inf := p
		else
			begin
				q := p;
				b := true;
				while b do
					begin
						q := q^.suiv^.suiv;
						p := p^.suiv;
						if q^.suiv = nil then
							b := false
						else if q^.suiv^.suiv = nil then
							b := false;
					end;
				milieu_inf := p;
			end;
	end;

	function additionner (p, q: pol): pol;
{Addition de deux polynomes par fusion de deux listes triees, recursive. }
{Les polynomes p et q sont donnes par degre decroissant de monomes}
{Le resultat p+q aussi}
{Les polynomes p et q sont perdus a la sortie}
		var
			r: pol;
	begin
		if est_vide(p) then
			additionner := q
		else if est_vide(q) then
			additionner := p
		else {les deux listes sont non vides}
			begin
				if (p^.degre > q^.degre) then
					begin
						r := p;
						r^.suiv := additionner(p^.suiv, q);
					end
				else if (p^.degre < q^.degre) then
					begin
						r := q;
						r^.suiv := additionner(p, q^.suiv);
					end
				else if (p^.degre = q^.degre) then
					begin
						r := p;
						p^.coef := p^.coef + q^.coef;
						if (p^.coef = 0) then
							r := additionner(p^.suiv, q^.suiv)
						else
							r^.suiv := additionner(p^.suiv, q^.suiv);
					end;
				additionner := r;
			end;
	end;

	function fusionner (p, q: pol): pol;
{fusion de deux listes triees, recursive}
		var
			r: pol;
	begin
		if est_vide(p) then
			fusionner := q
		else if est_vide(q) then
			fusionner := p
		else {les deux listes sont non vides}
			begin
				if p^.degre >= q^.degre then
					begin
						r := p;
						r^.suiv := fusionner(p^.suiv, q);
					end
				else
					begin
						r := q;
						r^.suiv := fusionner(p, q^.suiv);
					end;
				fusionner := r;
			end;
	end;

	procedure tri_fusion (var p: pol);
{trifusion recursif}
		var
			m, t: pol;
	begin
		if est_vide(p) then
		else if est_vide(p^.suiv) then
		else
			begin
				m := milieu_inf(p);{coupure debut}
				t := m^.suiv;
				m^.suiv := nil;{coupure fin}
				tri_fusion(p);
				tri_fusion(t);
				p := fusionner(p, t);
			end;
	end;



begin{principal}
	ShowText;
	creation_polynome(p);
	afficher(p);
	creation_polynome(q);
	afficher(q);
	r := additionner(p, q);
	afficher(r);
end. {principal}

