R xts – 重新采样不等时间步长xts到等距时间序列

2019年7月28日 289次阅读

我正在使用xts时间序列在R中工作.

是)我有的：
时间序列数据集具有不等间隔的时间步长.

我想得到什么：
具有等间隔时间步长的时间序列,其值对应于与时间步长重叠的原始值的比例(参见下面的示例).

示例：使用如下原始系列：

sample_xts <- as.xts(read.zoo(text='
2016-07-01 00:00:20,   0.0
2016-07-01 00:01:20,  60.0
2016-07-01 00:01:50,  30.0
2016-07-01 00:02:30,  40.0
2016-07-01 00:04:20, 110.0
2016-07-01 00:05:30, 140.0
2016-07-01 00:06:00,  97.0
2016-07-01 00:07:12, 144.0
2016-07-01 00:08:09,   0.0
', sep=',', index=1, tz='', format="%Y-%m-%d %H:%M:%S"))
names(sample_xts) <- c('x')

我想获得一个看起来像这样的等间隔时间序列：

                         x
2016-07-01 00:00:00,   0.0
2016-07-01 00:01:00,  40.0
2016-07-01 00:02:00,  60.0
2016-07-01 00:03:00,  60.0
2016-07-01 00:04:00,  60.0
2016-07-01 00:05:00, 100.0
2016-07-01 00:06:00, 157.0
2016-07-01 00:07:00, 120.0
2016-07-01 00:08:00,  24.0
2016-07-01 00:09:00,   0.0

注意：

>某些原始时间步长小于新时间步长
其他人更大.
> x的colSums保持不变(即621).

这是我用来创建上面例子的草图(可能有助于说明我想做的事情)：
《R xts – 重新采样不等时间步长xts到等距时间序列》

我想要的方法不仅限于创建1分钟的时间步骤系列,而且通常是任何固定的时间步长.

我已经查看了很多关于stackoverflow的q / a并尝试了许多不同的东西,但没有成功.

任何帮助将不胜感激！谢谢.

最佳答案 这是我用动物园编写的一些代码 – 我没有使用过多的xts所以我不知道是否可以应用相同的函数.希望有所帮助！

功能

对于原始数据的每个间隔,以下函数计算与给定间隔重叠的分数(注意：在以下所有代码中,变量名称ta1和ta2指的是给定时间间隔的开始和结束(例如,每个您需要作为输出的等间隔),而tb1和tb2指的是原始数据的(不相等)间隔的开始和结束)：

frac.overlap <- function(ta1,ta2,tb1,tb2){
if(tb1 <= ta1 & tb2 >= ta2) {   # Interval 2 starts earlier and ends later than interval 1
    frac <- as.numeric(difftime(ta2,ta1,units="secs"))/as.numeric(difftime(tb2,tb1,units="secs"))
} else if(tb1 >= ta1 & tb2 <= ta2) {    # Interval 2 is fully contained within interval 1
    frac <- 1
} else if(tb1 <= ta1 & tb2 >= ta1) {    # Interval 2 partly overlaps with interval 1 (starts earlier, ends earlier)
    frac <- as.numeric(difftime(tb2,ta1,units="secs"))/as.numeric(difftime(tb2,tb1,units="secs"))
} else if (tb1 <= ta2 & tb2 >= ta2){    # Interval 2 partly overlaps with interval 1 (starts later, ends later)
    frac <- as.numeric(difftime(ta2,tb1,units="secs"))/as.numeric(difftime(tb2,tb1,units="secs"))
        } else {                                # No overlap
            frac <- 0
    }

    return(frac)
}

下一个函数确定原始数据集的哪些记录与当前考虑的间隔ta1-ta2重叠：

check.overlap <- function(ta1,ta2,tb1,tb2){
ov <- vector("logical",4)
ov[1] <- (tb1 <= ta1 & tb2 >= ta2)  # Interval 2 starts earlier and ends later than interval 1
ov[2] <- (tb1 >= ta1 & tb2 <= ta2)  # Interval 2 is fully contained within interval 1
ov[3] <- (tb1 <= ta1 & tb2 >= ta1)  # Interval 2 partly overlaps with interval 1 (starts earlier, ends earlier)
ov[4] <- (tb1 <= ta2 & tb2 >= ta2)  # Interval 2 partly overlaps with interval 1 (starts later, ends later)
return(as.logical(sum(ov))) # Gives TRUE if at least one element of ov is TRUE, otherwise FALSE
}

(注意：这适用于您提供的示例数据,但是在更大的数据集上,我发现它非常慢.因为我编写此代码以定时时间步重新采样时间序列,所以我通常使用固定的时间间隔来完成此步骤,速度要快得多.修改代码(参见下一个函数的代码)可能很容易,根据原始数据的间隔加快此步骤.)

下一个函数使用前两个函数计算间隔ta1-ta2的重采样值：

fracres <- function(tstart,interval,input){
# tstart: POSIX object
# interval: length of interval in seconds
# input: zoo object

ta1 <- tstart
ta2 <- tstart + interval

# First, determine which records of the original data (input) overlap with the current
# interval, to avoid going through the whole object at every iteration
ind <- index(input)
ind1 <- index(lag(input,-1))
recs <- which(sapply(1:length(ind),function(x) check.overlap(ta1,ta2,ind[x],ind1[x])))
#recs <- which(abs(as.numeric(difftime(ind,ta1,units="secs"))) < 601)


# For each record overlapping with the current interval, return the fraction of the input data interval contained in the current interval
if(length(recs) > 0){
    fracs <- sapply(1:length(recs), function(x) frac.overlap(ta1,ta2,ind[recs[x]],ind1[recs[x]]))
    return(sum(coredata(input)[recs]*fracs))

} else {
    return(0)
}
}

(如果已知原始时间步骤和新时间步长之间的最大时间差,则注释掉的行显示如何获取相关记录.)

应用

首先,让我们将您的示例数据作为zoo对象读入：

sample_zoo <- read.zoo(text='
2016-07-01 00:00:20,   0.0
2016-07-01 00:01:20,  60.0
2016-07-01 00:01:50,  30.0
2016-07-01 00:02:30,  40.0
2016-07-01 00:04:20, 110.0
2016-07-01 00:05:30, 140.0
2016-07-01 00:06:00,  97.0
2016-07-01 00:07:12, 144.0
2016-07-01 00:08:09,   0.0
', sep=',', index=1, tz='', format="%Y-%m-%d %H:%M:%S")

看起来您的数据集包含瞬时值(“在01:20,x的值为60”).由于我为求和值编写了此代码,因此时间戳的含义不同(“从01:20开始的记录的值为60”).要纠正这个问题,需要转移记录：

sample_zoo <- lag(sample_zoo,1)

然后,我们定义一个对应于所需分辨率的POSIXct对象序列：

time.out <- seq.POSIXt(from=as.POSIXct("2016-07-01"),to=(as.POSIXct("2016-07-01")+(60*9)),by="1 min")

然后我们可以应用上面描述的函数fracres：

data.out <- sapply(1:length(time.out), function(x) fracres(tstart=time.out[x],interval=60,input=sample_zoo))

索引和数据组合到一个zoo对象：

zoo.out <- read.zoo(data.frame(time.out,data.out))

最后,时间序列再次向前移动一步,与之前的方向相反：

zoo.out <- lag(zoo.out,-1)

2016-07-01 00:01:00 2016-07-01 00:02:00 2016-07-01 00:03:00 2016-07-01 00:04:00 2016-07-01 00:05:00 2016-07-01 00:06:00 2016-07-01 00:07:00 2016-07-01 00:08:00 2016-07-01 00:09:00 
             40                  60                  60                  60                 100                 157                 120                  24                   0
点赞