(* ::Package:: *) (* :Title: PartitionTypes *) (* :Author: John J. Lattanzio *) (* :Comments: This package can be used as a supplement to the package "Combinatorica" by Pemmaraju and Skiena. Please forward any comments, suggestions, or bugs to: John Lattanzio Department of Mathematics Indiana University of Pennsylvania Indiana, PA 15705 Email: John.Lattanzio@iup.edu Phone: (724) 357-4760 *) (* :Summary: This package contains functions used to analyze, from a group-theoretic perspective, the set of all partitions of V (G) determined by \[Chi] (G)-colorings of G. A few of these functions return output that is for visual and analysis purposes only and thus cannot be used for subsequent computations. However, these functions do have counterpart functions which return output that is usable for subsequent computations. *) (* :Context: PartitionTypes` *) (* :Reference: Lattanzio, John J., Partition Types, Journal of Combintorial Mathematics and Combinatorial Computing, 78 (August 2011), pp. xxx-xxx *) BeginPackage["PartitionTypes`",{"Combinatorica`"}] Unprotect[ ActionOnkPartitions, ColorG, ToEquivalenceClasses, EquivalenceRelation, FunctionForm, GroupAnalyze, IndependentSets, kPartitions, ToPermutations, sig, Sig, StabilizerkPartitions, StabilizerkPartitionsToPermutations]; Block[{$NewMessage}, If[Not[ValueQ[ActionOnkPartitions::usage]], ActionOnkPartitions::usage="ActionOnkPartitions[G,X] gives the image of the set of all partitions, each partition consisting of k independent subsets of V[G], under each element in the subset X of the automorphism group of G. The default value of X is V[G]. Here, k=\[Chi](G). Together with ToEquivalenceClasses[G] and StabilizerkPartitionsToPermutations[G], this is a usable portion of EquivalenceRelation[G]." ]; If[Not[ValueQ[ColorG::usage]], ColorG::usage="ColorG[G,L] gives a vertex coloring of G having the elements of L as color classes. L is required to be a partition of V[G]. Color[G,L] returns a proper vertex coloring provided that L is a partition of independent subsets of V[G]. Otherwise, a nonproper vertex coloring of G is given." ]; If[Not[ValueQ[ToEquivalenceClasses::usage]],ToEquivalenceClasses::usage="ToEquivalenceClasses[G] returns the set of all equivalence classes together with the type sequence of each equivalence class. Together with ActionOnkPartitions[G] and StabilizerkPartitionsToPermutations[G],this is a usable portion of the output of EquivalenceRelation[G]." ]; If[Not[ValueQ[EquivalenceRelation::usage]], EquivalenceRelation::usage="EquivalenceRelation[G] gives the image of the set of all partitions, each partition consisting of k independent subsets of V[G], under each element of automorphism group of G. Here, k=\[Chi](G). Additionally, EquivalenceRelation[G] returns the set of all equivalence classes together with the type sequence of each equivalence class. The orbits of V[G] and a \[Chi](G)-coloring of G are given. EquivalenceRelation[G] is primarily used for analysis." ]; If[Not[ValueQ[FunctionForm::usage]], FunctionForm::usage="FunctionForm[X] gives the function form of each permutation in the subset X of the set of all permutations on n elements, where n is the length of any member of X." ]; If[Not[ValueQ[GroupAnalyze::usage]], GroupAnalyze::usage="GroupAnalyze[G] gives the combined outputs of StabilizerkPartitions[G] and EquivalenceRelation[G]. This is analysis tool; output from GroupAnalyze[G]is in general not reusable." ]; If[Not[ValueQ[IndependentSets::usage]], IndependentSets::usage="IndependentSets[G,L] gives a list of all independent subsets of G containing the vertex v for every vertex in list L. The default value of L is V[G]." ]; If[Not[ValueQ[kPartitions::usage]], kPartitions::usage="kPartitions[G] gives the list of all possible partitions of V[G] consisting of k independent subsets of V[G], where k=\[Chi](G)." ]; If[Not[ValueQ[ToPermutations::usage]], ToPermutations::usage="ToPermutations[G] gives the list of all pairs {sig[i],Automorphisms[G][[i]]}. ToPermutations[G] essentially assigns a lable to each element of Automorphisms[G]." ]; If[Not[ValueQ[Sig::usage]], Sig::usage="Sig[G,i,L] gives the image of list L under the permutation representation of the i-th element of Automorphisms[G}. The default value of L is V[G]." ]; If[Not[ValueQ[StabilizerkPartitions::usage]], StabilizerkPartitions::usage="StabilizerkPartitions[G] gives the stabilizer of each element of the set of all partitions of V[G] consisting of k independent subsets of V[G], where k=\[Chi](G). It also gives the function form for each element in the group of automorphisms of G." ]; If[Not[ValueQ[StabilizerkPartitionsToPermutations::usage]], StabilizerkPartitionsToPermutations::usage="StabilizerkPartitionsToPermutations[G] gives the stabilizer, as a subset of permutations, of each element of the set of all partitions of V[G] consisting of k independent subsets of V[G], where k=\[Chi](G). Together with ActionOnkPartitions[G] and ToEquivalenceClasses[G], this is a usable portion of EquivalenceRelation[G]." ];]; Begin["`Private`"] ActionOnkPartitions[G_Graph,X_:Automatic]:=Module[ {Aut,g=G,K,S=X}, Aut=Automorphisms[g]; K=kPartitions[g]; If[S===Automatic,S=Table[a,{a,Length[Aut]}]]; Table[Table[Sig[g,S[[m]],K[[j,t]]],{j,Length[K]},{t,Length[K[[j]]]}],{m,Length[S]}]] ColorG[G_Graph,L_List]:=Module[ {g=G,a=L,n=V[G]}, If[Sort[Flatten[L]]==Table[z,{z,V[g]}],ShowGraph[SetGraphOptions[Highlight[g,a],VertexLabel->Table[i,{i,n}],VertexLabelPosition->Center]],Print[L," is required to be a partition of V[G]."]]] EquivalenceRelation[G_Graph]:=Module[ {g=G,ER,K,P,P2,AUT,Class1,Class2,ERClasses,ERTypes,Temp,gam}, K=kPartitions[g]; P=ToPermutations[g]; P2=Table[P[[i,2]],{i,Length[P]}]; AUT=ActionOnkPartitions[g]; Do[Print[P[[k,1]]," : ",P[[k,2]],K//MatrixForm," = ",AUT[[k]]//MatrixForm],{k,Length[P]}]; Class1=Table[Table[AUT[[k,j]],{k,Length[P]}],{j,Length[K]}]; Class2=Table[Table[Sort[Map[Sort,AUT[[k,j]]]],{k,Length[P]}],{j,Length[K]}]; ER=Union[Table[Map[Sort,Class2[[i,j]]],{i,Length[Class2]},{j,Length[Class2[[i]]]}]]; ERClasses=Union[Table[Union[ER[[i]]],{i,Length[ER]}]]; Temp={}; Do[If[Temp==K,gam=i-1;Break[],Temp=Union[Temp,ERClasses[[i]]]],{i,Length[ERClasses]+1}]; Do[Print["Type ",j,": = ",ERClasses[[j]]//MatrixForm," ","Type Sequence: ",Table[Length[ERClasses[[j,1,p]]],{p,Length[ERClasses[[j,1]]]}]],{j,gam}]; Print["The orbits are: ",Union[Map[Union,Thread[Apply[List,P2]]]]]; ShowGraph[SetGraphOptions[Highlight[g,ERClasses[[1,1]]],VertexLabel->Table[i,{i,V[g]}],VertexLabelPosition->Center]]] ToEquivalenceClasses[G_Graph]:=Module[ {g=G,ER,K,P,AUT,Class1,Class2,ERClasses,ERTypes,Temp,gam}, K=kPartitions[g]; P=ToPermutations[g]; AUT=ActionOnkPartitions[g]; Class1=Table[Table[AUT[[k,j]],{k,Length[P]}],{j,Length[K]}]; Class2=Table[Table[Sort[Map[Sort,AUT[[k,j]]]],{k,Length[P]}],{j,Length[K]}]; ER=Union[Table[Map[Sort,Class2[[i,j]]],{i,Length[Class2]},{j,Length[Class2[[i]]]}]]; ERClasses=Union[Table[Union[ER[[i]]],{i,Length[ER]}]]; Temp={}; Do[If[Temp==K,gam=i-1;Break[],Temp=Union[Temp,ERClasses[[i]]]],{i,Length[ERClasses]+1}]; Table[{ERClasses[[j]],Table[Length[ERClasses[[j,1,p]]],{p,Length[ERClasses[[j,1]]]}]},{j,gam}]] FunctionForm[X_List]:=Module[ {Dom,x=X}, Dom=Table[i,{i,Length[x[[1]]]}]; Check1=Table[Sort[x[[i]]],{i,Length[x]}]; Check2=Do[If[Check1[[i]]!=Dom,x={};Break],{i,Length[x]}]; If[x!={},FF=Table[{Dom,x[[j]]}//MatrixForm,{j,Length[x]}],Print["Elements of X are required to be permutations of {1,2,...,n}."]]] GroupAnalyze[G_Graph]:=Module[ {g=G}, Print[StabilizerkPartitions[g]]; Print[EquivalenceRelation[g]]] IndependentSets[G_Graph,M_:Automatic]:=Module[ {A,d=M,g,Ind,IndEdges,IndPaths,IndSets,IndTemp,IndTreePaths,NextInd,NonNeighbors,PathToEdges,SetAppend,SetToRootedPaths,Vertex,z}, g=G;A=ToAdjacencyMatrix[g]; If[d===Automatic,d=Table[i,{i,V[g]}]]; SetAppend[X_List,Y_List]:=If[Y!={},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]]!={},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]==Ind[k-2],IndPaths=Ind[k-2];z=-1;Break[],Ind[k]=Flatten[Table[If[NextInd[Ind[k-1][[i]]]!={},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]}]; Do[If[IndTreePaths[i]!={},IndSets[i]=IndTreePaths[i],IndSets[i]={{i}}],{i,V[g]}]; Table[IndSets[d[[i]]],{i,Length[d]}]] kPartitions[G_Graph]:=Module[ {g,X}, g=G; X=KSubsets[Union[Map[Sort,Flatten[IndependentSets[g],1]]],ChromaticNumber[g]]; Select[X,Sort[Flatten[#]]==Table[j,{j,V[g]}] &]] ToPermutations[G_Graph]:=Module[ {Aut,g}, g=G; Aut=Automorphisms[g]; Table[{sig[i],Aut[[i]]},{i,Length[Aut]}]] Sig[G_Graph,i_Integer,x_:Automatic]:=Module[ {g=G,j=i,L=x}, S=ToPermutations[g]; If[L===Automatic,L=Table[k,{k,V[g]}]]; If[MemberQ[Table[s,{s,Length[S]}],j]==True, Table[ToPermutations[g][[i,2]][[L[[j]]]],{j,Length[L]}], Print["Input value ",j," is invalid."," For the given graph, the variable i is required to satisfy 1\[LessEqual]i\[LessEqual]",Length[S],"."]]] StabilizerkPartitions[G_Graph]:=Module[{g=G,A,K,B,P,Stab,Stabilizer}, K=kPartitions[g]; A=ActionOnkPartitions[g]; P=ToPermutations[g]; B=Table[P[[t,2]],{t,Length[P]}]; Do[Stabilizer[j]={},{j,Length[K]}]; Do[Do[If[K[[i]]==Map[Sort,A[[j,i]],{0,1}],Stabilizer[i]=Append[Stabilizer[i],B[[j]]]],{j,Length[B]}],{i,Length[K]}]; Stab=Table[Stabilizer[z],{z,Length[K]}]; Do[Do[Do[If[Stab[[i,j]]==P[[u,2]],Stab=ReplacePart[Stab,{i,j}->P[[u,1]]]],{u,Length[P]}],{j,Length[Stab[[i]]]}],{i,Length[Stab]}]; Do[Print["Stab","(",K[[s]],")"," = ",Stab[[s]]],{s,Length[K]}]; FunctionForm[B]] StabilizerkPartitionsToPermutations[G_Graph]:=Module[{g=G,A,K,B,P,Spots,Stab,Stabilizer}, K=kPartitions[g]; A=ActionOnkPartitions[g]; P=ToPermutations[g]; B=Table[P[[t,2]],{t,Length[P]}]; Do[Stabilizer[j]={},{j,Length[K]}]; Do[Do[If[K[[i]]==Map[Sort,A[[j,i]],{0,1}],Stabilizer[i]=Append[Stabilizer[i],B[[j]]]],{j,Length[B]}],{i,Length[K]}]; Stab=Table[Stabilizer[z],{z,Length[K]}]; Do[Do[Do[If[Stab[[i,j]]==P[[u,2]],Stab=ReplacePart[Stab,{i,j}->P[[u,1]]]],{u,Length[P]}],{j,Length[Stab[[i]]]}],{i,Length[Stab]}]; Spots=Table[Select[Table[i,{i,Length[B]}],MemberQ[Stab[[j]],P[[#,1]]]&],{j,Length[Stab]}]; Table[P[[Spots[[i,j]],2]],{i,Length[Spots]},{j,Length[Spots[[i]]]}]] End[ ] Protect[ ActionOnkPartitions, ColorG, ToEquivalenceClasses, EquivalenceRelation, FunctionForm, GroupAnalyze, kPartitions, IndependentSets, ToPermutations, sig, Sig, StabilizerkPartitions, StabilizerkPartitionsToPermutations] EndPackage[ ]