Can Mathematica help me win my on-line game?

Question

I've become addicted to the Forge of Empires web browser game. Presently, the game has a special event going on, which is in commemoration of the 2016 EUFA Soccer Championship. The event has a set of probability-based challenges and I would like to use Mathematica to figure out the best use of my resources.

---

Goal (heh) of the event

Take a penalty shot, score, and gain points (aka cups). Cups can be traded in for prizes. You receive one credit per hour to take one shot at the goal. You can make four different types of shots, each with a different chance of earning cups. The riskier the shot, the greater then number of cups awarded if successful.

Rules of the event

I probably do not have these starting values correct, but it may not be relevant as you'll see below

Initially, each of the four shots has a base score of points that can be rewarded:

• A shot with 100% chance of scoring rewards 10 cups
• A shot with 20% chance of scoring rewards 40 cups
• A shot with 10% chance of scoring rewards 60 cups
• A shot with 5% chance of scoring rewards 100 cups

If a shot is missed, then the reward increases:

• 20% shot increases by 5 cups per miss
• 10% shot increases by 10 cups per miss
• 15% shot increases by 15 cups per miss

My objective is to figure out which shot is best to take

My approach to the problem thus far has been to create a set of random integers with a range appropriate so that the presence of a "1" indicates success, find the positions of the 1's, and calculate the differences between those positions to figure out how much the pot has increased each time. The code looks something like this:

cups[prob_, inc_, base_] := Module[{shots, wins},
  shots = RandomInteger[{1, prob}, 1000];
  wins = Position[shots, 1] // Flatten;
  Sum[inc i, {i, #}] + base & /@ 
    Prepend[Differences[wins], First@wins] // Total
  ]

One example output using MapThread[ cups[#1, #2, #3] &, {{5, 10, 20}, {5, 10, 15}, {40, 60, 100}}] gives me points of 30k, 107k, and 317k for each, suggesting to me that I should always stick with the lowest probability shot because over time, it will provide me with the greatest payout. Is my thinking on this correct?

The real challenge

The hard part, which I have no idea how to model, is that all players in my neighborhood influence the rewards. For example, if there is one player in my neighborhood (typically, there are 80), and she misses a 1-in-20 shot, then my potential reward for a 1-in-20 shot is increased by 15 cups. Likewise, if she wins the attempt, the reward is reset to its base. How might I incorporate this complexity into my model?

---

May the best country win, and may your relatives (who scored tickets to the game while you are at home working) not be terribly affected by the endless strikes, currently underway in France.

Answer 1

Running the code below, which shows the results for runs of 1000 shots, the rewards as set mean you should always take the 100% shot. With different rewards you could add a condition to take a different shot depending on the level of the increased reward.

shot[chance_, reward_, hike_] := Module[{result},
  result = If[chance < RandomInteger[{1, 100}], "miss", "hit"];
  Switch[result,
   "hit", score += reward; misshike = 0,
   "miss", misshike += hike]]

calc[chance_, reward_, hike_] := Module[{},
  table = Table[
    score = 0;
    misshike = 0;
    Do[shot[chance, reward, hike], {1000}]; score, {100}];
  N@Through[{Mean, StandardDeviation}@table]]

TableForm[{
  calc[100, 10, Null],
  calc[20, 40, 5],
  calc[10, 60, 10],
  calc[5, 100, 15]}, TableHeadings -> {
   {"100%", "20%", "10%", "5%"}, {"Average", "Std.dev."}}]

Answer 2

I know I'm a billion years late on this, and an answer now won't do anyone any good, but I found it really interesting for some reason. I'm not great with probabilities, but my reasoning seemed to match the simulation, so I think it's correct.

We should expect it to take $\frac{1}{p}$ tries to get a goal, where $p$ is the probability of a goal. This means we would have $\frac{1}{p} - 1$ failures where the pot increases each time, followed by 1 goal where the pot pays out.

The expected value of a win without the increasing cups is just $pb$ where $b$ is the base number of cups. So the expected value of a payout is $(\frac{1}{p}-1)a + b$ where $a$ is the additional cups gained for each loss, and this makes the expected value of each attempt (the average, essentially) $(1-p)a + p b$.

p = {1, 0.2, 0.1, 0.05};
a = {0, 5, 10, 15};
b = {10, 40, 60, 100};
TableForm[
 Transpose[{100 p, (1/p - 1) a + b, (1 - p) a + p b}],
 TableHeadings -> {None, {"Goal Probability (%)", 
    "Expected Value of a Win", "Expected Value of Each Attempt"}}
 ]

I think there might be a mistake in the accepted answer, where the score is only incremented by the reward amount. If I understand it correctly, I think the score should be incremented by reward + misshike. Making that change, I get a table like this:

This looks a lot like 1000 times the expected value of each attempt. My own attempt at simulating the result:

simulate[probability_, additional_, base_, n_ : 1000] := Module[{
   value = base,
   cups = 0
   },
  Reap[
    Do[
     If[
      RandomReal[] < probability,
      Sow[value]; value = base,
      Sow[0]; value += additional
      ],
     n
     ]
    ][[2, 1]]
  ]
p = {1, 0.2, 0.1, 0.05};
a = {0, 5, 10, 15};
b = {10, 40, 60, 100};
ListLinePlot[
 Accumulate /@ MapThread[simulate, {p, a, b}],
 PlotLegends -> (ToString[Round[100 #]] <> "%" & /@ p),
 Prolog -> {
   Opacity[0.5],
   Line[{{1, #}, {1000, #}}] & /@ {10000, 12000, 15000, 19250},
   Text[#, {100, #}, {0, -0.6}] & /@ {10000, 12000, 15000, 19250}
   }
 ]

In summary, unless I'm hugely mistaken, I think that the math and simulations are in agreement that the 5% options is nearly 2x as lucrative as the 100% option. As for the effect of other players, you can try set a threshold and only play games when the reward is above a certain level. For example, if you only play the 5% game when the reward is over 250, you can maximize the value of each play. Of course, you spend a substantial amount of time waiting for the jackpot to increase, and waste even more time since there's an excellent chance someone else will take a turn and win the pot before you if there's 79 others playing.

val = 100;
inc = 15;
prob = 0.05;
newlist = Reap[
   Do[
    If[val >= 250 \[And] RandomReal[] <= 1/80,
     If[
      RandomReal[] < prob,
      Sow[val, "Agent 2"]; val = 100,
      Sow[0, "Agent 2"]; val += inc
      ],
     If[
      RandomReal[] < prob,
      Sow[val, "Agent 1"]; val = 100,
      Sow[0, "Agent 1"]; val += inc
      ]
     ],
    1000000
    ],
   {"Agent 1", "Agent 2"}];

Show[
 Plot[
  19.25 x, {x, 1, 7000},
  PlotStyle -> Directive[Dashed, Black]
  ],
 ListLinePlot[{
   Accumulate@newlist[[2, 1, 1]],
   Accumulate@newlist[[2, 2, 1]]
   }
  ]
 ]

It looks like you can increase the value of each token you spend. However, you end up playing far fewer games over a specified period than someone who plays indiscriminately. I'm not sure if that would matter here, though, it sounds like the most important thing is to not waste tokens.

Answer 3

I cant see doing more than this:

shot[rewards_] := 
   MaximalBy[
    Transpose[{#, rewards #/100} &@{100, 20, 10, 5}], #[[2]] &][[1, 1]]

shot[{10, 40, 60, 100}]

100

then just key in the current values before your shot:

 shot[{10, 50, 160, 200}]

10

That said, I suppose the real game is about watching the rewards change and taking the right shot at the right time.

Another thought is just make a chart like this:

Grid[{{"20%", "10%", "5%"}, {
   TableForm@Table[{x,  x/5}  , {x, 40, 100, 5 }],
   TableForm@Table[{x,  x/10}  , {x, 60, 180, 10 }],
   TableForm@Table[{x,  x/20}  , {x, 100, 340, 20 }]}}, 
 Dividers -> All]

so you can readily see the probabilistic value of each choice as the rewards change.