Rolling conditional count in R

Question

I'm wanting to create a rolling function that conditionally counts the occurance of two columns in previous rows.

As an example, I have a dataset that looks like the following.

# Generate data
set.seed(123)
test <- data.frame(
  Round = rep(1:5, times = 3),
  Team = rep(c("Team 1", "Team 2", "Team 3"), each = 5),
  Venue = sample(sample(c("Venue A", "Venue B"), 15, replace = T))
)

   Round   Team   Venue
1      1 Team 1 Venue B
2      2 Team 1 Venue B
3      3 Team 1 Venue A
4      4 Team 1 Venue A
5      5 Team 1 Venue B
6      1 Team 2 Venue B
7      2 Team 2 Venue B
8      3 Team 2 Venue A
9      4 Team 2 Venue A
10     5 Team 2 Venue A
11     1 Team 3 Venue B
12     2 Team 3 Venue A
13     3 Team 3 Venue B
14     4 Team 3 Venue B
15     5 Team 3 Venue B

I want a new column that shows for each row, the number of times the team in that row has played at the venue in that row in the last 3 rounds.

I can do this quite easily with a for loop.

window <- 3

for (i in 1:nrow(dat)){
  # Create index to search (if i is less than window, start at 1)
  index <- max(i - window, 1):i

  # Search when current row matches both team and venue
  dat$VenueCount[i] <- sum(dat$Team[i] == dat$Team[index] & dat$Venue[i] == dat$Venue[index])
}

   Round   Team   Venue VenueCount
1      1 Team 1 Venue B          1
2      2 Team 1 Venue B          2
3      3 Team 1 Venue A          1
4      4 Team 1 Venue A          2
5      5 Team 1 Venue B          2
6      1 Team 2 Venue B          1
7      2 Team 2 Venue B          2
8      3 Team 2 Venue A          1
9      4 Team 2 Venue A          2
10     5 Team 2 Venue A          3
11     1 Team 3 Venue B          1
12     2 Team 3 Venue A          1
13     3 Team 3 Venue B          2
14     4 Team 3 Venue B          3
15     5 Team 3 Venue B          3

However, I'm wanting to avoid a for loop (mostly as my actual dataset is relatively large at around ~30k rows). I'm thinking it should be doable with one of zoo, dplyr, purrr or apply but haven't been able to work it out.

Thanks

score 3 · Answer 1 · answered Apr 03 '18 at 03:12

venturing a data.table solution here. Will take it down if you are only looking for dplyr solution

You can roll using a window of size 4, then count the number of occurrence matching the latest row.

library(data.table)
library(zoo)
setDT(test)
winsize <- 4
test[, .(Round, 
        Venue, 
        VenueCount=rollapplyr(c(rep("", winsize-1), Venue), winsize, 
            function(x) sum(x==last(x)))), 
    by=.(Team)]

result:

#       Team Round   Venue VenueCount
#  1: Team 1     1 Venue B          1
#  2: Team 1     2 Venue B          2
#  3: Team 1     3 Venue A          1
#  4: Team 1     4 Venue A          2
#  5: Team 1     5 Venue B          2
#  6: Team 2     1 Venue B          1
#  7: Team 2     2 Venue B          2
#  8: Team 2     3 Venue A          1
#  9: Team 2     4 Venue A          2
# 10: Team 2     5 Venue A          3
# 11: Team 3     1 Venue B          1
# 12: Team 3     2 Venue A          1
# 13: Team 3     3 Venue B          2
# 14: Team 3     4 Venue B          3
# 15: Team 3     5 Venue B          3

Or without zoo `test[, n := .SD[.(Team = Team, Venue = Venue, r_dn = Round - 3L, r_up = Round), on=.(Team, Venue, Round >= r_dn, Round <= r_up), .N, by=.EACHI]$N]` — Frank, Apr 03 '18 at 03:21
Thanks! I'm not super familiar with `data.table` but happy to leave it here for others — jimmyday87, Apr 03 '18 at 04:45

score 2 · Accepted Answer · answered Apr 03 '18 at 04:43

I actually worked out an answer using rollify from the tibbletime package with dplyr::mutate. Will post here but still open to other responses!

library(dplyr)
library(tibbletime)

# Create data
set.seed(123)
test <- data.frame(
  Round = rep(1:5, times = 3),
  Team = rep(c("Team 1", "Team 2", "Team 3"), each = 5),
  Venue = sample(sample(c("Venue A", "Venue B"), 15, replace = T))
)

Use rollify to create custom function.

last_n_games = 3
count_games <- rollify(function(x) sum(last(x) == x), window = last_n_games)

Now use mutate to run the function. This returns NA for the first 2 rows (i.e. last_n_games - 1). I can then use group_by and row_number to count these first occurrences

test <- test %>%
  group_by(Team) %>%
  mutate(VenueCount = count_games(Venue)) %>%
  group_by(Team, Venue) %>%
  mutate(VenueCount = ifelse(is.na(VenueCount), row_number(Team), VenueCount))

This returns the following

# A tibble: 15 x 4
# Groups:   Team, Venue [6]
   Round Team   Venue   VenueCount
   <int> <fct>  <fct>        <int>
 1     1 Team 1 Venue B          1
 2     2 Team 1 Venue B          2
 3     3 Team 1 Venue A          1
 4     4 Team 1 Venue A          2
 5     5 Team 1 Venue B          1
 6     1 Team 2 Venue B          1
 7     2 Team 2 Venue B          2
 8     3 Team 2 Venue A          1
 9     4 Team 2 Venue A          2
10     5 Team 2 Venue A          3
11     1 Team 3 Venue B          1
12     2 Team 3 Venue A          1
13     3 Team 3 Venue B          2
14     4 Team 3 Venue B          2
15     5 Team 3 Venue B          3

SunLisa · Answer 3 · 2018-04-04T06:44:08.377

So I like using data.table, it's fast, versatile.

The idea is to join itself on 2 times, with 2 lag (round+1) and (round+2), so here is what I did.

> test1<-test
> test2<-test
> test<-as.data.table(test)
> test1<-as.data.table(test1)
> test2<-as.data.table(test2)

Get these data.frames into data.table after get replicas

> test1[,Round:=Round+1,]
> test2[,Round:=Round+2,]

Round with lags then join them together like this:

> test2[test1,on=c('Round','Team')][test,on=c('Round','Team')]
    Round   Team   Venue i.Venue i.Venue.1
 1:     1 Team 1      NA      NA   Venue B
 2:     2 Team 1      NA Venue B   Venue B
 3:     3 Team 1 Venue B Venue B   Venue A
 4:     4 Team 1 Venue B Venue A   Venue A
 5:     5 Team 1 Venue A Venue A   Venue B
 6:     1 Team 2      NA      NA   Venue B
 7:     2 Team 2      NA Venue B   Venue B
 8:     3 Team 2 Venue B Venue B   Venue A
 9:     4 Team 2 Venue B Venue A   Venue A
10:     5 Team 2 Venue A Venue A   Venue A
11:     1 Team 3      NA      NA   Venue B
12:     2 Team 3      NA Venue B   Venue A
13:     3 Team 3 Venue B Venue A   Venue B
14:     4 Team 3 Venue A Venue B   Venue B
15:     5 Team 3 Venue B Venue B   Venue B

Since this result a lot of NAs, here we use a function from R-Cookbook.com ben mentioned in his answer

  compareNA <- function(v1,v2) {
    # This function returns TRUE wherever elements are the same, including NA's,
    # and false everywhere else.
    same <- (v1 == v2)  |  (is.na(v1) & is.na(v2))
    same[is.na(same)] <- FALSE
    return(same)
   }

we can get our end result:

 > end <-
      test2[test1, on = c('Round', 'Team')][test, on = c('Round', 
      'Team')][, VenueCount :=
      (1 + compareNA(i.Venue.1, i.Venue) + compareNA(i.Venue.1, Venue)), ]

Explanation: test2 right join test1, on Round and Team, and right join test on Round and Team, so you get:

i.Venue.1 is current Venue of the Team, i.Venue is last Venue of the Team, Venue is last 2 Venue of the Team,

with a logical

(1 + compareNA(i.Venue.1, i.Venue) + compareNA(i.Venue.1, Venue))

You can count how many times the team played on this venue in last 3 rounds.

> end
    Round   Team   Venue i.Venue i.Venue.1 VenueCount
 1:     1 Team 1      NA      NA   Venue B          1
 2:     2 Team 1      NA Venue B   Venue B          2
 3:     3 Team 1 Venue B Venue B   Venue A          1
 4:     4 Team 1 Venue B Venue A   Venue A          2
 5:     5 Team 1 Venue A Venue A   Venue B          1
 6:     1 Team 2      NA      NA   Venue B          1
 7:     2 Team 2      NA Venue B   Venue B          2
 8:     3 Team 2 Venue B Venue B   Venue A          1
 9:     4 Team 2 Venue B Venue A   Venue A          2
10:     5 Team 2 Venue A Venue A   Venue A          3
11:     1 Team 3      NA      NA   Venue B          1
12:     2 Team 3      NA Venue B   Venue A          1
13:     3 Team 3 Venue B Venue A   Venue B          2
14:     4 Team 3 Venue A Venue B   Venue B          2
15:     5 Team 3 Venue B Venue B   Venue B          3

hope this helps

Rolling conditional count in R

3 Answers3