Mathematica in Abstract Algebra:
The Inverse Galois Problem

by
David Jabon
Department of Mathematics
Eastern Washington University
Cheney, WA 99004
djabon@ewu.edu

Mathematica in Education and Research
Vol.4 No.4
Fall 1995

Copyright 1995 TELOS/Springer-Verlag

FindGoodPrime[d_] := Module[{i=1},
   While[!PrimeQ[d i + 1], i++];
   d i + 1]

FindGoodPrime[9]

Needs["NumberTheory`NumberTheoryFunctions`"]

?PrimitiveRoot

Ord[x_, p_] := Module[{i=1},
   While[PowerMod[x,i,p] != 1, i++];
   i]

PrimRoot[p_] := Module[{i=1},
   While[Ord[i,p] < p-1, i++];
   i]

CyclicPolynomial[d_, p_?PrimeQ]:=
   Module[{g = PrimitiveRoot[p],r,A,B},
   r = Sum[y^PowerMod[g, k d, p],
          {k, 0, (p-1)/d - 1}];
   A = Table[r^i /. 
            AlgebraicRules[{y^p == 1,
		y^(p-1)==Sum[-y^m,
		            {m,0,p-2}]},
	        {y}],
	    {i,0,d}];
   B = NullSpace[Table[
          Coefficient[A[[j]],y,i],
	  {i,0,p-2}, {j,d+1}]];
   Sum[B[[1,i]]x^(i-1), {i, d+1}]]

CyclicPolynomial[d_,p_?PrimeQ]:=
Module[{g=PrimRoot[p],r,A={1},B},
   r = Sum[y^PowerMod[g, k d, p],
          {k,0,(p-1)/d - 1}];
   Do[A=Append[A,((A[[i-1]] r) /. 
   AlgebraicRules[{y^p==1},{y}]) /.
      AlgebraicRules[{y^(p-1)==
         Sum[-y^m,{m,0,p-2}]},{y}]],
   {i, 2, d+1}];
   B = NullSpace[Table[
         Coefficient[A[[j]], y, i],
	 {i, 0, p-2}, {j, 1, d+1}]];
   Sum[B[[1,i]]x^(i-1),{i, 1, d+1}]]

CyclicPolynomial[5, 11]

CyclicPolynomial[7, 29]

FindNextGoodPrime[d_, p_]:=
   Module[{i=(p-1)/d + 1},
      While[!PrimeQ[d i + 1], i++];
      d i + 1]

FindNextGoodPrime[7, 29]

FindGoodPrime[2]

CyclicPolynomial[2, 3]

FindGoodPrime[3]

CyclicPolynomial[3, 7]

FindNextGoodPrime[3, 7]

CyclicPolynomial[3, 13]

FindGoodPrime[9]

CyclicPolynomial[9, 19]

Expand[CyclicPolynomial[2, 3]  *
       CyclicPolynomial[3, 7]  *
       CyclicPolynomial[3, 13] *
       CyclicPolynomial[9, 19],
     x]