4

I have a data table structure of about 1.5 M rows and hundreds of columns, representing dates with horse racing results - this is to be used for a predictive model, but first feature engineering is necessary to calculate strike rates of various entities in terms of creating a prior record coming into every race for every previous day.

"Strike rate" can be defined in various ways, but a simple one is the ratio of wins to times run for any given horse, trainer, jockey etc. Of course this must take into account all previous runs and wins, but not include the results from "today" since this would be nonsense for building a model.

No matter, a simplified data structure, adapted from some examples online, will suffice to explain.

Generate data as follows:


n <- 90
dt <- data.table(
  date=rep(seq(as.Date('2010-01-01'), as.Date('2015-01-01'), by='year'), n/6), 
  finish=c(1:5),
  trainer=sort(rep(letters[1:5], n/5))
)

Imagine on these dates each trainer has a runner whose finish position in a race is represented by "finish". For a new date in the sequence (but not in this data), the ratio of times won so far could be calculated thus:

dt[order(trainer, date), .(strike_rate = sum(finish==1)/.N), by=trainer]

However, the resulting strike_rate variable shown for each trainer would only be valid for a new date in the sequence that is not in this dataset, say '2015-01-02', or our out of sample set.

To build the model, we need strike rates in line for each day and each trainer (and many other entities, but let's stick with trainer for now).

I've played around with the shift function and data table constructs but cannot get it to work for this particular problem - however, in a loop context it works fine though is incredibly show.

To illustrate the required output, this example code (though I am sure it is not elegant!) works fine:

#order dates most recent to oldest so that the loop works backwards in time:
dt <- dt[order(-date)]  

#find unique dates (converting to character as something weird with date)
dates = as.character(unique(dt$date))

for (d in dates) {

  #find unique trainers on this date
  trainers = unique(dt$trainer[dt$date==d])

                    for (t in trainers) {

                    trainer_past_form = dt[trainer==t & date < d]

                    strike_rate = sum(trainer_past_form$finish==1)/nrow(trainer_past_form)

                    # save this strike rate for this day and this trainer
                    dt$strike_rate[dt$trainer==t & dt$date==d] <- strike_rate
                    }

}

And gives the desired output:

          date finish trainer strike_rate
 1: 2015-01-01      1       a   0.2000000
 2: 2015-01-01      2       a   0.2000000
 3: 2015-01-01      3       a   0.2000000
 4: 2015-01-01      4       b   0.2000000
 5: 2015-01-01      5       b   0.2000000
 6: 2015-01-01      1       b   0.2000000
 7: 2015-01-01      2       c   0.2000000
 8: 2015-01-01      3       c   0.2000000
 9: 2015-01-01      4       c   0.2000000
10: 2015-01-01      5       d   0.2000000
11: 2015-01-01      1       d   0.2000000
12: 2015-01-01      2       d   0.2000000
13: 2015-01-01      3       e   0.2000000
14: 2015-01-01      4       e   0.2000000
15: 2015-01-01      5       e   0.2000000
16: 2014-01-01      5       a   0.1666667
17: 2014-01-01      1       a   0.1666667
18: 2014-01-01      2       a   0.1666667
19: 2014-01-01      3       b   0.2500000
20: 2014-01-01      4       b   0.2500000
21: 2014-01-01      5       b   0.2500000
22: 2014-01-01      1       c   0.1666667
23: 2014-01-01      2       c   0.1666667
24: 2014-01-01      3       c   0.1666667
25: 2014-01-01      4       d   0.1666667
26: 2014-01-01      5       d   0.1666667
27: 2014-01-01      1       d   0.1666667
28: 2014-01-01      2       e   0.2500000
29: 2014-01-01      3       e   0.2500000
30: 2014-01-01      4       e   0.2500000
31: 2013-01-01      4       a   0.1111111
32: 2013-01-01      5       a   0.1111111
33: 2013-01-01      1       a   0.1111111
34: 2013-01-01      2       b   0.3333333
35: 2013-01-01      3       b   0.3333333
36: 2013-01-01      4       b   0.3333333
37: 2013-01-01      5       c   0.1111111
38: 2013-01-01      1       c   0.1111111
39: 2013-01-01      2       c   0.1111111
40: 2013-01-01      3       d   0.2222222
41: 2013-01-01      4       d   0.2222222
42: 2013-01-01      5       d   0.2222222
43: 2013-01-01      1       e   0.2222222
44: 2013-01-01      2       e   0.2222222
45: 2013-01-01      3       e   0.2222222
46: 2012-01-01      3       a   0.1666667
47: 2012-01-01      4       a   0.1666667
48: 2012-01-01      5       a   0.1666667
49: 2012-01-01      1       b   0.3333333
50: 2012-01-01      2       b   0.3333333
51: 2012-01-01      3       b   0.3333333
52: 2012-01-01      4       c   0.0000000
53: 2012-01-01      5       c   0.0000000
54: 2012-01-01      1       c   0.0000000
55: 2012-01-01      2       d   0.3333333
56: 2012-01-01      3       d   0.3333333
57: 2012-01-01      4       d   0.3333333
58: 2012-01-01      5       e   0.1666667
59: 2012-01-01      1       e   0.1666667
60: 2012-01-01      2       e   0.1666667
61: 2011-01-01      2       a   0.3333333
62: 2011-01-01      3       a   0.3333333
63: 2011-01-01      4       a   0.3333333
64: 2011-01-01      5       b   0.3333333
65: 2011-01-01      1       b   0.3333333
66: 2011-01-01      2       b   0.3333333
67: 2011-01-01      3       c   0.0000000
68: 2011-01-01      4       c   0.0000000
69: 2011-01-01      5       c   0.0000000
70: 2011-01-01      1       d   0.3333333
71: 2011-01-01      2       d   0.3333333
72: 2011-01-01      3       d   0.3333333
73: 2011-01-01      4       e   0.0000000
74: 2011-01-01      5       e   0.0000000
75: 2011-01-01      1       e   0.0000000
76: 2010-01-01      1       a         NaN
77: 2010-01-01      2       a         NaN
78: 2010-01-01      3       a         NaN
79: 2010-01-01      4       b         NaN
80: 2010-01-01      5       b         NaN
81: 2010-01-01      1       b         NaN
82: 2010-01-01      2       c         NaN
83: 2010-01-01      3       c         NaN
84: 2010-01-01      4       c         NaN
85: 2010-01-01      5       d         NaN
86: 2010-01-01      1       d         NaN
87: 2010-01-01      2       d         NaN
88: 2010-01-01      3       e         NaN
89: 2010-01-01      4       e         NaN
90: 2010-01-01      5       e         NaN

Any help on doing this "properly" in data table would be much appreciated. As can be seen, I have started to use the library but hitting a road block on this type of problem. I understand the logic of the loop, but it's just not efficient on 1.5M rows with lots of this type of calc to do across all variables.

user1849286
  • 179
  • 1
  • 10
  • So, you need a strike-rate that is for "data before today", expanding as the dates increment? – r2evans Apr 28 '20 at 17:45
  • Yes - on a date by date basis. So each day incorporates the full history from before today (strike-rate, mean, whatever the calculation is) but no results from today itself. At the same time, each strike rate must be shown alongside today's row of data, so that the model can be trained against it. The example output for the data shown is accurate, but was done with a slow for loop. – user1849286 Apr 28 '20 at 18:23
  • What if you set the index before `for` loop: `setindex(dt, date, trainer)`? – Parfait Apr 28 '20 at 19:26
  • Haven't tried, but it's the many for loops that make it slow so not sure how setindex would help (also this is a simplified example, in reality we want to do the same for jockey, horse etc) - I was hoping to use some combination of shift and froll in a single statement but it proved beyond me – user1849286 Apr 28 '20 at 19:29
  • Hi - point taken; however, I have already upvoted all the answers as they all work on the example given (including your own, and thanks again); it's a shame you can only accept one answer - before doing this final step, I want to try them all out on the much larger dataset I am working with, to see what the issues are with scaling etc, which will take some time; in the meantime a big thanks to yourself and the other posters, all quality answers, it seems to me at this juncture... – user1849286 May 04 '20 at 14:59

3 Answers3

2

Here are some options.

1) using non-equi join:

dt[, strike_rate :=
    .SD[.SD, on=.(trainer, date<date), by=.EACHI, sum(finish==1L)/.N]$V1
]

2) Another option which should be faster:

dt[order(trainer, date), strike_rate := {
    ri <- rleid(date)
    firstd <- which(diff(ri) != 0) + 1L

    cs <- replace(rep(NA_real_, .N), firstd, cumsum(finish==1L)[firstd - 1L])
    k <- replace(rep(NA_real_, .N), firstd, as.double(1:.N)[firstd - 1L])

    nafill(cs, "locf") / nafill(k, "locf")
}, trainer]

output of setorder(dt, -date, trainer, finish)[]:

          date finish trainer strike_rate
 1: 2015-01-01      1       a   0.2000000
 2: 2015-01-01      2       a   0.2000000
 3: 2015-01-01      3       a   0.2000000
 4: 2015-01-01      1       b   0.2000000
 5: 2015-01-01      4       b   0.2000000
 6: 2015-01-01      5       b   0.2000000
 7: 2015-01-01      2       c   0.2000000
 8: 2015-01-01      3       c   0.2000000
 9: 2015-01-01      4       c   0.2000000
10: 2015-01-01      1       d   0.2000000
11: 2015-01-01      2       d   0.2000000
12: 2015-01-01      5       d   0.2000000
13: 2015-01-01      3       e   0.2000000
14: 2015-01-01      4       e   0.2000000
15: 2015-01-01      5       e   0.2000000
16: 2014-01-01      1       a   0.1666667
17: 2014-01-01      2       a   0.1666667
18: 2014-01-01      5       a   0.1666667
19: 2014-01-01      3       b   0.2500000
20: 2014-01-01      4       b   0.2500000
21: 2014-01-01      5       b   0.2500000
22: 2014-01-01      1       c   0.1666667
23: 2014-01-01      2       c   0.1666667
24: 2014-01-01      3       c   0.1666667
25: 2014-01-01      1       d   0.1666667
26: 2014-01-01      4       d   0.1666667
27: 2014-01-01      5       d   0.1666667
28: 2014-01-01      2       e   0.2500000
29: 2014-01-01      3       e   0.2500000
30: 2014-01-01      4       e   0.2500000
31: 2013-01-01      1       a   0.1111111
32: 2013-01-01      4       a   0.1111111
33: 2013-01-01      5       a   0.1111111
34: 2013-01-01      2       b   0.3333333
35: 2013-01-01      3       b   0.3333333
36: 2013-01-01      4       b   0.3333333
37: 2013-01-01      1       c   0.1111111
38: 2013-01-01      2       c   0.1111111
39: 2013-01-01      5       c   0.1111111
40: 2013-01-01      3       d   0.2222222
41: 2013-01-01      4       d   0.2222222
42: 2013-01-01      5       d   0.2222222
43: 2013-01-01      1       e   0.2222222
44: 2013-01-01      2       e   0.2222222
45: 2013-01-01      3       e   0.2222222
46: 2012-01-01      3       a   0.1666667
47: 2012-01-01      4       a   0.1666667
48: 2012-01-01      5       a   0.1666667
49: 2012-01-01      1       b   0.3333333
50: 2012-01-01      2       b   0.3333333
51: 2012-01-01      3       b   0.3333333
52: 2012-01-01      1       c   0.0000000
53: 2012-01-01      4       c   0.0000000
54: 2012-01-01      5       c   0.0000000
55: 2012-01-01      2       d   0.3333333
56: 2012-01-01      3       d   0.3333333
57: 2012-01-01      4       d   0.3333333
58: 2012-01-01      1       e   0.1666667
59: 2012-01-01      2       e   0.1666667
60: 2012-01-01      5       e   0.1666667
61: 2011-01-01      2       a   0.3333333
62: 2011-01-01      3       a   0.3333333
63: 2011-01-01      4       a   0.3333333
64: 2011-01-01      1       b   0.3333333
65: 2011-01-01      2       b   0.3333333
66: 2011-01-01      5       b   0.3333333
67: 2011-01-01      3       c   0.0000000
68: 2011-01-01      4       c   0.0000000
69: 2011-01-01      5       c   0.0000000
70: 2011-01-01      1       d   0.3333333
71: 2011-01-01      2       d   0.3333333
72: 2011-01-01      3       d   0.3333333
73: 2011-01-01      1       e   0.0000000
74: 2011-01-01      4       e   0.0000000
75: 2011-01-01      5       e   0.0000000
76: 2010-01-01      1       a          NA
77: 2010-01-01      2       a          NA
78: 2010-01-01      3       a          NA
79: 2010-01-01      1       b          NA
80: 2010-01-01      4       b          NA
81: 2010-01-01      5       b          NA
82: 2010-01-01      2       c          NA
83: 2010-01-01      3       c          NA
84: 2010-01-01      4       c          NA
85: 2010-01-01      1       d          NA
86: 2010-01-01      2       d          NA
87: 2010-01-01      5       d          NA
88: 2010-01-01      3       e          NA
89: 2010-01-01      4       e          NA
90: 2010-01-01      5       e          NA
          date finish trainer strike_rate

3) And if OP can stomach the 2nd approach, here is one that brings the by=trainer into j :)

dt[order(trainer, date), strike_rate := {

    ri <- rleid(date)
    firstd <- which(diff(ri) != 0) + 1L

    cs <- cumsum(finish==1L)

    cumfinishes <- replace(rep(NA_real_, .N), firstd, cs[firstd - 1L])
    k <- replace(rep(NA_real_, .N), firstd, rowid(trainer)[firstd - 1L])

    newt <- which(trainer != shift(trainer))
    prevTrainer <- replace(rep(NA_real_, .N), newt, cs[newt - 1L])

    finishes <- cumfinishes - nafill(replace(prevTrainer, 1L, 0), "locf")
    finishes <- replace(finishes, newt, NaN)

    nafill(finishes, "locf") / nafill(k, "locf")
}]

4) And the same idea using Rcpp which should be the fastest and also more readable:

library(Rcpp)
cppFunction("
NumericVector strike(IntegerVector date, IntegerVector finish, IntegerVector trainer) {
    int i, sz = date.size();
    double cumstrikes = 0, prevcs = NA_REAL, days = 1, prevdays = 1;
    NumericVector strikes(sz), ndays(sz);

    for (i = 0; i < sz; i++) {
        strikes[i] = NA_REAL;
    }

    if (finish[0] == 1)
        cumstrikes = 1;
    for (i = 1; i < sz; i++) {
        if (trainer[i-1] != trainer[i]) {
            cumstrikes = 0;
            days = 0;

        } else if (date[i-1] != date[i]) {
            strikes[i] = cumstrikes;
            ndays[i] = days;

        } else {
            strikes[i] = strikes[i-1];
            ndays[i] = ndays[i-1];
        }

        if (finish[i] == 1) {
            cumstrikes++;
        }

        days++;
    }

    for (i = 0; i < sz; i++) {
        strikes[i] /= ndays[i];
    }

    return strikes;
}")

dt[order(trainer, date), strike_rate := strike(date, finish, rleid(trainer))]
chinsoon12
  • 25,005
  • 4
  • 25
  • 35
  • 1
    Neat - very succinct! Not sure how well it will work on the larger (1.5M row) problem, going to give that a go and will comment back. – user1849286 Apr 29 '20 at 08:02
  • Very fast solution for smaller datasets but not quite larger ones, comparable to OP's and mine. – Parfait Apr 29 '20 at 19:09
  • @Parfait Thanks for sharing the timing, Parfait. I have tried another approach. and if its still too slow, will try another one – chinsoon12 Apr 29 '20 at 22:22
  • @user1849286 as mentioned by Parfait. This approach is not fast. I have added another approach. if its still too slow, please let me know. i will try another approach – chinsoon12 Apr 29 '20 at 22:26
  • Thanks - a lot to get through here. Each answer to date clearly works well for the small examples, but the acid test is on the larger data - as mentioned, the strike rate for trainer example is heavily simplified, so will be interesting to see how well each scales for a) multiple strikes (which may require different subsetting to trainer) and b) over the whole data. – user1849286 Apr 30 '20 at 05:20
  • i bet on `Rcpp`. what odds are you offering :) ? – chinsoon12 Apr 30 '20 at 05:52
  • Lol. The sagest tip is of course to keep your money in your pocket! – user1849286 Apr 30 '20 at 07:16
  • i was hoping that you will share your model performance in real life so that i can replicate it here! – chinsoon12 Apr 30 '20 at 07:18
  • 1
    Thanks - after going through the process I've found your solutions in this answer most closely matched what has been implemented. Using cumsum for the number of wins, .N for the number of rows and grouping by trainer_id was by far the easiest solution to understand and worked efficiently. Important to add that a shift(trainer_strike_rate, type="lag") is needed after the above, so that only previous values are assigned to each row. - since data table is so fast, none of the extra code was needed but will come in handy in future. – user1849286 Jul 21 '20 at 06:22
1

I think no for-loops are required. I use magrittr::%>% here primarily because I think it helps break out the flow of operations; it is not required, and this can easily be converted into a data.table-pipe or similar preference.

library(data.table)
library(magrittr)
dt %>%
  .[ order(date), ] %>%
  .[, c("rate", "n") := .(cumsum(finish == 1), seq_len(.N)), by = .(trainer) ] %>%
  .[, .(rate = max(rate) / max(n)), by = .(date, trainer) ] %>%
  .[, date := shift(date, type = "lead"), by = .(trainer) ] %>%
  merge(dt, ., by = c("trainer", "date"), all.x = TRUE) %>%
  .[ order(-date), ]
#     trainer       date finish      rate
#  1:       a 2015-01-01      1 0.2000000
#  2:       a 2015-01-01      2 0.2000000
#  3:       a 2015-01-01      3 0.2000000
#  4:       b 2015-01-01      4 0.2000000
#  5:       b 2015-01-01      5 0.2000000
#  6:       b 2015-01-01      1 0.2000000
#  7:       c 2015-01-01      2 0.2000000
#  8:       c 2015-01-01      3 0.2000000
#  9:       c 2015-01-01      4 0.2000000
# 10:       d 2015-01-01      5 0.2000000
# 11:       d 2015-01-01      1 0.2000000
# 12:       d 2015-01-01      2 0.2000000
# 13:       e 2015-01-01      3 0.2000000
# 14:       e 2015-01-01      4 0.2000000
# 15:       e 2015-01-01      5 0.2000000
# 16:       a 2014-01-01      5 0.1666667
# 17:       a 2014-01-01      1 0.1666667
# 18:       a 2014-01-01      2 0.1666667
# 19:       b 2014-01-01      3 0.2500000
# 20:       b 2014-01-01      4 0.2500000
# 21:       b 2014-01-01      5 0.2500000
# 22:       c 2014-01-01      1 0.1666667
# 23:       c 2014-01-01      2 0.1666667
# 24:       c 2014-01-01      3 0.1666667
# 25:       d 2014-01-01      4 0.1666667
# 26:       d 2014-01-01      5 0.1666667
# 27:       d 2014-01-01      1 0.1666667
# 28:       e 2014-01-01      2 0.2500000
# 29:       e 2014-01-01      3 0.2500000
# 30:       e 2014-01-01      4 0.2500000
# 31:       a 2013-01-01      4 0.1111111
# 32:       a 2013-01-01      5 0.1111111
# 33:       a 2013-01-01      1 0.1111111
# 34:       b 2013-01-01      2 0.3333333
# 35:       b 2013-01-01      3 0.3333333
# 36:       b 2013-01-01      4 0.3333333
# 37:       c 2013-01-01      5 0.1111111
# 38:       c 2013-01-01      1 0.1111111
# 39:       c 2013-01-01      2 0.1111111
# 40:       d 2013-01-01      3 0.2222222
# 41:       d 2013-01-01      4 0.2222222
# 42:       d 2013-01-01      5 0.2222222
# 43:       e 2013-01-01      1 0.2222222
# 44:       e 2013-01-01      2 0.2222222
# 45:       e 2013-01-01      3 0.2222222
# 46:       a 2012-01-01      3 0.1666667
# 47:       a 2012-01-01      4 0.1666667
# 48:       a 2012-01-01      5 0.1666667
# 49:       b 2012-01-01      1 0.3333333
# 50:       b 2012-01-01      2 0.3333333
# 51:       b 2012-01-01      3 0.3333333
# 52:       c 2012-01-01      4 0.0000000
# 53:       c 2012-01-01      5 0.0000000
# 54:       c 2012-01-01      1 0.0000000
# 55:       d 2012-01-01      2 0.3333333
# 56:       d 2012-01-01      3 0.3333333
# 57:       d 2012-01-01      4 0.3333333
# 58:       e 2012-01-01      5 0.1666667
# 59:       e 2012-01-01      1 0.1666667
# 60:       e 2012-01-01      2 0.1666667
# 61:       a 2011-01-01      2 0.3333333
# 62:       a 2011-01-01      3 0.3333333
# 63:       a 2011-01-01      4 0.3333333
# 64:       b 2011-01-01      5 0.3333333
# 65:       b 2011-01-01      1 0.3333333
# 66:       b 2011-01-01      2 0.3333333
# 67:       c 2011-01-01      3 0.0000000
# 68:       c 2011-01-01      4 0.0000000
# 69:       c 2011-01-01      5 0.0000000
# 70:       d 2011-01-01      1 0.3333333
# 71:       d 2011-01-01      2 0.3333333
# 72:       d 2011-01-01      3 0.3333333
# 73:       e 2011-01-01      4 0.0000000
# 74:       e 2011-01-01      5 0.0000000
# 75:       e 2011-01-01      1 0.0000000
# 76:       a 2010-01-01      1        NA
# 77:       a 2010-01-01      2        NA
# 78:       a 2010-01-01      3        NA
# 79:       b 2010-01-01      4        NA
# 80:       b 2010-01-01      5        NA
# 81:       b 2010-01-01      1        NA
# 82:       c 2010-01-01      2        NA
# 83:       c 2010-01-01      3        NA
# 84:       c 2010-01-01      4        NA
# 85:       d 2010-01-01      5        NA
# 86:       d 2010-01-01      1        NA
# 87:       d 2010-01-01      2        NA
# 88:       e 2010-01-01      3        NA
# 89:       e 2010-01-01      4        NA
# 90:       e 2010-01-01      5        NA
#     trainer       date finish      rate

One point of this is that the success rate is dependent on number of wins in the number of attempts. For this,

  1. Group by trainer, collect the number of attempts (seq_len(.N)) and the number of wins (cumsum(finish == 1));
  2. Group by date, trainer, summarize each group with the ratio of max-wins to max-attempts, ensuring we have "the end of last day";
  3. Shift the date so that we can ultimately ...
  4. merge (join) back into the original data bringing "last known date" data to this day, so today's races do not affect today's strike-rate

The interim (pre-merge) can be insightful, and showing prevdate (shifted date) instead of replacing it, as above. Know that prevdate here is what is joined on the original data's date:

dt %>%
  .[ order(date), ] %>%
  .[, c("rate", "n") := .(cumsum(finish == 1), seq_len(.N)), by = .(trainer) ] %>%
  # .[, c("rate", "n") := .(cumsum(finish == 1), .I), by = .(trainer) ] %>%
  .[, .(rate = max(rate) / max(n)), by = .(date, trainer) ] %>%
  .[, prevdate := shift(date, type = "lead"), by = .(trainer) ]
#           date trainer      rate   prevdate
#  1: 2010-01-01       a 0.3333333 2011-01-01
#  2: 2010-01-01       b 0.3333333 2011-01-01
#  3: 2010-01-01       c 0.0000000 2011-01-01
#  4: 2010-01-01       d 0.3333333 2011-01-01
#  5: 2010-01-01       e 0.0000000 2011-01-01
#  6: 2011-01-01       a 0.1666667 2012-01-01
#  7: 2011-01-01       b 0.3333333 2012-01-01
#  8: 2011-01-01       c 0.0000000 2012-01-01
#  9: 2011-01-01       d 0.3333333 2012-01-01
# 10: 2011-01-01       e 0.1666667 2012-01-01
# 11: 2012-01-01       a 0.1111111 2013-01-01
# 12: 2012-01-01       b 0.3333333 2013-01-01
# 13: 2012-01-01       c 0.1111111 2013-01-01
# 14: 2012-01-01       d 0.2222222 2013-01-01
# 15: 2012-01-01       e 0.2222222 2013-01-01
# 16: 2013-01-01       a 0.1666667 2014-01-01
# 17: 2013-01-01       b 0.2500000 2014-01-01
# 18: 2013-01-01       c 0.1666667 2014-01-01
# 19: 2013-01-01       d 0.1666667 2014-01-01
# 20: 2013-01-01       e 0.2500000 2014-01-01
# 21: 2014-01-01       a 0.2000000 2015-01-01
# 22: 2014-01-01       b 0.2000000 2015-01-01
# 23: 2014-01-01       c 0.2000000 2015-01-01
# 24: 2014-01-01       d 0.2000000 2015-01-01
# 25: 2014-01-01       e 0.2000000 2015-01-01
# 26: 2015-01-01       a 0.2222222       <NA> ### data this point and below are "lost"
# 27: 2015-01-01       b 0.2222222       <NA> ### when merged, because there are no
# 28: 2015-01-01       c 0.1666667       <NA> ### dates after it to join onto
# 29: 2015-01-01       d 0.2222222       <NA>
# 30: 2015-01-01       e 0.1666667       <NA>
#           date trainer      rate   prevdate
r2evans
  • 141,215
  • 6
  • 77
  • 149
1

Since you essentially need grouped windowing functionality, consider split.data.table (not to be confused with base::split), to handle date/trainer subsets in one loop:

setindex(dt, date, trainer)                                       # ADD FOR OTHER GROUPS
strike_rates_dt <- split(dt, by=c("date", "trainer"))             # ADD FOR OTHER GROUPS

strike_rates_dt <- lapply(strike_rates_dt, function(sub) {
  t <- sub$trainer[[1]]                                           # ADD FOR OTHER GROUPS
  d <- sub$date[[1]]

  trainer_past_form <- dt[trainer==t & date < d]                  # ADD FOR OTHER GROUPS
  sr <- sum(trainer_past_form$finish==1)/nrow(trainer_past_form)

  sub[, strike_rate := sr]                                        # SAVE AS NEW COLUMN
})


final_dt <- rbindlist(strike_rates_dt)[order(-date)]

Timings indicate noticeable differences with nested for loop approach:

Approaches

op_proc <- function() {
  dt <- dt[order(-date)]  

  dates = as.character(unique(dt$date))

  for (d in dates) {
    trainers = unique(dt$trainer[dt$date==d])

    for (t in trainers) {
      trainer_past_form = dt[trainer==t & date < d]
      strike_rate = sum(trainer_past_form$finish==1)/nrow(trainer_past_form)

      # save this strike rate for this day and this trainer
      dt$strike_rate[dt$trainer==t & dt$date==d] <- strike_rate
    }
  }

  return(dt)
}

my_proc <- function() {
  strike_rates_dt <- split(dt, by=c("date", "trainer"))

  strike_rates_dt <- lapply(strike_rates_dt, function(sub) {
    t <- sub$trainer[[1]]
    d <- sub$date[[1]]

    trainer_past_form <- dt[trainer==t & date < d]
    sr <- sum(trainer_past_form$finish==1)/nrow(trainer_past_form)
    sub[, strike_rate := sr]
  })

  final_dt <- rbindlist(strike_rates_dt)[order(-date)]
}

n = 90 Timings

# Unit: milliseconds
#                expr      min       lq     mean   median       uq      max neval
#  op_dt <- op_proc() 57.02562 59.13524 60.13463 59.73631 60.56061 77.34649   100
# Unit: milliseconds
#                expr      min       lq   mean   median       uq      max neval
#  my_dt <- my_proc() 46.11871 46.67702 48.891 48.67245 49.64088 59.61806   100

n = 900 Timings

# Unit: milliseconds
#                expr      min       lq     mean   median       uq      max neval
#  op_dt <- op_proc() 58.07979 59.83595 62.24291 60.26232 60.73125 229.4492   100
# Unit: milliseconds
#               expr      min       lq     mean   median       uq     max neval
#  my_dt <- my_proc() 45.06198 47.09655 48.00078 47.40018 47.93625 53.7639   100

n = 9000 Timings

# Unit: milliseconds
#                expr      min       lq     mean   median       uq      max neval
#  op_dt <- op_proc() 66.31556 67.07828 68.20643 67.32226 68.23552 82.22218   100
# Unit: milliseconds
#                expr      min       lq     mean   median       uq      max neval
#  my_dt <- my_proc() 50.05955 51.42313 52.81052 51.73318 54.23603 61.34065   100

n = 90000 Timings

# Unit: milliseconds
#                expr      min       lq     mean   median       uq      max neval
#  op_dt <- op_proc() 134.3456 137.7812 148.0204 139.4907 142.4315 356.7175   100
# Unit: milliseconds
#                expr      min       lq     mean   median       uq     max neval
#  my_dt <- my_proc() 87.33779 91.21512 105.1705 92.20642 94.82666 269.798   100
Parfait
  • 104,375
  • 17
  • 94
  • 125