Zero-Divisor, Nilradical, and Non-Nilradical Graphs of (Subscript[Z, n])

Brendan Kelly The College of New Jersey 
Oliver Pechenik Oberlin College
Elizabeth Wilson The College of William and Mary

The following Mathematica file has the code to produce the zero-divisor, nilradical, and nonnilradical graphs of a ring (Subscript[Z, n]). The program also calculates the diameter, girth, and chromatic number of the resultant graph. To produce the zero-divisor graph Γ((Subscript[Z, n])), use the command ZeroGraph[n, 1] (or use ZeroGraph[n, 2]  to suppress computation intensive calculation of the chromatic number).  To produce the nilradical graph N((Subscript[Z, n])) , use the command NilGraph[n,1]  (alternatively, NilGraph[n,2] 
). To produce the non-nilradical graph Ω( (Subscript[Z, n])), use the command NonNilGraph[n, 1] (alternatively, NonNilGraph[n, 2]).  NonNilGraph[n, i] will fail to show isolated vertices, i.e. only the connected portion is shown. The isolated vertices of the non-nilradical graph can be found fairly easilly however--they are the vertices of the zero-divisor graph that don't show up in either other graph.

ZeroGraph[12, 1]

NonNilGraph[18, 2]

NonNilGraph[12,1]

NilGraph[12, 1]

<<"GraphUtilities`";

ZeroGraph[p_, c_]:=
	Module[
		

{
		Counter1,
		Counter2,
		B,
		m,
		g,
		coord,
		labels,
		},


B={"0->0"};
Counter1=1;
Counter2=1;
m=0;

		While[
			Counter1<p,
			Counter2=1;
			While[
				Counter2<p,
				If[
				Mod[Counter1*Counter2,p]==0,
				B=Append[B,ToString[Counter1->Counter2]],
				m=m+1
				];
				Counter2=Counter2+1
				];
			Counter1=Counter1+1
			];


	g=ToExpression[B];
	g=Drop[g,1];
	coord=GraphCoordinates[g];
	labels = VertexList[g];
	Print["Diameter is:"];
	Print[Diameter[ToCombinatoricaGraph[g]]];
	Print["Girth is:"];
	Print[Girth[RemoveSelfLoops[ToCombinatoricaGraph[g]]]];
	Print["Chromatic Number is:"];
	If[c==1,Print[ChromaticNumber[ToCombinatoricaGraph[g]]]];
GraphPlot[g,VertexLabeling->True,SelfLoopStyle->.25,MultiedgeStyle->False]

]

NonNilGraph[p_,c_]:=
	Module[
		

{
		Counter1,
		Counter2,
		Counter3,
		B,
		m,
		n,
		g,
		coord,
		labels,
		},


B={"0->0"};
Counter1=1;
Counter2=1;
Counter3=1;
m=0;
n=0;

		While[
			Counter1<p,
			Counter2=1;
			While[
				Counter2<p,
				Counter3=1;
				n=0;
				While[
						Counter3<p,
						If[
							Mod[Counter2^Counter3,p]==0||Mod[Counter1^Counter3,p]==0,
							n=1];
						Counter3 = Counter3+1
				];
				If[
				Mod[Counter1*Counter2,p]==0&&n==0,
				B=Append[B,ToString[Counter1->Counter2]],
				m=m+1
				];
				Counter2=Counter2+1
				];
			Counter1=Counter1+1
			];


	g=ToExpression[B];
	g=Drop[g,1];
	coord=GraphCoordinates[g];
	labels = VertexList[g];
	Print["Diameter is:"];
	Print[Diameter[ToCombinatoricaGraph[g]]];
	Print["Girth is:"];
	Print[Girth[RemoveSelfLoops[ToCombinatoricaGraph[g]]]];
	Print["Chromatic Number is:"];
	If[c==1,Print[ChromaticNumber[ToCombinatoricaGraph[g]]]];
GraphPlot[g,VertexLabeling->True,SelfLoopStyle->.25,MultiedgeStyle->False]

]

NilGraph[p_,c_]:=
	Module[
		

{
		Counter1,
		Counter2,
		Counter3,
		B,
		m,
		n,
		g,
		coord,
		labels,
		},


B={"0->0"};
Counter1=1;
Counter2=1;
Counter3=1;
m=0;
n=0;

		While[
			Counter1<p,
			Counter2=1;
			While[
				Counter2<p,
				Counter3=1;
				n=0;
				While[
						Counter3<p,
						If[
							Mod[Counter2^Counter3,p]==0&&Mod[Counter1^Counter3,p]==0,
							n=1];
						Counter3++
				];
				If[
				Mod[Counter1*Counter2,p]==0&&n==1,
				B=Append[B,ToString[Counter1->Counter2]],
				m=m+1
				];
				Counter2=Counter2+1
				];
			Counter1=Counter1+1
			];


	g=ToExpression[B];
	g=Drop[g,1];
	coord=GraphCoordinates[g];
	labels = VertexList[g];
	Print["Diameter is:"];
	Print[Diameter[ToCombinatoricaGraph[g]]];
	Print["Girth is:"];
	Print[Girth[RemoveSelfLoops[ToCombinatoricaGraph[g]]]];
	Print["Chromatic Number is:"];
	If[c==1,Print[ChromaticNumber[ToCombinatoricaGraph[g]]]];
GraphPlot[g,VertexLabeling->True,SelfLoopStyle->.25,MultiedgeStyle->False]

]