En otra parte de este hilo propuse una solución simple pero algo ad hoc de submuestreo de puntos. Es rápido, pero requiere algo de experimentación para producir grandes parcelas. La solución a punto de describirse es un orden de magnitud más lento (que demora hasta 10 segundos por 1.2 millones de puntos) pero es adaptativo y automático. Para grandes conjuntos de datos, debería dar buenos resultados la primera vez y hacerlo razonablemente rápido.
renorte , la desviación vertical máxima de una línea ajustada. En consecuencia, el algoritmo es este:
( x , y)ty , reemplace la gráfica con esta línea. De lo contrario, divida los datos en los que preceden al punto de máxima desviación vertical y los que siguen y aplique el algoritmo recursivamente a las dos piezas.
Hay algunos detalles a tener en cuenta, especialmente para hacer frente a conjuntos de datos de diferente longitud. Hago esto reemplazando el más corto por los cuantiles correspondientes al más largo: en efecto, se usa una aproximación lineal por partes del FED del más corto en lugar de sus valores de datos reales. ("Más corto" y "más largo" se pueden revertir configurandouse.shortest=TRUE
).
Aquí hay una R
implementació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
}
Como ejemplo, uso datos simulados como en mi respuesta anterior (con un valor atípico extremadamente alto y
y bastante más contaminación en x
este momento):
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)
Tracemos varias versiones, utilizando valores cada vez más pequeños del umbral. Con un valor de .0005 y que se muestra en un monitor de 1000 píxeles de altura, estaríamos garantizando un error de no más de la mitad de un píxel vertical en todas partes del gráfico. Esto se muestra en gris (solo 522 puntos, unidos por segmentos de línea); las aproximaciones más gruesas se trazan en la parte superior: primero en negro, luego en rojo (los puntos rojos serán un subconjunto de los negros y los trazarán en exceso), luego en azul (que nuevamente son un subconjunto y una sobreparcela). Los tiempos varían de 6.5 (azul) a 10 segundos (gris). Dado que escalan tan bien, uno podría usar aproximadamente medio píxel como valor predeterminado universal para el umbral ( por ejemplo , 1/2000 para un monitor de 1000 píxeles de altura) y terminar con él.
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")
Editar
He modificado el código original para qq
devolver una tercera columna de índices en la más larga (o más corta, como se especifica) de las dos matrices originales, x
yy
, correspondiente a los puntos que se seleccionan. Estos índices apuntan a valores "interesantes" de los datos y, por lo tanto, podrían ser útiles para su posterior análisis.
También eliminé un error que ocurría con valores repetidos de x
(que causaban beta
ser indefinidos).
approx()
función entra en juego en laqqplot()
función.