uses crt,algebra,modulop; procedure getpmatrix(u:intvect;n:byte;p:longint;var m:matrix); var a,b:intvect; i,j,k,d:longint; begin fillchar(a,sizeof(a),0); fillchar(b,sizeof(b),0); fillchar(m,sizeof(m),0); a[0]:=1; m[0,0]:=1; for i:=1 to n-1 do begin for j:=1 to p do begin d:=a[n-1]; b[0]:=-d*u[0] mod p; for k:=1 to n-1 do b[k]:=(a[k-1]-d*u[k]) mod p; a:=b; end; m[i]:=a; end; for i:=0 to n-1 do m[i,i]:=(m[i,i]-1) mod p; for i:=0 to n-1 do for j:=0 to n-1 do if m[i,j]<0 then inc(m[i,j],p); end; procedure affiche (a:matrix;n:longint); var i,j:longint; begin writeln; for i:=0 to n-1 do begin writeln; for j:=0 to n-1 do Begin if a[i,j]<=9 then write(' '); write(a[i,j],' '); end; end; end; procedure _n(a:matrix;n:longint;p:longint;var r:longint;var list:pliste); var i,j,k,l,tin:longint; c,s:intvect; oui:boolean; v:vecteur; b:matrix; ad:pointer; begin ad:=nil; fillchar(c,sizeof(c),$FF); fillchar(s,sizeof(c),$FF); r:=0; for k:=0 to n-1 do begin j:=-1; repeat inc(j); oui:=(a[k,j]<>0) and (c[j]<0); until oui or (j=n-1); if oui then begin tin:=(p-inv^[a[k,j]]) mod p; for i:=0 to n-1 do a[i,j]:=(tin*a[i,j]) mod p; b:=a; for i:=0 to n-1 do if i<>j then begin for l:=0 to n-1 do begin inc(b[l,i],a[k,i]*a[l,j]); b[l,i]:=b[l,i] mod p; end; end; a:=b; c[j]:=k; s[k]:=j; { affiche(a,n); readln;} end else begin inc(r); new(list); list^.next:=ad; ad:=list; fillchar(list^.v,sizeof(list^.v),0); for j:=0 to n-1 do begin if s[j]<>-1 then list^.v[j]:=a[k,s[j]] else if j=k then list^.v[j]:=1 else list^.v[j]:=0; end; end; end; end; PROCEDURE SAISIE(VAR L:intvect); 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; procedure affl(l:pliste;n:longint); var i:longint; begin while l<>nil do begin writeln; for i:=0 to n do write(l^.v[i],' '); l:=l^.next; end; end; procedure split(u,v:intvect;r,p:longint); var d:intvect; s:string; var i,j,W:longint; begin i:=0; w:=0; repeat pgcd_poly_modp(v,u,d); for j:=0 to max do if d[j]*2>p then d[j]:=d[j]-p; s:=ecris_mod_p(d); if s<>'1' then begin write('(',s,')'); inc(w); end; dec(v[0]); inc(i); until (i=p) or (w=r); writeln; if w=r then writeln('Factorisation complŠte') else writeln('!! Factorisation incomplŠte :il y a ',r,' facteurs en tout'); end; Function Simplifie(var a:intvect;p:longint):boolean; var b,r:intvect; i:longint; Begin fillchar(b,sizeof(b),0); b[1]:=1; for i:=0 to p do if Int_Val(a,i,p)=0 then Begin if 2*i
p then a[i]:=a[i]-p; write('(',ecris_mod_p(a),')'); Simplifie:=true; End else Simplifie:=false End; var m:matrix; p:intvect; r,prim,n:longint; l:pliste; begin clrscr; saisie(p); write('p='); readln(prim); Set_prime(prim); writeln; If not Simplifie(p,prim) then Begin n:=Int_Degre(p); getpmatrix(p,n,prim,m); _n(m,n,prim,r,l); if r=1 then writeln('(',ecris_mod_p(p),')') else split(p,l^.v,r,prim); End; Delete_prime; end.