4

私が使用している言語はRですが、質問に答えるために必ずしもRについて知っている必要はありません。

質問： グラウンドトゥルースと見なすことができるシーケンスと、最初のシーケンスのシフトバージョンであり、いくつかの値が欠落している別のシーケンスがあります。2つを揃える方法を知りたいのですが。

設定

ground.truth基本的に一連の時間であるシーケンスがあります。

ground.truth <- rep( seq(1,by=4,length.out=10), 5 ) +
                rep( seq(0,length.out=5,by=4*10+30), each=10 )

ground.truth私が次のことをしているときと考えてください。

{take a sample every 4 seconds for 10 times, then wait 30 seconds} x 5

2番目のシーケンスobservationsがあります。これは値の20％が欠落している状態でground.truth シフトされています。

nSamples <- length(ground.truth)
idx_to_keep <- sort(sample( 1:nSamples, .8*nSamples ))
theLag <- runif(1)*100
observations <- ground.truth[idx_to_keep] + theLag
nObs     <- length(observations)

これらのベクトルをプロットすると、次のようになります（覚えておいてください、これらを時間と考えてください）。

ここに画像の説明を入力してください

私が試したこと。私がしたい：

  • シフトを計算します（theLag上記の私の例では）
  • idx次のようなベクトルを計算しますground.truth[idx] == observations - theLag

まず、私たちが知っていると仮定しtheLagます。ground.truth[1]必ずしもそうではないことに注意してくださいobservations[1]-theLag。実際、私たちground.truth[1] == observations[1+lagI]-theLagはいくつかのために持っていlagIます。

ccfこれを計算するには、相互相関（関数）を使用すると思いました。

ただし、これを行うと、最大でラグが発生します。0の相互相関、つまりground.truth[1] == observations[1] - theLag。しかし、これを明示的に確認してobservations[1] - theLagいない 例でこれを試しましたground.truth[1]（つまり、idx_to_keep1が含まれていないことを確認するために変更します）。

シフトtheLagは相互相関に影響を与えないはずなので（そうではありませんccf(x,y) == ccf(x,y-constant)か？）、後で解決するつもりでした。

おそらく私は誤解しています。なぜなら、その中にobservationsはそれほど多くの値がないからground.truthですか？を設定したより単純なケースでもtheLag==0、相互相関関数は正しいラグを識別できないため、これは間違っていると考えています。

誰かが私がこれについて取り組むための一般的な方法論を持っていますか、または役立つかもしれないいくつかのR関数/パッケージを知っていますか？

どうもありがとう。

4

2 に答える 2

6

ラグについては、2つのポイントセット間のすべての差（距離）を計算できます。

diffs <- outer(observations, ground.truth, '-')

ラグは、次の時間に表示される値である必要がありますlength(observations)。

which(table(diffs) == length(observations))
# 55.715382960625 
#              86

再確認：

theLag
# [1] 55.71538

あなたが見つけたらあなたの質問の2番目の部分は簡単ですtheLag：

idx <- which(ground.truth %in% (observations - theLag))
于 2012-04-19T03:17:32.343 に答える
3

時系列が長すぎない場合は、次のように機能するはずです。

タイムスタンプの2つのベクトルがあり、2番目のベクトルは最初のベクトルのシフトされた不完全なコピーであり、どれだけシフトされたかを調べたいと考えています。

# Sample data
n <- 10
x <- cumsum(rexp(n,.1))
theLag <- rnorm(1)
y <- theLag + x[sort(sample(1:n, floor(.8*n)))]

考えられるすべてのラグを試すことができ、それぞれについて、観測された各タイムスタンプを最も近い「真実」のタイムスタンプと照合することにより、アライメントがどれほど悪いかを計算できます。

# Loss function
library(sqldf)
f <- function(u) {
  # Put all the values in a data.frame
  d1 <- data.frame(g="truth",    value=x)
  d2 <- data.frame(g="observed", value=y+u)
  d <- rbind(d1,d2)
  # For each observed value, find the next truth value
  # (we could take the nearest, on either side, 
  # but it would be more complicated)
  d <- sqldf("
    SELECT A.g, A.value, 
           ( SELECT MIN(B.value) 
             FROM   d AS B 
             WHERE  B.g='truth' 
             AND    B.value >= A.value
           ) AS next
    FROM   d AS A
    WHERE  A.g = 'observed'
  ")
  # If u is greater than the lag, there are missing values.
  # If u is smaller, the differences decrease 
  # as we approach the lag.
  if(any(is.na(d))) {
    return(Inf)
  } else {
    return( sum(d$`next` - d$value, na.rm=TRUE) )
  }
}

これで、最適なラグを検索できます。

# Look at the loss function
sapply( seq(-2,2,by=.1), f )

# Minimize the loss function.
# Change the interval if it does not converge, 
# i.e., if it seems in contradiction with the values above
# or if the minimum is Inf
(r <- optimize(f, c(-3,3)))
-r$minimum
theLag # Same value, most of the time
于 2012-04-19T03:14:43.173 に答える