Question

我使用的语言是R，但您不一定需要知道R来回答这个问题。

问题： 我有一个序列可以被认为是基本事实，而另一个序列是第一个的移位版本，有一些缺失值。我想知道如何调整两者。

设置

我的序列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

我有第二个序列observations，ground.truth 已移位，其中20％的值丢失：

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)

如果我绘制这些矢量，这就是它的样子（请记住，将它们视为时间）：

enter image description here

我尝试过的。我想：

计算班次（我上例中的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_keep确保它没有1）。

转换theLag不应该影响互相关（不是ccf(x,y) == ccf(x,y-constant)？）所以我稍后会解决这个问题。

或许我误解了，因为observations中的ground.truth没有与theLag==0一样多的值？即使在我设置{{1}}的更简单的情况下，互相关函数仍然无法识别正确的滞后，这使我相信我正在考虑这个错误。

有没有人有一般的方法可以帮我解决这个问题，或者知道一些可以提供帮助的R函数/软件包？

非常感谢。

Answer 1

对于延迟，您可以计算两组点之间的所有差异（距离）：

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

您的滞后应该是length(observations)次出现的值：

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

仔细检查：

theLag
# [1] 55.71538

找到theLag后，问题的第二部分很简单：

idx <- which(ground.truth %in% (observations - theLag))

Answer 2

如果时间序列不太长，以下情况应该有效。

你有两个时间戳矢量，第二个是第一个的转移和不完整的副本，并且你想找到它移动了多少。

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

我们可以尝试所有可能的滞后，对于每一个，计算对齐有多糟糕，通过匹配每个观察到的时间戳与最近的时间戳＆＃34;真相＆＃34;时间戳。

# 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

将序列与缺失值对齐

2 个答案: