Re: Re: Ten chess-players...
- To: mathgroup at smc.vnet.net
- Subject: [mg99366] Re: [mg99352] Re: Ten chess-players...
- From: Leonid Shifrin <lshifr at gmail.com>
- Date: Mon, 4 May 2009 05:59:02 -0400 (EDT)
- References: <36a5dba2-11b9-45df-84c3-9e712e47fec9@q33g2000pra.googlegroups.com>
Hi,
I think, the solution of DrMajorBob is superior, since mine is
non-deterministic and slow. In any case, it is better to first obtain all
the schedule in a
single data structure (matrix or just list), and then, if you insist on
printing,
write a separate printing routine. In this way, you don't touch your solver
code if you later decide to rewrite the printing routine or do something
else with your results.
Taking your code (I would recommend to avoid imperative programming in
Mathematica, but at least, to localize your variables) it is a
straightforward change to produce a list of games by replacing Print by
Reap-Sow:
In[1] =
games =
Module[{numPlayers = 10, odd, a1, a3, a4, i, b1, j},
Reap[
Do[
If[OddQ[numPlayers], odd = 1; numPlayers = numPlayers + odd,
odd = 0]; a1 = Range[2, numPlayers];
If[odd == 1, a1 = a1 /. a1[[numPlayers - 1]] -> 0];
a3 = Range[1, numPlayers/2];
a4 = Range[numPlayers, numPlayers/2 + 1, -1];
For[i = 1, i < 10, i++, a1 = RotateLeft[a1];
b1 = Join[{1}, a1];
For[j = 1, j < numPlayers/2 + 1, j++,
Sow[{b1[[a3[[j]]]], b1[[a4[[j]]]]}]]], {1}]][[2, 1]]]
Out[1] = {{1, 2}, {3, 10}, {4, 9}, {5, 8}, {6, 7}, {1, 3}, {4, 2}, {5, 10},
{6,
9}, {7, 8}, {1, 4}, {5, 3}, {6, 2}, {7, 10}, {8, 9}, {1, 5}, {6,
4}, {7, 3}, {8, 2}, {9, 10}, {1, 6}, {7, 5}, {8, 4}, {9, 3}, {10,
2}, {1, 7}, {8, 6}, {9, 5}, {10, 4}, {2, 3}, {1, 8}, {9, 7}, {10,
6}, {2, 5}, {3, 4}, {1, 9}, {10, 8}, {2, 7}, {3, 6}, {4, 5}, {1,
10}, {2, 9}, {3, 8}, {4, 7}, {5, 6}}
The following will then print the results in more or less the way you want:
In[2] = Print @@ Flatten[{" ", #1, ":", #2, " "} & @@@ #] & /@
Transpose@Partition[games, 5];
1:2 1:3 1:4 1:5 1:6 1:7 1:8 1:9 1:10
3:10 4:2 5:3 6:4 7:5 8:6 9:7 10:8 2:9
4:9 5:10 6:2 7:3 8:4 9:5 10:6 2:7 3:8
5:8 6:9 7:10 8:2 9:3 10:4 2:5 3:6 4:7
6:7 7:8 8:9 9:10 10:2 2:3 3:4 4:5 5:6
Hope this helps.
Regards,
Leonid
On Sun, May 3, 2009 at 2:23 AM, Bruno Campanini <BC at gmail.com> wrote:
> "Leonid Shifrin" <lshifr at gmail.com> wrote in message
> news:gth5l5$f3c$1 at smc.vnet.net...
>
> > If I understand correctly, you would like to find some player arrangement
> > such that each player plays each day exactly once, and at the end,
> > each player plays with all the others. While I don't know the general way
> > to efficiently produce all such solutions, this code seems to get some
> > particular one in about a second or less on the average on my PC. It is
> > rather ad hoc in the way it looks for a solution - perhaps there are
> > faster
> > and more systematic and elegant ways but I did not figure them out.
> >
> > In[1] =
> >
> > getSolution[numOfPlayers_?EvenQ] :=
> [..]
>
> You understood very well what I'd like to do and your formula
> works perfectly!
> But it's very hard to me to understand the algorithm you used
> because of my very poor knowledge of Mathematica.
> Then I tried resembling something from my Visual Basic routine:
>
> Do[numPlayers := 10;
> If[OddQ[numPlayers], odd = 1; numPlayers = numPlayers + odd,
> odd = 0]; a1 = Range[2, numPlayers];
> If[odd == 1, a1 = a1 /. a1[[numPlayers - 1]] -> 0];
> a3 = Range[1, numPlayers/2];
> a4 = Range[numPlayers, numPlayers/2 + 1, -1];
> For[i = 1, i < 10, i++, a1 = RotateLeft[a1];
> b1 = Join[{1}, a1];
> For[j = 1, j < numPlayers/2 + 1, j++,
> Print[b1[[a3[[j]]]] , " ", b1[[a4[[j]]]]]]], {1}]
>
> I works also ok but I'm unable to get it printing by columns, i.e:
> 1 2 1 3 1 4
> 3 10 4 2 5 3
> 4 9 5 10 6 2
> 5 8 6 9 7 10
> 6 7 7 8 8 9
> etc.
>
> Could you help me?
>
> Bruno
>
> PS
> I works even with an odd number of players, adding 1 to that
> number and replacing the last player with zero.
>
>