# Find Square-Free decomposition for multivariates over finite fields.
# Based on the partial decomposition (psqfr), due to Martelli
#
# See help page below.
#
#
# Author:   Steven L. Swanson
#           swany@math.purdue.edu
#
# May 1993
 
`mod/SqrFree` := proc(f,P)
    local lx, lp, r, In, lf, co, p1, CO, v;
    
    In := indets(f);
    if (In = {}) then RETURN( [f,[]] ) fi;
    if nops(In) = 1 then RETURN( Sqrfree( f ) mod P ) fi;
    lf := f;
    CO := [1,[]];
    for v in In do
        co := Content( lf, v, 'p1' ) mod P;
        if co <> 1 then
            CO := `SqrFree/list_mult`( CO, SqrFree( co ) mod P ) mod P;
            lf := p1;
        fi;
        p1 := 'p1';            # For Content assignment.
    od;
    r  := `SqrFree/psqfr`(lf,In[1]) mod P;
    lx := r[1];
    for v in In minus {In[1]} do    # Run through the rest of the variables.
        if r[2] = 1 then break fi;
        r  := `SqrFree/psqfr`(r[2],v) mod P;
        if (r[1] <> [1]) then
            lx := `SqrFree/list_mult`( lx, r[1] ) mod P;
        fi;
    od;
    if r[2] <> 1 then        # This part has derivative 0 wrt all variables.
        lp := `SqrFree/SqFrPr`( PthRoot(r[2]) mod P ) mod P;
        lp := `SqrFree/up_exponents`( lp, P );
        lx := `SqrFree/smart_list_mult`( lx, lp, In[1] ) mod P;
    fi;
    `SqrFree/list_mult`( lx, CO ) mod P;
    RETURN( " );
end:
 
# Version of above which avoids content calculations.
#
 
`mod/SqrFree/SqFrPr` := proc(f,P)
    local lx, lp, r, In, lf, p1, v;
    
    In := indets(f);
    if (In = {}) then RETURN( [f,[]] ) fi;
    if nops(In) = 1 then RETURN( Sqrfree( f ) mod P ) fi;
    lf := f;
    r  := `SqrFree/psqfr`(lf,In[1]) mod P;
    lx := r[1];
    for v in In minus {In[1]} do
        if r[2] = 1 then
            break;
        fi;
        r  := `SqrFree/psqfr`(r[2],v) mod P;
        if (r[1] <> [1]) then
            lx := `SqrFree/list_mult`( lx, r[1] ) mod P;
        fi;
    od;
    if r[2] <> 1 then
        lp := `SqrFree/SqFrPr`( PthRoot(r[2]) mod P ) mod P;
        lp := `SqrFree/up_exponents`( lp, P );
        lx := `SqrFree/smart_list_mult`( lx, lp, In[1] ) mod P;
    fi;
    RETURN( lx );
end:
 
#
# The partial square-free decomposition routine.
#
# See the documentation for what this does.
#
`mod/SqrFree/psqfr` := proc(f,X,P)
    local g, h, l, i, lg, lh, q, u;
 
    h := Gcd( f, Diff(f,X) mod P ) mod P;
    g := Quo( f, h, X ) mod P;
    u := 1; l := []; i := 1; lh := h; lg := g;
    while (degree( g, X) > 0) do
        lh := h;
        lg := g;
        h  := Gcd( lh, Diff(lh,X) mod P ) mod P;
        g  := Quo( lh, h, X ) mod P;
        if (g <> lg) then
            q := Quo( lg, g, X ) mod P;
            if degree(q,X) > 0 then
                l := [op(l),[q, i]];
            else
                u := Expand( u*q^i ) mod P;
            fi;
        fi;
        i := i + 1;
    od;
    RETURN( [[u,l], lh] );
end:
 
 
`SqrFree/up_exponents` := proc( L, P )
    if (nops(L[2]) = 0) then
        RETURN( [Expand(L[1]^P) mod P,[]] );
    else
        RETURN( [Expand(L[1]^P) mod P, map( proc(a,b) RETURN( subsop(2=b*a[2],a)) end, L[2], P )] );
    fi;
end:
 
# Combine two lists of terms with multiplicities.
# We assume that these are always maintained so there is at most one
# term of each multiplicity and they are ordered.
# We also assume that all the terms are relatively prime.
 
`mod/SqrFree/list_mult` := proc( L, M, P )
    local N, mL, mM;
# lprint( `l_m`, L, M );
    # take care of trivial cases
    if (nops(L[2])=0 and nops(M[2])=0) then
        RETURN( [L[1]*M[1] mod P,[]] );
    elif (nops(L[2])=0) then
        RETURN( [L[1]*M[1] mod P, M[2]] );
    elif (nops(M[2])=0) then
        RETURN( [L[1]*M[1] mod P, L[2]] );
    fi;
    N := [];
    mL := L[2]; mM := M[2];
    while (mL <> [] and mM <> []) do
        if (mL[1][2] = mM[1][2]) then
            # better not to expand this
            N  := [op(N), [mL[1][1]*mM[1][1],mL[1][2]]];
            mL := subsop( 1=NULL, mL );
            mM := subsop( 1=NULL, mM );
        elif (mL[1][2] < mM[1][2]) then
            N  := [op(N), mL[1]];
            mL := subsop( 1=NULL, mL );
        else #mM[1][2] < mL[1][2]
            N  := [op(N), mM[1]];
            mM := subsop( 1=NULL, mM );
        fi;
    od;
    if (mL <> []) then
        N := [op(N),op(mL)];
    elif (mM <> []) then
        N := [op(N),op(mM)];
    fi;
    RETURN( [L[1]*M[1] mod P, N] );
end:
 
# Combine two lists of terms with multiplicities.
# We assume that these are always maintained so there is at most one
# term of each multiplicity and they are ordered.
# We do not assume that the terms are relative prime, just in each list.
 
`mod/SqrFree/smart_list_mult` := proc( L, M, x, P )
    local N, Ex, i, j, mL, mM, g, u, t;
# lprint( `sl_m`, L, M );
    # take care of trivial cases
    if (nops(L[2])=0 and nops(M[2])=0) then
        RETURN( [L[1]*M[1] mod P,[]] );
    elif (nops(L[2])=0) then
        RETURN( [L[1]*M[1] mod P, M[2]] );
    elif (nops(M[2])=0) then
        RETURN( [L[1]*M[1] mod P, L[2]] );
    fi;
    N := [];    Ex := [];
    mL := L[2]; mM := M[2];
    u := 1;
    while (mL <> [] and mM <> []) do
        g := mL[1][1];
        for i from 1 to nops(mM) do
            j := Gcd( g, mM[i][1] ) mod P;
            if (j <> 1) then
                break;
            fi;
        od;
# lprint( `sl_m Gcd`, j, i, s, t );
        if (j <> 1) then
            Ex := [op(Ex), [j,mL[1][2]+mM[i][2]]];
            # ugly list surgery
            if (j = g) then
                mL := subsop( 1=NULL, mL );
            else
                t := Quo( g, j, x ) mod P;
                if (type(t,numeric)) then
                    u  := (u * t^mL[1][2]) mod P;
                    mL := subsop( 1=NULL, mL );
                else
                    mL := subsop( 1=[t,mL[1][2]],mL);
                fi;
            fi;
            if (j = mM[i][1]) then
                mM := subsop( i=NULL, mM );
            else
                t := Quo( mM[i][1], j, x ) mod P;
                if (type(t,numeric)) then
                    u  := u * t^mM[i][2] mod P;
                    mM := subsop( i=NULL, mM );
                else
                    mM := subsop( i=[t,mM[1][2]], mM );
                fi;
            fi;
        elif (mL[1][2] = mM[1][2]) then
            N  := [op(N), [mL[1][1]*mM[1][1],mL[1][2]]];
            mL := subsop( 1=NULL, mL );
            mM := subsop( 1=NULL, mM );
        elif (mL[1][2] < mM[1][2]) then
            N  := [op(N), mL[1]];
            mL := subsop( 1=NULL, mL );
        else #mM[1][2] < mL[1][2]
            N  := [op(N), mM[1]];
            mM := subsop( 1=NULL, mM );
        fi;
    od;
    if (mL <> []) then
        N := [op(N),op(mL)];
    elif (mM <> []) then
        N := [op(N),op(mM)];
    fi;
# lprint( `sl_m, Ex`, Ex, ` N `, N );
    # sort the extra stuff we got
    if (nops(Ex) > 1) then
        Ex := sort( Ex, proc(a,b) RETURN( evalb( a[2]<b[2] ) ) end );
    fi;
    # the two lists are relatively prime, combine
    RETURN( `SqrFree/list_mult`( [L[1]*M[1] mod P, N], [u, Ex] ) mod P );
end:
 
 
#
# This routine, handy for testing, expands the
# SqrFree structure.
#
`mod/ExpSqrFree` := proc(l,P)
    Expand( l[1]*convert(map(x->x[1]^x[2],l[2]),`*`) ) mod P;
end:
 
 
# Bivariate Square-free test.
#   Returns true is poly is square-free.
# Cheaper to run than above if all you want is a test.
 
# Right now, this returns true if arg is square-free
# false if the square-free routine will do some kind of factorization.
 
`mod/SqrFreeTest` := proc( R, P)
    local V, x, Rp, Rpp, RR, co, p1, p2;
 
    V := indets( R );
    if V = {} then RETURN( true ) fi;
    RR := R;
    x := V[1];
    if nops(V) = 1 then
        Rp := Diff( RR, x ) mod P;
        if Rp = 0 then RETURN( false ) fi;
    elif nops(V) > 2 then
        ERROR( `too many variables` );
    else
        co := Content( RR, x, 'p1' ) mod P;
        # decompose the V[1] content
        if co <> 1 then
            if not SqrFreeTest( co ) mod P then
                RETURN( false );
            fi;
            RR := p1;
            if degree( RR, x ) <= 1 then
                RETURN( true );
            fi;
        fi;
        co := Content( RR, V[2], `p2` ) mod P;
        # decompose the V[2] content
        if co <> 1 then
            if not SqrFreeTest( co ) mod P then
                RETURN( false );
            fi;
            RR := p2;
            if degree( RR, V[2] ) <= 1 then
                RETURN( true );
            fi;
        fi;
        # We may now assume that RR is primitive.
        Rp := Diff( RR, x ) mod P;
        if Rp = 0 then        # may be Pth power
            Rp := Diff( RR, V[2] ) mod P;
            if Rp = 0 then
                RETURN( false );   # really Pth power
            else
                x := V[2];         # not quite Pth power
            fi;
        fi;
    fi;
    Rpp := Gcd( RR, Rp ) mod P;
    if Rpp = 1 then        # ie no common factor
        RETURN( true );
    else
# THIS IS WRONG.  SEE EXAMPLE above.
# With 1 variable, derivative 0 iff multiplicity at least 2.
# not true with 2 variables.
        RETURN( false );
    fi;
end:
 
# Compute the Pth root of a polynomial in characteristic
# P.
# R is a polynomial which we can take the Pth root of.
`mod/PthRoot` := proc( R, P )
    local V, i, RES;
 
    V := indets( R );
    if V = {} then        # constant - if not in prime field
        if hastype(R,RootOf) then    # RootOf determines deg
            i := indets( R, RootOf );    # a set
            i := i[1];                    # a RootOf
            i := op(1,i);                # a polynomial
            i := degree(i);                # an integer
            RETURN( Normal( R ^ (P^(i-1)) ) mod P );
        else            # in prime field, do nothing
            RETURN( R );
        fi;
    fi;
    RES := 0;
    # note that we assume R is a Pth power here.
    for i from 0 to degree( R, V[1] ) / P do
        RES := RES + (PthRoot( coeff( R, V[1], i*P ) ) mod P) * V[1]^i;
    od;
    RETURN( RES );
end:
 
 
# mod doesn't know how to differentiate
 
`mod/Diff` := proc( f, x, p )
    Normal( diff( f, x)) mod p;
end:
 
 
`help/text/SqrFree` := TEXT(   
`FUNCTION: SqrFree - inert square free factorization function`,
`   `,
`CALLING SEQUENCE:`,
`   SqrFree(a) mod p`,
`   `,
`PARAMETERS:`,
`   a - multivariate polynomial`,
`  `,
`SYNOPSIS:`,
`- The SqrFree function is a placeholder for representing the square free fac-`,
`  torization of the multivariate polynomial a over a finite field.`,
`  It is used in conjunction with mod as described below.`,
`  `,
`! Sqrfree should do this, but only works for univariates,`,
`   `,
`- The SqrFree function returns a data structure of the form`,
`  [u,[[f[1],e[1]],...,[f[n],e[n]]] such that`,
`  a = u * f[1]^e[1] * ... * f[n]^e[n] and f[i] is square free where`,
`  Gcd(f[i],f[j]) = 1 for i <> j where u is an element of the field.`,
`  `,
`! Note that the help description for Sqrfree doesn't make sense.   `,
`  `,
`- The call SqrFree(a) mod p computes the square free factorization of a modulo`,
`  p a prime integer.  The multivariate polynomial a must have rational coeffi-`,
`  cients or coefficients from an algebraic extension of the integers mod p.`,
`   `,
`EXAMPLES:`,
`> SqrFree(2*x^2+6*x+6) mod 7;`,
`                                   2`,
`                            [2, [[x  + 3 x + 3, 1]]]`,
`   `,
`> SqrFree(4*x^2+4*x+1) mod 7;`,
`                               [4, [[x + 4, 2]]]`,
`   `,
`> alias(alpha=RootOf(x^2+x+1));`,
`                                    I, alpha`,
`   `,
`> SqrFree(alpha*x^3+(alpha+1)*x^2+x+alpha) mod 2;`,
`                           [alpha, [[x + alpha, 3]]]`,
`  `,
`> SqrFree(x^3+y^3-z^3) mod 3;`,
`                           [1, [[2 z + y + x, 3]]]`,
`  `,
`SEE ALSO:  Sqrfree, mod`):
 
#save `SqrFree.m`;
#quit
