R - нелинейный фильтр для временного ряда - фильтр, Lapply или цикл?

Question

У меня есть вектор, содержащий простые данные временных рядов (извлеченные из матрицы deSolve), который для целей тестирования может быть:

x <- c(1, 2, 3, 4, 5)

и хотел бы применить нелинейный фильтр

x[n]*x[n]-x[n-1]*x[n+1]

ко всем элементам вектора, кроме первого и последнего, потому что фильтр не может быть применен к этим двум элементам (например, когда термин x[n-1] соответствует первому элементу или термин x[n+1] соответствует последнему элементу).В этом и заключается моя проблема.

То, что я пробовал: 1) Команда filter() ожидает линейный фильтр (т.е. без умножения коэффициентов фильтра).2) lapply() требует, чтобы функция применялась ко всем элементам списка.

Является ли петля единственной альтернативой?

Спасибо за вашу помощь, Кэри

Answer 1

Можно сделать это с помощью цикла, применить или векторизовать.

> x <- c(1, 2, 3, 4, 5)
> r <- NA
> for (n in 2:length(x)) r[n] <- x[n]*x[n]-x[n-1]*x[n+1]
> (r)
[1] NA  1  1  1 NA
> 
> r <- NA
> lapply(2:length(x),function(n) r[n] <<- x[n]*x[n]-x[n-1]*x[n+1])
[[1]]
[1] 1

[[2]]
[1] 1

[[3]]
[1] 1

[[4]]
[1] NA

> (r)
[1] NA  1  1  1 NA

> r <- NA
> r <- x^2 - c(NA,x[1:(length(x)-1)]) * c(x[2:length(x)],NA)
> (r)
[1] NA  1  1  1 NA

векторизация наиболее эффективна, но код сложнее расшифровать

> x <- runif(50000)
> 
> r <- NA
> system.time(for (n in 2:length(x)) r[n] <- x[n]*x[n]-x[n-1]*x[n+1])
   user  system elapsed 
   8.55    0.01    8.58 
> 
> r <- NA
> system.time(lapply(2:length(x),function(n) r[n] <<- x[n]*x[n]-x[n-1]*x[n+1]))
   user  system elapsed 
  11.36    0.00   11.39 
> 
> r <- NA
> system.time(r <- x^2 - c(NA,x[1:(length(x)-1)]) * c(x[2:length(x)],NA))
   user  system elapsed 
   0.01    0.00    0.01 

Answer 2

1) Попробуйте rollapply в пакете зоопарка:

> library(zoo)
> rollapply(zoo(1:5), 3, function(x) x[2] * x[2] - x[1] * x[3])
2 3 4 
1 1 1 

coredata(z) дает часть данных, т.е. c(1, 1, 1), а time(z) дает часть времени, т.е. c(2, 3, 4).

2) Еще один способ сделать это в зоопарке:

> z <- zoo(1:5)
> z*z - lag(z) * lag(z,-1)
2 3 4 
1 1 1

3) Этот последний подход также работает в классе TS, найденном в ядре R:

> tt <- ts(1:5)
> tt * tt - lag(tt) * lag(tt, -1)
Time Series:
Start = 2 
End = 4 
Frequency = 1 
[1] 1 1 1