Menghitung keterlambatan spasial per tahun dalam R


8

Saat ini saya mengalami beberapa kesulitan dalam menghitung jeda spasial dalam R. Saya tahu bagaimana menghitung lag dalam format space-wide tetapi saya tidak dapat melakukannya dalam bentuk panjang, yaitu telah mengulangi pengamatan untuk unit analisis.

Di bawah ini adalah beberapa data tiruan untuk menggambarkan apa yang saya coba lakukan. Mari kita mulai dengan menghasilkan beberapa pengamatan peristiwa yang saya minati.

# Create observations
pts<-cbind(set.seed(2014),x=runif(30,1,5),y=runif(30,1,5),
       time=sample(1:5,30,replace=T))
require(sp)
pts<-SpatialPoints(pts)

xdan ymerupakan koordinat saat timemewakili periode waktu di mana acara berlangsung. Peristiwa perlu dikumpulkan ke poligon yang merupakan unit analisis. Dalam contoh ini poligon adalah sel-kotak dan untuk kesederhanaan batas-batasnya diperbaiki dari waktu ke waktu.

# Observations take place in different areas; create polygons for areas
X<-c(rep(1,5),rep(2,5),rep(3,5),rep(4,5),rep(5,5)) 
Y<-c(rep(seq(1,5,1),5))
df<-data.frame(X,Y)
df$cell<-1:nrow(df) # Grid-cell identifier
require(raster)
coordinates(df)<-~X+Y 
rast<-raster(extent(df),ncol=5,nrow=5)
grid<-rasterize(df,rast,df$cell,FUN=max)
grid<-rasterToPolygons(grid) # Create polygons 

Kami dapat memplot data hanya untuk mendapatkan ikhtisar distribusi: Distribusi acara

Untuk format ruang-lebar, saya akan menghitung spasi spasi dengan cara berikut:

pointsincell=over(SpatialPolygons(grid@polygons),SpatialPoints(pts),
              returnList=TRUE)
grid$totalcount<-unlist(lapply(pointsincell,length))
require(spdep)
neigh<-poly2nb(grid) # Create neighbour list
weights<-nb2listw(neigh,style="B",zero.policy=TRUE) # Create weights (binary)
grid$spatial.lag<-lag.listw(weights,
                            grid$totalcount,zero.policy=TRUE) # Add to raster

Namun, seperti yang Anda lihat melakukannya dengan cara ini tidak memperhitungkan fakta bahwa peristiwa itu terjadi pada saat yang berbeda pada waktu yang bersamaan. Itu hanya mengumpulkan semuanya ke tingkat poligon. Sekarang saya ingin menghitung keterlambatan spasial ini dengan mempertimbangkan dimensi temporal ini sehingga menggabungkan data dalam kasus ini ke tingkat waktu poligon.

Saya bertanya-tanya apakah ada yang punya saran berguna tentang bagaimana hal ini dapat dicapai? Apa cara paling nyaman untuk menghitung jeda spasial dalam format panjang?

Saya telah melihat spacetimepaketnya tetapi tidak berhasil menerapkannya.


Sudahkah Anda mencoba mengulang fungsi spdep :: autocov_dist?
Jeffrey Evans

Tidak, belum. Saya melakukan sedikit hack-job menggunakan produk Kronecker.
horseoftheyear

Jawaban:


2

Saya pikir cara paling mudah untuk mencapai ini adalah dengan menggunakan loop, dan buat lag.listw () untuk variabel jumlah Anda setiap tahun.

Sesuatu seperti ini?

spatlag <- data.frame(id=NULL, time=NULL, lag=NULL)
for (y in sort(unique(data$time))){
  print(y)

Kemudian di dalam for loop Anda mengelompokkan kedua titik dan poligon, dan menjalankan overlay. Kemudian Anda merangkum jumlah titik untuk setiap titik waktu dan mengikatnya ke bingkai data spatlag, satu titik waktu pada saat itu.

pointsincell=over(SpatialPolygons(grid@polygons),SpatialPoints(pts),
              returnList=TRUE)
grid$totalcount<-unlist(lapply(pointsincell,length))
require(spdep)
neigh<-poly2nb(grid) # Create neighbour list
weights<-nb2listw(neigh,style="B",zero.policy=TRUE) # Create weights (binary)
grid$spatial.lag<-lag.listw(weights,grid$totalcount,zero.policy=TRUE) # Add to raster
rbind(spatlag, grid)
}

Kode di atas hanya untuk contoh. Jadi: 1. Buat frame data kosong untuk menyimpan kelambatan 2. Untuk loop untuk setiap titik waktu 3. Buat subset untuk titik-titik di mana waktu sama dengan waktu untuk loop run 4. Overlay titik pada grid / poligon 5. Jumlah angkanya poin di setiap overlay poligon (bisa menggunakan dplyr untuk agregat) 6. Ikat jumlah poin yang diringkas ke frame data kosong.


Sejujurnya saya tidak sepenuhnya yakin bagaimana ini bekerja.
horseoftheyear

1

Ini akan jauh lebih mudah menggunakan slagfungsi splmpaket.

Katakan R Anda data.frameadalah bingkai data panel, lalu bekerja dengan pseries.

Harap perhatikan bahwa ini hanya akan bekerja dengan panel seimbang. Sekedar memberi Anda contoh:

library(plm)
library(splm)
library(spdep)

data("EmplUK", package = "plm")

names(EmplUK)
table(EmplUK$year)
#there should be 140 observations /year, but this is not the case, so tomake it balanced

library(dplyr)
balanced_p<-filter(EmplUK, year>1977 & year<1983)
table (balanced_p$year)
#now it is balanced

firm<-unique(balanced_p$firm)
#I'm using the coordinates (randomly generated) of the firms, but it works also if you use the polygons as you did in your question
coords <- cbind(runif(length(firm),-180,+180), runif(length(firm),-90,+90))
pts_firms<-SpatialPoints(coords)

#now tell R that this is a panel, making sure that the firm id and years are the first two columns of the df
p_data<-pdata.frame(balanced_p)
firm_nb<-knn2nb(knearneigh(pts_firms))
firm_nbwghts<-nb2listw(firm_nb, style="W", zero.policy=T)

#now you can easily create your spatial lag 
#I'm assuming here that the dependent variable is wage! 
p_data$splag<-slag(p_data$wage,firm_nbwghts)

p_data$wageadalah kelas pseries, sementara firm_nbwghtsalistw


Menarik. Mungkin coba ini di masa depan.
horseoftheyear

0

Jadi saya pikir saya sudah menemukan metode untuk melakukan ini. Data keluaran akan datang dalam bentuk kerangka data normal. Agak canggung tapi berhasil.

# Start by creating a panel (CSTS) data frame
grid$cc<-1:nrow(grid)
tiempo<-1:5
polygon<-as.vector(unique(unlist(grid$cc,use.names=FALSE)))

# Loop to create panel data frame
timeCol<-rep(tiempo,length(polygon))
timeCol<-timeCol[order(timeCol)]

polCol <- character()
for(i in tiempo){ 
 row <- polygon
 polCol <- c(polCol, row)
}

df<-data.frame(time=timeCol,nrow=polCol)
df$nrow<-as.numeric(df$nrow)
df<-df[order(df$time,df$nrow),] # Order data frame 

# Assign each point to its corresponding polygon
pts<-SpatialPointsDataFrame(pts,data.frame(pts$time)) # This is a bit clumsy
pts$nrow=over(SpatialPoints(pts),SpatialPolygons(grid@polygons),
              returnlist=TRUE) 

# Aggregate the data per polygon
pts$level<-1
pts.a<-aggregate(level~nrow+time,pts,FUN=sum) # No NA's

# Merge the data
df2<-merge(df,pts.a,all.x=T)
df2[is.na(df2$level),]$level<-0 # Set NA's to 0

# Create contiguity matrix
k<-poly2nb(grid,queen=TRUE) # Create neighbour list
W<-nb2listw(k,style="B",zero.policy=TRUE) # Spatial weights; binary
con<-as.matrix(listw2mat(W)) # Contiguity matrix

# Calculate spatial lag using Kronecker product
N<-length(unique(df2$nrow))
T<-length(unique(df2$time))
ident<-diag(1,nrow=T)
df2$SpatLag<-(ident%x%con)%*%df2$level # Done
Dengan menggunakan situs kami, Anda mengakui telah membaca dan memahami Kebijakan Cookie dan Kebijakan Privasi kami.
Licensed under cc by-sa 3.0 with attribution required.