R：滚动窗口功能，窗口和步长可调，用于不规则间隔的观测_R_Time Series_Sliding Window

R：滚动窗口功能，窗口和步长可调，用于不规则间隔的观测

R：滚动窗口功能，窗口和步长可调，用于不规则间隔的观测,r,time-series,sliding-window,R,Time Series,Sliding Window,假设有一个2列数据帧，其中一个时间或距离列依次增加，另一个观察列可能到处都有NAs。我如何有效地使用滑动窗口函数来获取持续时间为X（例如5秒）的窗口中观察值的统计数据（例如平均值），将窗口滑动Y秒（例如2.5秒），然后重复窗口中的观察次数基于时间列，因此每个窗口的观察次数和滑动窗口的观察次数都可能不同函数应接受最大为观察次数和步长的任何窗口大小以下是示例数据（有关更大的示例集，请参见“编辑：”）说明：在所需的输出中，第一个窗口查找-2.5和2.5之间的时间。在这个窗口中有一个度量值的观测值，

假设有一个2列数据帧，其中一个时间或距离列依次增加，另一个观察列可能到处都有NAs。我如何有效地使用滑动窗口函数来获取持续时间为X（例如5秒）的窗口中观察值的统计数据（例如平均值），将窗口滑动Y秒（例如2.5秒），然后重复窗口中的观察次数基于时间列，因此每个窗口的观察次数和滑动窗口的观察次数都可能不同函数应接受最大为观察次数和步长的任何窗口大小

以下是示例数据（有关更大的示例集，请参见“编辑：”）

说明：在所需的输出中，第一个窗口查找-2.5和2.5之间的时间。在这个窗口中有一个度量值的观测值，它不是NA，因此我们得到该观测值：1.0222694。下一个窗口是从0到5，窗口中有一个NA，所以我们得到NA。从2.5到7.5的窗口也是如此。下一个窗口是从5点到10点。窗口中有5个观测值，没有一个是NA。因此，我们得到这5个观测值的平均值（即平均值（dat[dat$time>5&dat$time）这里有一个函数，它为您的小数据帧提供相同的结果。它不是特别快：在第二个

dat

示例中的一个较大数据集上运行需要几秒钟

rolling_summary <- function(DF, time_col, fun, window_size, step_size, min_window=min(DF[, time_col])) {
    # time_col is name of time column
    # fun is function to apply to the subsetted data frames
    # min_window is the start time of the earliest window

    times <- DF[, time_col]

    # window_starts is a vector of the windows' minimum times
    window_starts <- seq(from=min_window, to=max(times), by=step_size)

    # The i-th element of window_rows is a vector that tells us the row numbers of
    # the data-frame rows that are present in window i 
    window_rows <- lapply(window_starts, function(x) { which(times>=x & times<x+window_size) })

    window_summaries <- sapply(window_rows, function(w_r) fun(DF[w_r, ]))
    data.frame(start_time=window_starts, end_time=window_starts+window_size, summary=window_summaries)
}

rolling_summary(DF=dat,
                time_col="time",
                fun=function(DF) mean(DF$measure),
                window_size=5,
                step_size=2.5,
                min_window=-2.5)

rolling\u summary以下是一些函数，它们将在第一个示例中提供相同的输出：
partition <- function(x, window, step = 0){
    a = x[x < step]    
    b = x[x >= step]
    ia = rep(0, length(a))
    ib = cut(b, seq(step, max(b) + window, by = window))    
    c(ia, ib)
}

roll <- function(df, window, step = 0, fun, ...){
    tapply(df$measure, partition(df$time, window, step), fun, ...)
}

roll_steps <- function(df, window, steps, fun, ...){
    X = lapply(steps, roll, df = df, window = window, fun = fun, ...)
    names(X) = steps
    X
}

> roll_steps(dat, 5, c(0, 2.5), mean)
$`0`
        1         2         3         4         5 
       NA 1.0126639 0.9514456        NA        NA 

$`2.5`
        0         1         2         3         4 
1.0222694        NA 0.9965048 1.0518228        NA

也可以通过这种方式轻松忽略缺少的值：
> roll_steps(dat, 5, c(0, 2.5), mean, na.rm = TRUE)
$`0`
        1         2         3         4         5 
0.7275438 1.0126639 0.9514456 0.9351326       NaN 

$`2.5`
        0         1         2         3         4 
1.0222694 0.8138012 0.9965048 1.0518228 0.6122983 

这也可用于data.frames的列表：
> x = lapply(dat2, roll_steps, 5, c(0, 2.5), mean)

好的，这个怎么样
library(data.table)
dat <- data.table(dat)
setkey(dat, time)

# function to compute a given stat over a time window on a given data.table
window_summary <- function(start_tm, window_len, stat_fn, my_dt) {
  pos_vec <- my_dt[, which(time>=start_tm & time<=start_tm+window_len)]
  return(stat_fn(my_dt$measure[pos_vec]))
}

# a vector of window start times
start_vec <- seq(from=-2.5, to=dat$time[nrow(dat)], by=2.5)

# sapply'ing the function above over vector of start times 
# (in this case, getting mean over 5 second windows)
result <- sapply(start_vec, window_summary, 
                 window_len=5, stat_fn=mean, my_dt=dat)

库（data.table）
dat这里是对Rcpp的一次尝试。该函数假定数据是根据时间排序的。建议进行更多的测试并进行调整
#包括
使用名称空间Rcpp；
//[[Rcpp:：导出]]
NumericVector rollAverage（常数NumericVector和时间），
数值向量和VAL，
双重启动，
康斯特双温伦，
常量（双温移）{
int n=ceil（（最大（次）-启动）/winshift）；
数值向量winvals；
数值向量平均值（n）；
int ind1（0），ind2（0）；
对于（int i=0；iwhile（（times[ind1]这里是使用纯data.table
方法及其between
函数的另一种尝试
将Rprof与上述答案（除了@Rolands答案）进行比较，它似乎是最优化的答案。
虽然还没有测试过bug，但是如果你喜欢，我会扩展答案
使用上面的dat

library(data.table)
Rollfunc <- function(dat, time, measure, wind = 5, slide = 2.5, FUN = mean, ...){
  temp <- seq.int(-slide, max(dat$time), by = slide)
  temp <- cbind(temp, temp + wind)
  setDT(dat)[, apply(temp, 1, function(x) FUN(measure[between(time, x[1], x[2])], ...))]
}

Rollfunc(dat, time, measure, 5, 2.5)

## [1] 1.0222694        NA        NA 1.0126639 0.9965048 0.9514456 1.0518228        NA        NA
## [10]        NA

也会起作用
编辑：我对@Roland做了一些板凳练习，他的方法显然获胜（到目前为止），所以我会用Rcpp aproach
你看过RcppRoll和它的朋友吗？我做了一个很酷的窗口平均函数；这和你想要的类似吗？@TrevorAlexander感谢你给我指出了RcppRoll
；我会看一看。至于你写的函数，窗口是基于观察的数量而不是时间的就我所知，这不是我想要的。是的，我认为你需要像你在问题中所拥有的那样的代码来将时间持续时间划分成离散的索引。我们需要一个更大的现实样本集：一个具有现实数量的NA，并且表示沿时间维度的最小间隔的样本集。+1非常好。在我看来（根据我对Rprof
output的解释，lappy（窗口_启动，函数（x）它（times>=x×）（我想这比James的解决方案慢，但可能有助于看到另一种方法）是的，对不起。我忘了删除这一行。我已经编辑过，但现在无法测试（今天稍后再试）。希望它仍然有效。我现在已经在win机器上运行了它，编译器抱怨vals
是一个常数。所以，我也改变了它。由于函数的变化和CPU速度的不同，计时也不同。它工作得很好！它使用起来既快又方便。缺点是你需要硬编码你想要使用的函数（例如本例中的mean
），afaik。当窗口完全在第一次出现之前出现时，会出现一个问题（即，请参见testdf，可能有一种方法可以将R函数传递给它，当然它需要一些输入检查，正如您注意到的，一些边缘情况需要修复（我已经修复了您发现的边缘情况）.剩下的就交给你了。一般来说，函数越专业，它的效率就越高。如果你把一个R函数传递给这个函数，你会付出性能损失的代价。它赢了多少钱？我很好奇，因为data.table往往有一些非常强的性能。如果性能上有一个像样的飞跃，那就在“那么我想Hadley Wickam（和其他人）会非常有兴趣推广它，并让R在那里获胜。@英语学生请忽略这个答案，因为这是一个非常古老的答案，当时我对data.table不太了解。如果你看到apply（…，1，…）
任何靠近数据的地方。表-我允许你否决投票。我想今天我会通过做类似的事情来解决这个问题，但我懒得在3年后修改这个答案。
> roll_steps(dat, 5, c(0, 2.5), mean, na.rm = TRUE)
$`0`
        1         2         3         4         5 
0.7275438 1.0126639 0.9514456 0.9351326       NaN 

$`2.5`
        0         1         2         3         4 
1.0222694 0.8138012 0.9965048 1.0518228 0.6122983 

> x = lapply(dat2, roll_steps, 5, c(0, 2.5), mean)

library(data.table)
dat <- data.table(dat)
setkey(dat, time)

# function to compute a given stat over a time window on a given data.table
window_summary <- function(start_tm, window_len, stat_fn, my_dt) {
  pos_vec <- my_dt[, which(time>=start_tm & time<=start_tm+window_len)]
  return(stat_fn(my_dt$measure[pos_vec]))
}

# a vector of window start times
start_vec <- seq(from=-2.5, to=dat$time[nrow(dat)], by=2.5)

# sapply'ing the function above over vector of start times 
# (in this case, getting mean over 5 second windows)
result <- sapply(start_vec, window_summary, 
                 window_len=5, stat_fn=mean, my_dt=dat)

set.seed(42)
dat <- data.frame(time = seq(1:50000)+runif(50000, 0.025, 1))
dat <- data.frame(dat, measure=c(diff(dat$time),NA_real_))
dat$measure[sample(1:50000,1000)] <- NA_real_
dat$measure[c(350:450,3000:3300, 20000:28100)] <- NA_real_
dat <- dat[-c(1000:2000, 30000:35000),] 

# a list with a realistic number of observations:
dat <- lapply(1:300,function(x) dat)

library(data.table)
dat <- lapply(dat, setDT)
for (ind in seq_along(dat)) dat[[ind]][, i := ind]
#possibly there is a way to avoid these copies?

dat <- rbindlist(dat)

system.time(res <- dat[, rollAverage(time, measure, -2.5, 5.0, 2.5), by=i])
#user  system elapsed 
#1.51    0.02    1.54 
print(res)
#           i        V1
#      1:   1 1.0217126
#      2:   1 0.9334415
#      3:   1 0.9609050
#      4:   1 1.0123473
#      5:   1 0.9965922
#     ---              
#6000596: 300 1.1121296
#6000597: 300 0.9984581
#6000598: 300 1.0093060
#6000599: 300        NA
#6000600: 300        NA

library(data.table)
Rollfunc <- function(dat, time, measure, wind = 5, slide = 2.5, FUN = mean, ...){
  temp <- seq.int(-slide, max(dat$time), by = slide)
  temp <- cbind(temp, temp + wind)
  setDT(dat)[, apply(temp, 1, function(x) FUN(measure[between(time, x[1], x[2])], ...))]
}

Rollfunc(dat, time, measure, 5, 2.5)

## [1] 1.0222694        NA        NA 1.0126639 0.9965048 0.9514456 1.0518228        NA        NA
## [10]        NA

Rollfunc(dat, time, measure, 5, 2.5, max, na.rm = TRUE)