Ở những nơi khác trong chủ đề này, tôi đã đề xuất một giải pháp đơn giản nhưng hơi đặc biệt là lấy mẫu các điểm. Nó nhanh, nhưng đòi hỏi một số thử nghiệm để tạo ra những âm mưu lớn. Giải pháp sắp được mô tả là một thứ tự cường độ chậm hơn (mất tới 10 giây cho 1,2 triệu điểm) nhưng là thích ứng và tự động. Đối với các bộ dữ liệu lớn, lần đầu tiên nên cho kết quả tốt và thực hiện nhanh chóng hợp lý.
Dn , độ lệch dọc tối đa từ một đường được trang bị. Theo đó, thuật toán này là:
(x,y)ty
Có một số chi tiết cần quan tâm, đặc biệt là để đối phó với các bộ dữ liệu có độ dài khác nhau. Tôi làm điều này bằng cách thay thế cái ngắn hơn bằng số lượng tử tương ứng với số lượng dài hơn: thực tế, một phép tính gần đúng tuyến tính của EDF của cái ngắn hơn được sử dụng thay cho giá trị dữ liệu thực tế của nó. ("Ngắn hơn" và "dài hơn" có thể được đảo ngược bằng cách cài đặtuse.shortest=TRUE .)
Đây là một Rthực hiện.
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
}
Như một ví dụ, tôi sử dụng dữ liệu mô phỏng như trong câu trả lời trước đây của mình (với một ngoại lệ cực cao được ném vào yvà ô nhiễm hơn một chút trong xthời gian này):
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)
Hãy vẽ một số phiên bản, sử dụng các giá trị nhỏ hơn và nhỏ hơn của ngưỡng. Với giá trị 0,0005 và hiển thị trên màn hình cao 1000 pixel, chúng tôi sẽ đảm bảo sai số không lớn hơn một nửa pixel dọc ở mọi nơi trên lô. Điều này được thể hiện bằng màu xám (chỉ 522 điểm, được nối bởi các đoạn đường); các xấp xỉ thô hơn được vẽ trên đầu của nó: đầu tiên là màu đen, sau đó là màu đỏ (các điểm màu đỏ sẽ là một tập hợp con của các màu đen và overplot chúng), sau đó là màu xanh lam (một lần nữa là một tập hợp con và overplot). Khoảng thời gian từ 6,5 (xanh dương) đến 10 giây (xám). Vì chúng có tỷ lệ rất tốt, người ta có thể sử dụng khoảng một nửa pixel làm mặc định phổ biến cho ngưỡng ( ví dụ: 1/2000 cho màn hình cao 1000 pixel) và được thực hiện với nó.
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")
Biên tập
Tôi đã sửa đổi mã gốc qqđể trả về một cột chỉ mục thứ ba thành dài nhất (hoặc ngắn nhất, theo quy định) của hai mảng ban đầu xvà y, tương ứng với các điểm được chọn. Các chỉ mục này chỉ ra các giá trị "thú vị" của dữ liệu và do đó có thể hữu ích để phân tích thêm.
Tôi cũng đã loại bỏ một lỗi xảy ra với các giá trị lặp lại của x(nguyên nhân betakhông được xác định).
approx()chức năng này được sử dụng trongqqplot()chức năng.