이 질문은 시리즈가 규칙적이지만 다른 간격으로 샘플링 될 때 한 시계열 ( "확장")이 다른 시계열 ( "볼륨")보다 지연되는 양을 찾는 방법을 묻습니다 .
이 경우 두 시리즈 모두 그림과 같이 합리적으로 연속적인 동작을 나타냅니다. 이는 (1) 초기 스무딩이 거의 또는 전혀 필요하지 않으며 (2) 리샘플링은 선형 또는 2 차 보간만큼 간단 할 수 있음을 의미합니다. 매끄러움으로 인해 이차가 약간 더 나을 수 있습니다. 리샘플링 후 스레드에 표시된 것처럼 상호 상관을 최대화하여 지연을 찾습니다. 두 오프셋 샘플 데이터 계열의 경우 오프셋 간의 최적 추정치는 무엇입니까? .
설명하기R
위해, 의사 코드를 사용하여 질문에 제공된 데이터를 사용할 수 있습니다 . 기본 기능, 상호 상관 및 리샘플링으로 시작하겠습니다.
cor.cross <- function(x0, y0, i=0) {
#
# Sample autocorrelation at (integral) lag `i`:
# Positive `i` compares future values of `x` to present values of `y`';
# negative `i` compares past values of `x` to present values of `y`.
#
if (i < 0) {x<-y0; y<-x0; i<- -i}
else {x<-x0; y<-y0}
n <- length(x)
cor(x[(i+1):n], y[1:(n-i)], use="complete.obs")
}
이것은 조잡한 알고리즘입니다. FFT 기반 계산이 더 빠릅니다. 그러나 이러한 데이터 (약 4000 개의 값 포함)는 충분합니다.
resample <- function(x,t) {
#
# Resample time series `x`, assumed to have unit time intervals, at time `t`.
# Uses quadratic interpolation.
#
n <- length(x)
if (n < 3) stop("First argument to resample is too short; need 3 elements.")
i <- median(c(2, floor(t+1/2), n-1)) # Clamp `i` to the range 2..n-1
u <- t-i
x[i-1]*u*(u-1)/2 - x[i]*(u+1)*(u-1) + x[i+1]*u*(u+1)/2
}
데이터를 쉼표로 구분 된 CSV 파일로 다운로드하고 헤더를 제거했습니다. (헤더는 진단에 신경 쓰지 않은 R에 문제를 일으켰습니다.)
data <- read.table("f:/temp/a.csv", header=FALSE, sep=",",
col.names=c("Sample","Time32Hz","Expansion","Time100Hz","Volume"))
NB 이 솔루션은 각 일련의 데이터가 시간 순서대로되어 있고 어느 한 쪽에도 간격이 없다고 가정합니다. 이를 통해 인덱스를 시간에 대한 프록시로 값으로 사용하고 시간으로 변환하기 위해 시간 샘플링 주파수에 따라 인덱스를 스케일링 할 수 있습니다.
이 악기 중 하나 또는 둘 다 시간이 지남에 따라 약간 표류하는 것으로 나타났습니다. 계속하기 전에 이러한 추세를 제거하는 것이 좋습니다. 또한 끝에 볼륨 신호가 좁아 지므로 클립을 잘라 내야합니다.
n.clip <- 350 # Number of terminal volume values to eliminate
n <- length(data$Volume) - n.clip
indexes <- 1:n
v <- residuals(lm(data$Volume[indexes] ~ indexes))
expansion <- residuals(lm(data$Expansion[indexes] ~ indexes)
결과를 최대한 정확하게 얻기 위해 덜 빈번한 시리즈를 다시 샘플링합니다 .
e.frequency <- 32 # Herz
v.frequency <- 100 # Herz
e <- sapply(1:length(v), function(t) resample(expansion, e.frequency*t/v.frequency))
이제 상호 상관을 계산할 수 있습니다. 효율성을 위해 합리적인 지연 창만 검색하고 최대 값이 발견 된 지연을 식별 할 수 있습니다.
lag.max <- 5 # Seconds
lag.min <- -2 # Seconds (use 0 if expansion must lag volume)
time.range <- (lag.min*v.frequency):(lag.max*v.frequency)
data.cor <- sapply(time.range, function(i) cor.cross(e, v, i))
i <- time.range[which.max(data.cor)]
print(paste("Expansion lags volume by", i / v.frequency, "seconds."))
출력은 확장이 1.85 초만큼 볼륨보다 느리다는 것을 알려줍니다. (최근 3.5 초의 데이터가 클리핑되지 않은 경우 출력은 1.84 초입니다.)
가급적 시각적으로 여러 가지 방법으로 모든 것을 확인하는 것이 좋습니다. 먼저 상호 상관 함수 :
plot(time.range * (1/v.frequency), data.cor, type="l", lwd=2,
xlab="Lag (seconds)", ylab="Correlation")
points(i * (1/v.frequency), max(data.cor), col="Red", cex=2.5)
다음으로 두 시리즈를 시간에 등록 하고 동일한 좌표축에 함께 그려 봅시다 .
normalize <- function(x) {
#
# Normalize vector `x` to the range 0..1.
#
x.max <- max(x); x.min <- min(x); dx <- x.max - x.min
if (dx==0) dx <- 1
(x-x.min) / dx
}
times <- (1:(n-i))* (1/v.frequency)
plot(times, normalize(e)[(i+1):n], type="l", lwd=2,
xlab="Time of volume measurement, seconds", ylab="Normalized values (volume is red)")
lines(times, normalize(v)[1:(n-i)], col="Red", lwd=2)
꽤 좋아 보인다! 그러나 scatterplot을 사용하면 등록 품질을 더 잘 이해할 수 있습니다 . 진행 상황을 보여주기 위해 시간에 따라 색상이 다릅니다.
colors <- hsv(1:(n-i)/(n-i+1), .8, .8)
plot(e[(i+1):n], v[1:(n-i)], col=colors, cex = 0.7,
xlab="Expansion (lagged)", ylab="Volume")
우리는 선을 따라 앞뒤로 추적 할 요점을 찾고 있습니다. 그 변화는 볼륨 확장에 대한 시간 지연 반응의 비선형 성을 반영합니다. 약간의 변형이 있지만 상당히 작습니다. 그러나 시간이 지남에 따라 이러한 변화가 어떻게 변화 하는지 는 생리적으로 관심이있을 수 있습니다. 통계, 특히 탐색 및 시각적 측면에서 훌륭한 점은 유용한 질문 과 함께 좋은 질문 과 아이디어 를 만드는 경향이 있다는 것입니다.