Окно zoo::rollapply со значениями столбцов, а не строк

Ширина в rollapply может быть вектором таким, что i-й элемент является шириной, используемой для i-й строки. Существует несколько интерпретаций вопроса. Мы могли бы использовать наибольшую ширину, охватывающую не более 100 единиц индекса, наименьшую ширину, по крайней мере, 100 единиц индекса или ширину, ближайшую к 100 единицам индекса. Вопрос, кажется, требует третьего, но ширина примера 7 не согласуется с этим и предполагает, что, возможно, требуется вторая интерпретация. Мы даем все три ширины в конце. Выбирайте, что хотите. Также в вопросе говорится, что первое окно равно 7, что указывает на то, что требуется выравнивание по левому краю.

library(zoo)

w <- w2 # see calcs of w1, w2 and w3 at end.  Use whichever you want.
transform(dat, roll = rollapplyr(V2, w, n_sites, fill = NA, align = "left"))

Если n_sites является просто заменой реальной функции, мы можем использовать приведенное выше, но если это реальная функция, мы можем исключить ее и написать так:

transform(dat, roll = rollapplyr(V2 > 1, w, sum, fill = NA, align = "left"))

Ширина

Возможны многие варианты этого, и мы вычисляем три упомянутых здесь.

В приведенном ниже коде используется findInterval базы R. Напомним, что findInterval(x, vec), где x и vec — векторы, а vec — неубывающее число, возвращает вектор той же длины, что и x, так что i-й компонент результата равен sum(x[i] ›= vec), но делает это более эффективно. То есть, если x[i] находится в vec, то он находит последнюю позицию в vec, которая равна x[i], а если x[i] не находится в vec, то он находит последнюю позицию в vec, которая меньше x[ я]. Обратите внимание, что он возвращает позиции, то есть индексы, а не значения vec. Например, findInterval(c(20, 30), c(10, 30, 30, 30, 40)) возвращает c(1, 4), поскольку 1 — это позиция наибольшего значения в vec меньше 20, а 4 — это позиция последнего значения в vec равна 30.

n <- nrow(dat)
index <- dat$index

# i1 is row number of last index no more than current index + 100
i1 <- findInterval(index + 100, index)
w1 <- i1 - 1:n + 1

# i2 is row number of first index at least equal to index + 100
i2 <- pmin(findInterval(index + 100 - 1, index) + 1, n)
w2 <- i2 - 1:n + 1
w2[1]
## [1] 7

# i is row number of index closest to current index + 100
i <- ifelse(index + 100 - index[i1] <= index[i2] - (index + 100), i1, i2)
w3 <- i - 1:n + 1

Вы также можете использовать пакет runner, где аргумент idx — это именно то, что вам нужно.

dat$n_sites <- runner::runner(x = dat$V2,
                              idx = dat$index,
                              k = 100,
                              f = n_sites)

head(dat, 10)
   index V2 n_sites
1  10505  3       1
2  10506  3       2
3  10511  3       3
4  10539  2       4
5  10542  2       5
6  10579  2       6
7  10642  2       2
8  11008  1       0
9  11012  0       0
10 13011  3       1

Вы можете использовать slider::slide_index вместо zoo::rollapply:

library(slider)
dat$n_sites <- slider::slide_index(.x = dat$V2,
                                   .i = dat$index,
                                   .f = n_sites,
                                   .before = 100)

head(dat,10)
   index V2 n_sites
1  10505  3       1
2  10506  3       2
3  10511  3       3
4  10539  2       4
5  10542  2       5
6  10579  2       6
7  10642  2       3
8  11008  1       0
9  11012  0       0
10 13011  3       1