Speed up code to numerically simulate a game of coin tossing

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?

• Possible description of the algorithm, in natural language? Commented Nov 27, 2018 at 9:43
• 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. Commented Nov 27, 2018 at 9:44
• The downvote is not from me but I guess someone tried to tell you that this is not a free coding service... Commented Nov 27, 2018 at 9:48
• 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. Commented Nov 27, 2018 at 10:27
• But you are getting +1 for each throw and +1 conditional upon the result in your code above?
– gwr
Commented Nov 27, 2018 at 11:52

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

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.

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

Edit:

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


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