9
$\begingroup$

Description

I would like to simulate n games in which two players toss one coin each at the same time: If you toss a tail you will receive two tokens, if you toss a head you will only get one token.

The player who first accumulates at least m tokens wins; if this happens at the same time, the game will result in a draw.

Code

I have written the following code:

m = 10; (* threshhold to win the game *)
n = 10^6; (* number of games simulated *)

flag1 = 0; (* # P1 wins *)
flag2 = 0; (* # P2 wins *)
flag3 = 0; (* # draws *)
flag4 = 0; (* # total throws *)

Do[
    (
        i1 = 0; (* initial score P1 *)
        i2 = 0; (* initial score P2 *)
        i3 = 0; (* initial # of tosses *)

        (* play one game until at least one player has collected m or more tokens *)
        While[i1 < m && i2 < m,
            i1 = i1 + 1 + RandomInteger[];
            i2 = i2 + 1 + RandomInteger[];
            i3 = i3 + 1
        ];

        (* keep score *)   
        If[i1 >= m && i2 >= m,
            flag3 = flag3 + 1, (* game is a draw *)
            If[i1 > i2,
                flag1 = flag1 + 1, (* P1 wins *)
                flag2 = flag2 + 1  (* P2 wins *)
            ]
        ];

        flag4 = flag4 + i3
    ), 
    n
]

Could someone please kindly tell me how to modify this to make it faster?

$\endgroup$
6
  • 4
    $\begingroup$ Possible description of the algorithm, in natural language? $\endgroup$ Nov 27, 2018 at 9:43
  • 2
    $\begingroup$ Preallocate storage and write into it instead of expanding it successively with Join; each Join requires a copy operation. Replace For by Do. Leave away Monitor. And Compile everything in the end. $\endgroup$ Nov 27, 2018 at 9:44
  • $\begingroup$ The downvote is not from me but I guess someone tried to tell you that this is not a free coding service... $\endgroup$ Nov 27, 2018 at 9:48
  • 6
    $\begingroup$ I did not downvote, but I would have expected a clear explanation of what you want to do instead of just posting a code block. Code like this does not communicate the intent behind it very well. The explanation must be in the question, not in comments. $\endgroup$
    – Szabolcs
    Nov 27, 2018 at 10:27
  • 1
    $\begingroup$ But you are getting +1 for each throw and +1 conditional upon the result in your code above? $\endgroup$
    – gwr
    Nov 27, 2018 at 11:52

3 Answers 3

6
$\begingroup$

I wrote something similar to @Okkes (+1), but with a general maximum m.

TeMgame = Compile[{{m, _Integer}},
   Block[{r = Range[m]},
      Sign[
         First[ Pick[r, UnitStep[Accumulate[RandomInteger[{1, 2}, m]] - m], 1]] -
         First[ Pick[r, UnitStep[Accumulate[RandomInteger[{1, 2}, m]] - m], 1]]
   ]], CompilationTarget -> "C", Parallelization -> True]

It is faster than cf from @gwr when m is larger. For example,

AbsoluteTiming[Sort@Tally[Table[TeMgame[200], {10^6}]]]

{10.4598, {{-1, 463391}, {0, 72762}, {1, 463847}}}

ParallelTable on 8 kernels takes 2.5 seconds.

Update

Write TeMgame3 to save the numbers of flips.

TeMgame3 = Compile[{{m, _Integer}},
   Block[{r},
      r = Range[m];
      {First[Pick[r, UnitStep[Accumulate[RandomInteger[{1, 2}, m]] - m], 1]], 
       First[Pick[r, UnitStep[Accumulate[RandomInteger[{1, 2}, m]] - m], 1]]}
   ], CompilationTarget -> "C", Parallelization -> True]

Now run the following to count the total number of flips, as well as the wins, draws, and losses.

AbsoluteTiming[
   With[{t = ParallelTable[TeMgame3[200], {i, 1, 10^6}]},
      {Total[Map[Min, t]], Sort[Tally[Sign[Subtract @@@ t]]]}
   ]]

{2.74122, {131388986, {{-1, 463096}, {0, 73098}, {1, 463806}}}}

Your second question refers to a draw being achieved "only when both players have the same number of coins". I currently do not see how it can be otherwise...

$\endgroup$
0
7
$\begingroup$

Some improvement with Compile and a slightly different "take" on the problem using NestWhile:

cf = Compile[
    {
        { m, _Integer },
        { n, _Integer }
    }, 
    Module[
        {
            game, (* vector to track a single game: { P1 tokens, P2 tokens, tosses } *)
            p1wins = {1, 0, 0, 0},
            p2wins = {0, 1, 0, 0},
            draw   = {0, 0, 1, 0},
            count  = {0, 0, 0, 1}
        },
        (* function returns vector: { # P1 wins, #P2 wins, # draws, # tosses } *)
        Total @ Table[
            (
                (* play game until at least one player has m or more tokens *)
                game = NestWhile[
                    # + { RandomInteger @ {1,2}, RandomInteger @ {1,2} , 1 } &,
                    {0, 0, 0},
                    #[[1]] < m && #[[2]] < m &
                ];
                (* keep score *)
                Which[
                    game[[1]] >= m && game[[2]] >= m, draw,
                    game[[1]] > game[[2]], p1wins,
                    True, p2wins
                ] + game[[3]] * count
            ),
            n
        ]
    ],
    CompilationTarget -> "C" (* this option requires C compiler installed *)
];

cf[ 10, 10^6]; // AbsoluteTiming

(* {0.922876, Null} *)

Maybe more is possible with parallelization.

$\endgroup$
2
  • 2
    $\begingroup$ @TeM Ok, Compile brings this down to around 1 sec. $\endgroup$
    – gwr
    Nov 27, 2018 at 13:55
  • 3
    $\begingroup$ 1 + RandomInteger[] is equivalent to RandomInteger[{1, 2}] $\endgroup$ Nov 27, 2018 at 14:40
4
$\begingroup$

Edit:

m = 10;
n = 100;
Table[Sign@
  Differences@
   Flatten[FirstPosition[#, 1] & /@ 
     UnitStep[Accumulate /@ RandomInteger[{1, 2}, {2, m}] - m]], n]

Original answer

Here is more compact one but slow, it might be improved. $\{+1,0,-1\}=\{\text{p1 wins},\text{draw},\text{p2 wins}\}$

   n=100;
Table[Sign@
      Differences[
       First@Flatten@Position[#, 10 | 11] & /@ 
        Accumulate /@ RandomInteger[{1, 2}, {2, 10}]], n]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.