Tính độ trễ không gian mỗi năm tính bằng R

Hiện tại tôi đang gặp một số khó khăn với việc tính toán độ trễ không gian R. Tôi biết cách tính độ trễ ở định dạng không gian rộng nhưng không thể thực hiện ở dạng dài, tức là có các quan sát lặp đi lặp lại cho đơn vị phân tích.

Dưới đây là một số dữ liệu giả để minh họa những gì tôi đang cố gắng làm. Hãy bắt đầu bằng cách tạo ra một số quan sát về các sự kiện mà tôi quan tâm.

# 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)

xvà ylà tọa độ trong khi timebiểu thị khoảng thời gian diễn ra sự kiện. Các sự kiện cần phải được tổng hợp thành đa giác là đơn vị phân tích. Trong ví dụ này, đa giác là các ô lưới và để đơn giản, các ranh giới được cố định theo thời gian.

# 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 

Chúng ta có thể vẽ dữ liệu chỉ để có cái nhìn tổng quan về phân phối:

Đối với định dạng toàn không gian, tôi sẽ tính độ trễ không gian theo cách sau:

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

Tuy nhiên, như bạn có thể thấy thực hiện theo cách này không tính đến thực tế là các sự kiện xảy ra vào những thời điểm khác nhau tại thời điểm đó. Nó chỉ đơn giản là tổng hợp mọi thứ đến mức đa giác. Bây giờ tôi muốn tính độ trễ không gian này có tính đến kích thước thời gian này để tổng hợp dữ liệu trong trường hợp này đến mức thời gian đa giác.

Tôi tự hỏi liệu có ai có một gợi ý hữu ích về cách này có thể được thực hiện không? Cách thuận tiện nhất để tính độ trễ không gian ở định dạng dài là gì?

Tôi đã xem xét spacetimegói nhưng không thành công trong việc áp dụng nó.

Tôi nghĩ cách dễ nhất để thực hiện điều này là sử dụng các vòng lặp và tạo lag.listw () cho biến đếm của bạn cho mỗi năm.

Một cái gì đó như thế này?

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

Sau đó, bên trong vòng lặp for, bạn tập hợp cả điểm và đa giác và thực hiện lớp phủ. Sau đó, bạn tóm tắt số điểm cho mỗi điểm thời gian và liên kết chúng với khung dữ liệu spatlag, một điểm thời gian tại thời điểm đó.

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)
}

Các mã ở trên chỉ là ví dụ. Vì vậy: 1. Tạo khung dữ liệu trống để lưu trữ độ trễ 2. Cho vòng lặp cho mỗi điểm thời gian 3. Tạo tập hợp con cho các điểm trong đó thời gian bằng với thời gian chạy vòng lặp 4. Xếp chồng các điểm trên lưới / đa giác 5. Tính tổng số trong số các điểm trong mỗi lớp phủ đa giác (có thể sử dụng dplyr để tổng hợp) 6. Liên kết số điểm tổng hợp vào khung dữ liệu trống.

Điều này sẽ dễ dàng hơn nhiều bằng cách sử dụng slagchức năng của splmgói.

Nói với R của bạn data.framelà khung dữ liệu bảng, sau đó làm việc với pseries.

Xin lưu ý rằng điều này sẽ chỉ làm việc với bảng cân bằng. Chỉ để cho bạn một ví dụ:

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$wagelà của lớp học pseries, trong khi firm_nbwghtsmộtlistw

Vì vậy, tôi nghĩ rằng tôi đã tìm thấy một phương pháp để làm điều này. Dữ liệu đầu ra sẽ ở dạng khung dữ liệu bình thường. Đó là một chút vụng về nhưng nó hoạt động.

# 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