下面是我用zoo
寫的一些代碼 - 我還沒有使用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
Thanks @ m.chips!最後在我的實時系列中嘗試了這一點。完美的作品,但是,是的,正如你所指出的那樣,即使是很短的系列,它也會變得「過於緩慢」。看起來,執行時間與系列的長度不成比例地增長 - 按指數或2^N。我的系列有30萬到1萬。觀察靈感來自你的算法,我決定嘗試別的。在下面的帖子中回答問題。 –