Cálculo de defasagens espaciais por ano em R

No momento, estou tendo algumas dificuldades para calcular um atraso espacial R. Sei como calcular o atraso no formato de todo o espaço, mas não consigo fazê-lo de forma longa, ou seja, tenho repetidas observações para a unidade de análise.

Abaixo estão alguns dados simulados para ilustrar o que estou tentando fazer. Vamos começar gerando algumas observações de eventos nos quais estou interessado.

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

xe ysão as coordenadas enquanto timerepresenta o período em que o evento ocorre. Os eventos precisam ser agregados aos polígonos, que é a unidade de análise. Neste exemplo, os polígonos são células de grade e, por simplicidade, os limites são fixados ao longo do tempo.

# 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 plotar os dados apenas para obter uma visão geral da distribuição:

Para o formato de todo o espaço, eu calcularia o atraso espacial da seguinte maneira:

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

No entanto, como você pode ver dessa maneira, não leva em consideração o fato de que os eventos acontecem em momentos diferentes no momento. Simplesmente agrega tudo ao nível do polígono. Agora eu quero calcular esse atraso espacial levando em consideração essa dimensão temporal, agregando os dados nesse caso ao nível de tempo do polígono.

Gostaria de saber se alguém tem uma sugestão útil sobre como isso pode ser feito. Qual é a maneira mais conveniente de calcular atrasos espaciais em formato longo?

Dei uma olhada no spacetimepacote, mas não consegui aplicá-lo.

Eu acho que a maneira mais fácil de fazer isso é usar loops e criar o lag.listw () para sua variável count a cada ano.

Algo assim?

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

Em seguida, dentro do loop for, você subconecta os pontos e polígonos e executa a sobreposição. Em seguida, você resume o número de pontos para cada ponto no tempo e os vincula ao dataframe de espaço de espaço, um ponto no tempo.

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

O código acima é apenas para exemplificação. Portanto: 1. Crie um quadro de dados vazio para armazenar os atrasos 2. Loop For para cada ponto de tempo 3. Crie subconjunto para os pontos em que o tempo é igual ao tempo na execução do loop 4. Sobreponha os pontos na grade / polígono 5. Soma o número de pontos em cada sobreposição de polígono (poderia usar o dplyr para agregar) 6. Vincule o número somado de pontos ao quadro de dados vazio.

Isso seria muito mais fácil usando a slagfunção do splmpacote.

Diga a R data.frameé um quadro de dados do painel e trabalhe com o pseries.

Observe que isso funcionará apenas com painel balanceado. Apenas para dar um exemplo:

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$wageé de classe pseries, enquanto firm_nbwghtsumlistw

Então, acho que encontrei um método para fazer isso. Os dados de saída virão na forma de um quadro de dados normal. É um pouco desajeitado, mas 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