Stochastic problem

Question

I have to organize a small sports league and I am puzzled on how to create the game plan.

We are 8 persons playing table soccer with 2 vs. 2 matches. The idea is that each person plays once with every other person. So e.g. person 1 will play once with person 2, 3, 4, 5, 6, 7 and 8. So there are 7 matchdays and 2 games on each. If a team wins both players receive a point. At the end of the season a player can have earned a max of 7 points.

E.g. matchday 1: p1&p2; p3&p4; p5&p6; p7&p8 E.g. matchday 2: p1&p3; p2&p4; p5&p7; p6&p8

How can I calculate the teams for each of the seven game days given the conditions above? Since the strongest two teams would play against each other depending on points collected in the earlier games I only need a set of 4 teams for each matchday.

I would be grateful for some smart help on calculating a game plan. I guess I am stuck here:

players = Range[1, 8]; teams = Select[Subsets[players , 2], Length[#] == 2 &];

Thanks a lot Patrick

Answer 1

The number of players is relatively short, so we can brute-force the problem. There are only 8! = 40,320 different arrangements of players and it is easy enough to generate them all and then filter them:

longList = (Sort /@ Partition[#, 2]) & /@ Permutations[Range@8];

Union[longList, SameTest -> (Or @@ Flatten[Outer[Equal, #1, #2, 1]] &)]

{{{1, 2}, {3, 4}, {5, 6}, {7, 8}}, {{1, 3}, {2, 4}, {5, 7}, {6, 8}}, {{1, 4}, {2, 3}, {5, 8}, {6, 7}}, {{1, 5}, {2, 6}, {3, 7}, {4, 8}}, {{1, 6}, {2, 5}, {3, 8}, {4, 7}}, {{1, 7}, {2, 8}, {3, 5}, {4, 6}}, {{1, 8}, {2, 7}, {3, 6}, {4, 5}}}

It basically does the following:

1. Permutations are generated, partitioned in pairs, and sorted because {1,2} equals {2, 1} for our purposes
2. Union is then used to weed out any partitioned permutation that has at least one pair already seen before (the SameTest function is defined such that it is True if this is the case).

Answer 2

Just a longer non-optimal alternative. This problem must have way cleaner solutions. I'll give it more thought in my sleep (or not)

SetAttributes[{team, matchDay}, Orderless];
players = player /@ Range@8;

There are only 7!!==105 possible match days you can build. One could build them up and then just find a combination in which every player plays only once with each other

Ugly way to build the candidates

matchDayCandidates = 
  matchDay @@@ (team @@@ Partition[#, 2] & /@ Permutations[players]);

Length@matchDayCandidates == 7!! gives True, good sign.

Ugly way to filter them to get a possible result

Reap[
  NestWhile[(Sow[First@#]; 
     DeleteCases[#, matchDay[Alternatives @@ First@#, __]]) &, 
   matchDayCandidates, # =!= {} &]
  ][[-1, 1]]