Speed up code to numerically simulate a game of coin tossing

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.


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...


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]