通过基于时间的窗口优化不规则时间序列的滚动函数
是否有某种方法可以使用rollapply（来自zoo包或类似的东西）优化函数（rollmean，rollmedian等）来计算具有基于时间的窗口的滚动函数，一个基于一些观察？我想要的很简单：对于不规则时间序列中的每个元素，我想计算一个带有N天窗口的滚动函数。也就是说，窗口应包括当前观察前N天的所有观察结果。时间序列也可能包含重复项。
以下是一个例子。鉴于以下时间序列：
date value
1/11/2011 5
1/11/2011 4
1/11/2011 2
8/11/2011 1
13/11/2011 0
14/11/2011 0
15/11/2011 0
18/11/2011 1
21/11/2011 4
5/12/2011 3
具有5天窗口的滚动中位数，与右侧对齐，应导致以下计算：
> c(
median(c(5)),
median(c(5,4)),
median(c(5,4,2)),
median(c(1)),
median(c(1,0)),
median(c(0,0)),
median(c(0,0,0)),
median(c(0,0,0,1)),
median(c(1,4)),
median(c(3))
)
[1] 5.0 4.5 4.0 1.0 0.5 0.0 0.0 0.0 2.5 3.0
我已经找到了一些解决方案，但它们通常很棘手，通常意味着很慢。我设法实现了自己的滚动函数计算。问题是，对于非常长的时间序列，中位数（rollmedian）的优化版本可以产生巨大的时间差，因为它考虑了窗口之间的重叠。我想避免重新实现它。我怀疑rollapply参数有一些技巧可以使它工作，但我无法弄明白。在此先感谢您的帮助。
6 个答案:
答案 0 :(得分：3)
从v1.9.8版本开始（2016年11月25日，CRAN），data.table获得了执行非等额联接的功能，可以在此处使用。
OP已请求
对于不规则时间序列中的每个元素，我想计算一个 具有N天窗口的滚动功能。也就是说，窗口应该 包括直到当前N天前的所有观测值 观察。时间序列也可能包含重复项。
请注意，OP已要求在当前观测前N天之前纳入所有观测。要求在当前天之前的N天之前请求所有观测值是不同的。
对于后者，我希望1/11/2011的一个值，即median(c(5, 4, 2)) = 4。
显然，OP希望基于观察的滚动窗口被限制为N天。因此，非等额联接的联接条件也必须考虑行号。
library(data.table)
n_days <- 5L
setDT(DT)[, rn := .I][
.(ur = rn, ud = date, ld = date - n_days),
on = .(rn <= ur, date <= ud, date >= ld),
median(as.double(value)), by = .EACHI]$V1
[1] 5.0 4.5 4.0 1.0 0.5 0.0 0.0 0.0 2.5 3.0
出于完整性考虑，基于 day 的滚动窗口的可能解决方案可能是：
setDT(DT)[.(ud = unique(date), ld = unique(date) - n_days), on = .(date <= ud, date >= ld),
median(as.double(value)), by = .EACHI]
date date V1 1: 2011-11-01 2011-10-27 4.0 2: 2011-11-08 2011-11-03 1.0 3: 2011-11-13 2011-11-08 0.5 4: 2011-11-14 2011-11-09 0.0 5: 2011-11-15 2011-11-10 0.0 6: 2011-11-18 2011-11-13 0.0 7: 2011-11-21 2011-11-16 2.5 8: 2011-12-05 2011-11-30 3.0
数据
library(data.table)
DT <- fread(" date value
1/11/2011 5
1/11/2011 4
1/11/2011 2
8/11/2011 1
13/11/2011 0
14/11/2011 0
15/11/2011 0
18/11/2011 1
21/11/2011 4
5/12/2011 3")[
# coerce date from character string to integer date class
, date := as.IDate(date, "%d/%m/%Y")]
答案 1 :(得分：2)
1）rollapply 没有检查速度，但如果没有日期超过max.dup，则必须是最后5 * max.dup条目包含最近5天所以传递给fn的下面显示的单行函数rollapplyr将执行此操作：
k <- 5
dates <- as.numeric(DF$date)
values <- DF$value
max.dup <- max(table(dates))
fn <- function(ix, d = dates[ix], v = values[ix], n = length(ix)) median(v[d >= d[n]-k])
rollapplyr(1:nrow(DF), max.dup * k, fn, partial = TRUE)
## [1] 5.0 4.5 4.0 1.0 0.5 0.0 0.0 0.0 2.5 3.0
2）sqldf 我们可以使用SQL自联接来执行此操作。我们在不超过5天的时间内加入a行b行，然后按a行分组，并将b行的中间值加入其中。< / p>
library(sqldf)
k <- 5
res <- fn$sqldf("select a.date, a.value, median(b.value) median
from DF a
left join DF b on b.date between a.date - $k and a.date and b.rowid <= a.rowid
group by a.rowid")
，并提供：
res$median
## [1] 5.0 4.5 4.0 1.0 0.5 0.0 0.0 0.0 2.5 3.0
注意：我们将此用于DF：
Lines <- "
date value
1/11/2011 5
1/11/2011 4
1/11/2011 2
8/11/2011 1
13/11/2011 0
14/11/2011 0
15/11/2011 0
18/11/2011 1
21/11/2011 4
5/12/2011 3
"
DF <- read.table(text = Lines, header = TRUE)
DF$date <- as.Date(DF$date, format = "%d/%m/%Y")
答案 2 :(得分：1)
大多数答案建议插入NA以使时间序列规则。 但是，在长时间序列的情况下，这可能会很慢。此外，它不适用于不能与NA一起使用的功能。
rollapply（zoo包）的width参数可以是一个列表（有关详细信息，请参阅rollapply的帮助）。基于此，我编写了一个函数，它创建了一个与rollapply一起使用的列表作为width参数。如果移动窗口是时间而不是基于索引，则该函数提取不规则动物园对象的索引。因此，zoo对象的索引应该是实际时间。
# Create a zoo object where index represents time (e.g. in seconds)
d <- zoo(c(1,1,1,1,1,2,2,2,2,2,16,25,27,27,27,27,27,31),
c(1:5,11:15,16,25:30,31))
# Create function
createRollapplyWidth = function(zoodata, steps, window ){
mintime = min(time(zoodata))
maxtime = max(time(zoodata))
spotstime = seq(from = mintime , to = maxtime, by = steps)
spotsindex = list()
for (i in 1:length(spotstime)){
spotsindex[[i]] = as.numeric(which(spotstime[i] <= time(zoodata) & time(zoodata) < spotstime[i] + window))}
rollapplywidth = list()
for (i in 1:length(spotsindex)){
if (!is.na(median(spotsindex[[i]])) ){
rollapplywidth[[round(median(spotsindex[[i]]))]] = spotsindex[[i]] - round(median(spotsindex[[i]]))}
}
return(rollapplywidth)
}
# Create width parameter for rollapply using function
rollwidth = createRollapplyWidth(zoodata = d, steps = 5, window = 5)
# Use parameter in rollapply
result = rollapply(d, width = rollwidth , FUN = sum, na.rm = T)
result
限制：不是基于过时而是基于秒的时间。参数＆＃34;部分＆＃34; rollapply不起作用。
答案 3 :(得分：1)
我建议使用runner软件包，该软件包经过优化可以执行本主题中要求的操作。转到documentation中的取决于日期的Windows 部分，以获取更多说明。
要解决您的任务，可以使用runner函数，该函数可以在运行的窗口中执行任何R函数。一线以下：
df <- read.table(
text = "date value
2011-11-01 5
2011-11-01 4
2011-11-01 2
2011-11-08 1
2011-11-13 0
2011-11-14 0
2011-11-15 0
2011-11-18 1
2011-11-21 4
2011-12-05 3", header = TRUE, colClasses = c("Date", "integer"))
library(runner)
runner(df$value, k = 5, idx = df$date, f = median)
[1] 5.0 4.5 4.0 1.0 0.0 0.0 0.0 0.0 2.5 3.0
P.S。应该知道，5天的窗口是[i-4, i-3, i-2, i-1, i]而不是(i-5):i（6天的窗口）。下图为对该概念的更好解释。
我已经在5天的窗口中创建了示例，但是如果要根据OP请求重现结果，可以指定6天的窗口：
identical(
runner(df$value, k = 6, idx = df$date, f = median),
c(5.0, 4.5, 4.0, 1.0, 0.5, 0.0, 0.0, 0.0, 2.5, 3.0)
)
# [1] TRUE
答案 4 :(得分：0)
这是我修补这个问题的方法。如果那种得到你想要的东西（我不知道它在速度方面是否令人满意），我可以把它写成一个更详细的答案（即使它是基于它的@ rbatt的想法。
library(zoo)
library(dplyr)
# create a long time series
start <- as.Date("1800-01-01")
end <- as.Date(Sys.Date())
df <- data.frame(V1 = seq.Date(start, end, by = "day"))
df$V2 <- sample(1:10, nrow(df), replace = T)
# make it an irregular time series by sampling 10000 rows
# including allowing for duplicates (replace = T)
df2 <- df %>%
sample_n(10000, replace = T)
# create 'complete' time series & join the data & compute the rolling median
df_rollmed <- data.frame(V1 = seq.Date(min(df$V1), max(df$V1), by = "day")) %>%
left_join(., df2) %>%
mutate(rollmed = rollapply(V2, 5, median, na.rm = T, align = "right", partial = T)) %>%
filter(!is.na(V2)) # throw out the NAs from the complete dataset
答案 5 :(得分：0)
我们可以使用base apply执行此操作，如下所示：
首先设置数据（基于@ g-grothendieck的注释）
library(data.table)
Lines <- "
date value
1/11/2011 5
1/11/2011 4
1/11/2011 2
8/11/2011 1
13/11/2011 0
14/11/2011 0
15/11/2011 0
18/11/2011 1
21/11/2011 4
5/12/2011 3
"
DT <- as.data.table(read.table(text = Lines, header = TRUE))
DT$date <- as.Date(DF$date, format = "%d/%m/%Y")
DT$row <- 1:NROW(DF)
setkey(DT, row, date) #mark columns as sorted, for speed
请注意，我在包含行号的数据表中添加了一个向量，以便我们可以将行号传递给apply函数。我还使用数据表来简化下一步的语法，并在将函数应用于大型数组时加速该函数。现在，我们使用apply如下：
roll.median.DT <- function(x){
this.date <- as.Date(x[1])
this.row <- as.numeric(x[3])
median(DT[row <= this.row & date >= (this.date-5)]$value) #NB DT is not defined within function, so it is found from parent scope
}
apply(DT, FUN=roll.median.DT, MARGIN = 1)
[1] 5.0 4.5 4.0 1.0 0.5 0.0 0.0 0.0 2.5 3.0
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？