26

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 パラメーターを使用して機能させるトリックがあると思われますが、それを理解することはできません。助けてくれてありがとう。

4

5 に答える 5

3

1) rollapply速度を確認していませんが、日付に複数のmax.dupオカレンスが含まれていない場合は、最後の 5 * max.dup エントリに過去 5 日間が含まれている必要があるため、fn以下に示す 1 行の関数が渡されます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化します。bab

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")
于 2015-11-24T13:10:36.667 に答える
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
于 2015-11-24T11:08:10.953 に答える