(* :Title: GraphColoring *)

(* :Author: John J. Lattanzio *)

(* :Comments: 
      This package is a supplement to the package "Combinatorica" by
Pemmaraju and Skiena.  Any problems or suggestions should be forwarded to:
          
            John Lattanzio
            Department of Mathematics
            Indiana University of Pennsylvania
            Indiana, PA  15705
    
            Email: John.Lattanzio@iup.edu
            Phone: (724) 357-4760 *)

(* :Context: ProgrammingInMathematica`GraphColoring` *)

BeginPackage["ProgrammingInMathematica`GraphColoring`", "DiscreteMath`Combinatorica`", "Graphics`Colors`"]

Unprotect[ColorGraph, TestColorGraph, SetAppend, IndependentSets, IndependenceTrees]

ColorGraph::usage = "ColorGraph[G] returns an upper bound, k, for \[Chi](G) together with a vertex partition of G having k members.  Successive vertices in a color class are determined by a maximum intersection property.  The option ExhibitGraph can be used to display the colored graph."

TestColorGraph::usage = "TestColorGraph[n, a, b, p] compares the algorithms of Brelaz and Lattanzio by returning the average of the differences between upper bounds, determined by the algorithms respectively, on the chromatic numbers of n randomly generated graphs, having between a and b vertices and an approximate edge probability of p.  The option ExhibitTest can be used to display the test data."

ExhibitGraph::usage = "ExhibitGraph is an option for ColorGraph that will display the colored graph determined by the algorithm.  The default value of ExhibitGraph is 0 so that the graph is not displayed.  To display the graph, the value of ExhibitGraph should be set to 1."

ExhibitTest::usage = "ExhibitTest is an option for TestColorGraph that will display the data determined by the algorithm.  The default value of ExhibitTest is 0 so that the data is not displayed.  To display the data, the value of ExhibitTest should be set to 1."

IndependentSets::usage = "IndependentSets[G, L] returns a labeled graph G together with a list in which element i of list L is the set of all independent subsets of V(G) containing vertex i.  L is required to be a nonempty subset of the vertex set of G.  The default for L is V(G)."

IndependenceTrees::usage = "IndependenceTrees[G, L] returns a labeled graph G together with a sequence of rooted trees,  a root for each vertex in L.  The vertices contained in the paths of the rooted trees correspond to independent subsets of V(G).  L is required to be a nonempty subset of the vertex set of G.  The default for L is V(G)."

Options[ColorGraph] = {ExhibitGraph -> 0}

Options[TestColorGraph] = {ExhibitTest -> 0}

Begin["`Private`"]

ColorGraph[G_Graph, options___Rule] := Module[{opt1, g, adlist, class, verpart, maxlength, v, nbhds, delnbhd, inter, s, maxinter, w, color},
g = G; adlist = ToAdjacencyLists[g]; class = {}; delnbhd = adlist; verpart = {};
opt1 = ExhibitGraph /. {options} /. Options[ColorGraph];
Do[If[Flatten[adlist] == {}, 
    verpart = Append[verpart, Complement[Table[t, {t, Length[adlist]}], Flatten[verpart]]]; Break[],
    If[Length[Flatten[verpart]] == Length[adlist], Break[]]; 
    Do[maxlength = Max[Table[Length[adlist[[a]]], {a, Length[adlist]}]];
      If[maxlength != 0, 
        Do[If[Length[adlist[[b]]] == maxlength && Not[MemberQ[Flatten[verpart],b]], v = b; 
            class = Union[class, {v}]; Break[]], {b, Length[adlist]}];
        nbhds = Union[{{v}}, Table[{adlist[[v, c]]}, {c, Length[adlist[[v]]]}]];
        delnbhd = ReplacePart[adlist, {}, nbhds];
        inter = Table[Intersection[adlist[[v]], delnbhd[[d]]], {d, Length[delnbhd]}];
        Do[If[Flatten[delnbhd] == {} && r == 1, s = r; color = {v}; Break[],
            If[Flatten[delnbhd] == {}, Break[]];
            s = r;
            If[Flatten[delnbhd] != {} && Flatten[inter] == {}, inter = delnbhd];
            maxinter = Max[Table[Length[inter[[m]]], {m, Length[inter]}]];
            Do[If[Length[inter[[n]]] == maxinter && Intersection[{n}, Flatten[verpart]] == {}, w = n; 
                class = Union[class, {w}]; Break[]], {n, Length[inter]}];
            nbhds = Union[nbhds, {{w}}, Table[{adlist[[w, p]]}, {p, Length[adlist[[w]]]}]];
            delnbhd = ReplacePart[adlist, {}, nbhds];
            inter = Table[Intersection[adlist[[w]], delnbhd[[q]]], {q, Length[delnbhd]}];
            If[Length[nbhds] == Length[adlist], Break[]]], {r, Length[delnbhd]}],
        s = 0;
        class = Complement[Table[e, {e, Length[adlist]}], Flatten[verpart]]];
      s = -1;
      If[s == 0 || s != 1, colorclass[y] = class, colorclass[y] = color];
      If[s != 0, color = {}; class = {}];
      adlist = ReplacePart[adlist, {}, Table[{colorclass[y][[o]]}, {o, Length[colorclass[y]]}]];
adlist = Table[Complement[adlist[[az]], colorclass[y]], {az, Length[adlist]}];
verpart = Append[verpart, colorclass[y]]];
If[Length[Flatten[verpart]] == Length[adlist],Break[]],{z, Length[adlist]}],{y, Length[adlist]}];
Print["\[Chi](G) \[PrecedesSlantEqual]  ", Length[verpart],"."];
Print["A vertex set partition is  ",Sort[verpart]//MatrixForm,"."];
If[MemberQ[{0,1}, opt1] && opt1 == 1, ShowGraph[SetGraphOptions[Highlight[g,verpart],VertexLabel->Table[i, {i, V[g]}],VertexLabelPosition->Center]]]; {Length[verpart], Sort[verpart]}]

ColorGraphTest[G_Graph] := Module[{g, adlist, class, verpart, maxlength, v, nbhds, delnbhd, inter, s, maxinter, w, color},
g = G; adlist = ToAdjacencyLists[g]; class = {}; delnbhd = adlist; verpart = {};
Do[If[Flatten[adlist] == {}, 
    verpart = Append[verpart, Complement[Table[t, {t, Length[adlist]}], Flatten[verpart]]]; Break[],
    If[Length[Flatten[verpart]] == Length[adlist], Break[]]; 
    Do[maxlength = Max[Table[Length[adlist[[a]]], {a, Length[adlist]}]];
      If[maxlength != 0, 
        Do[If[Length[adlist[[b]]] == maxlength && Not[MemberQ[Flatten[verpart],b]], v = b; 
            class = Union[class, {v}]; Break[]], {b, Length[adlist]}];
        nbhds = Union[{{v}}, Table[{adlist[[v, c]]}, {c, Length[adlist[[v]]]}]];
        delnbhd = ReplacePart[adlist, {}, nbhds];
        inter = Table[Intersection[adlist[[v]], delnbhd[[d]]], {d, Length[delnbhd]}];
        Do[If[Flatten[delnbhd] == {} && r == 1, s = r; color = {v}; Break[],
            If[Flatten[delnbhd] == {}, Break[]];
            s = r;
            If[Flatten[delnbhd] != {} && Flatten[inter] == {}, inter = delnbhd];
            maxinter = Max[Table[Length[inter[[m]]], {m, Length[inter]}]];
            Do[If[Length[inter[[n]]] == maxinter && Intersection[{n}, Flatten[verpart]] == {}, w = n; 
                class = Union[class, {w}]; Break[]], {n, Length[inter]}];
            nbhds = Union[nbhds, {{w}}, Table[{adlist[[w, p]]}, {p, Length[adlist[[w]]]}]];
            delnbhd = ReplacePart[adlist, {}, nbhds];
            inter = Table[Intersection[adlist[[w]], delnbhd[[q]]], {q, Length[delnbhd]}];
            If[Length[nbhds] == Length[adlist], Break[]]], {r, Length[delnbhd]}],
        s = 0;
        class = Complement[Table[e, {e, Length[adlist]}], Flatten[verpart]]];
      s = -1;
      If[s == 0 || s != 1, colorclass[y] = class, colorclass[y] = color];
      If[s != 0, color = {}; class = {}];
      adlist = ReplacePart[adlist, {}, Table[{colorclass[y][[o]]}, {o, Length[colorclass[y]]}]];
adlist = Table[Complement[adlist[[az]], colorclass[y]], {az, Length[adlist]}];
verpart = Append[verpart, colorclass[y]]];
If[Length[Flatten[verpart]] == Length[adlist],Break[]],{z, Length[adlist]}],{y, Length[adlist]}];
bre=Max[BrelazColoring[g]];
lat=Length[verpart];
{bre,lat,bre-lat}]

TestColorGraph[n_, a_, b_, p_, options___Rule] := Module[{i, s, t, opt1}, s = Table[RandomGraph[Random[Integer, {a, b}], p], {i, n}];
opt1 = ExhibitTest /. {options} /. Options[TestColorGraph];
t = Table[ColorGraphTest[s[[i]]], {i, n}];
Print["On average for this test, ColorGraph uses ", N[Sum[t[[i, 3]]/n, {i, n}], 3]," fewer colors than BrelazColoring."];
If[MemberQ[{0,1}, opt1] && opt1 == 1, Print[Prepend[t,{"Brelaz","ColorGraph","Difference"}]//TableForm]];
{N[Sum[t[[i, 3]]/n, {i, n}], 3]}] /;
IntegerQ[n] && IntegerQ[a] && IntegerQ[b] && NumberQ[p] && 0 < a < b && 0 < p < 1

IndependentSets[x_Graph,M_List]:=
  Module[{G,A,NonNeighbors,IndPaths,z},G=x;A=ToAdjacencyMatrix[G];
    SetAppend[X_List,Y_List]:=
      If[Y\[NotEqual]{},MapThread[Append,{Table[X,{Length[Y]}],Y}],X];
    NonNeighbors=
      Table[Complement[Table[p,{p,V[G]}],Neighborhood[G,v,1]],{v,V[G]}];
    NextInd[Z_List]:=
      Select[NonNeighbors[[Z[[1]]]],#>Z[[-1]] && 
            MemberQ[Apply[Intersection,
                Table[NonNeighbors[[Z[[-i]]]],{i,Length[Z]}]],#] &];
    Do[IndTemp[v,1]={v},{v,V[G]}];
    Ind[1]=Flatten[Table[IndTemp[v,1],{v,V[G]}],0];
    Do[If[NonNeighbors[[v]]\[NotEqual]{},
        IndTemp[v,2]=SetAppend[IndTemp[v,1],NonNeighbors[[v]]],
        IndTemp[v,2]={IndTemp[v,1]}],{v,V[G]}];
    Ind[2]=Flatten[Table[IndTemp[v,2],{v,V[G]}],1];
    z=0;
    Do[If[Ind[k-1]\[Equal]Ind[k-2],IndPaths=Ind[k-2];z=-1;Break[],
        Ind[k]=Flatten[
            Table[If[NextInd[Ind[k-1][[i]]]\[NotEqual]{},
                SetAppend[Ind[k-1][[i]],
                  NextInd[Ind[k-1][[i]]]],{SetAppend[Ind[k-1][[i]],
                    NextInd[Ind[k-1][[i]]]]}],{i,Length[Ind[k-1]]}],1]],{k,3,
        V[G]}];
    If[z!=-1,IndPaths=Ind[V[G]]];
    PathToEdges[L_List]:=
      If[Length[L]>1,Table[{L[[i]],L[[i+1]]},{i,Length[L]-1}],L];
    SetToRootedPaths[S_List]:=
      If[Length[S]>1,Table[Table[S[[i]],{i,j}],{j,Length[S]}],S];
    Do[Vertex[i]=Select[IndPaths,# [[1]]==i &],{i,V[G]}];
    Do[If[Length[Flatten[Vertex[i]]]>1,
        IndEdges[i]=Union[Flatten[Map[PathToEdges,Vertex[i]],1]],
        IndEdges[i]={}],{i,V[G]}];
    Do[If[Length[Flatten[Vertex[i]]]>1,
        IndTreePaths[i]=Union[Flatten[Map[SetToRootedPaths,Vertex[i]],1]],
        IndTreePaths[i]={}],{i,V[G]}];
    ShowGraph[
      SetGraphOptions[G,VertexStyle\[Rule]Disk[Large],
        VertexColor\[Rule]LightGray,VertexLabel\[Rule]Table[i,{i,V[G]}],
        VertexLabelPosition\[Rule]Center]];
    Do[If[IndTreePaths[i]\[NotEqual]{},IndSets[i]=IndTreePaths[i],
        IndSets[i]={{i}}],{i,V[G]}];
    Table[IndSets[M[[i]]],{i,Length[M]}]]
    
    IndependenceTrees[x_Graph,L_List]:=Module[{t,G},
    G=x;
    t=IndependentSets[G,Table[z,{z,V[G]}]];
    Do[IndTreePaths[i]=t[[i]],{i,Length[t]}];
    Do[If[IndTreePaths[j]\[NotEqual]{},
        HalfEdges[j]=
          Flatten[Table[
              Position[IndTreePaths[j],Delete[IndTreePaths[j][[i]],-1] ,1,
                1],{i,Length[IndTreePaths[j]]}],2],HalfEdges[j]={}],{j,1,
        V[G]}];
    Do[If[HalfEdges[j]\[NotEqual]{},
        EdgesTree[j]=
          Table[{HalfEdges[j][[i]],i+1},{i,Length[IndTreePaths[j]]-1}],
        EdgesTree[j]={}],{j,1,V[G]}];
    Do[If[EdgesTree[i]\[NotEqual]{},g[i]=FromUnorderedPairs[EdgesTree[i]],
        g[i]=CompleteGraph[1]],{i,V[G]}];
    Do[If[IndTreePaths[j]\[NotEqual]{},
        TreeLabels[j]=
          Table[IndTreePaths[j][[i,-1]],{i,Length[IndTreePaths[j]]}],
        TreeLabels[j]={j}],{j,V[G]}];
    indtrees=
      Table[SetGraphOptions[
          Highlight[RootedEmbedding[g[i]],{Table[j,{j,V[g[i]]}]}],
          VertexStyle\[Rule]Disk[Normal],VertexLabel\[Rule]TreeLabels[i],
          VertexLabelPosition\[Rule]Center],{i,V[G]}];
    Do[ShowGraph[indtrees[[L[[i]]]]],{i,Length[L]}]]
    
    IndependentSets[G_Graph] := IndependentSets[G, Table[i, {i, V[G]}]]
    
    IndependenceTrees[G_Graph] := IndependenceTrees[G, Table[i, {i, V[G]}]]

End[]
Protect[ColorGraph, ShowColorGraph, TestColorGraph, IndependentSets, IndependenceTrees]
EndPackage[]