QQ grafiğinin merkezine yakın yabancı noktaların kaldırılması

Ben (qqplot kullanarak ve ggplot2 içine veri besleme), R yaklaşık 1.2 milyon puanlık iki veri seti ile bir QQ-komplo çizmek çalışıyorum. Hesaplama yeterince kolaydır, ancak sonuçta ortaya çıkan grafiğin yüklenmesi oldukça yavaştır, çünkü çok fazla nokta vardır. 10000 sayısını azaltmak için doğrusal yaklaşım denedim (veri kümeleriniz diğerinden daha büyükse, qqplot işlevinin yaptığı şey budur), ancak daha sonra kuyruklarda çok fazla ayrıntı kaybedersiniz.

Merkeze doğru veri noktalarının çoğu temelde işe yaramaz - o kadar çok örtüşürler ki, muhtemelen piksel başına yaklaşık 100 vardır. Kuyruklara karşı daha seyrek verileri kaybetmeden birbirine çok yakın olan verileri kaldırmanın basit bir yolu var mı?

QQ grafikleri kuyruklar dışında inanılmaz derecede otokorelasyonlu. Onları incelerken, arsanın genel şekli ve kuyruk davranışı üzerinde durulur. Ergo , dağıtımların merkezlerinde kabaca alt örnekleme yaparak ve yeterli sayıda kuyruk ekleyerek iyi yapacaksınız .

Burada, tüm veri kümesinde nasıl örnekleme yapılacağını ve uç değerlerin nasıl alınacağını gösteren kod verilmiştir.

quant.subsample <- function(y, m=100, e=1) {
  # m: size of a systematic sample
  # e: number of extreme values at either end to use
  x <- sort(y)
  n <- length(x)
  quants <- (1 + sin(1:m / (m+1) * pi - pi/2))/2
  sort(c(x[1:e], quantile(x, probs=quants), x[(n+1-e):n]))
  # Returns m + 2*e sorted values from the EDF of y
}

Örneklemek gerekirse, bu simüle edilmiş veri seti, yaklaşık 1.2 milyon değere sahip iki veri kümesi ile bunlardan birinde çok az miktarda "kontaminasyon" arasında yapısal bir fark göstermektedir. Ayrıca, bu testi katı hale getirmek için, veri kümelerinden birinden bir değer aralığı tamamen hariç tutulur: QQ grafiğinin bu değerler için bir kopma göstermesi gerekir.

set.seed(17)
n.x <- 1.21 * 10^6
n.y <- 1.20 * 10^6
k <- floor(0.0001*n.x)
x <- c(rnorm(n.x-k), rnorm(k, mean=2, sd=2))
x <- x[x <= -3 | x >= -2.5]
y <- rbeta(n.y, 10,13)

Her veri kümesinin% 0.1'ini alt örnekleyebilir ve uç noktalarının% 0.1'ini daha ekleyebiliriz ve çizmek için 2420 puan veririz. Toplam geçen süre 0,5 saniyeden az:

m <- .001 * max(n.x, n.y)
e <- floor(0.0005 * max(n.x, n.y))

system.time(
  plot(quant.subsample(x, m, e), 
       quant.subsample(y, m, e), 
       pch=".", cex=4,
       xlab="x", ylab="y", main="QQ Plot")
  )

Hiçbir bilgi kaybolmaz:

Bu iş parçacığının başka yerlerinde , noktaları alt örneklemenin basit ama biraz ad hoc bir çözümünü önerdim . Hızlıdır, ancak harika araziler üretmek için bazı deneyler gerektirir. Açıklanacak olan çözüm, daha yavaş bir büyüklük sırasıdır (1.2 milyon nokta için 10 saniyeye kadar sürebilir), ancak uyarlanabilir ve otomatiktir. Büyük veri kümeleri için, ilk kez iyi sonuçlar vermeli ve bunu hızlı bir şekilde makul bir şekilde yapmalıdır.

Fikir, QQ grafiğinin özelliklerine uyarlanmış Douglas-Peucker çoklu çizgi sadeleştirme algoritmasıdır. Böyle bir arsa için ilgili istatistik , monte edilmiş bir çizgiden maksimum dikey sapma olan Kolmogorov-Smirnov istatistiği . Buna göre, algoritma şudur:$D_n$

çiftlerinin ekstremalarını birleştiren çizgi ile QQ grafiği arasındaki maksimum dikey sapmayı bulun . Bu, tüm aralığının kabul edilebilir bir kısmı içindeyse , grafiği bu çizgi ile değiştirin. Aksi takdirde, verileri maksimum dikey sapma noktasından önceki ve sonraki sapmalara bölün ve algoritmayı iki parçaya tekrar tekrar uygulayın.t $(x,y)$$t$$y$

Özellikle farklı uzunluktaki veri kümeleriyle başa çıkmak için bazı ayrıntılar vardır. Bunu daha kısa olanı daha uzun olana karşılık gelen niceliklerle değiştirerek yaparım: aslında, gerçek veri değerleri yerine daha kısa olanın EDF'sinin parçalı doğrusal bir yaklaşımı kullanılır. ("Daha kısa" ve "daha uzun" ayarlanarak ters çevrilebilir use.shortest=TRUE.)

İşte bir Ruygulama.

qq <- function(x0, y0, t.y=0.0005, use.shortest=FALSE) {
  qq.int <- function(x,y, i.min,i.max) {
    # x, y are sorted and of equal length
    n <-length(y)
    if (n==1) return(c(x=x, y=y, i=i.max))
    if (n==2) return(cbind(x=x, y=y, i=c(i.min,i.max)))
    beta <- ifelse( x[1]==x[n], 0, (y[n] - y[1]) / (x[n] - x[1]))
    alpha <- y[1] - beta*x[1]
    fit <- alpha + x * beta
    i <- median(c(2, n-1, which.max(abs(y-fit))))
    if (abs(y[i]-fit[i]) > thresh) {
      assemble(qq.int(x[1:i], y[1:i], i.min, i.min+i-1), 
               qq.int(x[i:n], y[i:n], i.min+i-1, i.max))
    } else {
      cbind(x=c(x[1],x[n]), y=c(y[1], y[n]), i=c(i.min, i.max))
    }
  }
  assemble <- function(xy1, xy2) {
    rbind(xy1, xy2[-1,])
  }
  #
  # Pre-process the input so that sorting is done once
  # and the most detail is extracted from the data.
  #
  is.reversed <- length(y0) < length(x0)
  if (use.shortest) is.reversed <- !is.reversed
  if (is.reversed) {
    y <- sort(x0)
    n <- length(y)
    x <- quantile(y0, prob=(1:n-1)/(n-1))    
  } else {
    y <- sort(y0)
    n <- length(y)
    x <- quantile(x0, prob=(1:n-1)/(n-1))    
  }
  #
  # Convert the relative threshold t.y into an absolute.
  #
  thresh <- t.y * diff(range(y))
  #
  # Recursively obtain points on the QQ plot.
  #
  xy <- qq.int(x, y, 1, n)
  if (is.reversed) cbind(x=xy[,2], y=xy[,1], i=xy[,3]) else xy
}

Örnek olarak, daha önceki cevabımda olduğu gibi simüle edilmiş verileri kullanıyorum (aşırı yüksek bir aykırı değer atıldı yve xbu süre içinde biraz daha fazla kirlenme ):

set.seed(17)
n.x <- 1.21 * 10^6
n.y <- 1.20 * 10^6
k <- floor(0.01*n.x)
x <- c(rnorm(n.x-k), rnorm(k, mean=2, sd=2))
x <- x[x <= -3 | x >= -2.5]
y <- c(rbeta(n.y, 10,13), 1)

Eşiğin daha küçük ve daha küçük değerlerini kullanarak birkaç sürümü çizelim. .0005 değerinde ve 1000 piksel yüksekliğinde bir monitörde görüntüleniyorsa , arsa üzerinde her yerde dikey pikselin yarısından daha fazla olmayan bir hata garanti ediyoruz . Bu gri renkte gösterilir (yalnızca 522 nokta, çizgi parçalarıyla birleştirilir); daha kaba tahminler üstüne çizilir: önce siyah, daha sonra kırmızı (kırmızı noktalar siyah olanların bir alt kümesi olacak ve bunları çizecektir), sonra mavi (yine bir alt küme ve overplot). Zamanlamalar 6,5 (mavi) ila 10 saniye (gri) arasında değişir. Çok iyi ölçeklendikleri göz önüne alındığında, eşik için evrensel bir varsayılan olarak yaklaşık yarım piksel de kullanılabilir ( örneğin , 1000 piksel yüksek monitör için 1/2000) ve onunla yapılabilir.

qq.1 <- qq(x,y)
plot(qq.1, type="l", lwd=1, col="Gray",
     xlab="x", ylab="y", main="Adaptive QQ Plot")
points(qq.1, pch=".", cex=6, col="Gray")
points(qq(x,y, .01), pch=23, col="Black")
points(qq(x,y, .03), pch=22, col="Red")
points(qq(x,y, .1), pch=19, col="Blue")

Düzenle

qqOrijinal iki dizinin en uzun (veya belirtildiği gibi en kısa) xve yseçilen noktalara karşılık gelen üçüncü bir dizin sütunu döndürmek için özgün kodu değiştirdim . Bu indeksler verinin "ilginç" değerlerine işaret eder ve bu nedenle daha ileri analizler için yararlı olabilir.

Ayrıca tekrarlanan değerleri ile oluşan bir hata kaldırıldı x( betatanımsız olmasına neden oldu).

Ortadaki bazı veri noktalarının kaldırılması ampirik dağılımı ve dolayısıyla qqplot'u değiştirir. Bununla birlikte, ampirik dağılımın miktarlarını ve teorik dağılımın miktarlarını doğrudan çizebilirsiniz:

x <- rnorm(1200000)
mean.x <- mean(x)
sd.x <- sd(x)
quantiles.x <- quantile(x, probs = seq(0,1,b=0.000001))
quantiles.empirical <- qnorm(seq(0,1,by=0.000001),mean.x,sd.x)
plot(quantiles.x~quantiles.empirical) 

Kuyruğa ne kadar derin girmek istediğinize bağlı olarak sırayı ayarlamanız gerekecektir. Zeki olmak istiyorsanız, arsa hızlandırmak için ortadaki diziyi inceltebilirsiniz. Örneğin

plogis(seq(-17,17,by=.1))

bir olasılıktır.

Bir hexbinkomplo yapabilirsin.

x <- rnorm(1200000)
mean.x <- mean(x)
sd.x <- sd(x)
quantiles.x <- quantile(x, probs = seq(0,1,b=0.000001))
quantiles.empirical <- qnorm(seq(0,1,by=0.000001),mean.x,sd.x)

library(hexbin)
bin <- hexbin(quantiles.empirical[-c(1,length(quantiles.empirical))],quantiles.x[-c(1,length(quantiles.x))],xbins=100)
plot(bin)

Başka bir alternatif, paralel bir kutu çizimidir; iki veri kümeniz olduğunu söylediniz, yani:

y <- rnorm(1200000)
x <- rnorm(1200000)
grpx <- cut(y,20)
boxplot(y~grpx)

ve verilerinizle daha iyi hale getirmek için çeşitli seçenekleri ayarlayabilirsiniz.