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]