Tournament

Author

Eric W. Weisstein
March 16, 2005

This notebook downloaded from http://mathworld.wolfram.com/notebooks/GraphTheory/Tournament.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/Tournament.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Code

Tournaments[n_]:=OrientedSets[System`CompleteGraph[n]]

OrientedSets[g_System`Graph]:=Module[{e=List@@@EdgeList[g],t,m=EdgeCount[g],n=VertexCount[g]},
If[m===0,Return[{g}]];
t=Transpose[{e,Reverse/@e}];
Tally[Sort[CanonicalGraph[System`Graph[Range[n],DirectedEdge@@@#]]&/@Flatten[Outer[List,Sequence@@t,1],m-1]]][[All,1]]
]

Enumeration

A000568

1, 1, 1, 2, 4, 12, 56, 456, 6880, 191536, 9733056, 903753248, 154108311168, 48542114686912, 28401423719122304, 31021002160355166848, 63530415842308265100288, 244912778438520759443245824

Do[Print[{n,Length[Tournaments[n]]//Timing}],{n,8}]

V5

Hack to get around Combinatorica bug

radialEmbedding[t_Graph]:=
ChangeVertices[t, Vertices[RadialEmbedding[MakeUndirected[t]]]] /;
  !UndirectedQ[t]&&V[t]>3

radialEmbedding[t_Graph]:=t

ShowGraphArray[Map[radialEmbedding,
Flatten[Map[Partition[#,6,6,{1,1},{}]&,
Select[#,TournamentQ]&/@Digraphs/@Range[4],
{1}],1],{2}]
]

Transitive Triple

Show[GraphGraphic[Tournaments[3][[1]],PlotStyles->{PointSize[.06]},VertexColors->{Red}]]

Cyclic Triple

Show[GraphGraphic[Tournaments[3][[2]],PlotStyles->{PointSize[.06]},VertexColors->{Red}]]

Counts

?SymmetricGroupIndex

?CycleIndex

CycleIndex[SymmetricGroup[5],x]

SymmetricGroupIndex[5,x]

Table[SymmetricGroupIndex[n,x];,{n,20}]//Timing

Method 1

poly=SymmetricGroupIndex[5,x]/.x[_?EvenQ]->0

List@@poly/.x[i_]:>1

((DeleteCases[List@@#,_?NumberQ]/.x[i_]^p_.->{p,i})&/@List@@poly)

dofpi[l_]:=Plus@@(#[[1]](#[[2]]#[[1]]-1)/2&/@l)+Plus@@(
#[[1,1]]#[[2,1]]GCD[#[[1,2]],#[[2,2]]]&/@KSubsets[l,2])

dofpi/@%

TournamentStructure[n_Integer]:=Module[
{
poly=SymmetricGroupIndex[n,x]/.x[_?EvenQ]->0,
s,d
},
s=List@@poly/.x[i_]:>1;
d=dofpi/@((DeleteCases[List@@#,_?NumberQ]/.x[i_]^p_.->{p,i})&/@List@@poly);
{s,d}
]/; n>2

TournamentStructure[5]

Table[Tournaments[n],{n,20}]//Timing

Method 2

poly=SymmetricGroupIndex[5,x]/.x[_?EvenQ]->0

dtl=Internal`DistributedTermsList[poly,v=Variables[poly]]

{l,s}=Transpose[First[dtl]]

Transpose[{#,First/@v}]&/@l

DeleteCases[%,List[0,_],Infinity]

dofpi[l_]:=Plus@@(Function[{p,i},p(i p-1)/2]@@@l)+Plus@@(
Function[{pi,i,pj,j},pi pj GCD[i,j]]@@@Flatten/@KSubsets[l,2])

dofpi/@%

TournamentStructure[n_Integer]:=Module[
{
poly=SymmetricGroupIndex[n,x]/.x[_?EvenQ]->0,
d,dtl,l,s,v
},
v=Variables[poly];
dtl=Internal`DistributedTermsList[poly,v];
{l,s}=Transpose[First[dtl]];
d=dofpi/@DeleteCases[Transpose[{#,First/@v}]&/@l,List[0,_],Infinity];
{s,d}
]/; n>2

Tournaments[1]:=0
Tournaments[2]:=1
Tournaments[n_]:=Module[{s,d},
{s,d}=TournamentStructure[n];
s.(2^d)
]

TournamentStructure[5]

Table[Tournaments[n],{n,20}]//Timing

Hamiltonian

radialEmbedding[t_Graph]:=t

ShowGraphArray[Map[radialEmbedding,
Flatten[Map[Partition[#,6,6,{1,1},{}]&,
Select[#,TournamentQ]&/@Digraphs/@Range[4],
{1}],1],{2}]
]

Paths

Map[HamiltonianPath[#,All]&,Tournaments/@Range[4],{2}]//ColumnForm

...these are wrong; every tournament has an odd number of Hamiltonian paths...

Cycles

?HamiltonianCycle

?HamiltonianQ

Map[HamiltonianQ[#]&,Tournaments/@Range[4],{2}]//ColumnForm

Map[ConnectedQ[#,Strong]&,Tournaments/@Range[4],{2}]//ColumnForm

...these are wrong; a tournament has a Hamiltonian cycle iff it is strongly connected...