How to make this recurrence formula run faster

Questions
,
1

I created a formula where
t = time
x,y is rugby union score
p3h, p5g etc are probabilities of scores (penalty-drop goal =3p, try -no conversion =5 p, try+conv =7 p) etc

g[t_, x_, y_] := g[t, x, y] = Which[

   x < 0 || y < 0, 0,

   x == 0 && y == 0 && t == 0, 1,

   (x != 0 || y != 0) && t == 0, 0,

   x == 1 || x == 2 || x == 4 || y == 1 || y == 2 || y == 4, 0,

   t > 0, 

   p3h*g[t - 1, x - 3, y] + p3a*g[t - 1, x, y - 3] + 

    p5h*g[t - 1, x - 5, y] + p5a*g[t - 1, x, y - 5] + 

    p7h*g[t - 1, x - 7, y] + p7a*g[t - 1, x, y - 7] + 

    pns*g[t - 1, x, y]

   ]

things are fast if I calculate a possible score in an early state of the game (t=1-80)
but when I want to compute something later on, it gets really slow (g[45, 15,7] for instance).

Furthermore if I want to sum all possible scores where home wins

Sum[g[79,i,j],{i,1,500},{j,0,i-1}]

then it takes ages.

Does anyone have any idea how to improve speed?

Should I create something similar in excel (lets sat a tennis markov chain with less states as rugby) it makes all calculations instanetly. Apparently because every state is calclated once.
Any idea? My knowledge in mathematica coding is really poor.

Thanks in advance.

2

It looks like you are already memoizing the function. That’s good. This means having the function g remembers what previous values it already computed instead of recomputing them. Transformation Rules and Definitions—Wolfram Documentation

Another common thing to do is to Compile the function so that it runs faster in general. http://reference.wolfram.com/mathematica/tutorial/CompilingMathematicaExpressions.html

Finally, you should know that there is a big speed difference between symbolic computing and numeric computing. You are doing symbolic computations with symbolic numbers instead of working with flaoting point values. Sum is not meant to be a fast function, it instead tries to reason about what it is given to create a symbolic value. If you want things to be added together efficiently, trying using Total. Total requires that you give it a list of numbers to add together. Ideally these are floating point numbers or Integers if you want any speed. For example:

Total@Flatten@Table[g[5, i, j], {i, 1, 10}, {j, 0, i - 1}]

The real way to optimize this is to see that this function is really a big recurrence relation. It’s probably a solvable one too. Mathematica provides RSolve which is usually pretty good at finding closed form solutions for these. If you plan on building up an entire table of values, you might try using ReccurenceTable although I’m not sure it’d be useful in this case.

3

I post this not as an answer, viz, speeding up code but as potential motivating alternate approaches. I am not sure what the ultimate aim is: simulation, modelling, prediction.
My point is to illustrate some of the Mathematica’s functionality for simulation.

In the following toy example there are a number of naive assumptions:

  • essentially it is a simulation of a random walk with fixed probabilities of events: nothing, penalty for/against, try for/against, converted try for/against.
  • the time intervals were discrete and regular 5 minute intervals (trying to be a little closer to reality, as two converted tries in a minute…hmm not going to happen)
  • there is no dependency or autocorrelation structure: so does not deal with run of penalties increasing probability of try; “momentum” etc

I present it for ‘fun’ not realism with all its limitations.

Manipulate[
 ed = EmpiricalDistribution[
   Rescale[{100, pa, pf, ta, tf, cta, ctf}] -> {0, -3, 3, -5, 5, 7, 
     7}];
 rv = RandomVariate[ed, 16];
 margin = Accumulate@rv;
 teama = Accumulate@(rv /. x_?Negative -> 0);
 teamb = Accumulate@(rv /. x_?Positive -> 0);
 legend = 
  Style[#, FontFamily -> "Kartika", 10] & /@ {StringForm[
     "Team A score: ``", Last@teama], 
    StringForm["Team B score: ``", -Last@teamb], 
    StringForm["Margin A-B: ``", Last@margin]};
 ListPlot[{teama, teamb, margin}, Joined -> True, 
  PlotStyle -> {Red, Orange, Black}, InterpolationOrder -> 0, 
  PlotLegends -> legend, BaseStyle -> {FontFamily -> "Kartika", 12}, 
  Frame -> True, 
  FrameTicks -> {Thread[{Range[16], 5 Range[16]}], Automatic}]
 ,
 {{pa, 25, "Penalties against"}, 20, 30}, {{pf, 25, "Penalties for"}, 
  20, 30}, {{ta, 7, "Tries against"}, 5, 10}, {{tf, 7, "Tries for"}, 
  5, 10}, {{cta, 3, "Converted tries against"}, 1, 
  5}, {{ctf, 3, "Converted tries for"}, 1, 5}, 
 Button["Reset", rv = RandomVariate[ed, 16]], 
 BaseStyle -> {FontFamily -> "Kartika", 20}, 
 FrameLabel -> {None, None, Style["Rugby Union Naive Simulation", 20],
    None}]

wcrugby.gif

4

thank you for your answers. unfortunately none of your proposals seemed to work, so I had to rewrite my initial approach.

nevertheless i learned lots of new stuff from them, thanks.