Dividiamolo in pezzi semplici. In questo modo, tutto il lavoro viene svolto in una mezza dozzina di righe di codice facilmente testabile.
Innanzitutto, dovrai calcolare le distanze. Poiché i dati sono in coordinate geografiche, ecco una funzione per calcolare le distanze su un dato sferico (usando la formula di Haversine):
#
# Spherical distance.
# `x` and `y` are (long, lat) pairs *in radians*.
dist <- function(x, y, R=1) {
d <- y - x
a <- sin(d[2]/2)^2 + cos(x[2])*cos(y[2])*sin(d[1]/2)^2
return (R * 2*atan2(sqrt(a), sqrt(1-a)))
}
Sostituiscilo con la tua implementazione preferita, se lo desideri (come uno che utilizza un dato ellissoidale).
Successivamente, dovremo calcolare le distanze tra ciascun "punto base" (in fase di verifica della stabilità) e il suo vicinato temporale. È semplicemente una questione di applicazione dist
al vicinato:
#
# Compute the distances between an array of locations and a base location `x`.
dist.array <- function(a, x, ...) apply(a, 1, function(y) dist(x, y, ...))
Terzo - questa è l'idea chiave - i punti fissi vengono rilevati rilevando quartieri di 11 punti con almeno cinque di fila le cui distanze sono sufficientemente piccole. Cerchiamo di implementarlo un po 'più in generale, determinando la lunghezza della sottosequenza più lunga dei valori reali all'interno di una matrice logica di valori booleani:
#
# Return the length of the longest sequence of true values in `x`.
max.subsequence <- function(x) max(diff(c(0, which(!x), length(x)+1)))
(Troviamo le posizioni dei valori falsi , in ordine, e calcoliamo le loro differenze: queste sono le lunghezze delle sottosequenze di valori non falsi. Viene restituita la lunghezza più grande di tali.)
In quarto luogo, applichiamo max.subsequence
per rilevare punti fissi.
#
# Determine whether a point `x` is "stationary" relative to a sequence of its
# neighbors `a`. It is provided there is a sequence of at least `k`
# points in `a` within distance `radius` of `x`, where the earth's radius is
# set to `R`.
is.stationary <- function(x, a, k=floor(length(a)/2), radius=100, R=6378.137)
max.subsequence(dist.array(a, x, R) <= radius) >= k
Questi sono tutti gli strumenti di cui abbiamo bisogno.
Ad esempio, creiamo alcuni dati interessanti con alcuni gruppi di punti stazionari. Farò una passeggiata casuale vicino all'equatore.
set.seed(17)
n <- 67
theta <- 0:(n-1) / 50 - 1 + rnorm(n, sd=1/2)
rho <- rgamma(n, 2, scale=1/2) * (1 + cos(1:n / n * 6 * pi))
lon <- cumsum(cos(theta) * rho); lat <- cumsum(sin(theta) * rho)
Le matrici lon
e lat
contengono le coordinate, in gradi, dei n
punti in sequenza. L'applicazione dei nostri strumenti è semplice dopo la prima conversione in radianti:
p <- cbind(lon, lat) * pi / 180 # Convert from degrees to radians
p.stationary <- sapply(1:n, function(i)
is.stationary(p[i,], p[max(1,i-5):min(n,i+5), ], k=5))
L'argomento p[max(1,i-5):min(n,i+5), ]
dice di guardare fino a 5 passi temporali o fino a 5 passi temporali dal punto base p[i,]
. Includendo k=5
dice di cercare una sequenza di 5 o più di fila che si trovano entro 100 km dal punto base. (Il valore di 100 km è stato impostato come predefinito in is.stationary
ma è possibile sovrascriverlo qui.)
L'output p.stationary
è un vettore logico che indica la stazionarietà: abbiamo quello per cui siamo venuti. Tuttavia, per verificare la procedura è meglio tracciare i dati e questi risultati piuttosto che ispezionare le matrici di valori. Nella trama seguente mostro il percorso e i punti. Ogni decimo punto è etichettato in modo da poter stimare quanti potrebbero sovrapporsi all'interno dei gruppi fissi. I punti fermi vengono ridisegnati in rosso fisso per evidenziarli e circondati dai loro respingenti di 100 km.
plot(p, type="l", asp=1, col="Gray",
xlab="Longitude (radians)", ylab="Latitude (radians)")
points(p)
points(p[p.stationary, ], pch=19, col="Red", cex=0.75)
i <- seq(1, n, by=10)
#
# Because we're near the Equator in this example, buffers will be nearly
# circular: approximate them.
disk <- function(x, r, n=32) {
theta <- 1:n / n * 2 * pi
return (t(rbind(cos(theta), sin(theta))*r + x))
}
r <- 100 / 6378.137 # Buffer radius in radians
apply(p[p.stationary, ], 1, function(x)
invisible(polygon(disk(x, r), col="#ff000008", border="#00000040")))
text(p[i,], labels=paste(i), pos=3, offset=1.25, col="Gray")
Per altri approcci (basati su statistiche) alla ricerca di punti fissi nei dati tracciati, incluso il codice di lavoro, visitare /mathematica/2711/clustering-of-space-time-data .