%mathpiper,def="xFactors"

/*------------------------------------------------------------------------
 *  PENULTIMATE VERSION 
 *    Started 091222
 *    revised 100108-22
 *    revised 100215
 *    revised 100301
 *------------------------------------------------------------------------*/

//Retract("xFactors",*);
//Retract("xFactorsPrimitivePart",*);
//Retract("xFactorsUnivariate",*);
//Retract("xFactorsMultivariate",*);
//Retract("xFactorsHomogeneousBivariate",*);
//Retract("CheckForSpecialForms",*);

//Retract("ApproximateRealCoefficients",*);
//Retract("FixUpMonicFactors",*);
//Retract("CombineNumericalFactors",*);
//Retract("IsPureRational",*);
//Retract("HasRealCoefficients",*);
//Retract("HasRationalCoefficients",*);
//Retract("matchPower",*);
//Retract("IsIrreducible",*);     //      NOT YET OPERATIONAL


/* --------------    LISTS    ---------------*/

10 # xFactors( L_IsList ) <-- xFactors /@ L;


/* -------------    NUMBERS    --------------*/


10 # xFactors(p_IsPositiveInteger) <--  
[
    If( p < 1600, FactorsSmallInteger(p), FactorizeInt(p) );
];


12 # xFactors(p_IsNegativeInteger) <-- xFactors(-p);


14 # xFactors(p_IsRational)_(Denominator(p) != 1) <-- 
             { {xFactor(Numerator(p)) / xFactor(Denominator(p) ) , 1} }; 
             

16 # xFactors(p_IsGaussianInteger)	<-- GaussianFactors(p);


18 # xFactors(_p)_(Length(VarList(p))=0) <-- {{p,1}};



/* -------------    POLYNOMIALS -- CAN BE UNI   --------------*/

21 # xFactors( poly_CanBeUni ) <--
[
    If(InVerboseMode(),Tell("xFactors_can_be_uni_100122",poly));
    Local(content,pp,ppFactors,monomialFactors,result);
    Local(vars,nvars,disassem,degrees,mpoly,nterms,allCoeffs,allPowers);
    Local(hasRealCoefficients,hasRationalCoefficients,isHomogeneous);

    //  First, check to see if the polynomial has any REAL coefficients.
    //  If so, convert to approximate integers (with divisor).
    hasRealCoefficients := HasRealCoefficients(poly);
    If( hasRealCoefficients, 
      [
         Local(realPoly);
         realPoly  := poly;   //  just in case -- save original form
         disassem  := DisassembleExpression(poly);
         allCoeffs := disassem[3];
         allPowers := Flatten(disassem[2],"List");
         poly      := ApproximateRealCoefficients(poly);
      ]
    );
    
    //  Also, check to see if the polynomial has Rational coeffs
    hasRationalCoefficients := HasRationalCoefficients(poly);
    
    // Now: get Content and Primitive Part
    content := xContent( poly );
    pp      := xPrimitivePart( poly, content );
    If(InVerboseMode(),Tell("  ",{content,pp}));
    vars     := VarList(pp);
    nvars    := Length(vars);
    disassem := DisassembleExpression(pp);
    nterms   := Length(disassem[3]);
    degrees  := {};
    allCoeffs         := disassem[3];
    allPowers         := Flatten(disassem[2],"List");
    If(nvars > 0,
      [
        ForEach(v,vars)
           [ DestructiveAppend(degrees,Degree(pp,v)); ];
        isHomogeneous     := [
            // A polynomial is homogeneous of degree n 
            // if all terms have degree n.   
            Local(sd,cmp); 
            sd  := Sum /@ disassem[2];
            cmp := FillList(sd[1],Length(sd));
            IsZeroVector(sd - cmp);
        ];
      ]
    );
    
    // Experimental: 
    //   Attach a set of Meta-Keys to pp, describing
    //   some of the above information
    pp := MetaSet(pp,"nvars",nvars);
    pp := MetaSet(pp,"nterms",nterms);
    pp := MetaSet(pp,"degrees",degrees);
    pp := MetaSet(pp,"isHomogeneous",isHomogeneous);
    
    If(InVerboseMode(),
      [
        Tell("               ",vars);
        Tell("              ",nvars);
        Tell("             ",nterms);
        Tell("            ",degrees);
        Tell("           ",disassem);
        Tell("          ",allCoeffs);
        Tell("          ",allPowers);
        Tell("      ",isHomogeneous);
        NewLine();
      ]
    );
    
    //  OK.  Now factor the PrimitivePart
    ppFactors := xFactorsPrimitivePart( pp );

    If(InVerboseMode(),[NewLine();Tell("  ",ppFactors);]);
    
    // Next, include the factors of the Content, if any
    If(InVerboseMode(),NewLine());
    monomialFactors := FactorsMonomial(content);
    If(InVerboseMode(),[Tell("  ",monomialFactors);]);
    If( monomialFactors[1][1] = 1,
        result := ppFactors,        
        result := Concat(monomialFactors,ppFactors)
    );
    
    If(InVerboseMode(),[NewLine();Tell("  final  ",result);]);
    result;
];



// -----------------  FACTOR PRIMITIVE PART  -----------------

     //  special case: binomials
10 # xFactorsPrimitivePart( _pp )_(nterms=2) <--
[
    If(InVerboseMode(),Tell("Binomial"));
    Local(ppFactors);
    ppFactors := xFactorsBinomial(pp);
];
UnFence("xFactorsPrimitivePart",1);


     //  special case: homogeneous bivariates
12 # xFactorsPrimitivePart( _pp )_(isHomogeneous And nvars=2) <--
[
    If(InVerboseMode(),Tell("Homogeneous and Bivariate"));
    Local(ppFactors);
    ppFactors := xFactorsHomogeneousBivariate(disassem);
];
UnFence("xFactorsPrimitivePart",1);


     //  special case:  no variables in pp!
14 # xFactorsPrimitivePart( _pp )_(nvars=0) <--
[
    Local(ppFactors);
    ppfactors := {};
];


     //  general case: univariate
16 # xFactorsPrimitivePart( _pp )_(nvars=1) <--  xFactorsUnivariate(pp); 
UnFence("xFactorsPrimitivePart",1);


     //  general case: multivariate
18 # xFactorsPrimitivePart( _pp )_(nvars>1) <-- xFactorsMultivariate(pp);
UnFence("xFactorsPrimitivePart",1);


     //  catch-all: represents an ERROR CONDITION
20 # xFactorsPrimitivePart( _pp ) <-- Tell("Should never get here!");
UnFence("xFactorsPrimitivePart",1);



// ----------------------  UNIVARIATE POLYNOMIALS  -----------------------

30 # xFactorsUnivariate( poly_CanBeUni )_(Length(VarList(poly))=1) <--
[
    Local(factrs,coeffs,deg,X,residuals,factrsnew);

    If(InVerboseMode(),
      [
         NewLine();
         Tell("xFactorsUnivariate",poly);
         Tell("       ",allCoeffs);
      ]
    );
    
    // OK, First, send it through MathPiper's basic factoring function
    // for univariate polynomials
    
    factrs := BinaryFactors(poly);
    If(InVerboseMode(),Tell("   output of BinaryFactors",factrs));

    //    Now fix-up the (monic) factors found above, to express them
    // as linear in x with integer coefficients.  
    //    Also, separate out any 'residual' factors -- defined here as
    // factors of degree > 2.
    
    {factrsnew,residuals} := FixUpMonicFactors(factrs);
    
    //  See if we can do something with the residuals
    Local(residOut);
    residOut := {};
    If(Length(residuals) > 0, residOut := xFactorsResiduals( residuals ) );
    
    If(InVerboseMode(),
      [
          NewLine();
          Tell(" just before end of univariate factoring");
          Tell("    ",factrs);
          Tell("    ",factrsnew);
          Tell("    ",residOut);
      ]
    );   
    //  Finally, the output --------
    Local(final);
    If(Length(Union(factrsnew,residOut)) > 0,
        final := Concat(factrsnew,residOut),
        final := factrs
    );
    CheckForSpecialForms( final );
];   //   xFactorsUnivariate
UnFence("xFactorsUnivariate",1);


// ----------------  MULTIVARIATE POLYNOMIALS  -----------------

40 # xFactorsMultivariate( poly_CanBeUni )_(Length(VarList(poly))>1) <--
[
    Local(factrs);
    
    If(InVerboseMode(),[NewLine();Tell("xFactorsMultivariate",poly);]);
    If( nterms = 2, 
      [
        If(InVerboseMode(),Tell("   Is Binomial"));
        factrs := xFactorsBinomial(poly); 
      ],
      [
        If(InVerboseMode(),Tell("   Has more than 2 terms"));
      ]
    );
    factrs;
];
UnFence("xFactorsMultivariate",1);


// ------------------  HOMOGENEOUS BIVARIATE  ------------------

10 # xFactorsHomogeneousBivariate( dis_IsList ) <-- 
[
    If(InVerboseMode(),[NewLine();Tell("xFactorsHomogeneousBivariate",dis);]);
    Local(dis1,f,lst,dis2,poly1,ppFactors,residuals,ii,preassem);
    dis1  := {{xi},{{X},{X[1]}} /@ dis[2],dis[3]};
    If(InVerboseMode(),Tell("   ",dis1));
    poly1 := Sum(ReassembleListTerms(dis1));
    If(InVerboseMode(),Tell("   ",poly1));
    ppFactors := BinaryFactors(poly1);
    {ppFactors,residuals} := FixUpMonicFactors(ppFactors);
    For(ii:=1,ii<=Length(ppFactors),ii++)
    [
        f := ppFactors[ii];
        If(InVerboseMode(),Tell("          ",f[1]));
        lst := DisassembleExpression(f[1]);
        If(InVerboseMode(),
          [
             Tell("               ",lst);
             Tell("                            ",dis[1]);
          ]
        );
        DestructiveReplace(lst,1,dis[1]);
        DestructiveAppend(lst[2][1],0);
        DestructiveAppend(lst[2][2],1);
        If(InVerboseMode(),Tell("               ",lst));
        preassem  := Sum(ReassembleListTerms(lst)) ;
        If(InVerboseMode(),Tell("               ",preassem));
        ppFactors[ii][1] := preassem;
    ];
    If(InVerboseMode(),[Tell("   ",ppFactors); Tell("   ",residuals);NewLine();] );  
    ppFactors;
];
UnFence("xFactorsHomogeneousBivariate",1);


// ------------------  SPECIAL FORMS  ------------------

10 # CheckForSpecialForms( final_IsList ) <-- 
[
    If(InVerboseMode(),[NewLine();Tell("CheckForSpecialForms",final);]);
    Local(LL,ii,fact,mult,dis,new);
    new := {};
    LL  := Length(final);
    For(ii:=1,ii<=LL,ii++)
    [
        fact := final[ii][1];
        mult := final[ii][2];
        If(InVerboseMode(),Tell("   ",{fact,mult}));
        dis := DisassembleExpression( fact );
        If(InVerboseMode(),Tell("   ",dis));
        Local(var);
        var := dis[1][1];
        if ( dis[2]={{4},{2},{0}} And dis[3]={1,1,1} )
            [
                Local(new1,new2);
                new1 := {var^2-var+1,mult};
                new2 := {var^2+var+1,mult};
                DestructiveAppend(new,new1);
                DestructiveAppend(new,new2);
                If(InVerboseMode(),Tell("   ",new));
            ]
        else
            [
                If(InVerboseMode(),Tell("   no special form"));
                DestructiveAppend(new,{fact,mult});
            ];
        );
    ];
    new;
];


// ---------------------   OTHER STUFF ------------------------


10 # ApproximateRealCoefficients( poly_IsPolynomial ) <--
[
    // If the polynomial has REAL coefficients, convert them to
    // approximate integers
    If(InVerboseMode(),[NewLine();Tell("  REAL",poly);]);
    Local(coeffs,gcd,lcm);
    coeffs := Rationalize /@ (allCoeffs);
    If(InVerboseMode(),[Tell("      to-Q",coeffs);Tell("      to-Z",coeffs);]);
    Local(gcd,lcm);
    gcd    := Gcd(Numerator /@ coeffs);
    lcm    := Lcm(Denominator /@ coeffs);
    If(InVerboseMode(),[Tell("       ",gcd);Tell("       ",lcm);]);
    disassem[3] := coeffs;
    allCoeffs   := coeffs;
    poly        := Sum(ReassembleListTerms(disassem));
    If(InVerboseMode(),Tell("   new",poly));
    poly;
];
UnFence("ApproximateRealCoefficients",1);


100 # CombineNumericalFactors( factrs_IsList ) <--
[
      If( InVerboseMode(), Tell("Combine",factrs) );
      Local(q,a,b,t,f,ff,err);
      err := False;
      t   := 1;
      f   := {};
      ForEach(q,factrs)
      [
          If( InVerboseMode(), Tell(1,q) );
          If( IsList(q) And Length(q)=2,
            [
                {a,b} := q;
                If( InVerboseMode(), Echo("     ",{a,b}) );
                If( IsNumericList( {a,b} ),
                    t := t * a^b,
                    f := {a,b}:f
                );
            ],
              err := True
          );
      ];
      If( InVerboseMode(),
        [
            Echo("      t = ",t);
            Echo("      f = ",f);
            Echo("    err = ",err);
        ]
      );
      ff := If(Not err And t != 1, {t,1}:Reverse(f), factrs);
      ff := Select(Lambda({x},x!={1,1}),ff);
      If(ff[1]<0,ff[1]:=-ff[1]);
];


// ----------------  RATIONAL POLYNOMIALS  -----------------

150 # xFactors( expr_IsRationalFunction )_
        (IsPolynomial(Numerator(expr)) And IsPolynomial(Denominator(expr))) <--
[
    If(InVerboseMode(),[NewLine();Tell("xFactors_Rational_Function",expr);]);
    Local(Numer,Denom,fNumer,fDenom);
    Numer  := Numerator(expr);
    Denom  := Denominator(expr);
    fNumer := xFactors(Numer);
    fDenom := xFactors(Denom);
    If(InVerboseMode(),[Tell("   ",fNumer); Tell("   ",fDenom);]);
    fNumer/fDenom;
];


152 # xFactors( expr_IsRationalFunction )_
        (IsConstant(Numerator(expr)) And IsPolynomial(Denominator(expr))) <--
[
    If(InVerboseMode(),[NewLine();Tell("xFactors_Rational_Denom",expr);]);
    Local(Numer,Denom,fNumer,fDenom);
    Numer  := Numerator(expr);
    Denom  := Denominator(expr);
    fNumer := xFactors(Numer);
    fDenom := xFactors(Denom);
    If(InVerboseMode(),[Tell("   ",fNumer); Tell("   ",fDenom);]);
    fNumer/fDenom;
];


// ----------   POSSIBLE NON-INTEGER EXPONENTS  ----------

200 # xFactors( _expr )_(Length(VarList(expr)) = 1) <--
[
    If(InVerboseMode(),[NewLine();Tell("Some other kind of expression",expr);]);
    Local(dis,X,pows);
    dis := DisassembleExpression(expr);
    X   := VarList(expr)[1];
    pows := matchPower /@ dis[1];
    rats := NearRational /@ pows;
    dis[1] := x^rats;
    p := Sum(ReassembleListTerms(dis));
    If(InVerboseMode(),Tell("    new ",p));
    xFactors(p);
];

10 # IsIrreducible( poly_IsPolynomial )_(Length(VarList(poly))=1) <--
[
    //  If these tests return True, the polynomial IS irreducible..
    //  If they return False, the reducibility of the polynomial is
    //  not established, one way or the other.
    //
    // ----   THIS FUNCTION IS NOT YET COMPLETE OR USEABLE   ---
    If(InVerboseMode(),Tell("IsIrreducible",poly));
    Local(var,deg,coeffs,num1);
    var    := VarList(poly)[1];
    deg    := Degree(poly);
    coeffs := Coef(poly,var,deg .. 0);
    If(InVerboseMode(),Tell("   ",deg));
    Local(ii,res,nprimes);
    nprimes := 0;
    For(ii:=-3*deg,ii<=3*deg,ii:=ii+3)
    [
        res := N(Subst(x,ii) poly);
        //Tell("      ",{ii,res,IsPrime(res)});
        If(Abs(res)=1 Or IsPrime(res), nprimes := nprimes + 1, );
    ];
    Tell("   ",nprimes);
    If(nprimes > 2*deg, True, False );
];


10 # matchPower(_Z^n_IsNumber) <-- n;

15 # matchPower(_Z) <-- 1;


//========================================================================

%/mathpiper








