Veo que MerseyViking ha recomendado un quadtree . Iba a sugerir lo mismo y para explicarlo, aquí está el código y un ejemplo. El código está escrito Rpero debe portarse fácilmente a, por ejemplo, Python.
La idea es notablemente simple: divida los puntos aproximadamente a la mitad en la dirección x, luego divida recursivamente las dos mitades a lo largo de la dirección y, alternando las direcciones en cada nivel, hasta que no se desee más división.
Debido a que la intención es disfrazar ubicaciones de puntos reales, es útil introducir algo de aleatoriedad en las divisiones . Una manera rápida y sencilla de hacer esto es dividir en un conjunto de cuantiles una pequeña cantidad aleatoria del 50%. De esta manera (a) es poco probable que los valores de división coincidan con las coordenadas de datos, de modo que los puntos caerán únicamente en cuadrantes creados por la partición, y (b) las coordenadas de puntos serán imposibles de reconstruir con precisión a partir del quadtree.
Debido a que la intención es mantener una cantidad mínima kde nodos dentro de cada hoja de quadtree, implementamos una forma restringida de quadtree. Admitirá (1) puntos de agrupamiento en grupos que tienen entre k2 y k-1 elementos cada uno y (2) mapeo de los cuadrantes.
Este Rcódigo crea un árbol de nodos y hojas terminales, distinguiéndolos por clase. El etiquetado de la clase agiliza el procesamiento posterior, como el trazado, que se muestra a continuación. El código usa valores numéricos para los identificadores. Esto funciona hasta profundidades de 52 en el árbol (usando dobles; si se usan enteros largos sin signo, la profundidad máxima es 32). Para árboles más profundos (que son altamente improbables en cualquier aplicación, porque al menos k* 2 ^ 52 puntos estarían involucrados), los identificadores deberían ser cadenas.
quadtree <- function(xy, k=1) {
d = dim(xy)[2]
quad <- function(xy, i, id=1) {
if (length(xy) < 2*k*d) {
rv = list(id=id, value=xy)
class(rv) <- "quadtree.leaf"
}
else {
q0 <- (1 + runif(1,min=-1/2,max=1/2)/dim(xy)[1])/2 # Random quantile near the median
x0 <- quantile(xy[,i], q0)
j <- i %% d + 1 # (Works for octrees, too...)
rv <- list(index=i, threshold=x0,
lower=quad(xy[xy[,i] <= x0, ], j, id*2),
upper=quad(xy[xy[,i] > x0, ], j, id*2+1))
class(rv) <- "quadtree"
}
return(rv)
}
quad(xy, 1)
}
Tenga en cuenta que el diseño recursivo de divide y vencerás de este algoritmo (y, en consecuencia, de la mayoría de los algoritmos de procesamiento posterior) significa que el requisito de tiempo es O (m) y el uso de RAM es O (n), donde mes el número de celdas y nes el número de puntos. mes proporcional a ndividido por los puntos mínimos por celda,k. Esto es útil para estimar los tiempos de cálculo. Por ejemplo, si se tarda 13 segundos en dividir n = 10 ^ 6 puntos en celdas de 50-99 puntos (k = 50), m = 10 ^ 6/50 = 20000. Si lo desea, en cambio, particione a 5-9 puntos por celda (k = 5), m es 10 veces más grande, por lo que el tiempo sube a unos 130 segundos. (Debido a que el proceso de dividir un conjunto de coordenadas alrededor de su centro se hace más rápido a medida que las celdas se hacen más pequeñas, el tiempo real fue de solo 90 segundos). Para llegar a k = 1 punto por celda, tomará aproximadamente seis veces más aún, o nueve minutos, y podemos esperar que el código sea un poco más rápido que eso.
Antes de continuar, generemos algunos datos interesantes espaciados irregularmente y creemos su quadtree restringido (tiempo transcurrido de 0.29 segundos):
Aquí está el código para producir estas parcelas. Explota Rel polimorfismo: points.quadtreese llamará siempre que la pointsfunción se aplique a un quadtreeobjeto, por ejemplo. El poder de esto es evidente en la extrema simplicidad de la función para colorear los puntos de acuerdo con su identificador de grupo:
points.quadtree <- function(q, ...) {
points(q$lower, ...); points(q$upper, ...)
}
points.quadtree.leaf <- function(q, ...) {
points(q$value, col=hsv(q$id), ...)
}
Trazar la cuadrícula en sí es un poco más complicado porque requiere el recorte repetido de los umbrales utilizados para la partición de quadtree, pero el mismo enfoque recursivo es simple y elegante. Use una variante para construir representaciones poligonales de los cuadrantes si lo desea.
lines.quadtree <- function(q, xylim, ...) {
i <- q$index
j <- 3 - q$index
clip <- function(xylim.clip, i, upper) {
if (upper) xylim.clip[1, i] <- max(q$threshold, xylim.clip[1,i]) else
xylim.clip[2,i] <- min(q$threshold, xylim.clip[2,i])
xylim.clip
}
if(q$threshold > xylim[1,i]) lines(q$lower, clip(xylim, i, FALSE), ...)
if(q$threshold < xylim[2,i]) lines(q$upper, clip(xylim, i, TRUE), ...)
xlim <- xylim[, j]
xy <- cbind(c(q$threshold, q$threshold), xlim)
lines(xy[, order(i:j)], ...)
}
lines.quadtree.leaf <- function(q, xylim, ...) {} # Nothing to do at leaves!
Como otro ejemplo, generé 1,000,000 de puntos y los dividí en grupos de 5-9 cada uno. El tiempo fue de 91.7 segundos.
n <- 25000 # Points per cluster
n.centers <- 40 # Number of cluster centers
sd <- 1/2 # Standard deviation of each cluster
set.seed(17)
centers <- matrix(runif(n.centers*2, min=c(-90, 30), max=c(-75, 40)), ncol=2, byrow=TRUE)
xy <- matrix(apply(centers, 1, function(x) rnorm(n*2, mean=x, sd=sd)), ncol=2, byrow=TRUE)
k <- 5
system.time(qt <- quadtree(xy, k))
#
# Set up to map the full extent of the quadtree.
#
xylim <- cbind(x=c(min(xy[,1]), max(xy[,1])), y=c(min(xy[,2]), max(xy[,2])))
plot(xylim, type="n", xlab="x", ylab="y", main="Quadtree")
#
# This is all the code needed for the plot!
#
lines(qt, xylim, col="Gray")
points(qt, pch=".")
Como un ejemplo de cómo interactuar con un SIG , escribamos todas las celdas del árbol cuádruple como un shapefilesarchivo de forma poligonal usando la biblioteca. El código emula las rutinas de recorte de lines.quadtree, pero esta vez tiene que generar descripciones vectoriales de las celdas. Estos se generan como marcos de datos para usar con la shapefilesbiblioteca.
cell <- function(q, xylim, ...) {
if (class(q)=="quadtree") f <- cell.quadtree else f <- cell.quadtree.leaf
f(q, xylim, ...)
}
cell.quadtree <- function(q, xylim, ...) {
i <- q$index
j <- 3 - q$index
clip <- function(xylim.clip, i, upper) {
if (upper) xylim.clip[1, i] <- max(q$threshold, xylim.clip[1,i]) else
xylim.clip[2,i] <- min(q$threshold, xylim.clip[2,i])
xylim.clip
}
d <- data.frame(id=NULL, x=NULL, y=NULL)
if(q$threshold > xylim[1,i]) d <- cell(q$lower, clip(xylim, i, FALSE), ...)
if(q$threshold < xylim[2,i]) d <- rbind(d, cell(q$upper, clip(xylim, i, TRUE), ...))
d
}
cell.quadtree.leaf <- function(q, xylim) {
data.frame(id = q$id,
x = c(xylim[1,1], xylim[2,1], xylim[2,1], xylim[1,1], xylim[1,1]),
y = c(xylim[1,2], xylim[1,2], xylim[2,2], xylim[2,2], xylim[1,2]))
}
Los puntos en sí pueden leerse directamente utilizando read.shpo importando un archivo de datos de coordenadas (x, y).
Ejemplo de uso:
qt <- quadtree(xy, k)
xylim <- cbind(x=c(min(xy[,1]), max(xy[,1])), y=c(min(xy[,2]), max(xy[,2])))
polys <- cell(qt, xylim)
polys.attr <- data.frame(id=unique(polys$id))
library(shapefiles)
polys.shapefile <- convert.to.shapefile(polys, polys.attr, "id", 5)
write.shapefile(polys.shapefile, "f:/temp/quadtree", arcgis=TRUE)
(Use cualquier extensión deseada xylimaquí para abrir una ventana en una subregión o para expandir el mapeo a una región más grande; este código se predetermina a la extensión de los puntos).
Esto por sí solo es suficiente: una unión espacial de estos polígonos a los puntos originales identificará los grupos. Una vez identificadas, las operaciones de "resumen" de la base de datos generarán estadísticas resumidas de los puntos dentro de cada celda.
