R: How to generate a column with row values based on the nearest N row's values

Question

I'm looking for a way to code a column based information in the previous N rows to a given row. The dataset is sorted.

In short, I want to create a column called oneweeksince that returns TRUE if the victims column is greater than 0 (or !NA) for seven rows after.

Put another way, if, for row[i], row[i]$victims > 0 within any row from row[i - 7] to row[i], then row[i]$oneweeksince should be TRUE. The oneweeksince value should also be TRUE on rows in which victims > 0 or !is.na(victims)

How can I automate the creation of this column/feature? It is also possible to use the date column to compute the date distance. I'm trying to avoid creating a loop because of the slow perf in R.

The dataset should look like this:

      date           oneweeksince victims
1    2009-01-01         FALSE      NA
2    2009-01-02         FALSE      NA
3    2009-01-03         FALSE      NA
4    2009-01-04         FALSE      NA
5    2009-01-05         FALSE      NA
6    2009-01-06         FALSE      NA
7    2009-01-07         FALSE      NA
8    2009-01-08          TRUE       1
9    2009-01-09          TRUE      NA
10   2009-01-10          TRUE      NA
11   2009-01-11          TRUE      NA
12   2009-01-12          TRUE      NA
13   2009-01-13          TRUE      NA
14   2009-01-14          TRUE      NA
15   2009-01-15          TRUE      NA
16   2009-01-16         FALSE      NA
17   2009-01-17         FALSE      NA
18   2009-01-18         FALSE      NA
19   2009-01-19         FALSE      NA
20   2009-01-20         FALSE      NA

The dataset is many years long so I need an efficient way to do it.

www · Accepted Answer · 2019-03-27T19:12:47.443

Solution from @G.Grothendieck

After some discussions, this is the most effective and efficient answer.

library(dplyr)
library(zoo)

dat2 <- dat %>%
  mutate(roll = rollapplyr(victims > 0, 8, any, na.rm = TRUE, fill = NA, partial = TRUE)) %>%
  mutate(oneweeksince = roll > 0) %>%
  select(-roll)

Solution from my previous attempt

A solution using rollapplyr from the zoo package. rollapplyr can apply a function with a rolling window. In this case, we can specify the rolling window to be 8 and apply the mean function. Notice that rollmean function is not suitable in this case becuas we cannot specify na.rm = TRUE in the rollmean function. The last step is to simply evaluate if the roll column is larger than 1.

library(dplyr)
library(zoo)

dat2 <- dat %>%
  mutate(roll = rollapplyr(victims, width = 8, FUN = function(x) mean(x, na.rm = TRUE), fill = NA)) %>%
  mutate(oneweeksince = roll > 0) %>%
  select(-roll)
# dat2
#          date victims oneweeksince
# 1  2009-01-01      NA           NA
# 2  2009-01-02      NA           NA
# 3  2009-01-03      NA           NA
# 4  2009-01-04      NA           NA
# 5  2009-01-05      NA           NA
# 6  2009-01-06      NA           NA
# 7  2009-01-07      NA           NA
# 8  2009-01-08       1         TRUE
# 9  2009-01-09      NA         TRUE
# 10 2009-01-10      NA         TRUE
# 11 2009-01-11      NA         TRUE
# 12 2009-01-12      NA         TRUE
# 13 2009-01-13      NA         TRUE
# 14 2009-01-14      NA         TRUE
# 15 2009-01-15      NA         TRUE
# 16 2009-01-16      NA           NA
# 17 2009-01-17      NA           NA
# 18 2009-01-18      NA           NA
# 19 2009-01-19      NA           NA

DATA

dat <- read.table(text = "      date           oneweeksince victims
1    '2009-01-01'         FALSE      NA
                  2    '2009-01-02'         FALSE      NA
                  3    '2009-01-03'         FALSE      NA
                  4    '2009-01-04'         FALSE      NA
                  5    '2009-01-05'         FALSE      NA
                  6    '2009-01-06'         FALSE      NA
                  7    '2009-01-07'         FALSE      NA
                  8    '2009-01-08'          TRUE       1
                  9    '2009-01-09'          TRUE      NA
                  10   '2009-01-10'          TRUE      NA
                  11   '2009-01-11'          TRUE      NA
                  12   '2009-01-12'          TRUE      NA
                  13   '2009-01-13'          TRUE      NA
                  14   '2009-01-14'          TRUE      NA
                  15   '2009-01-15'          TRUE      NA
                  16   '2009-01-16'         FALSE      NA
                  17   '2009-01-17'         FALSE      NA
                  18   '2009-01-18'         FALSE      NA
                  19   '2009-01-19'         FALSE      NA
                  20   '2009-01-20'         FALSE      NA",
                  header = TRUE, stringsAsFactors = FALSE)

dat$oneweeksince <- NULL

My second attempt

The OP pointed out that my solution will not work if there are entries in the first N rows where N is the window width. Here I provided a solution to address that. I am going to use the same example data frame except that I change the second row of victims to be 1. The new solution needs functions from purrr and tidyr, so I load the tidyverse package for this.

library(tidyverse)
library(zoo)

dat2 <- dat %>%
  mutate(roll = rollapplyr(victims, width = 8, FUN = function(x) mean(x, na.rm = TRUE), fill = NA)) %>%
  # Split the data frame for the first width - 1 rows and others
  mutate(GroupID = ifelse(row_number() <= 7, 1L, 2L)) %>%
  split(.$GroupID) %>%
  # Check if the GroupID is 1. If yes, change the roll column to be the same as victims
  # After that, use fill to fill in NA
  map_if(function(x) unique(x$GroupID) == 1L, 
         ~.x %>% mutate(roll = victims) %>% fill(roll)) %>%
  # Combine data frames
  bind_rows() %>%
  mutate(oneweeksince = roll > 0) %>%
  select(-roll)
# dat2
# date victims GroupID oneweeksince
# 1  2009-01-01      NA       1           NA
# 2  2009-01-02       1       1         TRUE
# 3  2009-01-03      NA       1         TRUE
# 4  2009-01-04      NA       1         TRUE
# 5  2009-01-05      NA       1         TRUE
# 6  2009-01-06      NA       1         TRUE
# 7  2009-01-07      NA       1         TRUE
# 8  2009-01-08       1       2         TRUE
# 9  2009-01-09      NA       2         TRUE
# 10 2009-01-10      NA       2         TRUE
# 11 2009-01-11      NA       2         TRUE
# 12 2009-01-12      NA       2         TRUE
# 13 2009-01-13      NA       2         TRUE
# 14 2009-01-14      NA       2         TRUE
# 15 2009-01-15      NA       2         TRUE
# 16 2009-01-16      NA       2           NA
# 17 2009-01-17      NA       2           NA
# 18 2009-01-18      NA       2           NA
# 19 2009-01-19      NA       2           NA
# 20 2009-01-20      NA       2           NA

DATA

dat <- read.table(text = "      date           oneweeksince victims
1    '2009-01-01'         FALSE      NA
                  2    '2009-01-02'         FALSE       1
                  3    '2009-01-03'         FALSE      NA
                  4    '2009-01-04'         FALSE      NA
                  5    '2009-01-05'         FALSE      NA
                  6    '2009-01-06'         FALSE      NA
                  7    '2009-01-07'         FALSE      NA
                  8    '2009-01-08'          TRUE       1
                  9    '2009-01-09'          TRUE      NA
                  10   '2009-01-10'          TRUE      NA
                  11   '2009-01-11'          TRUE      NA
                  12   '2009-01-12'          TRUE      NA
                  13   '2009-01-13'          TRUE      NA
                  14   '2009-01-14'          TRUE      NA
                  15   '2009-01-15'          TRUE      NA
                  16   '2009-01-16'         FALSE      NA
                  17   '2009-01-17'         FALSE      NA
                  18   '2009-01-18'         FALSE      NA
                  19   '2009-01-19'         FALSE      NA
                  20   '2009-01-20'         FALSE      NA",
                  header = TRUE, stringsAsFactors = FALSE)

dat$oneweeksince <- NULL

This seems to fail if the date is within first N entries of the data.frame, where N is the window range. — Union find, Mar 26 '19 at 03:33
@Robert I fail to understand why do you want to add `2008-12-28 2` at the beginning. Notice that in the example data frame, the `date` column is complete. If you add `2008-12-28 2`, the `date` column is not complete as there are gaps. This becomes a different question. To address your question, we can convert the `date` column to `date` class and then use `complete` from the `tidyr` to expand the `date` column with completed date series. After that, we can use my solution. But since it is not a condition specified by the OP, I will not mention it in my answer. — www, Mar 26 '19 at 08:31
I was thinking on a general approach where may be gaps in the data. Otherwise you are right. — Robert, Mar 26 '19 at 12:56
Suggest using `rollapplyr(victims > 0, 8, any, na.rm = TRUE, fill = NA, partial = TRUE)` . The `partial` argument allows it to work with fewer than 8 elements at the beginning. — G. Grothendieck, Mar 26 '19 at 14:32
I'm not really worried about a 2008 date.. but I am worried about the first N date having a value fwiw. — Union find, Mar 26 '19 at 14:58
@G.Grothendieck Good to know the use of the `partial` argument. Thanks. — www, Mar 26 '19 at 17:48
@www Do you mind updating your answer to use Partial? That seems much more sensible. Then I'll accept. — Union find, Mar 26 '19 at 19:56
@www Cool. It'd be good to rename "update" in the lower heading as that may seem like an update to the answer you posted at the top. Ill accept. — Union find, Mar 27 '19 at 17:00

score 1 · Answer 2 · answered Mar 26 '19 at 03:04

We can do a rolling sum and test that it is greater than 0:

library(RcppRoll)
your_data$result = roll_sum(
  x = your_data$victims,
  n = 8, 
  na.rm = TRUE,
  fill = 0,
  align = "right"
) > 0
your_data
#          date oneweeksince victims result
# 1  2009-01-01        FALSE      NA  FALSE
# 2  2009-01-02        FALSE      NA  FALSE
# 3  2009-01-03        FALSE      NA  FALSE
# 4  2009-01-04        FALSE      NA  FALSE
# 5  2009-01-05        FALSE      NA  FALSE
# 6  2009-01-06        FALSE      NA  FALSE
# 7  2009-01-07        FALSE      NA  FALSE
# 8  2009-01-08         TRUE       1   TRUE
# 9  2009-01-09         TRUE      NA   TRUE
# 10 2009-01-10         TRUE      NA   TRUE
# 11 2009-01-11         TRUE      NA   TRUE
# 12 2009-01-12         TRUE      NA   TRUE
# 13 2009-01-13         TRUE      NA   TRUE
# 14 2009-01-14         TRUE      NA   TRUE
# 15 2009-01-15         TRUE      NA   TRUE
# 16 2009-01-16        FALSE      NA  FALSE
# 17 2009-01-17        FALSE      NA  FALSE
# 18 2009-01-18        FALSE      NA  FALSE
# 19 2009-01-19        FALSE      NA  FALSE
# 20 2009-01-20        FALSE      NA  FALSE

Using this data:

your_data = read.table(header = T, text = '      date           oneweeksince victims
1    2009-01-01         FALSE      NA
2    2009-01-02         FALSE      NA
3    2009-01-03         FALSE      NA
4    2009-01-04         FALSE      NA
5    2009-01-05         FALSE      NA
6    2009-01-06         FALSE      NA
7    2009-01-07         FALSE      NA
8    2009-01-08          TRUE       1
9    2009-01-09          TRUE      NA
10   2009-01-10          TRUE      NA
11   2009-01-11          TRUE      NA
12   2009-01-12          TRUE      NA
13   2009-01-13          TRUE      NA
14   2009-01-14          TRUE      NA
15   2009-01-15          TRUE      NA
16   2009-01-16         FALSE      NA
17   2009-01-17         FALSE      NA
18   2009-01-18         FALSE      NA
19   2009-01-19         FALSE      NA
20   2009-01-20         FALSE      NA')

This seems to fail if the date is within first N entries of the data.frame, where N is the window range. — Union find, Mar 26 '19 at 03:33
@Learningstatsbyexample I'd suggest updating your sample data in the question to include this case. Seems to be a common point of failure. — Gregor Thomas, Mar 26 '19 at 12:46

score 1 · Answer 3 · answered Mar 26 '19 at 03:06

I prefer Gregor's answer, but here are two alternatives.

Base R

x$y <- Sys.Date()[NA] # just a class-stable way
x$y[ !is.na(x$victims) ] <- x$date[ !is.na(x$victims) ]
x$since <- difftime(x$date, zoo::na.locf(x$y, na.rm = FALSE), units="days")
x$oneweeksince <- !is.na(x$since) & (0 <= x$since & x$since <= 7)

`dplyr`

library(dplyr)
x %>%
  mutate(
    y = zoo::na.locf(if_else(is.na(victims), date[NA], date), na.rm = FALSE),
    since = difftime(date, zoo::na.locf(if_else(is.na(victims), date[NA], date), na.rm = FALSE),
                     units = "days"),
    anotherweeksince = !is.na(since) & between(since, 0, 7)
  )

Data:

x <- read.table(stringsAsFactors=FALSE, header=TRUE, text="
      date           oneweeksince victims
1    2009-01-01         FALSE      NA
2    2009-01-02         FALSE      NA
3    2009-01-03         FALSE      NA
4    2009-01-04         FALSE      NA
5    2009-01-05         FALSE      NA
6    2009-01-06         FALSE      NA
7    2009-01-07         FALSE      NA
8    2009-01-08          TRUE       1
9    2009-01-09          TRUE      NA
10   2009-01-10          TRUE      NA
11   2009-01-11          TRUE      NA
12   2009-01-12          TRUE      NA
13   2009-01-13          TRUE      NA
14   2009-01-14          TRUE      NA
15   2009-01-15          TRUE      NA
16   2009-01-16         FALSE      NA
17   2009-01-17         FALSE      NA
18   2009-01-18         FALSE      NA
19   2009-01-19         FALSE      NA
20   2009-01-20         FALSE      NA")
x$date <- as.Date(x$date)

Right, works if adding this data at the beginning `2008-12-28 2 ` — Robert, Mar 26 '19 at 03:25

score 1 · Answer 4 · answered Mar 26 '19 at 03:07

1

Not sure about the efficiency but one way to do this in base R using sapply would be for every row we go back 7 rows and check if it satisfies any of the condition and return a boolean output accordingly.

sapply(seq_len(nrow(df)), function(x) {
    temp = df$victims[x : pmax(1, x - 7)]
    any(temp > 0) & any(!is.na(temp))
})

#[1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE  TRUE  TRUE  TRUE  TRUE 
#    TRUE  TRUE  TRUE FALSE FALSE FALSE FALSE FALSE

answered Mar 26 '19 at 03:07

Ronak Shah

377,200
20
156
213

Fails if adding this data at the beginning `2008-12-28 2` – Robert Mar 26 '19 at 03:23
@Robert How? OP has mentioned to check previous 7 rows and see if any `victims` has value greater than 0 and a non-NA value. – Ronak Shah Mar 26 '19 at 03:32
1

I was thinking on a general approach where may be gaps in the data. Otherwise you are right. – Robert Mar 26 '19 at 12:56