UNIT ALGEBRA;

INTERFACE

Const epsilon=1e-6;
      MAX=30;

VAR COUPE:BOOLEAN;

TYPE VECTEUR=ARRAY[0..MAX] OF REAL;
     MATRICE=ARRAY[0..MAX] OF VECTEUR;

     facto=record
            poly:vecteur;
               n:byte;
            next:pointer;
            end;

     pfacto=^facto;

FUNCTION FACTORIELLE(N:WORD):REAL;
FUNCTION PGCD(A:REAL;B:REAL):REAL;
FUNCTION DEGRE(P:VECTEUR):INTEGER;
PROCEDURE DIV_POLY(N,D:VECTEUR;VAR Q,R:VECTEUR);
PROCEDURE DIVC_POLY(N,D:VECTEUR;VAR Q,R:VECTEUR;H:WORD);
PROCEDURE MUL_POLY(A,B:VECTEUR;VAR V:VECTEUR);
PROCEDURE PUIS_POLY(A:VECTEUR;N:WORD;VAR V:VECTEUR);
PROCEDURE COMPOSEE(A,B:VECTEUR;VAR R:VECTEUR);
FUNCTION NORMAL(L:REAL):STRING;
FUNCTION ECRITURE_POLY(V:VECTEUR):STRING;
FUNCTION EXP_PUIS(S:STRING;P:REAL;DENOM:BOOLEAN):STRING;
FUNCTION SIMPLE(S:STRING):BOOLEAN;
FUNCTION NOMBRE(S:STRING;VAR R:REAL):BOOLEAN;
PROCEDURE SAISIE(VAR L:vecteur);
Procedure Derive_vecteur(p:vecteur;var r:vecteur);
procedure affiche_facto(p:pfacto);
procedure pgcd_poly(a,b:vecteur;var r:vecteur);

IMPLEMENTATION

FUNCTION FACTORIELLE(N:WORD):REAL;
 VAR R:REAL;
     I:WORD;
  BEGIN
   R:=1;
   FOR I:=1 TO N DO R:=R*I;
   FACTORIELLE:=R
  END;

FUNCTION PGCD(A:REAL;B:REAL):REAL;
VAR AA,R:REAL;
BEGIN
 IF (A=1) OR (B=1) OR COUPE OR ((A=0) AND (B=0)) THEN PGCD:=1 ELSE
 IF (A<>INT(A)) OR (B<>INT(B)) THEN PGCD:=1
 ELSE
 IF A=0 THEN PGCD:=B
 ELSE
 IF B=0 THEN PGCD:=A
 ELSE
 BEGIN
 AA:=A;
 IF A<B THEN
  BEGIN
   A:=B;
   B:=AA;
  END;
  REPEAT
   R:=A-INT(A/B)*B;
   A:=B;
   B:=R;
  UNTIL (R=0) OR (R=1);
 IF R=1 THEN PGCD:=1 ELSE PGCD:=A
 END
END;

PROCEDURE SAISIE(VAR L:vecteur);
 VAR J,R:WORD;
 BEGIN
    FILLCHAR(L,SIZEOF(L),0);
    WRITE('Degr‚ : ');
    READLN(R);
    FOR J:=R DOWNTO 0 DO
     BEGIN
      WRITE('Coeff en x^',J,' : ');
      READLN(L[j])
     END;
 END;

Function Degre(p:vecteur):integer;
var i:integer;
begin
  i:=Max;
  while ((i>=0) and (abs(p[i])<=epsilon)) do i:=i-1;
  if i<0 then i:=-maxint;
  Degre:=i;
end;

Procedure Derive_vecteur(p:vecteur;var r:vecteur);
 var i:integer;
 begin
  fillchar(r,sizeof(r),0);
  for i:=1 to degre(p) do r[i-1]:=i*p[i];
 end;

procedure affiche_facto(p:pfacto);
 var s:string;
 begin
  repeat
   s:=ecriture_poly(vecteur(p^.poly));
   if s<>'1' then
   begin
   write('(');
   write(s);
   write(')');
   case p^.n of
    1: {};
    2: write('ý');
    else write('^',p^.n); end; end;
   p:=p^.next;
  until p=nil;
 end;

PROCEDURE DIV_POLY(N,D:VECTEUR;VAR Q,R:VECTEUR);
VAR DD,I,A,B:WORD;
    COEFF:REAL;
 BEGIN
  R:=N;
  DD:=DEGRE(D);
  FILLCHAR(Q,SIZEOF(Q),0);
  WHILE DEGRE(R)>=DD DO
   BEGIN
    A:=DEGRE(R);
    B:=DEGRE(D);
    COEFF:=R[A]/D[B];
    Q[A-B]:=COEFF;
    FOR I:=0 TO B DO
     R[I+A-B]:=R[I+A-B]-COEFF*D[I];
   END;
 END;

PROCEDURE DIVC_POLY(N,D:VECTEUR;VAR Q,R:VECTEUR;H:WORD);
VAR DD,I,A,B,NP:WORD;
    COEFF:REAL;
 BEGIN
  R:=N;
  DD:=DEGRE(D);
  FILLCHAR(Q,SIZEOF(Q),0);
  FOR NP:=0 TO H DO
   BEGIN
    COEFF:=R[NP]/D[0];
    Q[NP]:=COEFF;
    R[NP]:=0;
    FOR I:=1 TO DD DO IF I+NP<=MAX THEN
     R[I+NP]:=R[I+NP]-COEFF*D[I];
   END;
 END;

procedure pgcd_poly(a,b:vecteur;var r:vecteur);
 var q:vecteur;
     i,j:integer;
       x:real;
 begin
  while Degre(b)<>-Maxint do
   begin
    Div_poly(a,b,q,r);
    a:=b;
    b:=r;
   end;
   fillchar(r,sizeof(r),0);
   j:=Degre(a);
   x:=a[j];
   for i:=0 to j do r[i]:=a[i]/x;
  end;


PROCEDURE MUL_POLY(A,B:VECTEUR;VAR V:VECTEUR);
 VAR I,J:WORD;
 BEGIN
  FILLCHAR(V,SIZEOF(V),0);
  FOR I:=0 TO DEGRE(A) DO FOR J:=0 TO DEGRE(B) DO
   V[I+J]:=V[I+J]+A[I]*B[J];
 END;

PROCEDURE PUIS_POLY(A:VECTEUR;N:WORD;VAR V:VECTEUR);
 VAR I:WORD;
     P:VECTEUR;
 BEGIN
  FILLCHAR(V,SIZEOF(V),0);
  V[0]:=1;
  FOR I:=1 TO N DO
   BEGIN
    MUL_POLY(A,V,P);
    V:=P
   END;
 END;

PROCEDURE COMPOSEE(A,B:VECTEUR;VAR R:VECTEUR);
VAR I,J:BYTE;
    S:VECTEUR;
 BEGIN
  FOR I:=0 TO MAX DO R[I]:=B[I]*A[1];
  R[0]:=R[0]+A[0];
  S:=B;
  FOR I:=2 TO DEGRE(A) DO
   BEGIN
    MUL_POLY(S,B,S);
    IF A[I]<>0 THEN FOR J:=0 TO DEGRE(S) DO R[J]:=R[J]+S[J]*A[I];
   END;
 END;

FUNCTION NORMAL(L:REAL):STRING;
VAR    S:STRING;
    TEST:BOOLEAN;
 BEGIN

  STR(L:15:5,S);  { CONVERTIR EN CHAINE }

  WHILE COPY(S,1,1)=' ' DO DELETE(S,1,1); {ENLEVER LES ESPACES }

   IF POS('.',S)<>0 THEN {ENLEVER LES ZEROS APRES LA VIRGULE}
    BEGIN
      REPEAT
       TEST:=(COPY(S,LENGTH(S),1)='0');
       IF TEST OR (COPY(S,LENGTH(S),1)='.') THEN DELETE(S,LENGTH(S),1);
      UNTIL NOT TEST
    END;
  NORMAL:=S
 END;


FUNCTION ECRITURE_POLY(V:VECTEUR):STRING;
VAR I,D:WORD;
      S:STRING;
 BEGIN
  S:='';
  D:=DEGRE(V);
  FOR I:=D DOWNTO 1 DO IF V[I]<>0 THEN
   BEGIN

    IF V[I]=1 THEN S:=S+'+x'
     ELSE IF V[I]=-1 THEN S:=S+'-x'
     ELSE
     BEGIN
      IF V[I]>0 THEN S:=S+'+';
      S:=S+NORMAL(V[I])+'x'
     END;
    IF I<>1 THEN S:=S+'^'+NORMAL(I);
   END;
  IF (D=0) OR (V[0]<>0) THEN
   BEGIN
    IF V[0]>0 THEN S:=S+'+';
    S:=S+NORMAL(V[0]);
   END;
  IF S[1]='+' THEN DELETE (S,1,1);
  ECRITURE_POLY:=S;
 END;

FUNCTION SIMPLE(S:STRING):BOOLEAN;
 BEGIN
  SIMPLE:=(POS('+',S)=0)
  AND (POS('-',S)=0)
  AND (POS('*',S)=0)
  AND (POS('/',S)=0)
  AND (POS('^',S)=0)
  END;

FUNCTION EXP_PUIS(S:STRING;P:REAL;DENOM:BOOLEAN):STRING;
 BEGIN
  IF NOT SIMPLE(S) THEN S:='('+S+')';
  IF P=0 THEN EXP_PUIS:='1' ELSE
   IF P=1 THEN EXP_PUIS:=S ELSE
    IF (P>0) OR (NOT DENOM) OR (FRAC(P)<>0)
     THEN EXP_PUIS:=S+'^'+NORMAL(P)
     ELSE
      IF P=-1 THEN EXP_PUIS:='1/'+S
              ELSE EXP_PUIS:='1/'+S+^'+NORMAL(P)
 END;

FUNCTION NOMBRE(S:STRING;VAR R:REAL):BOOLEAN;
VAR I:INTEGER;
 BEGIN
  VAL(S,R,I);
  NOMBRE:=(I=0)
 END;

BEGIN
 COUPE:=FALSE;
END.