# Let D = C(x)[tau] where tau is the shift operator. # Let D_p = C(x)[tau^p] = a subring of D that is isomorphic to D. # # IsomD( _ , p) is an isomorphism from D to D_p given by: tau, x |--> tau^p, x/p. # # The inverse automorphism is IsomD( _ , 1/p). # IsomD := proc(L, p) subs(_Env_LRE_tau = _Env_LRE_tau^p, _Env_LRE_x = _Env_LRE_x / p, L) end: # Let M = D/DL, this is a D-module and also a D_p-module. # # L is irreducible in D if and only if M is an irreducible D-module. # # Definition: We say that L is absolutely irreducible if M is an irreducible D_p-module # for every positive integer p. # # Theorem: this is equivalent to saying that M is an irreducible D_p-module for every # prime number p that divides the order of L. # # Assuming that L is irreducible, our goal is to either (a) use the theorem to prove that L # is absolutely irreducible, or (b) explicitly show that L is not absolutely irreducible by # returning a generator of a non-trivial D_p-submodule of M. # section_op(L, p, 1) returns the smallest operator in D_p that is divisible by L. # This is the minimal annihilator in D_p of 1+DL in M. # The notation in the paper is "L downarrow p". # # section_op(L, p) returns the image of "L downarrow p" in D under IsomD( _ , 1/p). # The notation in the paper is "L^(p)". # section_op := proc(L, p) local a, ord, Lp, i, eqns, solutions, nf, tau; if nargs = 2 then return procname(L, p, p) fi; tau := _Env_LRE_tau; ord := degree(L, tau); Lp := add(a[i]*tau^(p*i), i = 0 .. ord); eqns := {coeffs(LREtools[RightDivision](Lp, L)[2], tau)}; solutions := SolveTools:-Linear(eqns, {seq(a[i], i = 0 .. ord)}); nf := add(`if`(lhs(i) = rhs(i), 1, 0), i = solutions); if nf > 1 then # The order is less than expected, the highest nf-1 terms are zero: eqns := {op(eqns), seq(a[i] = 0, i = ord - nf + 2 .. ord)}; solutions := solve(eqns, {seq(a[i], i = 0 .. ord)}) fi; Simpl_op(IsomD(eval(Lp, solutions), 1/args[3]), tau) end: # Simplify the operator L: Simpl_op := proc(L, tau) sort(collect(primpart(L,tau),tau,factor),tau) end: # v:= list of irreducible factors and multiplicities of the determinant ReducedDet := proc(v::list,x) local r,s,i; # Loop over v, search for same type, then combine. if v=[] then return v fi; r := NULL; s := v[1,2]; for i from 2 to nops(v) do if IntShift(v[1,1],v[i,1],x) then s := s + v[i,2] else r := r, v[i] fi od; [`if`(s=0, NULL, [v[1,1],s]), op(procname([r],x))] end: # Check if two monic irreducible poly's are an integer shift from each other. IntShift := proc(A, P, x) local n,e; n := degree(A,x); if n <> degree(P,x) then false elif lcoeff(A,x)<>1 or lcoeff(P,x)<>1 then procname(A/lcoeff(A,x), P/lcoeff(P,x), x) else e := Normalizer(coeff(A,x,n-1)-coeff(P,x,n-1))/n; type(e,integer) and Normalizer(A-subs(x=x+e,P))=0 fi; end: # Input: L in C[x,tau], collected w.r.t. tau # Output: The highest-degree terms of L that are invariant under gauge-transformations # These are the terms whose x-degree is greater than "point on Newton polygon" - 1. # For example, if L = a2*tau^2 + a1*tau + a0 and degree(a2,x) = 3 and degree(a1,x) = 3 # and degree(a0,x) = 4, then the slope is 1/2, and the points on the polygon are # (0,4), (1, 3+1/2), (2,3) and then the coefficients we take are those of x^4*tau^0, # and x^3*tau^1, and x^3*tau^2 as those are invariant under gauge-transformations. # InvariantTerms := proc(L,x,tau) local n, d, degs, powd, v, L0, m, i, j, c; n := degree(L,tau); d := degree(lcoeff(L,tau),x); degs := [seq(degree(coeff(L,tau,i),x) - d,i=0..n)]; powd := 0; v := degs[1]; L0 := lcoeff(coeff(L,tau,0),x) * x^v; while powd(i-powd)*m do i := i-1 od; for j to i-powd do c := floor(v + j * m); L0 := L0 + coeff(coeff(L, tau, powd + j), x, c+d) * x^c * tau^(powd+j) od; powd := i; v := degs[powd+1] od; L0 end: # Input: L in D, assumed irreducible. This assumption is not checked here (use RightFactors for that). # # Output: true if L is absolutely irredubile, otherwise [p, {R_1,...}] where p is a prime number # and where each IsomD_Dm(R_i, p) generates a non-trivial D_p-submodule(s) of D/DL, explicitly showing # that L is not absolutely irreducible. # AbsFactorization := proc(L) local i,ord,p,c,G,L_tilde,L_p,S,x,tau; x, tau := _Env_LRE_x, _Env_LRE_tau; N := InvariantTerms(L, x, tau); coeffs(N, tau, 't'); # Only primes p for which N in Q(x)[tau^p] can occur: for p in map(i -> i[1], ifactors(igcd(op(map(degree,[t],tau))))[2]) do L_p := section_op(L, p); if degree(L_p, tau) < degree(L, tau) then return [p, {1}] elif p=2 and args[-1] = `Hom method` then # Step 1(a) in Section 3.3: L_tilde := subs(tau = -tau, L); # Step 1(b) in Section 3.3: (this step needs the file "Hom.txt") G := Hom(L, L_tilde); if G <> [] then if nops(G) > 1 then error "Input was not irreducible" fi; G := G[1]; c := LREtools[MultiplyOperators](subs(tau=-tau,G), G); c := LREtools[RightDivision](c, L)[2]; if has(c, {x,tau}) then error "should not happen" fi; G := collect(G/sqrt(c), tau, normal); return [p, {seq(Simpl_op(IsomD(LREtools[RightDivision](LREtools[LCLM](L, 1 + i*G), 1 + i*G)[1], 1/2), tau), i = {1,-1})}] fi else # Pass along data to RightFactors to only compute factors that are consistent with this data. # Need to load an update for RightFactors for this to make a difference. # _Env_RightFactors_data := [p, IsomD(N, 1/p), ReducedDet(select(has,factors(tcoeff(L,tau)/lcoeff(L,tau))[2],x), x)]; S := LREtools[RightFactors](L_p, degree(L,tau)/p); if S <> {} then return [p,S] fi fi od; # Step 2 true end: # LREtools[RightFactors] makes a list of "candidate determinants" for # the factors that it is trying to construct. The larger this list is, # the longer the computation will take. # However, some of these candidate determinants can be discarded if # we know that the input of RightFactors comes from AbsFactorization. # Given a "candidate determinant" v, the following program tells a # modification of RightFactors if we should keep v or not. # # To measure if this improvement makes a difference, you can turn off # this improvement by inserting "return true" at the beginning. DetFactorsSelect := proc(v, x, tau) local N; # return true; N := _Env_RightFactors_data[2]; f := mul(i[2],i=v[-1]); evalb(degree(f,tau) = degree(N,tau) and evala(rem(InvariantTerms(collect(f,tau), x, tau), N, tau)) = 0) end: # LREtools[RightFactors] also makes a list of "candidate Invariant terms". But like # the previous program, some of these may be discarded if we know that the input comes # from AbsFactorization. # DeterminantSelect := proc(v, x) local N; # return true; N := _Env_RightFactors_data; evalb([] = ReducedDet( [op(N[3]), op(select(has,factors(subs(x=x/N[1], 1/v))[2],x))], x)) end: _Env_LRE_tau := tau; _Env_LRE_x := x; with(LREtools): L4 := (4*x-11)*(524160*x^8+9391200*x^7-118179432*x^6-253541284*x^5-339259113*x^4-283416626*x^3-140532705*x^2-35130024*x-2220048)*(x+5)^2*(x+4)^2 *(2*x+9)^2*(2*x+7)^2*tau^4+16*(524160*x^12+15113280*x^11-364158816*x^10-4278491572*x^9-9186978746*x^8+12166953346*x^7-86741410290*x^6-\ 843333775440*x^5-2144077451746*x^4-3001904754612*x^3-2506144851117*x^2-1178353117620*x-242095406175)*(x+4)^2*(2*x+7)^2*tau^3+(-\ 137438945280*x^17-6482503372800*x^16-90355220358144*x^15-154953056569984*x^14+8139627355615616*x^13+69179680108818000*x^12+ 277321791062784832*x^11+698868352509149328*x^10+1236863662787672992*x^9+1625448731323698944*x^8+1626145247262854144*x^7+ 1235819925815197696*x^6+686291085150978048*x^5+244593652122419200*x^4+24045290042818560*x^3-27607241721839616*x^2-15602879836717056*x-\ 2930851407200256)*tau^2-32768*(1048320*x^12+38613120*x^11-475672512*x^10-11499544808*x^9-68147233556*x^8-184773020492*x^7-262836346620*x^6 -216526023556*x^5-122659285853*x^4-39783078178*x^3+1029344695*x^2+7429526904*x+2484513522)*(x+2)^2*(2*x+3)^2*tau+4096*(4*x+33)*(524160*x^8 +13584480*x^7-37764552*x^6-736049716*x^5-3014273813*x^4-6181409598*x^3-7122549901*x^2-4430333096*x-1162363872)*(2*x+3)^2*(2*x+1)^2*(x+2)^2 *(x+1)^2; read "RightFactors.txt": # LREtools[RightFactors] code with a modification in case _Env_RightFactors_data is assigned. t0 := time(); _Env_print_number_cases := true; AbsFactorization(L4); lprint(time() - t0); # 24.702 seconds for 1791 cases (use neither) # 11.938 seconds for 597 cases (use DetFactorsSelect) # 6.950 seconds for 363 cases (use DeterminantSelect) # 3.185 seconds for 121 cases (use both)