Bu tür gürültülerin üstesinden gelmenin basit ve sağlam bir yöntemi, medyanları hesaplamaktır.

Kısa bir pencerede yuvarlanan bir medyan, en küçük sıçramalar dışında tümünü algılarken, algılanan sıçramalar arasındaki aralıklar içindeki yanıtın ortancaları bunların seviyelerini sağlam bir şekilde tahmin eder. (Bu ikinci tahmini, aykırı değerlerden etkilenmeyen herhangi bir sağlam tahminle değiştirebilirsiniz.)

Kabul edilebilir hata oranlarına ulaşmak için bu yaklaşımı gerçek veya simüle edilmiş verilerle ayarlamalısınız. Örneğin, sorudaki simülasyon için, atlamaları algılamak için eşikleri ayarlamak için ikinci ve 98. yüzdelik dilimleri kullanmayı iyi buldum. Diğer durumlarda - örneğin çok sayıda sıçramanın meydana gelebileceği durumlarda - daha merkezi yüzdelik dilim daha iyi çalışır.

İşte (a) üç sıçramayı kırmızı noktalar olarak ve (b) tahmini dört seviyeyi açık mavi çizgiler olarak gösteren sonuç.

Sıçramaların 100, 200, 250 dizinlerinde (simülasyonun meydana geldiği yer tam olarak budur) gerçekleşeceği tahmin edilmektedir ve sonuçta elde edilen düzeyler 199,6, 249,8, 300,0 ve 250,2 olarak tahmin edilmektedir: tümü gerçek temelin 0,4'ü içinde değerler.

Bu mükemmel davranış, tekrarlanan simülasyonlarla devam eder (başlangıçta set.seed komutunun kaldırılması).

İşte R kodu.

  #
# Yuvarlanan medyanlar.
#
<- fonksiyonu (x, k = 3) {
  n <- uzunluk (x)
  x.med <- sapply (1: (n-k + 10), işlev (i) medyan (x [i + 0: (k-1)]))
  l <- kat (k / 2)
  c (rep (NA, l), x.med, rep (NA, k-l))
}
y.med <- rollmed (y, k = 5)
#
# Değişiklik noktası analizi.
#
dy <- diff (y.med)
dördüncü <- kuantil (dy, c (1,49) / 50, na.rm = DOĞRU)
eşikler <- dördüncü + fark (dördüncüsü) * 2,5 * c (-1,1)
<- atlar (dy < eşikleri [1] | dy > eşikleri [2]) + 1

noktalar (atlamalar, y.med [atlamalar], pch = 21, bg = "Kırmızı")
#
# Çizim.
#
limitler <- c (1, atlamalar, uzunluk (y) +1)
y.hat <- rep (NA, uzunluk (atlamalar) +1)
for (i in 1: (length (atlar) +1)) {
  j0 <- sınırlar [i]
  j1 <- sınırlar [i + 1] -1
  y.hat [i] <- medyan (y [j0: j1])
  çizgiler (x [j0: j1], rep (y.hat [i], j1-j0 + 1), col = "skyblue", lwd = 2)
}
 

L0 cezalarıyla düzeltmeyle hala ilgileniyorsanız, şu referansa bir göz atacağım: "Genomik Değişikliklerin L0 Cezası Kullanılarak Segmentlere Ayrılmış Düzeltme ile Görselleştirilmesi" - DOI: 10.1371 / journal.pone.0038230 (güzel bir Whittaker pürüzsüzlüğüne giriş P. Eilers kağıt "Mükemmel pürüzsüzlükte" - DOI: 10.1021 / ac034173t) bulunabilir. Elbette, hedefinize ulaşmak için yöntem etrafında biraz çalışmanız gerekir.

Prensip olarak 3 malzemeye ihtiyacınız var:

1. Daha pürüzsüz - Whittaker'ı daha pürüzsüz kullanırdım. Ayrıca, matris büyütmeyi kullanacağım (bkz.Eilers ve Marx, 1996 - "B-spline'lar ile Esnek Düzeltme ve Cezalar ", s.101).
2. Nicelik regresyonu - Tembellik için R paketi quantreg (rho = 0.5) kullanacağım :-)
3. L0-ceza - Bahsedilen "Genomik Değişikliklerin L0 Cezası Kullanılarak Segmentlere Ayrılmış Düzeltme ile Görselleştirilmesi" ni takip edeceğim - DOI: 10.1371 / journal.pone.0038230

Elbette, en uygun düzleştirme miktarını seçmenin de bir yolunu bulmanız gerekir. Bu örnek için marangoz gözlerim tarafından yapıldı. DOI: 10.1371 / journal.pone.0038230'daki ölçütleri kullanabilirsiniz (sf. 5, ancak sizin örneğinizde denemedim).

Aşağıda küçük bir kod bulacaksınız. Yol göstermesi için bazı yorumlar bıraktım.

  # Çapraz Doğrulanmış örnek
rm (liste = ls ()); graphics.off (); kedi ("\ 014")

kitaplık (eğri çizgiler)
kütüphane (Matrix)
kütüphane (quantreg)

# Veri
set.seed (20181118)
n = 400
x = 1: n
true_fct = stepfun (c (100, 200, 250), c (200, 250, 300, 250))
y = true_fct (x) + rt (uzunluk (x), df = 1)

# Bazları hazırlayın - Kimlik matrisi (Whittaker)
# B-spline'lar için değiştirilebilir
B = diag (1, n, n)

# Ceza hazırlayın - lambda parametresi düzeltmesi
nb = ncol (B)
D = fark (diag (1, nb, nb), fark = 1)
lambda = 1e2

# Standart Whittaker'ı çözün - başlangıç ​​değerleri için
a = çöz (t (B)% *% B + çapraz kanal (D), t (B)% *% y, tol = 1e-50)

DOI: 10.1371 / journal.pone.0038230'daki gibi L0-Diff cezalı tahmini döngü
p = 1e-6
nit = 100
beta = 1e-5

for (it in 1: nit) {
  ao = a

  # Ceza ağırlıkları
w = (c (D% *% a) ^ 2 + beta ^ 2) ^ ((p - 2) / 2)
  W = diag (c (w))

  # Matris büyütme
  cD = lambda * sqrt (W)% *% D
  Bp = rbind (B, cD)
  yp = c (y, 1: nrow (cD) * 0)

  # Katsayıları güncelle - Quantreg'den rq.fit
  a = rq.fit (Bp, yp, tau = 0.5) $ coef

  # Yakınsamayı kontrol edin ve güncelleyin
  da = max (abs ((a - ao) / ao))
  kedi (o, da, '\ n')
  eğer (da < 1e-6) kırılırsa
}

# Uygun
v = B% *% a

# Sonuçları göster
arsa (x, y, pch = 16, cex = 0.5)
çizgiler (x, y, col = 8, lwd = 0.5)
çizgiler (x, v, col = 'blue', lwd = 2)
çizgiler (x, true_fct (x), col = 'red', lty = 2, lwd = 2)
açıklama ("topright", açıklama = c ("Gerçek Sinyal", "Düzleştirilmiş sinyal"),
       col = c ("kırmızı", "mavi"), lty = c (2, 1))
 

PS.Bu, Çapraz Doğrulamayla ilgili ilk cevabım.Umarım yeterince yararlı ve anlaşılırdır :-)

Ruey Tsay'in kağıt Aykırı Değerlerini, seviye değişimlerini ve zaman serilerindeki varyans değişikliklerini AR1 ve 21 aykırı değerlere sahip Fark modelini kullanmayı düşünürdüm.

Farklılıkları kapattık ve özellikle seviye değişimleri çağrıldı.