7
$\begingroup$

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.

$\endgroup$
  • 1
    $\begingroup$ May be this question has to be asked with a bounty... $\endgroup$ – Anton Antonov Jun 9 '16 at 14:12
  • $\begingroup$ Do you always know the current reward at the time of the shot? $\endgroup$ – george2079 Jun 9 '16 at 14:38
  • $\begingroup$ @george2079 yes, and any changes by the neighborhood players are reflected in realtime (well, realtime for a flash player game) $\endgroup$ – bobthechemist Jun 9 '16 at 14:43
  • $\begingroup$ Not sure I see the question here - unless you either know the precise strategies of the other players in the pool, or they all play randomly, all the simulation in the world is for naught. Seems that taking the shot with the highest expected value at the time of the shot is the optimal solution, or am I missing something? $\endgroup$ – ciao Jun 9 '16 at 22:42
  • $\begingroup$ I'm quite interested in this problem(even more if a bounty is offered :) ), and I would like to make something clear: can you shot a few shots at one time or you can only shot once an hour? Is one of your goal to be able to choose whether to shot at some time and how much shot you shall take or simply wait till next time you play? $\endgroup$ – Wjx Jun 10 '16 at 1:26
4
$\begingroup$

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."}}]
| improve this answer | |
$\endgroup$
  • $\begingroup$ Hmm, slow and steady wins the race. The results of your code suggest that none of the < 100% options have a chance for a bigger payout than the trivial option. I wonder if the game designers would be so sneaky... $\endgroup$ – bobthechemist Jun 9 '16 at 19:04
  • $\begingroup$ @bobthechemist Well the OP does say "I probably do not have these starting values correct." If they were different one could try a switch of shot depending on the reward increase. $\endgroup$ – Chris Degnen Jun 9 '16 at 19:42
  • $\begingroup$ Chris, you know bob here is the OP, right? :) $\endgroup$ – J. M.'s technical difficulties Jun 9 '16 at 22:39
  • $\begingroup$ Oops. Missed that :-) $\endgroup$ – Chris Degnen Jun 10 '16 at 5:45
  • $\begingroup$ Cleaning up my old questions, and reflecting on what I could have done with all of those hours spent on useless web-games. $\endgroup$ – bobthechemist Dec 17 '18 at 13:22
3
$\begingroup$

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"}}
 ]

Table of probabilities and expected values.

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:

Simulation results.

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}
   }
 ]

Plot of simulations.

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]]
   }
  ]
 ]

enter image description here

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.

| improve this answer | |
$\endgroup$
  • $\begingroup$ Cool, although I don't know what to think about you dredging up memories of the time I wasted on this game :-) $\endgroup$ – bobthechemist May 27 at 11:43
1
$\begingroup$

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]

enter image description here

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

| improve this answer | |
$\endgroup$
  • $\begingroup$ Interesting approach. I may not be using the correct terminology here, but your answer would give the best instantaneous option, but does not take in to account that the 3 non-100% options grow with time and a few failures may ultimately lead to a better reward. Perhaps I'm overthinking things. $\endgroup$ – bobthechemist Jun 9 '16 at 19:00

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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