Di tempat lain di utas ini saya mengusulkan solusi sederhana namun agak ad hoc untuk mengamplas poin. Ini cepat, tetapi membutuhkan beberapa percobaan untuk menghasilkan plot yang bagus. Solusi yang akan dijelaskan adalah urutan besarnya lebih lambat (mengambil hingga 10 detik untuk 1,2 juta poin) tetapi bersifat adaptif dan otomatis. Untuk kumpulan data besar, itu harus memberikan hasil yang baik pertama kali dan melakukannya dengan cepat.
Dn
( x , y)ty
Ada beberapa detail yang harus diperhatikan, terutama untuk mengatasi dataset dengan panjang yang berbeda. Saya melakukan ini dengan mengganti yang lebih pendek dengan kuantil yang sesuai dengan yang lebih panjang: pada dasarnya, pendekatan linear piecewise dari EDF yang lebih pendek digunakan sebagai pengganti nilai data aktualnya. ("Lebih pendek" dan "lebih lama" dapat dibalik dengan pengaturan use.shortest=TRUE
.)
Berikut ini adalah R
implementasinya.
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
}
Sebagai contoh, saya menggunakan data yang disimulasikan seperti pada jawaban saya sebelumnya (dengan pencilan yang sangat tinggi yang dilemparkan ke dalam y
dan lebih banyak kontaminasi x
saat ini):
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)
Mari kita plot beberapa versi, menggunakan nilai ambang yang lebih kecil dan lebih kecil. Pada nilai .0005 dan ditampilkan pada monitor dengan tinggi 1000 piksel, kami akan menjamin kesalahan tidak lebih dari setengah piksel vertikal di mana-mana di plot. Ini ditampilkan dalam warna abu-abu (hanya 522 poin, bergabung dengan segmen garis); perkiraan kasar diplot di atasnya: pertama berwarna hitam, kemudian merah (titik merah akan menjadi subset dari yang hitam dan overplot), kemudian biru (yang lagi-lagi merupakan subset dan overplot). Rentang waktu mulai dari 6,5 (biru) hingga 10 detik (abu-abu). Mengingat bahwa mereka skala dengan sangat baik, orang mungkin menggunakan sekitar setengah-pixel sebagai standar universal untuk ambang ( misalnya , 1/2000 untuk monitor tinggi 1000-pixel) dan dilakukan dengan itu.
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")
Edit
Saya telah memodifikasi kode asli untuk qq
mengembalikan kolom indeks ketiga menjadi yang terpanjang (atau terpendek, sebagaimana ditentukan) dari dua array asli, x
dan y
, sesuai dengan poin yang dipilih. Indeks-indeks ini menunjuk ke nilai-nilai "menarik" dari data sehingga dapat berguna untuk analisis lebih lanjut.
Saya juga menghapus bug yang terjadi dengan nilai berulang x
(yang menyebabkan beta
tidak terdefinisi).
approx()
fungsinya ikut berperan dalamqqplot()
fungsi tersebut.