come sovrapporre un poligono su SpatialPointsDataFrame e conservare i dati SPDF?


17

Ho un SpatialPointsDataFramecon alcuni dati aggiuntivi. Vorrei estrarre quei punti all'interno di un poligono e allo stesso tempo preservare l' SPDFoggetto e i suoi dati corrispondenti.

Finora ho avuto poca fortuna e ho fatto ricorso alla corrispondenza e alla fusione tramite un ID comune, ma questo funziona solo perché ho acquisito dati con ID individuali.

Ecco un breve esempio, sto cercando punti all'interno del quadrato rosso.

library(sp)
set.seed(357)
pts <- data.frame(x = rnorm(100), y = rnorm(100), var1 = runif(100), var2 = sample(letters, 100, replace = TRUE))
coordinates(pts) <- ~ x + y
class(pts)
plot(pts)
axis(1); axis(2)

ply <- matrix(c(-1,-1, 1,-1, 1,1, -1,1, -1,-1), ncol = 2, byrow = TRUE)
ply <- SpatialPolygons(list(Polygons(list(Polygon(ply)), ID = 1)))
ply <- SpatialPolygonsDataFrame(Sr = ply, data = data.frame(polyvar = 357))
plot(ply, add = TRUE, border = "red")

L'approccio più ovvio sarebbe usare over, ma questo restituisce i dati dal poligono.

> over(pts, ply)
    polyvar
1        NA
2       357
3       357
4        NA
5       357
6       357

1
Grazie per aver fornito un esempio riproducibile. Aiuta sempre quando si cerca di capire un problema!
fdetsch,

Risposte:


21

Dalla sp::overaiuto:

 x = "SpatialPoints", y = "SpatialPolygons" returns a numeric
      vector of length equal to the number of points; the number is
      the index (number) of the polygon of ‘y’ in which a point
      falls; NA denotes the point does not fall in a polygon; if a
      point falls in multiple polygons, the last polygon is
      recorded.

Quindi, se si converte il vostro SpatialPolygonsDataFrameper SpatialPolygonsottenere di nuovo un vettore di indici e si può sottoinsieme tuoi punti NA:

> over(pts,as(ply,"SpatialPolygons"))
  [1] NA  1  1 NA  1  1 NA NA  1  1  1 NA NA  1  1  1  1  1 NA NA NA  1 NA  1 NA
 [26]  1  1  1 NA NA NA NA NA  1  1 NA NA NA  1  1  1 NA  1  1  1 NA NA NA  1  1
 [51]  1 NA NA NA  1 NA  1 NA  1 NA NA  1 NA  1  1 NA  1  1 NA  1 NA  1  1  1  1
 [76]  1  1  1  1  1 NA NA NA  1 NA  1 NA NA NA NA  1  1 NA  1 NA NA  1  1  1 NA

> nrow(pts)
[1] 100
> pts = pts[!is.na(over(pts,as(ply,"SpatialPolygons"))),]
> nrow(pts)
[1] 54
> head(pts@data)
         var1 var2
2  0.04001092    v
3  0.58108350    v
5  0.85682609    q
6  0.13683264    y
9  0.13968804    m
10 0.97144627    o
> 

Per i dubbiosi, ecco le prove che il sovraccarico di conversione non è un problema:

Due funzioni: prima il metodo di Jeffrey Evans, poi il mio originale, poi la mia conversione hackerata, quindi una versione basata sulla gIntersectsrisposta di Josh O'Brien:

evans <- function(pts,ply){
  prid <- over(pts,ply)
  ptid <- na.omit(prid) 
  pt.poly <- pts[as.numeric(as.character(row.names(ptid))),]
  return(pt.poly)
}

rowlings <- function(pts,ply){
  return(pts[!is.na(over(pts,as(ply,"SpatialPolygons"))),])
}

rowlings2 <- function(pts,ply){
  class(ply) <- "SpatialPolygons"
  return(pts[!is.na(over(pts,ply)),])
}

obrien <- function(pts,ply){
pts[apply(gIntersects(columbus,pts,byid=TRUE),1,sum)==1,]
}

Ora per un esempio reale, ho sparso alcuni punti casuali sul columbusset di dati:

require(spdep)
example(columbus)
pts=data.frame(
    x=runif(100,5,12),
    y=runif(100,10,15),
    z=sample(letters,100,TRUE))
coordinates(pts)=~x+y

Sembra buono

plot(columbus)
points(pts)

Controlla che le funzioni stiano facendo la stessa cosa:

> identical(evans(pts,columbus),rowlings(pts,columbus))
[1] TRUE

Ed esegui 500 volte per il benchmarking:

> system.time({for(i in 1:500){evans(pts,columbus)}})
   user  system elapsed 
  7.661   0.600   8.474 
> system.time({for(i in 1:500){rowlings(pts,columbus)}})
   user  system elapsed 
  6.528   0.284   6.933 
> system.time({for(i in 1:500){rowlings2(pts,columbus)}})
   user  system elapsed 
  5.952   0.600   7.222 
> system.time({for(i in 1:500){obrien(pts,columbus)}})
  user  system elapsed 
  4.752   0.004   4.781 

Secondo la mia intuizione, non è un grande sovraccarico, in effetti potrebbe essere meno di un sovraccarico che convertire tutti gli indici di riga in carattere e viceversa, o eseguire na.omit per ottenere valori mancanti. Che per inciso porta ad un'altra modalità di errore della evansfunzione ...

Se una riga del frame di dati dei poligoni è tutto NA(il che è perfettamente valido), la sovrapposizione con SpatialPolygonsDataFrameper i punti in quel poligono produrrà un frame di dati di output con tutti gli NAs, che evans()quindi scenderà:

> columbus@data[1,]=rep(NA,20)
> columbus@data[5,]=rep(NA,20)
> columbus@data[17,]=rep(NA,20)
> columbus@data[15,]=rep(NA,20)
> set.seed(123)
> pts=data.frame(x=runif(100,5,12),y=runif(100,10,15),z=sample(letters,100,TRUE))
> coordinates(pts)=~x+y
> identical(evans(pts,columbus),rowlings(pts,columbus))
[1] FALSE
> dim(evans(pts,columbus))
[1] 27  1
> dim(rowlings(pts,columbus))
[1] 28  1
> 

MA gIntersectsè più veloce, anche con la scansione della matrice per controllare le intersezioni in R anziché in codice C. Sospetto che sia l' prepared geometryabilità di GEOS, la creazione di indici spaziali - sì, con prepared=FALSEun po 'più di tempo, circa 5,5 secondi.

Sono sorpreso che non ci sia una funzione per restituire direttamente gli indici o i punti. Quando ho scritto splancs20 anni fa le funzioni point-in-poligono avevano entrambe ...


Ottimo, questo funziona anche con più poligoni (ho aggiunto un esempio con cui giocare nella risposta di Giosuè).
Roman Luštrik,

Con set di dati poligonali di grandi dimensioni la coercizione in un oggetto SpatialPolygons è molto sovraccarica e non necessaria. L'applicazione di "over" a SpatialPolygonsDataFrame restituisce l'indice di riga che può essere utilizzato per sottoinsieme dei punti. Vedi il mio esempio di seguito.
Jeffrey Evans,

Un sacco di spese generali? Praticamente sta semplicemente prendendo lo slot @polygons dall'oggetto SpatialPolygonsDataFrame. Puoi persino "falsificarlo" riassegnando la classe di uno SpatialPolygonsDataFrame come "SpatialPolygons" (anche se questo è confuso e sconsigliato). Qualunque cosa che utilizzerà la geometria dovrà comunque ottenere quella fessura ad un certo punto, quindi relativamente parlando non è affatto sovraccarico. È comunque insignificante in qualsiasi applicazione del mondo reale in cui farai un carico di test punto-poligono.
Spacedman,

Vi sono più di considerazioni sulla velocità nella contabilità delle spese generali. Nella creazione di un nuovo oggetto nello spazio dei nomi R si utilizza la RAM necessaria. Se questo non è un problema in un set di dati di piccole dimensioni, influirà sulle prestazioni con dati di grandi dimensioni. R mostra un decadimento lineare delle prestazioni. Man mano che i dati aumentano, le prestazioni richiedono un ding. Se non è necessario creare un oggetto aggiuntivo, perché?
Jeffrey Evans,

1
Non lo sapevamo fino a quando non l'ho provato proprio ora.
Spacedman,

13

sp fornisce una forma più breve per selezionare le funzioni in base all'intersezione spaziale, seguendo l'esempio OP:

pts[ply,]

come di:

points(pts[ply,], col = 'red')

Dietro le quinte questo è l'abbreviazione di

pts[!is.na(over(pts, geometry(ply))),]

La cosa da notare è che esiste un geometrymetodo che elimina gli attributi: overcambia comportamento se il suo secondo argomento ha attributi o meno (questa era la confusione di OP). Funziona in tutte le classi spaziali * sp, anche se alcuni overmetodi richiedono rgeos, vedere questa vignetta per i dettagli, ad esempio il caso di più corrispondenze per poligoni sovrapposti.


Buono a sapersi! Non ero a conoscenza del metodo della geometria.
Jeffrey Evans,

2
Benvenuto sul nostro sito, Edzer - è bello vederti qui!
whuber

1
Grazie Bill - sta diventando più tranquillo su stat.ethz.ch/pipermail/r-sig-geo , o forse dovremmo sviluppare software che causi più problemi! ;-)
Edzer Pebesma,

6

Eri sulla strada giusta con Over. I rownames dell'oggetto restituito corrispondono all'indice di riga dei punti. Puoi implementare il tuo approccio esatto con solo poche righe di codice aggiuntive.

library(sp)
set.seed(357)

pts <- data.frame(x=rnorm(100), y=rnorm(100), var1=runif(100), 
                  var2=sample(letters, 100, replace=TRUE))
  coordinates(pts) <- ~ x + y

ply <- matrix(c(-1,-1, 1,-1, 1,1, -1,1, -1,-1), ncol=2, byrow=TRUE)
  ply <- SpatialPolygons(list(Polygons(list(Polygon(ply)), ID=1)))
    ply <- SpatialPolygonsDataFrame(Sr=ply, data=data.frame(polyvar=357))

# Subset points intersecting polygon
prid <- over(pts,ply)
  ptid <- na.omit(prid) 
    pt.poly <- pts[as.numeric(as.character(row.names(ptid))),]  

plot(pts)
  axis(1); axis(2)
    plot(ply, add=TRUE, border="red")
      plot(pt.poly,pch=19,add=TRUE) 

Sbagliato - i rownames dell'oggetto restituito corrispondono all'indice di riga in_this_case - in generale i nomi delle righe sembrano essere i nomi delle righe dei punti - che potrebbero anche non essere numerici. È possibile modificare la soluzione per eseguire una corrispondenza di caratteri che potrebbe renderla un po 'più robusta.
Spacedman,

@Sapcedman, non essere così dogmatico. La soluzione non è errata Se si desidera sottoporre i punti a un insieme di poligoni o assegnare valori di poligoni ai punti, la funzione di over funziona senza coercizione. Esistono diversi modi per eseguire il passaggio pedonale una volta ottenuto l'oggetto sopra risultante. La soluzione di forzatura a un oggetto SpatialPolygon crea un notevole sovraccarico necessario poiché questa operazione può essere eseguita direttamente sull'oggetto SpatialPolygonDataFrame. A proposito prima di modificare un post assicurati di avere ragione. Il termine libreria e pacchetto sono usati in modo intercambiabile in R.
Jeffrey Evans il

Ho aggiunto alcuni benchmark al mio post e ho riscontrato un altro problema con la tua funzione. Inoltre "I pacchetti sono raccolte di funzioni R, dati e codice compilato in un formato ben definito. La directory in cui sono memorizzati i pacchetti è chiamata libreria"
Spacedman,

Sebbene tu sia tecnicamente corretto riguardo al "pacchetto" rispetto alla "biblioteca", stai discutendo di semantica. Ho appena ricevuto una richiesta dell'editor di modellistica ecologica che cambi il nostro uso di "pacchetto" (che in realtà è la mia preferenza) in "libreria". Il mio punto è che stanno diventando termini intercambiabili e una questione di preferenza.
Jeffrey Evans,

1
"tecnicamente corretto", come ha osservato una volta il dott. Sheldon Cooper, "è il miglior tipo di corretto". Quell'editor è tecnicamente sbagliato, che è il peggior tipo di errore.
Spacedman,

4

È questo ciò che cerchi?

Una nota, in fase di modifica: apply()è necessaria la chiamata a capo per far funzionare questo con SpatialPolygonsoggetti arbitrari , possibilmente contenenti più di una funzione poligonale. Grazie a @Spacedman per avermi indotto a dimostrare come applicare questo al caso più generale.

library(rgeos)
pp <- pts[apply(gIntersects(pts, ply, byid=TRUE), 2, any),]


## Confirm that it works
pp[1:5,]
#              coordinates       var1 var2
# 2 (-0.583205, -0.877737) 0.04001092    v
# 3   (0.394747, 0.702048) 0.58108350    v
# 5    (0.7668, -0.946504) 0.85682609    q
# 6    (0.31746, 0.641628) 0.13683264    y
# 9   (-0.469015, 0.44135) 0.13968804    m

plot(pts)
plot(ply, border="red", add=TRUE)
plot(pp, col="red", add=TRUE)

Non funziona in modo orribile se plyha più di una funzione, perché gIntersectsrestituisce una matrice con una riga per ogni funzione. Probabilmente puoi probabilmente spazzare le righe per un valore VERO.
Spacedman,

@Spacedman - Bingo. Necessità di fare apply(gIntersects(pts, ply, byid=TRUE), 2, any). In effetti, andrò avanti e cambierò la risposta, poiché comprende anche il caso di un singolo poligono.
Josh O'Brien,

Ah, any. Potrebbe essere leggermente più veloce della versione che ho appena analizzato.
Spacedman,

@Spacedman - Dai miei test rapidi, sembra obriene rowlings2corro collo e collo, con obrien forse il 2% più veloce.
Josh O'Brien,

@ JoshO'Brien come si può usare questa risposta su molti poligoni? Questo ppdovrebbe avere un IDche indica in quale poligono si trovano i punti.
codice123

4

Ecco un possibile approccio usando il rgeospacchetto. Fondamentalmente, si avvale della gIntersectionfunzione che consente di intersecare due spoggetti. Estraendo gli ID di quei punti che si trovano all'interno del poligono, sarai in grado di sottoinsieme l'originale SpatialPointsDataFrame, mantenendo tutti i dati corrispondenti. Il codice è quasi autoesplicativo, ma se ci sono domande, non esitare a chiedere!

# Required package
library(rgeos)

# Intersect polygons and points, keeping point IDs
pts.intersect <- gIntersection(ply, pts, byid = TRUE)

# Extract point IDs from intersected data
pts.intersect.strsplit <- strsplit(dimnames(pts.intersect@coords)[[1]], " ")
pts.intersect.id <- as.numeric(sapply(pts.intersect.strsplit, "[[", 2))

# Subset original SpatialPointsDataFrame by extracted point IDs
pts.extract <- pts[pts.intersect.id, ]

head(coordinates(pts.extract))
              x          y
[1,] -0.5832050 -0.8777367
[2,]  0.3947471  0.7020481
[3,]  0.7667997 -0.9465043
[4,]  0.3174604  0.6416281
[5,] -0.4690151  0.4413502
[6,]  0.4765213  0.6068021

head(pts.extract)
         var1 var2
2  0.04001092    v
3  0.58108350    v
5  0.85682609    q
6  0.13683264    y
9  0.13968804    m
10 0.97144627    o

1
Dovrebbe tmpessere pts.intersect? Inoltre, l'analisi dei nomi in chiaro restituiti in questo modo dipende dal comportamento non documentato.
Spacedman,

@Spacedman, hai ragione, hai tmpdimenticato di rimuoverlo quando hai finito il codice. Inoltre, hai ragione sull'analisi di dimnames. Questa è stata una sorta di soluzione rapida per fornire una rapida risposta all'interrogante, e sicuramente ci sono approcci migliori (e più universali), ad esempio i tuoi :-)
fdetsch,

1

Esiste una soluzione estremamente semplice che utilizza la spatialEcolibreria.

library(spatialEco)

# intersect points in polygon
  pts <- point.in.poly(pts, ply)

# check plot
  plot(ply)
  plot(a, add=T)

# convert to data frame, keeping your data
  pts<- as.data.frame(pts)

Controlla il risultato:

pts

>             x          y       var1 var2 polyvar
> 2  -0.5832050 -0.8777367 0.04001092    v     357
> 3   0.3947471  0.7020481 0.58108350    v     357
> 5   0.7667997 -0.9465043 0.85682609    q     357
> 6   0.3174604  0.6416281 0.13683264    y     357
> 9  -0.4690151  0.4413502 0.13968804    m     357
> 10  0.4765213  0.6068021 0.97144627    o     357
Utilizzando il nostro sito, riconosci di aver letto e compreso le nostre Informativa sui cookie e Informativa sulla privacy.
Licensed under cc by-sa 3.0 with attribution required.