Score Sequence

Author

Eric W. Weisstein
June 3, 2004

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

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

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

Checking Sequences

ScoreSequenceQ[l_List]:=Module[{n=Length[l]},
Plus@@l==Binomial[n,2]&&
And@@
Thread[(Plus@@@Reverse[NestList[Drop[#,-1]&,l,n-1]]>=Table[Binomial[k,2],{k,n}])
]
]

seqs[n_]:=Select[Flatten[Outer[List,Sequence@@Table[Range[0,n-1],{n}]],n-1],OrderedQ]

Select[seqs[2],ScoreSequenceQ]

Select[seqs[3],ScoreSequenceQ]

Select[seqs[4],ScoreSequenceQ]

Select[seqs[5],ScoreSequenceQ]

Table[Count[seqs[n],_?ScoreSequenceQ],{n,6}]

Ruskey's Algorithm

Gen[k_,sum_,n_]:=(
If[k==n,
count++;
s[n]=c[n]-sum;
AppendTo[l,Table[s[i],{i,n}]],
(*else*)
Do[s[k]=i;Gen[k+1,sum+i,n],{i,Max[s[k-1],c[k]-sum],(c[n]-sum)/(n-k+1)}]
]
);

Scores[n_]:=(
c[1]=0;
s[0]=0;
Do[c[i]=c[i-1]+i-1,{i,2,n}];
count=0;
l={};
Gen[1,0,n];
Sort[l]
)

Scores[3]

Scores[4]