Rでの1年あたりの空間ラグの計算

現時点では、で空間ラグを計算するのにいくつか問題がありますR。スペース全体の形式でラグを計算する方法を知っていますが、長い形式で計算することはできません。つまり、分析単位の観測を繰り返しています。

以下は、私が何をしようとしているのかを説明するための模擬データです。まず、興味のあるイベントの観測を生成します。

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

xおよびyは、timeイベントが発生する期間を表す座標です。イベントは、分析の単位であるポリゴンに集約する必要があります。この例では、ポリゴンはグリッドセルであり、簡単にするために、境界は時間の経過とともに固定されます。

# 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 

分布の概要を取得するためだけにデータをプロットできます。

スペース全体のフォーマットでは、次の方法で空間ラグを計算します。

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

ただし、ご覧のように、この方法では、イベントが同時に発生するという事実は考慮されません。単にすべてをポリゴンレベルに集約するだけです。次に、この時間的次元を考慮してこの空間遅延を計算して、この場合のデータをポリゴン時間レベルに集約したいと思います。

これをどのように達成できるかについて誰かが有益な提案をしているのだろうか？長い形式で空間ラグを計算する最も便利な方法は何ですか？

spacetimeパッケージを確認しましたが、適用に失敗しました。

これを実現する最も簡単な方法は、ループを使用して、毎年のカウント変数にlag.listw（）を作成することだと思います。

このようなもの？

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

次に、forループ内でポイントとポリゴンの両方をサブセット化し、オーバーレイを実行します。次に、各時点のポイント数を要約し、それらを一度に1つの時点でspatlagデータフレームにバインドします。

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

上記のコードは単なる例示です。そのため：1.ラグを格納するための空のデータフレームを作成します2.各時間ポイントのforループ3. forループ実行の時間が時間と等しいポイントのサブセットを作成します4.グリッド/ポリゴンにポイントをオーバーレイします5.数値を合計します各ポリゴンオーバーレイ内のポイントの数（dplyrを使用して集約できます）6.ポイントの合計数を空のデータフレームにバインドします。

これはslag、splmパッケージの機能を使用するとはるかに簡単になります。

Rにdata.frameパネルデータフレームであることを伝え、次にで作業しますpseries。

これはバランスの取れたパネルでのみ機能することに注意してください。例を挙げましょう：

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クラスpseriesですがfirm_nbwghts、listw

だから私はこれを行う方法を見つけたと思います。出力データは、通常のデータフレームの形式になります。少し不器用ですが、機能します。

# 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