Cálculo de retrasos espaciales por año en R

En este momento estoy teniendo algunas dificultades para calcular un retraso espacial R. Sé cómo calcular el retraso en el formato de todo el espacio, pero no puedo hacerlo en forma larga, es decir, tengo observaciones repetidas para la unidad de análisis.

A continuación hay algunos datos simulados para ilustrar lo que estoy tratando de hacer. Comencemos generando algunas observaciones de eventos que me interesan.

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

xy yson las coordenadas, mientras que timerepresenta el período de tiempo en el que tiene lugar el evento. Los eventos deben agregarse a polígonos, que es la unidad de análisis. En este ejemplo, los polígonos son celdas de cuadrícula y, por simplicidad, los límites se fijan con el tiempo.

# 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 

Podemos trazar los datos solo para obtener una visión general de la distribución:

Para el formato de todo el espacio, calcularía el retraso espacial de la siguiente manera:

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

Sin embargo, como puede ver, hacerlo de esta manera no tiene en cuenta el hecho de que los eventos suceden en diferentes momentos. Simplemente agrega todo al nivel de polígono. Ahora quiero calcular este retraso espacial teniendo en cuenta esta dimensión temporal, agregando los datos en este caso al nivel de tiempo de polígono.

Me pregunto si alguien tiene una sugerencia útil sobre cómo se podría lograr esto. ¿Cuál es la forma más conveniente de calcular retrasos espaciales en formato largo?

Eché un vistazo al spacetimepaquete, pero no tuve éxito al aplicarlo.

Creo que la forma más fácil de lograr esto es usar bucles y crear el lag.listw () para su variable de conteo para cada año.

¿Algo como esto?

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

Luego, dentro del bucle for, subconjuntos los puntos y los polígonos, y ejecuta la superposición. Luego, resume el número de puntos para cada punto de tiempo y los vincula al marco de datos de la barra espaciadora, un punto de tiempo en el momento.

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

El código anterior es solo para ejemplificar. Entonces: 1. Cree un marco de datos vacío para almacenar los retrasos 2. Para el ciclo para cada punto de tiempo 3. Cree un subconjunto para los puntos donde el tiempo es igual al tiempo para la ejecución del ciclo 4. Superponga los puntos en la cuadrícula / polígono 5. Sume el número de puntos en cada superposición de polígono (podría usar dplyr para agregar) 6. Vincula el número de puntos sumados al marco de datos vacío.

Esto sería mucho más fácil usando la slagfunción del splmpaquete.

Dígale a R que data.framees un marco de datos de panel, luego trabaje con el pseries.

Tenga en cuenta que esto solo funcionará con un panel equilibrado. Solo para darte un ejemplo:

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$wagees de clase pseries, mientras que firm_nbwghtsunlistw

Así que creo que he encontrado un método para hacer esto. Los datos de salida vendrán en forma de un marco de datos normal. Es un poco torpe pero funciona.

# 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