
(* Realize lambda_10 *)
<<cox.m
Print["\n\n\n             LEHMER'S NUMBER - Coxeter group approach\n"]

prime = 23
salem = salem10
(*-----------------Find Salem action --------------*)
qs = QE[10]
fs = Cox[qs]
(* 
	subs = FactorIdeal[prime,salem10] 
*)
subs = {2 + 3*x^2 + 4*x^3 + 3*x^4 + x^5 - 2*x^7 - 2*x^8 - 3*x^9, 
 -1 + 3*x + 4*x^2 + 2*x^3 + 3*x^4 + 2*x^5 - 3*x^7 - 4*x^8 - x^9, 
  1 + x - x^4 - 2*x^6 + x^9, -1 + x + x^3 + x^5 + x^7 - x^8 - x^9}
subs = Select[subs,AbGp[QTwist[qs,fs,AdjPoly[#]],prime]=={prime,prime}&]
sub = subs[[1]]
polys = AdjPoly[sub]

polys=PolynomialRemainder[polys,CxToReal[salem],x]
Print["Twisting qs by p(a), p = ",polys];
Print[TeXForm[polys]];
qs = QTwist[qs,fs,polys]
charfs = GlueChar[qs,fs,prime]

(*-----------------Find cyclotomic action --------------*)
(* NOTE:  has order 22, because of minus sign below *)
qc = QA[10]
fc = -Cox[qc]
(* 
ps = PrimeTwists[qc,fc,prime,2] 
ps = Select[ps,GlueChar[QTwist[qc,fc,#],fc,prime]==charfs&]
polyc = ps[[1]]
*)
polyc =  x*(-2 + x^2)*(-2 - 3*x + 3*x^2 + x^3 - x^4)
polyc=PolynomialRemainder[polyc,CxToReal[Cyclotomic[22,x]],x]
Print["Twisting qc by p(a), p = ",polyc];
Print[TeXForm[polyc]];
qc = QTwist[qc,fc,polyc]

(*-----------------Glue Salem and cyclotomic pieces --------------*)
{qj,fj} = GlueAuto[qs,fs,qc,fc,prime]

(*-----------------Final 2D piece --------------*)
(* Glue group Z/11 *)
q2 = {{6,-5},{-5,6}}
f2 = {{0,1},{1,0}}
{q,f} = GlueAuto[qj,fj,q2,f2,11]

(*-----------------Display final result --------------*)
DiK3[q,f,polys]

Print["Checking Coxeter obstruction: ",CoxOb[QA[10],sub]]

(*---------------------------------Strategy details -------------------------*)
DiK3Salem[salem10]
Print[""]
Print["	Strategy Details"]

polys = FactorIdeal[23,salem10]
qx = QE[10]
fx = Cox[qx]
{q1,q2,q3,q4} = Map[QSub[qx,#]&,polys]

MaxPeriod = 10^6
per1 = GluePeriod[q1,fx]
per2 = GluePeriod[q3,fx]

Print["Period 23^4: ",per1," requires dim ",CycloDim[per1]]
Print["Period 23^1: ",per2," requires dim ",CycloDim[per2]]
Print["Factorization of S(x) mod 23: ",Factor[salem10,Modulus->23]]
Print[TeXForm[Factor[salem10,Modulus->23]]]
