How to calculate all the possible leagues for a group of n teams

Question

Given a set of $n$ teams, I would like to calculate how many different leagues exist. For a league, I mean a series of days, where in each day (with $\frac{n}{2}$ matches) every team plays a match against another team, and the total number of days $(n-1)$ produces the league, such that every team competed with every other team.

Calculating the combinations of pairs from a group of $n$ elements gives all the possible matches, and calculating the combinations of all the possible matches in groups of $\frac{n}{2}$ gives all the possible different days (the order is not important).

Matches and days can be easily calculated with $\frac{n!}{k!(n-k)!}$ but at this point, how to calculate all the possible combinations of matches in $n-1$ days, without having the same match more than once?

For example, for a group of 8 teams, there are 28 possible matches and a total of 105 possible days (4 matches each). The question is, how many leagues (series of 7 days) with everyone of the 28 matches disputed only once, do exist? Thanks for reading.

Answer 1

I implemented a brute-force calculation for this problem. Unless I made a mistake, the count for $n = 2, 4, 6, 8$ is respectively 1, 6, 720, 16511040. I couldn't find a match in OEIS, so this leads me to suspect there is no simple answer.

My Mathematica code for the $n=8$ case (I was to lazy to code a function that works directly for any $n$, but it should be obvious how to generalize):

<< Combinatorica`    
n = 8; X = Select[Involutions[n, Cycles], Length[#] == (n/2) &]; Sum[
     Y = Select[X, Intersection[X[[i]], #] == {} &];
     Sum[
      Z = Select[Y, Intersection[Y[[j]], #] == {} &];
      Sum[
       W = Select[Z, Intersection[Z[[k]], #] == {} &];
       Sum[
        VVV = Select[W, Intersection[W[[l]], #] == {} &];
        Length[VVV]
        , {l, 1, Length[W]}]
       , {k, 1, Length[Z]}]
      , {j, 1, Length[Y]}]
     , {i, 1, Length[X]}]

EDIT: The above code does not give the correct result. For $n=8$ the value should be 31449600, and the relevant OEIS sequence is https://oeis.org/A036981. Here is new code which should be correct, and is also much faster (it could be made even faster by exploiting the initial symmetry, but it's meant to be a brute-force script):

<< Combinatorica`  

Leagues[adj_, 0] := 1

Leagues[adj_, 1] := Length[adj]

Leagues[adj_, n_] :=
 (
  graph = AdjacencyGraph[adj];
  matchFound = False;
  Do[
   If[IsomorphicGraphQ[graph, CacheGraphs[n][[i]]],
    matchFound = True;
    val = CacheValues[n][[i]]]
   , {i, 1, Length[CacheGraphs[n]]}];
  If[matchFound, val,
   val = Sum[row = adj[[i]];
     itemCount = Total[row];
     newItems = Table[0, {itemCount}];
     j = 1;
     Do[If[row[[k]] == 1, newItems[[j]] = k; j++], {k, 1, 
       Length[row]}];
     newAdj = adj[[newItems, newItems]];
     Leagues[newAdj, n - 1]
     , {i, 1, Length[adj]}];
   graph = AdjacencyGraph[adj];
   AppendTo[CacheGraphs[n], graph];
   AppendTo[CacheValues[n], val];
   val]
  )

Result[n_]:= (
X = Select[Involutions[n, Cycles], Length[#] == (n/2) &];
Do[CacheGraphs[m] = {};
CacheValues[m] = {}, {m, 1, n}]; Leagues[
 Table[Boole[Intersection[X[[i]], X[[j]]] == {}], {i, 1, 
   Length[X]}, {j, 1, Length[X]}], n - 1])

With a few minutes of calculation it is able to also match the next term in the OEIS sequence, 444733651353600.

Incidentally, it seems the hardest part of the calculation in my new approach can be reduced to the graph isomorphism problem, which is not known to be in either P or NP-Complete.