reduce-historical/r38/packages/factor/coeffts.red

module coeffts;

% Authors: A. C. Norman and P. M. A. Moore, 1981.

fluid '(!*trfac
        alphalist
        best!-known!-factor!-list
        best!-known!-factors
        coefft!-vectors
        deg!-of!-unknown
        difference!-for!-unknown
        divisor!-for!-unknown
        factor!-level
        factor!-trace!-list
        full!-gcd
        hensel!-growth!-size
        image!-factors
        m!-image!-variable
        multivariate!-factors
        multivariate!-input!-poly
        non!-monic
        number!-of!-factors
        polyzero
        reconstructing!-gcd
        true!-leading!-coeffts
        unknown
        unknowns!-list);


%**********************************************************************;
%  Code for trying to determine more multivariate coefficients
%  by inspection before using multivariate hensel construction.


symbolic procedure determine!-more!-coeffts();
% ...
  begin scalar unknowns!-list,uv,r,w,best!-known!-factor!-list;
    best!-known!-factors:=mkvect number!-of!-factors;
    uv:=mkvect number!-of!-factors;
    for i:=number!-of!-factors step -1 until 1 do
      putv(uv,i,convert!-factor!-to!-termvector(
        getv(image!-factors,i),getv(true!-leading!-coeffts,i)));
    r:=red multivariate!-input!-poly;
            % we know all about the leading coeffts;
    if not depends!-on!-var(r,m!-image!-variable)
      or null(w:=try!-first!-coefft(
              ldeg r,lc r,unknowns!-list,uv)) then <<
      for i:=1:number!-of!-factors do
        putv(best!-known!-factors,i,force!-lc(
          getv(image!-factors,i),getv(true!-leading!-coeffts,i)));
      coefft!-vectors:=uv;
      return nil >>;
    factor!-trace <<
      printstr
         "By exploiting any sparsity wrt the main variable in the";
      printstr "factors, we can try guessing some of the multivariate";
      printstr "coefficients." >>;
    try!-other!-coeffts(r,unknowns!-list,uv);
    w:=convert!-and!-trial!-divide uv;
%   trace!-time
%     if full!-gcd then prin2t "Possible gcd found"
%     else prin2t "Have found some coefficients";
    return set!-up!-globals(uv,w)
  end;

symbolic procedure convert!-factor!-to!-termvector(u,tlc);
% ...
  begin scalar termlist,res,n,slist;
    termlist:=(ldeg u . tlc) . list!-terms!-in!-factor red u;
    res:=mkvect (n:=length termlist);
    for i:=1:n do <<
      slist:=(caar termlist . i) . slist;
      putv(res,i,car termlist);
      termlist:=cdr termlist >>;
    putv(res,0,(n . (n #- 1)));
    unknowns!-list:=(reversip slist) . unknowns!-list;
    return res
  end;

symbolic procedure try!-first!-coefft(n,c,slist,uv);
% ...
  begin scalar combns,unknown,w,l,d,v,m;
    combns:=get!-term(n,slist);
    if (combns='no) or not null cdr combns then return nil;
    l:=car combns;
    for i:=1:number!-of!-factors do <<
      w:=getv(getv(uv,i),car l);    % degree . coefft ;
      if null cdr w then <<
         if unknown then <<c := nil; i := number!-of!-factors + 1>>
          else <<unknown := i . car l; d := car w>>>>
      else <<
        c:=quotf(c,cdr w);
        if didntgo c then i := number!-of!-factors+1>>;
      l:=cdr l >>;
    if didntgo c then return nil;
    putv(v:=getv(uv,car unknown),cdr unknown,(d . c));
    m:=getv(v,0);
    putv(v,0,(car m . (cdr m #- 1)));
    if cdr m = 1 and factors!-complete uv then return 'complete;
    return c
  end;

symbolic procedure solve!-next!-coefft(n,c,slist,uv);
% ...
  begin scalar combns,w,unknown,deg!-of!-unknown,divisor!-for!-unknown,
    difference!-for!-unknown,v;
    difference!-for!-unknown:=polyzero;
    divisor!-for!-unknown:=polyzero;
    combns:=get!-term(n,slist);
    if combns='no then return 'nogood;
    while combns do <<
      w:=split!-term!-list(car combns,uv);
      if w='nogood then combns := nil else combns:=cdr combns >>;
    if w='nogood then return w;
    if null unknown then return;
    w:=quotf(addf(c,negf difference!-for!-unknown),
             divisor!-for!-unknown);
    if didntgo w then return 'nogood;
    putv(v:=getv(uv,car unknown),cdr unknown,(deg!-of!-unknown . w));
    n:=getv(v,0);
    putv(v,0,(car n . (cdr n #- 1)));
    if cdr n = 1 and factors!-complete uv then return 'complete;
    return w
  end;

symbolic procedure split!-term!-list(term!-combn,uv);
% ...
  begin scalar a,v,w;
    a:=1;
    for i:=1:number!-of!-factors do <<
      w:=getv(getv(uv,i),car term!-combn);  % degree . coefft ;
      if null cdr w then
        if v or (unknown and not((i.car term!-combn)=unknown)) then
          <<v:='nogood; i := number!-of!-factors+1>>
        else <<
          unknown:=(i . car term!-combn);
          deg!-of!-unknown:=car w;
          v:=unknown >>
      else a:=multf(a,cdr w);
      if not(v eq 'nogood) then term!-combn:=cdr term!-combn >>;
    if v='nogood then return v;
    if v then divisor!-for!-unknown:=addf(divisor!-for!-unknown,a)
    else difference!-for!-unknown:=addf(difference!-for!-unknown,a);
    return 'ok
  end;

symbolic procedure factors!-complete uv;
% ...
  begin scalar factor!-not!-done,r;
    r:=t;
    for i:=1:number!-of!-factors do
      if not(cdr getv(getv(uv,i),0)=0) then
        if factor!-not!-done then <<r:=nil; i:=number!-of!-factors+1>>
        else factor!-not!-done:=t;
    return r
  end;

symbolic procedure convert!-and!-trial!-divide uv;
% ...
  begin scalar w,r,fdone!-product!-mod!-p,om;
    om:=set!-modulus hensel!-growth!-size;
    fdone!-product!-mod!-p:=1;
    for i:=1:number!-of!-factors do <<
      w:=getv(uv,i);
      w:= if (cdr getv(w,0))=0 then termvector2sf w
        else merge!-terms(getv(image!-factors,i),w);
      r:=quotf(multivariate!-input!-poly,w);
      if didntgo r then best!-known!-factor!-list:=
        ((i . w) . best!-known!-factor!-list)
      else if reconstructing!-gcd and i=1
       then <<full!-gcd:=if non!-monic then car primitive!.parts(
          list w,m!-image!-variable,nil) else w;
          i := number!-of!-factors+1>>
      else <<
        multivariate!-factors:=w . multivariate!-factors;
        fdone!-product!-mod!-p:=times!-mod!-p(
          reduce!-mod!-p getv(image!-factors,i),
          fdone!-product!-mod!-p);
        multivariate!-input!-poly:=r >> >>;
    if full!-gcd then return;
    if null best!-known!-factor!-list then multivariate!-factors:=
      primitive!.parts(multivariate!-factors,m!-image!-variable,nil)
    else if null cdr best!-known!-factor!-list then <<
      if reconstructing!-gcd then
        if not(caar best!-known!-factor!-list=1) then
          errorf("gcd is jiggered in determining other coeffts")
        else full!-gcd:=if non!-monic then car primitive!.parts(
          list multivariate!-input!-poly,
          m!-image!-variable,nil)
          else multivariate!-input!-poly
      else multivariate!-factors:=primitive!.parts(
        multivariate!-input!-poly . multivariate!-factors,
        m!-image!-variable,nil);
      best!-known!-factor!-list:=nil >>;
    factor!-trace <<
      if null best!-known!-factor!-list then
        printstr
           "We have completely determined all the factors this way"
      else if multivariate!-factors then <<
        prin2!* "We have completely determined the following factor";
        printstr if (length multivariate!-factors)=1 then ":" else "s:";
        for each ww in multivariate!-factors do printsf ww >> >>;
    set!-modulus om;
    return fdone!-product!-mod!-p
  end;

symbolic procedure set!-up!-globals(uv,f!-product);
  if null best!-known!-factor!-list or full!-gcd then 'done
  else begin scalar i,r,n,k,flist!-mod!-p,imf,om,savek;
    n:=length best!-known!-factor!-list;
    best!-known!-factors:=mkvect n;
    coefft!-vectors:=mkvect n;
    r:=mkvect n;
    k:=if reconstructing!-gcd then 1 else 0;
    om:=set!-modulus hensel!-growth!-size;
    for each w in best!-known!-factor!-list do <<
      i:=car w; w:=cdr w;
      if reconstructing!-gcd and i=1 then << savek:=k; k:=1 >>
      else k:=k #+ 1;
            % in case we are reconstructing gcd we had better know
            % which is the gcd and which the cofactor - so don't move
            % move the gcd from elt one;
      putv(r,k,imf:=getv(image!-factors,i));
      flist!-mod!-p:=(reduce!-mod!-p imf) . flist!-mod!-p;
      putv(best!-known!-factors,k,w);
      putv(coefft!-vectors,k,getv(uv,i));
      if reconstructing!-gcd and k=1 then k:=savek;
            % restore k if necessary;
      >>;
    if not(n=number!-of!-factors) then <<
      alphalist:=for each modf in flist!-mod!-p collect
        (modf . remainder!-mod!-p(times!-mod!-p(f!-product,
          cdr get!-alpha modf),modf));
      number!-of!-factors:=n >>;
    set!-modulus om;
    image!-factors:=r;
    return 'need! to! reconstruct
  end;

symbolic procedure get!-term(n,l);
% ...
  if n#<0 then 'no
  else if null cdr l then get!-term!-n(n,car l)
  else begin scalar w,res;
    for each fterm in car l do <<
      w:=get!-term(n#-car fterm,cdr l);
      if not(w='no) then res:=
        append(for each v in w collect (cdr fterm . v),res) >>;
    return if null res then 'no else res
  end;

symbolic procedure get!-term!-n(n,u);
  if null u or n #> caar u then 'no
  else if caar u = n then list(cdar u . nil)
  else get!-term!-n(n,cdr u);

endmodule;

end;