123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104 |
- module pfacmult; % multivariate modular factorization.
- % Author: Herbert Melenk.
- % Reduction of multivariate modular factorization to univariate
- % factorization by Kroneckers map.
- % See Kaltofen: Factorization of Polynomials, in: Buchberger,
- % Collins, Loos: Computer Algebra, Springer, 1982.
- % This module should be removed as soon as a multivariate modular
- % factorizer based on Hensel lifting has been written.
- fluid '(!*trfac);
- symbolic procedure fctrfkronm f;
- begin scalar sub,tra,k,x,xx,x0,y,z,r,q,f0,fl,fs,dmode!*;
- integer d,d0;
- k:=kernels f;
- dmode!*:='!:mod!:;
- for each z in decomposedegr(f,for each x in k collect (x. 0))
- do if cdr z >d then d:=cdr z;
- d:=d+1; d0:=d; x0:=car k;
- for each x in cdr k do
- <<sub:=(x . {'expt,x0,d0}).sub; tra:=(x.d0).tra; d0:=d0*d>>;
- fs:=numr subf(f,sub);
- if !*trfac then
- <<writepri("Kronecker mapped form:",'first);
- writepri(mkquote prepf fs,'last)>>;
- fl:=decomposefctrf fs;
- if null cdr fl then return {1,f.1};
- f0:=numr resimp (f ./ 1);
- for each fc in fl do if not domainp f0 then
- <<y:=fctrfmk1(fc,tra);
- y:=numr resimp(y ./ 1);
- x := fctrfmk3 y;
- if x then y:= quotf(y, x);
- if !*trfac then
- <<writepri("test next candidate ",'first);
- writepri(mkquote prepf y,'last)>>;
- if (q:=quotf(f0,y)) then
- <<f0:=q; if(z:=assoc(y,r)) then cdr z:=cdr z+1
- else r:=(y. 1).r>>>>;
- if null r then return {1,f. 1};
- if domainp f0 then return (f0 .r);
- if !*trfac then
- <<writepri("descend in recursion with",'only);
- writepri(mkquote prepf f0, 'only)>>;
- fl := fctrfkronm f0;
- if !*trfac then
- <<writepri("return from recursion; numeric factor ",'first);
- writepri(mkquote prepf car fl, 'last);
- for each fc in cdr fl do
- <<writepri("polynomial factor: ",'first);
- writepri(mkquote prepf car fc, nil);
- writepri(" multiplicity ", nil);
- writepri(mkquote prepf cdr fc, 'last)>> >>;
- x := car fl; xx := cdr fl;
- if null cdr xx and cdar xx = 1 and fctrfmk4 x then
- <<y := fctrfmk3 car xx;
- if y then
- <<x := y;
- xx := list(quotf(caar xx, x) . 1);
- if !*trfac then
- <<writepri("number correction; numeric factor ",'first);
- writepri(mkquote x,'last);
- writepri("polynomial factor ",'first);
- writepri(mkquote prepf caar xx,'last)>> >> >>;
- for each fc in xx do
- <<y:=numr resimp(car fc ./ 1);
- if !*trfac then
- <<writepri("next division: ",'first);
- writepri(mkquote prepf y,'last)>>;
- f0:=quotf(f0,y);
- if(z:=assoc(y,r)) then cdr z:=cdr z+cdr fc
- else r:=(y. cdr fc).r>>;
- x := quotf(x, f0);
- return x . r
- end;
- symbolic procedure fctrfmk1(f,tra);
- % Kronecker backtransform.
- if domainp f then f else
- addf(multf(lc f,fctrfmk2(mvar f,ldeg f,tra)),fctrfmk1(red f,tra));
- symbolic procedure fctrfmk2(x,n,tra);
- if n=0 then 1 else
- if null tra then x.**n .* 1 .+ nil else
- if n>=cdar tra then multf(caar tra .** (n/cdar tra) .* 1 .+nil,
- fctrfmk2(x,remainder(n,cdar tra),cdr tra))
- else fctrfmk2(x,n,cdr tra);
- symbolic procedure fctrfmk3 f;
- % Extract the leading coefficient.
- if domainp f then (if fctrfmk4 f then nil else f) else fctrfmk3 lc f;
- symbolic procedure fctrfmk4 u;
- % Test u=1 in modular mode;
- numberp u and u = 1 or
- not atom u and car u = '!:mod!: and modonep!: u;
- endmodule;
- end;
|