ZeonColorings.nb

Nilpotent adjacency matrix methods in graph coloring problems

G. Stacey Staples 
July 2016

Introduction

This notebook contains code and examples related to the paper Zeons, Orthozeons, and Graph Colorings (Preprint, 2016) by G. Stacey Staples and Tiffany Stellhorn.

(* Sometimes, you just need a fresh start.  Quitting the kernel allows you to start over. *)
Quit[]

Code

Load required packages

<<CliffMath2014a`
<<CliffSymNil2014a`

Initialize code for zeon graph colorings

(* Code for generating a (standard) nilpotent adjacency matrix from list of edges and number of vertices *)
NilAdjacencyMatrix[Edges_,nverts_]:=Module[{i,j},
Table[If[MemberQ[Edges,i\[UndirectedEdge]j]∨MemberQ[Edges,j\[UndirectedEdge]i],(Subscript[e, {j}]),0],{i,nverts},{j,nverts}]];

(* Generate nilpotent vertex-coloring matrix from list of vertex zeon-colors and list of edges. *)
NilColorMatrix[CL_,Edges_]:=Module[{i,j},Table[If[MemberQ[Edges,i\[UndirectedEdge]j]∨MemberQ[Edges,j\[UndirectedEdge]i],CL[[j]],0],{i,Length[CL]},{j,Length[CL]}]];

(* Generate nilpotent edge-coloring matrix from list of edge zeon-colors, list of edges, and number of vertices. *)
NilColorEdgeMatrix[CL_,Edges_,nverts_]:=Module[{i,j},Table[If[MemberQ[Edges,i\[UndirectedEdge]j],CL[[Flatten[Position[Edges,i\[UndirectedEdge]j]]]][[1]],If[MemberQ[Edges,j\[UndirectedEdge]i],CL[[Flatten[Position[Edges,j\[UndirectedEdge]i]]]][[1]],0]],{i,nverts},{j,nverts}]];


(* Code for generating random graphs on n vertices, where the probability of adjacency for any pair is p*)
GenRandGraph[n_,p_]:=Module[{i,j,A,rw,co},
A=Table[0,{i,1,n},{j,1,n}];For[rw=1,rw≤n,rw++,
For[co=1,co<rw,co++,
If[RandomReal[]<p,A[[rw,co]]=1;A[[co,rw]]=1;,Null];]];Return[A];];

(*Use nilpotent matrix properties to count heterochromatic k-paths from fixed initial vertex*)
KPathsFromInit[initrow_,niladjmat_,k_]:=If[k==1,Return[Expand[initrow]],Return[KPathsFromInit[ClNilExpand[ClNilMatrixProduct[initrow,niladjmat]],niladjmat,k-1]]];


(* Define multiplication in commutative algebra generated by orthogonal rank-one projectors (Subscript[τ, n]) *)

ζ=Symbol["ζ"];

Unprotect[SmallCircle];
SetAttributes[SmallCircle, {Flat,OneIdentity,Orderless,Listable}];
SmallCircle[(Subscript[(Overscript[ζ, i_]), X_]),(Subscript[(Overscript[ζ, j_]), Y_])]:=If[i≠j,0,If[Length[Intersection[X,Y]]>0,0,(Subscript[(Overscript[ζ, i]), Union[X,Y]])]];
SmallCircle[a_(Subscript[(Overscript[ζ, i_]), X_]),(Subscript[(Overscript[ζ, j_]), Y_])]:=If[i≠j,0,If[Length[Intersection[X,Y]]>0,0,a (Subscript[(Overscript[ζ, i]), Union[X,Y]])]];
SmallCircle[(Subscript[(Overscript[ζ, i_]), X_]),a_(Subscript[(Overscript[ζ, j_]), Y_])]:=If[i≠j,0,If[Length[Intersection[X,Y]]>0,0,a (Subscript[(Overscript[ζ, i]), Union[X,Y]])]];

SmallCircle[a_(Subscript[(Overscript[ζ, i_]), X_]),b_(Subscript[(Overscript[ζ, j_]), Y_])]:=If[i≠j,0,If[Length[Intersection[X,Y]]>0,0,Expand[a b] (Subscript[(Overscript[ζ, i]), Union[X,Y]])]];

SmallCircle[x_,y_ ]:=Expand[x y]/;(FreeQ[x,ζ]∧FreeQ[y,ζ]);

SmallCircle=Symbol["SmallCircle"];

SmallCircle[x_ + y_,z_]:=Block[{$RecursionLimit=∞},SmallCircle[x,z]+SmallCircle[y,z]];
SmallCircle[x_ , y_+z_]:=Block[{$RecursionLimit=∞},SmallCircle[x,y]+SmallCircle[x,z]];

SmallCircle[0.,y_]:=0;
SmallCircle[0,y_]:=0;
SmallCircle[x_,0.]:=0;
SmallCircle[x_,0]:=0;

SetAttributes[SmallCircle,{Orderless,Listable}];
Protect[SmallCircle];

Unprotect[scExpand];
ClearAll[scExpand];
SetAttributes[scExpand,Listable];
scExpand[x_ + y_]:= Block[{$RecursionLimit=∞},Simplify[scExpand[x] + scExpand[y]]];
scExpand[x_?NumericQ  arg1_]:=x scExpand[arg1];
scExpand[arg1_]:= Module[{arg2},
arg2 = Distribute[ExpandAll[arg1],Plus, SmallCircle];
If[!FreeQ[arg2,_∘_] && arg2  !=  arg1,
arg2 =  scExpand[arg2];
];
Return[Collect[arg2,(Subscript[ζ, _])]];
];
Protect[scExpand];


(* Extend the multiplication to matrices *)
OZMatrixProd[A_,B_]:=scExpand[Inner[SmallCircle,A,B,Plus]];

OZMatrixPower[A_,m_]:=Module[{y},y=scExpand[A];Switch[EvenQ[m],
True,If[m==0,Return[IdentityMatrix[Length[y]]],Return[scExpand[OZMatrixPower[OZMatrixProd[y,y],(m/2)]]]],
False,If[m==1,Return[y],Return[scExpand[OZMatrixProd[OZMatrixPower[scExpand[OZMatrixProd[y,y]],((m-1)/2)],y]]]]]];

(* Extract the maximum generator index appearing in a Clifford element *)
MaxGenerator[u_+v_]:=Max[{MaxGenerator[u],MaxGenerator[v]}];
MaxGenerator[(Subscript[e, a_])]:=Max[a];
MaxGenerator[x_]:=0/;(FreeQ[x,(Subscript[e, _])]);
MaxGenerator[x_ (Subscript[e, a_])]:=Max[a]/;(FreeQ[x,(Subscript[e, _])]);
SetAttributes[MaxGenerator,Listable];

OZScalarSum[ξ_]:=Expand[ξ]/.{(Subscript[(Overscript[ζ, a_]), b_])->1};
SetAttributes[OZScalarSum,Listable];

Generating colorings with nilpotent adjacency matrices

(* Given adjacency matrix A, return {A',P} where A'=(PAP^(-1)) is the adjacency matrix of an isomorphic graph whose vertices are labeled in descending vertex-degree order. *)
DescendingDegree[A_]:=Module[{P,Aprime,cy},
Aprime=Reverse[SortBy[A,Total]];
cy=FindPermutation[A,Aprime];
P=Permute[IdentityMatrix[Length[A]],cy];
Return[{P.A.Inverse[P],P}];];

(*Given an adjacency matrix A, generate a greedy proper-coloring nilpotent adjacency matrix ψ*)
GreedyZeonColoring[A_]:=Module[{j,maxcolorset,co,ψ},
ψ=A;
co=1;
maxcolorset=Range[Length[A]];
For[j=1,j≤Length[A],j++,
co=Min[Complement[maxcolorset,DeleteDuplicates[MaxGenerator[ψ[[;;,j]]]]]];
(*Multiply col of ψ by e_co i.e., color the jth vertex *)
ψ[[;;,j]]=(Subscript[e, {co}])A[[;;,j]];
(* Place e_{co} along row j in positions of later vertices to disallow jth color for neighbors *)
ψ[[ j,j;;]]=(Subscript[e, {co}])A[[j,j;;]];
];
Return[ψ]];

(*Given an adjacency matrix A, generate a greedy proper-coloring nilpotent adjacency matrix ψ*)
(*Vertices are colored in order of descending degree. *)

GreedyZeonColoring2[A_]:=Module[{j,Aprime,maxcolorset,co,P,ψ},
{Aprime,P}=DescendingDegree[A];
ψ=Aprime;
co=1;
maxcolorset=Range[Length[A]];
For[j=1,j≤Length[A],j++,
co=Min[Complement[maxcolorset,DeleteDuplicates[MaxGenerator[ψ[[;;,j]]]]]];
(*Multiply col of ψ by e_co i.e., color the jth vertex *)
ψ[[;;,j]]=(Subscript[e, {co}])A[[;;,j]];
(* Place e_{co} along row j in positions of later vertices to disallow jth color for neighbors *)
ψ[[ j,j;;]]=(Subscript[e, {co}])A[[j,j;;]];
];
Return[Inverse[P].ψ.P]];

(*Given an adjacency matrix A, generate a random vertex-coloring nilpotent adjacency matrix using μ or fewer colors*)
RandomZeonColoring[A_,μ_]:=Module[{j},A.DiagonalMatrix[Table[(Subscript[e, {RandomInteger[{1,μ}]}]),{j,Length[A]}]]];

(*Given an adjacency matrix A, generate a greedy proper-coloring nilpotent adjacency matrix ψ*)
GreedyZeonEdgeColoring[A_]:=Module[{i,j,numedges,maxcolorset,co,p,ψ},
ψ=A;
p=Position[A,1];
numedges=Length[p]/2;
maxcolorset=Range[numedges];
For[j=1,j≤Length[A],j++,
For[i=j+1,i≤Length[A],i++,
If[A[[i,j]]==1,
co=Min[Complement[maxcolorset,Union[DeleteDuplicates[MaxGenerator[Transpose[ψ][[;;i,j]]]],DeleteDuplicates[MaxGenerator[Transpose[ψ][[i,;;j]]]]]]];
ψ[[i,j]]=(Subscript[e, {co}]);
ψ[[ j,i]]=(Subscript[e, {co}]);
,];
];];
Return[ψ]];

(*Given an adjacency matrix A, generate a random edge-coloring nilpotent adjacency matrix using μ or fewer colors*)
RandomZeonEdgeColoring[A_,μ_]:=Module[{i,j,U},
U=Table[If[i>j,A[[i,j]](Subscript[e, {RandomInteger[{1,μ}]}]),0],{i,1,Length[A]},{j,1,Length[A]}];
Return[U+Transpose[U]]];

(*Given a nilpotent vertex κ-coloring matrix ψ, return a corresponding vertex-colored graph and the value of κ, the number of colors used *) 
ZeonColorPlot[X_,layout_:"RadialEmbedding",colormethod_:"deterministic"]:=Module[{A,gA,vcolor,κ,zeoncolorlabels,pallette,edges},
A=X/.{(Subscript[e, _])->1};
gA=AdjacencyGraph[A];
κ=Length[DeleteCases[MaxGenerator[DeleteDuplicates[Flatten[X]]],0]];
If[colormethod=="random",
pallette=Table[RGBColor[RandomReal[1,3]],{j,κ}];
vcolor=Table[j->pallette[[Max[MaxGenerator[Total[Transpose[X][[j]]]],1]]],{j,1,Length[X]}];,
vcolor=Table[j->ColorData[1,"ColorList"][[Mod[Max[MaxGenerator[Total[Transpose[X][[j]]]],1]-1,15]+1]],{j,1,Length[X]}];];
zeoncolorlabels=Table[j->(Subscript[ζ, Max[MaxGenerator[Total[Transpose[X][[j]]]],1]]),{j,1,Length[X]}];
edges=EdgeList[gA];
Return[{Graph[VertexList[gA],edges,VertexSize->Medium,VertexLabels->zeoncolorlabels,VertexStyle->vcolor,EdgeStyle->{Opacity[0.2]},GraphLayout->{layout}],κ}]
];

(*Given a nilpotent vertex κ-coloring matrix X, return a corresponding vertex-colored graph and the value of κ, the number of colors used *) 
ZeonEdgeColorPlot[X_,layout_:"RadialEmbedding",colormethod_:"deterministic"]:=Module[{A,gA,vcolor,κ,zeoncolorlabels,pallette,edges},
A=X/.{(Subscript[e, _])->1};
gA=AdjacencyGraph[A];
edges=EdgeList[gA];
κ=Length[DeleteCases[MaxGenerator[DeleteDuplicates[Flatten[X]]],0]];
If[colormethod=="random",
pallette=Table[RGBColor[RandomReal[1,3]],{j,κ}];
vcolor=Table[edges[[j]]->pallette[[MaxGenerator[X[[edges[[j]][[1]],edges[[j]][[2]]]]]]],{j,1,Length[edges]}];,
vcolor=Table[edges[[j]]->ColorData[1,"ColorList"][[Mod[MaxGenerator[X[[edges[[j]][[1]],edges[[j]][[2]]]]]-1,15]+1]],{j,1,Length[edges]}];];
zeoncolorlabels=Table[edges[[j]]->(Subscript[ζ, MaxGenerator[X[[edges[[j]][[1]],edges[[j]][[2]]]]]]),{j,1,Length[edges]}];
Return[{Graph[VertexList[gA],edges,VertexSize->Tiny, EdgeLabels->zeoncolorlabels,EdgeStyle->vcolor,EdgeLabelStyle->Directive[20],GraphLayout->{layout}],κ}]
];

Generate Ortho-Zeon Colorings

(*Given an adjacency matrix A, generate a random vertex-coloring nilpotent adjacency matrix using μ or fewer colors*)
RandomOrthoZeonColoring[A_,μ_]:=Module[{j},A.DiagonalMatrix[Table[(Subscript[(Overscript[ζ, RandomInteger[{1,μ}]]), {j}]),{j,Length[A]}]]];

(*Given an orthozeon vertex κ-coloring matrix X, return a corresponding vertex-colored graph and the value of κ, the number of colors used *) 
OrthoZeonColorPlot[X_,layout_:"RadialEmbedding",colormethod_:"deterministic"]:=Module[{A,AT,a,gA,vcolor,κ,zeoncolorlabels,pallette,edges},
A=OZScalarSum[X];
AT=X/.{(Subscript[(Overscript[ζ, a_]), b_])->(Subscript[e, {a}])};
gA=AdjacencyGraph[A];
κ=Length[DeleteCases[MaxGenerator[DeleteDuplicates[Flatten[AT]]],0]];
If[colormethod!="deterministic",
pallette=Table[RGBColor[RandomReal[1,3]],{j,κ}];
vcolor=Table[j->pallette[[Max[MaxGenerator[Total[Transpose[AT][[j]]]],1]]],{j,1,Length[AT]}];,
vcolor=Table[j->ColorData[1,"ColorList"][[Mod[Max[MaxGenerator[Total[Transpose[AT][[j]]]],1]-1,15]+1]],{j,1,Length[AT]}];];
zeoncolorlabels=Table[j->(Subscript[(Overscript[ζ, Max[MaxGenerator[Total[Transpose[AT][[j]]]],1]]), {j}]),{j,1,Length[AT]}];
edges=EdgeList[gA];
Return[{Graph[VertexList[gA],edges,VertexSize->Medium,VertexLabels->zeoncolorlabels,VertexStyle->vcolor,EdgeStyle->{Opacity[0.2]},GraphLayout->{layout}],κ}]
];
(*Use nilpotent matrix properties to count monochromatic k-paths from fixed initial vertex*)
OZKPathsFromInit[initrow_,niladjmat_,k_]:=If[k==1,Return[Expand[initrow]],Return[OZKPathsFromInit[scExpand[OZMatrixProd[initrow,niladjmat]],niladjmat,k-1]]];

Examples

Proper vs. Improper colorings

SetSignature[5,0]

Vertex Colorings

(* An example *)
EM={{1,1,2},{2,1,3},{3,2,3},{4,2,9},{5,2,10},{6,3,4},{7,3,5},{8,3,11},{9,4,5},{10,5,6},{11,5,7},{12,5,16},{13,6,13},{14,6,17},{15,7,9},{16,7,13},{17,8,9},{18,8,11},{19,9,14},{20,10,11},{21,10,18},{22,11,12},{23,11,14},{24,11,19},{25,12,15},{26,13,14},{27,13,17},{28,14,15},{29,14,16},{30,14,26},{31,15,20},{32,16,17},{33,16,31},{34,18,19},{35,18,21},{36,19,20},{37,19,24},{38,20,26},{39,21,22},{40,22,23},{41,22,24},{42,23,25},{43,24,25},{44,24,26},{45,25,27},{46,25,29},{47,26,27},{48,26,31},{49,27,28},{50,28,29},{51,28,30},{52,28,31},{53,30,32},{54,31,32}};
edges=Table[IntegerPart[EM[[i]][[2]]]\[UndirectedEdge]IntegerPart[EM[[i]][[3]]],{i,Length[EM]}];

(* Create pallette of m distinct colors *)
m=10;
Pallette=Table[{RandomReal[],RandomReal[],RandomReal[]},{i, m}];
ChosenColors=Table[Pallette[[RandomInteger[{1,Length[Pallette]}]]],{i,32}];
Distinct=DeleteDuplicates[ChosenColors];
NColors=Length[Distinct];
Colors=Table[RGBColor[ChosenColors[[i]]],{i,32}];
ColorLabels=Table[(Subscript[e, Flatten[Position[Distinct,ChosenColors[[i]]]]]),{i,32}];
MonoLabels=Table[(Subscript[τ, Flatten[Position[Distinct,ChosenColors[[i]]]][[1]]])(Subscript[ζ, {i}]),{i,32}];

(* Construct the matrix *)
(ψ=NilColorMatrix[ColorLabels,edges])//MatrixForm//NilOut

{g,κ}=ZeonColorPlot[ψ,"RadialEmbedding"];

Print["Number of colors used: ",κ]

g

(* Create the labels and view the graph *)
ZColorLabels=Table[i->NilOut[ColorLabels][[i]],{i,32}]
VLabels=Table[i->(Subscript[v, i]),{i,32}];
Vcolor=Table[i->Colors[[i]],{i,32}]
g2=Graph[edges,VertexSize->Large,VertexLabels->VLabels,VertexStyle->Vcolor]

(* Proper coloring? *)
SetSignature[NColors,0]
Print["Trace of (ψ^2):"];
Print[(t2=Expand[Tr[ClNilMatrixPower[ψ,2]]])//NilOut];
Print["Scalar sum of trace : ",sstr=ScalarSum[t2]];
Print["Number of edges in graph: ",ecard=Length[edges]];
Print[If[sstr/ecard==2,"Proper coloring.","NOT a proper coloring."]];

(* Heterochromatic 5-cycles? *)
Print["Trace of (ψ^5):"];
Print[(t5=Expand[Tr[ClNilMatrixPower[ψ,5]]])//NilOut];
Print["Number of heterochromatic 5-cycles: ",ScalarSum[t5]/10];

(* A random graph example *)
NVerts=16;
A=GenRandGraph[NVerts,.32]; 
gA=AdjacencyGraph[A];
m=2Max[VertexDegree[gA]];  (* Number of colors to choose from *)
edges=EdgeList[gA];
Pallette=Table[{RandomReal[],RandomReal[],RandomReal[]},{i, m}];
ChosenColors=RandomChoice[Pallette,NVerts];
Distinct=DeleteDuplicates[ChosenColors];
NColors=Length[Distinct];
SetSignature[NColors,0];
Colors=Table[RGBColor[ChosenColors[[i]]],{i,NVerts}];
ColorLabels=Table[(Subscript[e, Flatten[Position[Distinct,ChosenColors[[i]]]]]),{i,NVerts}];
(ψ=NilColorMatrix[ColorLabels,edges])//MatrixForm//NilOut;
ZColorLabels=Table[i->NilOut[ColorLabels][[i]],{i,NVerts}];
VLabels=Table[i->(Subscript[v, i]),{i,NVerts}];
Vcolor=Table[i->Colors[[i]],{i,NVerts}]
g=Graph[VertexList[gA],edges,VertexSize->Medium,VertexLabels->VLabels,VertexStyle->Blue]
g2=Graph[VertexList[gA],edges,VertexSize->Medium,VertexLabels->ZColorLabels,VertexStyle->Vcolor,EdgeStyle->{Opacity[0.2]},GraphLayout->{"RadialEmbedding"}]
SetSignature[NColors,0];
Print[NColors," colors used."];
Print["Trace of (ψ^2): "];
Print[Expand[t2=Tr[ClNilMatrixPower[ψ,2]]]//NilOut];
Print["Scalar sum of trace: ",sstr=ScalarSum[t2]];
Print[ecard=Length[edges], " edges."];
Print[If[sstr/ecard==2,"Proper coloring.","NOT a proper coloring."]];

{g,χ}=ZeonColorPlot[ψ];

Print["Number of colors used: ",χ];

g

Randomly generated graphs with random vertex colorings

(* A random graph example *)
NVerts=14;
A=GenRandGraph[NVerts,.3]; 
gA=AdjacencyGraph[A];
m=2Max[VertexDegree[gA]];  (* Number of colors to choose from *)
edges=EdgeList[gA];
Pallette=Table[{RandomReal[],RandomReal[],RandomReal[]},{i, m}];
ChosenColors=RandomChoice[Pallette,NVerts];
Distinct=DeleteDuplicates[ChosenColors];
NColors=Length[Distinct];
SetSignature[NColors,0];
Colors=Table[RGBColor[ChosenColors[[i]]],{i,NVerts}];
ColorLabels=Table[(Subscript[e, Flatten[Position[Distinct,ChosenColors[[i]]]]]),{i,NVerts}];
(ψ=NilColorMatrix[ColorLabels,edges])//MatrixForm//NilOut;
ZColorLabels=Table[i->NilOut[ColorLabels][[i]],{i,NVerts}];
Vcolor=Table[i->Colors[[i]],{i,NVerts}];
g2=Graph[VertexList[gA],edges,VertexSize->Medium,VertexLabels->ZColorLabels,VertexStyle->Vcolor,EdgeStyle->{Opacity[0.2]},GraphLayout->{"RadialEmbedding"}]
SetSignature[NColors,0];
Print[NColors," colors used."];
Print["Trace of (ψ^2): "];
Print[Expand[t2=Tr[ClNilMatrixPower[ψ,2]]]//NilOut];
Print["Scalar sum of trace: ",sstr=ScalarSum[t2]];
Print[ecard=Length[edges], " edges."];
Print[If[sstr/ecard==2,"Proper coloring.","NOT a proper coloring."]];

(* Recolor the graph and try again *)
m=2Max[VertexDegree[gA]];  (* Number of colors to choose from *)
Pallette=Table[{RandomReal[],RandomReal[],RandomReal[]},{i, m}];
ChosenColors=RandomChoice[Pallette,NVerts];
Distinct=DeleteDuplicates[ChosenColors];
NColors=Length[Distinct];
SetSignature[NColors,0];
Print[NColors," colors used."];
Colors=Table[RGBColor[ChosenColors[[i]]],{i,NVerts}];
ColorLabels=Table[(Subscript[e, Flatten[Position[Distinct,ChosenColors[[i]]]]]),{i,NVerts}];
(ψ=NilColorMatrix[ColorLabels,edges])//MatrixForm//NilOut;
ZColorLabels=Table[i->NilOut[ColorLabels][[i]],{i,NVerts}];
Vcolor=Table[i->Colors[[i]],{i,NVerts}];
g2=Graph[VertexList[gA],edges,VertexSize->Medium,VertexLabels->ZColorLabels,VertexStyle->Vcolor,EdgeStyle->{Opacity[0.2]},GraphLayout->{"RadialEmbedding"}]
SetSignature[NColors,0];
Print["Trace of (ψ^2): "];
Print[Expand[t2=Tr[ClNilMatrixPower[ψ,2]]]//NilOut];
Print["Scalar sum of trace: ",sstr=ScalarSum[t2]];
Print[ecard=Length[edges], " edges."];
Print[If[sstr/ecard==2,"Proper coloring.","NOT a proper coloring."]];

Edge Colorings

(* Generate a random graph with random edge-coloring *)
NVerts=12;
A=GenRandGraph[NVerts,.3];
(*A={{0,1,1,1,0,0},{1,0,1,0,0,0},{1,1,0,0,1,1},{1,0,0,0,1,0},{0,0,1,1,0,1},{0,0,1,0,1,0}};*)
gA=AdjacencyGraph[A];
edges=EdgeList[gA];
m=2Max[VertexDegree[gA]];  (* Number of colors to choose from *)
Pallette=Table[{RandomReal[],RandomReal[],RandomReal[]},{i, m}];
ChosenColors=RandomChoice[Pallette,Length[edges]];
Distinct=DeleteDuplicates[ChosenColors];
NColors=Length[Distinct];
SetSignature[NColors,0];
Print[NColors," colors used."];
Colors=Table[RGBColor[ChosenColors[[i]]],{i,Length[edges]}];
ColorLabels=Table[(Subscript[e, Flatten[Position[Distinct,ChosenColors[[i]]]]]),{i,Length[edges]}];
(ψ=NilColorEdgeMatrix[ColorLabels,edges,NVerts])//MatrixForm//NilOut;
ZColorLabels=Table[edges[[i]]->NilOut[ColorLabels][[i]],{i,Length[edges]}];
Vcolor=Table[edges[[i]]->Colors[[i]],{i,Length[edges]}];
g2=Graph[VertexList[gA],edges,VertexSize->Tiny, EdgeLabels->ZColorLabels,EdgeStyle->Vcolor,EdgeLabelStyle->Directive[20]]
SetSignature[NColors,0];
Print["Nilpotent Edge-Coloring Matrix: ψ = ",ψ//MatrixForm//NilOut];
Print["(ψ^2)= "];
Print[MatrixForm[Expand[t2=ClNilMatrixPower[ψ,2]]]//NilOut];
Ones=Table[1,NVerts];
Print["Scalar sum of (ψ^2): ",sstr=Ones.ScalarSum[t2].Ones];
Print[ecard=Length[edges], " edges."];
Print["Total coincident pairs: ",tcp=Total[Binomial[VertexDegree[gA],2]]];
Print[If[sstr==2 tcp,"Proper edge coloring.","NOT a proper edge coloring."]];

Greedy vertex-colorings

SetSignature[32,0];

A=GenRandGraph[30,.4];
(X=GreedyZeonColoring[A])//MatrixForm//NilOut

({g,κ}=ZeonColorPlot[X,"RadialEmbedding","Random"]);
Print[κ,"-coloring generated."]

g

Verify proper coloring.

Print["Trace of (ψ^2): ",(t2=Tr[ClNilMatrixPower[X,2]])//NilOut];
Print["Scalar sum of trace: ",ss=ScalarSum[t2]];
Print["Number of edges: ",ec=EdgeCount[AdjacencyGraph[A]]];
Print [ss, "/",ec,"=", ss/ec,"  ",If[ss/ec==2,"The coloring is proper.","Something has gone horribly wrong!"]];

Paths, Cycles, Trails, and Circuits

Heterochromatic self-avoiding walks

A=GenRandGraph[40,.1];
(ψ=GreedyZeonColoring[A]);
(ϕ=GreedyZeonColoring2[A]);
{g1,κ}=ZeonColorPlot[ψ];
Print[κ,"-coloring generated."];
{g2,κ2}=ZeonColorPlot[ϕ];
Print[κ2,"-coloring generated."];

IsomorphicGraphQ[g1,g2]

g1

g2

Count heterochromatic κ-cycles

(* Heterochromatic κ-cycles? *)
Print["Trace of (ψ^κ):"];
Print[(t5=Expand[Tr[ClNilMatrixPower[ψ,κ]]])//NilOut];
Print["Number of heterochromatic ",κ,"-cycles: ",ScalarSum[t5]/(2κ)];

(* Count heterochromatic κ-paths with initial vertex (Subscript[v, 1])*)
ScalarSum[KPathsFromInit[ψ[[1]],ψ,κ]]

(* Generate a random graph with a random coloring *)
A=GenRandGraph[20,.3];
(ψ=RandomZeonColoring[A,5])//MatrixForm//NilOut

{g,κ}=ZeonColorPlot[ψ,"RadialEmbedding"];
Print[κ,"-coloring generated."];

g

(* Heterochromatic κ-cycles? *)
Print["Trace of (ψ^κ):"];
Print[(t5=Expand[Tr[ClNilMatrixPower[ψ,κ]]])//NilOut];
Print["Number of heterochromatic ",κ,"-cycles: ",ScalarSum[t5]/(2κ)];

(* Count heterochromatic κ-paths with initial vertex (Subscript[v, 1])*)
ScalarSum[KPathsFromInit[ψ[[1]],ψ,κ]]

Edge colorings

NVerts=10;
A=GenRandGraph[NVerts,.2];
(ψ=RandomZeonEdgeColoring[A,12])//MatrixForm

{g,κ}=ZeonEdgeColorPlot[ψ,"SpringEmbedding"];
Print[κ,"-coloring generated."];

g

Print["Nilpotent Edge-Coloring Matrix: ψ = ",ψ//MatrixForm//NilOut];
Print["(ψ^2)= "];
Print[MatrixForm[Expand[t2=ClNilMatrixPower[ψ,2]]]//NilOut];
Ones=Table[1,NVerts];
Print[ecard=Tr[A.A]/2, " edges."];
Print["Scalar sum of (ψ^2): ",sstr=Ones.ScalarSum[t2].Ones];
Print["Total coincident pairs: ",tcp=Sum[Binomial[Total[A[[j]]],2],{j,1,NVerts}]];
Print[If[sstr==2 tcp,"Proper edge coloring.","NOT a proper edge coloring."]];

NVerts=30;
A=GenRandGraph[NVerts,.4];
(ψ=GreedyZeonEdgeColoring[A])//MatrixForm

{g,κ}=ZeonEdgeColorPlot[ψ];
Print[κ,"-coloring rendered."];

g

Print["Nilpotent Edge-Coloring Matrix: ψ = ",ψ//MatrixForm//NilOut];
Print["(ψ^2)= "];
Print[MatrixForm[Expand[t2=ClNilMatrixPower[ψ,2]]]//NilOut];
Ones=Table[1,NVerts];
Print[ecard=Tr[A.A]/2, " edges."];
Print["Scalar sum of (ψ^2): ",sstr=Ones.ScalarSum[t2].Ones];
Print["Total coincident pairs: ",tcp=Sum[Binomial[Total[A[[j]]],2],{j,1,NVerts}]];
Print[If[sstr==2 tcp,"Proper edge coloring.","NOT a proper edge coloring."]];

Monochromatic self-avoiding walks

(* Generate a random graph with a random coloring *)
A=GenRandGraph[30,.4];
(ψ=RandomOrthoZeonColoring[A,5])//MatrixForm

{g,κ}=OrthoZeonColorPlot[ψ];
Print[κ,"-coloring generated."];

g

(* Monoochromatic κ-cycles? *)
Print["Trace of (ψ^κ):"];
Print[(t5=scExpand[Tr[OZMatrixPower[ψ,κ]]])];
Print["Number of monochromatic ",κ,"-cycles: ",Expand[OZScalarSum[t5]/(κ)]];

(* Monoochromatic paths? - Initial vertex could be visited once. *)
Print[(t5=scExpand[OZKPathsFromInit[ψ[[1]],ψ,κ]])];
Print["Number of monochromatic ",κ," -cycles based at (Subscript[v, 1]): ",Expand[OZScalarSum[t5[[1]]]]];
Print["Number of monochromatic ",κ," -cycles based at (Subscript[v, 3]): ",Expand[OZScalarSum[t5[[3]]]]];

References

G.S. Staples, T. Stellhorn. Zeons, Orthozeons, and Graph Colorings, Preprint, 2016.