PROGRAM bezout;

{
     Ecole Polytechnique  ...........................   95.419

Soient a et b deux entiers relatifs non nuls.
On sait que s'ils sont premiers entre eux, il existe (thorme de Bezout)
deux autres entiers relatifs u et v tels que :

	(1) 			au+bv=1

1/	Ecrire un programme qui calcule, en fonction de a et b, un couple
d'entiers (u, v) satisfaisant  l'quation (1). Adapter
le programme de manire  rechercher le plus grand commun dnominateur (PGCD)
de deux entiers a et b quelconques.
	

2/ 	On considre maintenant l'algbre H des polynmes de la forme :

P(x)=c0+c1x+C2xύ  +   cn.x^n


	dont les coefficients ci appartiennent  Z et o
        n est le degr du polynme P, not deg(P)

Montrer que si A et B sont deux polynmes quelconques de H,
il est possible de trouver un couple de polynmes (U, V)
 appartenant  Hύ (non simultanment nuls) et un entier k tels que :

	(2)	A(x)U(x)+B(x)V(x)=k

o k appartient  Z  et deg(U)<deg(B)  et deg(V)<deg(A)

Ecrire un programme Pascal qui calcule k, U et V
(on prsentera, parmi toutes les solutions,
celle qui fournit une valeur de k positive et la plus petite possible).
		
Tester le fonctionnement du programme sur des polynmes du type :

A(x)=1-x^m       B(x)=1+x^m


3/ 	Dans quel cas obtient-on k=0  ?
Adapter le programme prcdent pour rechercher le PGCD de deux polynmes,
c'est  dire le polynme de degr le plus lev possible qui soit
 la fois un diviseur de A et de B.

4/ 	On dit qu'une famille de n polynmes appartenant  H forme une
dcomposition du polynme P appartenant  H si P peut s'exprimer sous
forme d'un produit :

P(x)=  U1(x).U2(x)......Un(x)


	La dcomposition de P est dite maximale si le nombre n de termes du produit est maximal. Si une dcomposition est maximale, que peut-on dire du degr de chaque terme Ui ? Ecrire un programme Pascal capable de dterminer une dcomposition maximale de tout polynme  P{CARSPECIAUX 206 \f "Symbol"}H et tester le fonctionnement du programme sur des polynmes de la forme  {INCORPORER Equation |}


}


uses
  crt,modubase;


const
     degmax=10;
type
    MyInt=Longint;
     polynome=record
         degre:integer;
         terme:array[0..degmax] of MyInt;
     end;


var
   zero:polynome;
   divider:polynome;
   u,v,a,b,n,p:integer;

const
     xmin=-10 ;
     xmax= 100;
     ymin=-30;
     ymax= 30;

var
   ch:char;
     Car         : Char ;
     Question    : Char;


procedure InitP(VAR p:polynome;deg:integer);
var
   i:integer;
begin
     p.degre:=deg;
     for i:=0 to deg do
         p.terme[i]:=0
end;

procedure ZeroP(VAR p:polynome);
begin
     InitP(p,0);
end;

function EqP(p,q:polynome):boolean;
var
   b:Boolean;
   i:integer;
const
   eps=1E-10;
begin
     b:=p.degre=q.degre;
     for i:=0 to p.degre do
         b:=b and (abs(p.terme[i]-q.terme[i])<eps);
     Eqp:=b;
end;


procedure NormP(VAR p:polynome);
var
   i:integer;
const
     eps=1E-10;
begin
     with P do
          while (degre>0) and (abs(terme[degre])<eps) do
                Dec(degre)
end;



Procedure AffP(p:polynome);
var
    j,k:integer;
    v:MyInt;
   rien : Boolean;

   procedure aff(s:string;ex:integer);
   begin
        if ex>0 then
          begin
             write(s);
             if ex=2 then
                write('ύ')
             else
              if ex>2 then
                 write('^',ex);
          end;
   end;
begin
     rien:=true;
     with p do
      begin
         for k:=0 to degre do
              begin
                 v:=terme[k];
                 if (v<>0) then
                    begin
                             if ((v>0) and ((v<>1)) or ((v>0) and not rien)) then
                               write(' + ');
                             if (v=-1) and (k>0) then
                                write(' - ');
                    if (abs(v)<>1) or (k=0) then
                     begin
                      if v=round(v) then
                       write(round(v))
                      else
                       write(v:10);
                     end ;
                         Aff('x',k);
                         rien:=false;

                    end
              else
                  if degre=0 then write(0);
              end;
      end;
end;


function max(i,j:integer):integer;
begin
     if i>j then max:=i else max:=j;
end;

Procedure AddP(p,q:polynome;var s:polynome);
var
   i:integer;
begin
     s.degre:=max(p.degre,q.degre);
     for i:=0 to s.degre do
      begin
            if i>p.degre then
               s.terme[i]:=0
            else
                s.terme[i]:=p.terme[i];
            if i<=q.degre then
               s.terme[i]:=s.terme[i]+q.terme[i]
      end;
      NormP(s);
end;

Procedure ScalP(p:polynome;coeff:MyInt;var q:polynome);
var
   i,j,k:integer;
begin
     q.degre:=p.degre;
     for i:=0 to p.degre do
              q.terme[i]:=p.terme[i]*coeff;
     NormP(q);
end;

Procedure SubP(p,q:polynome;var s:polynome);
var
   i:integer;
begin
     s.degre:=max(p.degre,q.degre);
     for i:=0 to s.degre do
      begin
            if i>p.degre then
               s.terme[i]:=0
            else
                s.terme[i]:=p.terme[i];
            if i<=q.degre then
               s.terme[i]:=s.terme[i]-q.terme[i];
      end;
      NormP(s);
end;

Procedure MulP(p,q:polynome;var s:polynome);
var
   i,j:integer;
begin
     InitP(s,p.degre+q.degre);
     for i:=0 to p.degre do
        for j:=0 to q.degre do
            s.terme[i+j]:=s.terme[i+j]+p.terme[i]*q.terme[j];
end;


Procedure bez (a,b:MyInt;var u,v:MyInt);
begin
     if a<0 then
      begin
        bez(-a,b,u,v);
        u:=-u
      end
      else
      if b<0 then
      begin
        bez(a,-b,u,v);
        v:=-v
      end
     else
     begin
     u:=1;
     v:=0;
     while abs(a*u+b*v-1)>0.1 do
     begin
          u:=u-1;
          v:=v-1;
          if u=0 then
             begin
                  u:=1-v;
                  v:=0;
             end;
     end;
     
  end;
 end;


function pgcd(a,b:integer):integer;
var
   q:integer;
begin
     a:=abs(a);
     b:=abs(b);
     p:=maxint;
     u:=1;
     v:=0;
     repeat
           q:=a*u-b*v;
           if (q>0) and (q<p) then
              p:=q;
          u:=u-1;
          v:=v+1;
          if u=0 then
             begin
                  u:=1+v;
                  v:=0;
             end;
     until (p=1) or (v>a*b);
     pgcd:=p;
 end;

procedure BezoutP(A,B:polynome;var u,v:polynome;var k:MyInt);
var
   zero,quotient,reste,u1,v1,P1,w,w1:polynome;
   alpha,beta:MyInt;
   pg:MyInt;
begin
     Write('Bezout [ A =');AffP(A);
     Write(' ] [ B =');AffP(B);WriTelN(']');
     Pause;

     ZeroP(zero);
     if A.degre<B.degre then
             BezoutP(B,A,v,u,k)
     else
         { Let us assume that  deg(A)>=deg(B)
          and replace A by alpha*A-beta*B*x^[deg(A)-deg(B)]   }
          if B.degre=0 then
             begin
                  ZeroP(u);
                  ZeroP(v);
                  v.terme[0]:=1;
                  k:=B.terme[0];
                  if k=0 then Divider:=A;
             end
          else
         begin
              alpha :=B.terme[B.degre];
              beta  :=A.terme[A.degre];
              pg:=pgcd(alpha,beta);
              alpha:=alpha div pg;
              beta:=beta div pg;


              InitP(w,A.degre-B.degre);
              W.terme[w.degre]:=-beta;

              MulP(W,B,W1);

              ScalP(A,alpha,P1);

              AddP(P1,W1,P1);

              BezoutP(P1,B,u1,v1,k);

              ScalP(u1,alpha,u);
              MulP(w,u1,w);
              AddP(v1,w,v);

         end;

end;


Procedure Presentation;
begin
    Efface;
    WriteLN('Thorme de Bezout         ');
    WriteLN('                           ');
    WriteLN('                           ');
    WriteLN(' (1)    au - bv  = 1  ');
    WriteLN(' (2)    PGCD de a et b     ');
    WriteLN(' (3)    Calculer U et V  tels que AU+BV=k          ');
    WriteLN(' (4)    PGCD de deux polynomes         ');
    WriteLN(' (5)    Decomposition de P(x)             ');
    WriteLN('                           ');
    WriteLN('                           ');

    end;

procedure Question1;
var
   a,b,u,v:MyInt;
begin
     Efface;
     Writeln('ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ Question nψ1 ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»');
     Writeln('Ί                                                                   Ί');
     Writeln('Ί   au - bv  = 1                                                    Ί');
     Writeln('Ί                                                                   Ί');
     Writeln('ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ');

    while true do
    begin
     Writeln('Entrez les nombres a et b =');
     Write('a='); ReadLN(a);
     Write('b='); ReadLN(b);

     Bez(a,b,u,v);
     WriteLN('Solution :',a,'*(',u,')+',b,'*(',v,')=1');
     Writeln ('u=',u:12,'       v=',v);
    end;
    pause;
end;

procedure Question2;
begin
     Efface;
     Writeln('ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ Question nψ2 ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»');
     Writeln('Ί                                                                   Ί');
     Writeln('Ί   PGCD du a et b                                                  Ί');
     Writeln('Ί                                                                   Ί');
     Writeln('ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ');

    while true do
    begin
     Writeln('Entrez les nombres a et b =');
     Write('a='); ReadLN(a);
     Write('b='); ReadLN(b);

     Writeln ('PGCD =',PGCD(a,b));
    end;
end;
                                                  

procedure Question3;
var
   A,B:polynome;
   U,V:polynome;
   m,n:integer;
   k:MyInt;

begin
     Efface;
     Writeln('ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ Question nψ3 ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»');
     Writeln('Ί                                                                   Ί');
     Writeln('Ί   Calculer U et V  tels que AU+BV=k                          Ί');
     Writeln('Ί                                                                   Ί');
     Writeln('ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ');

     Write('A=1-x^m   avec   m=');Read(m);
     InitP(A,degmax) ;
     A.terme[0]:=1;
     A.terme[m]:=-1;
     NormP(A);
     Write('A= ');AffP(A);WriteLN;

     Write('B=1+x^n   avec   n=');Read(n);
     InitP(B,degmax) ;
     B.terme[0]:=1;
     B.terme[n]:=1;
     NormP(B);
     Write('B= ');AffP(B);WriteLN;

     WriteLN('Bezout entre A et B');
     BezoutP(A,B,U,V,k);
     if k<0 then
        begin
             ScalP(U,-1,U);
             ScalP(V,-1,V);
             k:=-k;
        end;

     WriteLN('Rsultat  final AU+BV=',k,'  avec');
     Write('A= ');AffP(A);WriteLN;
     Write('B= ');AffP(B);WriteLN;
     Write('U= ');   AffP(u);WriTeln;
     Write('V= ');   AffP(v);WriTeln;
     WriteLN('AU+BV=',k);
     PAuse;
end;




procedure Question4;
var
   A,B:polynome;
   U,V:polynome;
   m,n:integer;
   k:MyInt;

begin
     Efface;
     Writeln('ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ Question nψ4 ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»');
     Writeln('Ί                                                                   Ί');
     Writeln('Ί   PGCD du A(x) et B(x)                                                  Ί');
     Writeln('Ί                                                                   Ί');
     Writeln('ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ');

     InitP(A,degmax) ;
     A.terme[0]:=1;
     A.terme[3]:=-1;
     NormP(A);
     Write('A= ');AffP(A);WriteLN;

     InitP(B,degmax) ;
     B.terme[0]:=1;
     B.terme[1]:=1;
     B.terme[2]:=1;
     NormP(B);
     Write('B= ');AffP(B);WriteLN;

     ZeroP(divider);
     BezoutP(A,B,U,V,k);

     WriteLN('Rsultat  final AU+BV=',k,'  avec');
     Write('A= ');AffP(A);WriteLN;
     Write('B= ');AffP(B);WriteLN;
     Write('U= ');   AffP(u);WriTeln;
     Write('V= ');   AffP(v);WriTeln;
     if k<>0 then
        WriteLN('A et B sont premiers entre eux.')
     else
        begin
             Write('Le PGCD de A et B :');
             AffP(divider);WriteLN;
             k:=-k;
        end;
     Pause;
end;

procedure Question5;
var
   A,B,C:polynome;
   m,n,p : integer;
   indecomposable : Boolean;

   function NulP(P:polynome):boolean;
   begin
        NulP:=(P.degre=0) and (P.terme[0]=0);
   end;


   function divise(a,b:integer):boolean;
   begin
        if b=0 then divise:=false
        else
        divise:=(a MOD b)=0;
   end;

   Procedure divisionP(B,C:polynome;VAR Q,R:polynome);
   var
      done:Boolean;
      QQ,RR:polynome;
   begin
        ZeroP(Q);
        R:=B;
        repeat
            done:=true;
            if R.degre>=C.degre then
             if divise(R.terme[R.degre],C.terme[C.degre]) then
               begin
                done:=false;
                InitP(QQ,R.degre-C.degre);
                QQ.terme[QQ.degre]:=R.terme[R.degre] DIV C.terme[C.degre];
                MulP(QQ,C,RR);
                SubP(R,RR,R);
                AddP(Q,QQ,Q);
              end;
        until done ;
   end;




   Procedure Decompose1;  { recherche d'un diviseur de degre 1 }
   var
      ok:boolean;
      Q,R:Polynome;
      begin
           ok:=false;
           InitP(C,1) ;
           C.terme[1]:=1;
           Repeat
                 if divise(A.terme[A.degre],C.terme[1]) then
                   begin
                       C.terme[0]:=-abs(A.terme[0]);
                       Repeat
                             if divise(A.terme[0],C.terme[0]) then
                             begin
                                  DivisionP(B,C,Q,R);
                                  if NulP(R) then
                                     begin
                                          Write('Terme trouve=');
                                          AffP(C);WriteLN;
                                          B:=Q;
                                          ok:=true;
                                     end;
                             end;
                             inc(C.terme[0]);
                       until ok or (C.terme[0]>abs(A.terme[0]))                 end;
               inc(C.terme[1]);
           until ok or (C.terme[1]>abs(A.terme[A.degre]));
           indecomposable:=not ok;
      end;

   Procedure Decompose2;  { recherche d'un diviseur de degre 2 }
   var
      ok:boolean;
      Q,R:Polynome;
      i,imax:integer;
      begin
           ok:=false;
           InitP(C,2) ;
           C.terme[2]:=1;
           imax:=1;
           for i:=0 to A.degre do
               imax:=imax*abs(A.terme[i]);
           Repeat
                 if divise(A.terme[A.degre],C.terme[1]) then
                   begin

                       C.terme[0]:=-abs(A.terme[0]);
                       Repeat
                         for i:=-imax to imax do
                          begin
                           C.terme[1]:=i;
                           if divise(A.terme[0],C.terme[0]) then
                           begin
                                  DivisionP(B,C,Q,R);
                                  if NulP(R) then
                                     begin
                                          Write('Terme trouve=');
                                          AffP(C);WriteLN;
                                          B:=Q;
                                          ok:=true;
                                     end;
                            end;
                           end;
                           inc(C.terme[0]);
                       until ok or (C.terme[0]>abs(A.terme[0]))                 end;
               inc(C.terme[2]);
           until ok or (C.terme[2]>abs(A.terme[A.degre]));
           indecomposable:=not ok;
      end;



begin
     Efface;
     Writeln('ΙΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ Question nψ5 ΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝ»');
     Writeln('Ί                                                                   Ί');
     Writeln('Ί   Dcomposition de P(x)                                           Ί');
     Writeln('Ί                                                                   Ί');
     Writeln('ΘΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΝΌ');

      Write('P=m-nx^p   avec   m=');ReadLN(m);
     Write('n=');ReadLN(n);
     Write('p=');ReadLN(p);

     InitP(A,degmax) ;
     A.terme[0]:=m;
     A.terme[p]:=-n;
     NormP(A);
     Write('P= ');AffP(A);WriteLN;
     B:=A;
     Pause;

     Repeat
           Decompose1;
     until indecomposable;
     Repeat
           Decompose2;
     until indecomposable ;
     WriteLN('terme restant=');
     AffP(B);
     WritelN;
     PAuse;


end;


begin
  while true do
  begin
    Presentation;

     write('Question choisie ? ');
     readln(question);
     case question of
          '1':  Question1;
          '2':  Question2;
          '3':  Question3;
          '4':  Question4;
          '5':  Question5;
     end;
     Pause;
  end;
end.