R：计算重叠多边形区域

Question

我在R中试图计算多边形之间的重叠区域时遇到了一些困难。例如，对于瑞士，我有关于各州行政边界和该国ethnic groups的数据。

## Libraries
library(sp)
library(spdep)
library(maptools)
library(rgeos)

## Data
print(load(url("http://gadm.org/data/rda/CHE_adm1.RData")))
greg<-readShapeSpatial("raw_data/GREG.shp",
                     proj4string=CRS(" +proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0")) 
switzerland<-greg[greg$COW==225,]

## Identical projections
proj<-CRS(" +proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0")
switzerland<-spTransform(switzerland,proj)

绘制数据并得到如下所示的内容：

## Plot data
par(mar=c(1,1,1,1))
plot(gadm,col="grey80")
plot(switzerland,add=TRUE,lwd=2,border="red")

我们可以看到，种族群体的界限并非完全遵循国界，而是足够好。我想要做的是为每个州计算族群的数量，同时考虑到该州内的族裔群体的面积。因此，对于东部的格劳宾登州，我想知道德国瑞士人，意大利人瑞士人，Rhaetoromaniens等所占领的地区。

在stackoverflow上阅读一些类似的问题我认为gIntersection是要使用的命令，但是这给了我以下错误：

int<-gIntersection(gadm,switzerland,byid=TRUE) # Updated


Error in RGEOSBinTopoFunc(spgeom1, spgeom2, byid, id, drop_lower_td, "rgeos_intersection") : 
TopologyException: no outgoing dirEdge found at 7.3306802801147688 47.439399101791921
In addition: Warning message:
In RGEOSBinTopoFunc(spgeom1, spgeom2, byid, id, drop_lower_td, "rgeos_intersection") :
spgeom1 and spgeom2 have different proj4 strings

不完全确定导致第二次警告任务的原因是

identicalCRS(gadm,switzerland)
[1] TRUE

有没有人建议如何计算各州和族群之间的重叠？

更新：可能的解决方案

这可能是一种可能的解决方案，尽管不同proj4字符串的警告仍然存在。另请注意，由于族群形状文件不能正确地遵循国界，因此存在一些测量误差（例如在Aargua中）。

## Possible solution
int<-gIntersection(gadm,switzerland,byid=T) # Multiple polygons per province
n<-names(int)
n<-data.frame(t(data.frame(strsplit(n," ",fixed=TRUE)))) 

colnames(n)[1:2]<-c("id0","ethnic.group")
n$area<-sapply(int@polygons, function(x) x@area)
a<-data.frame(id0=row.names(gadm),total.area=gadm$Shape_Area)
df<-merge(n,a,all.x=TRUE)

df$share.area<-df$area/df$total.area*100

Answer 1

这是一种与您略有不同的方法（但只是略有不同）。

对switzerland@data的检查显示，虽然有11 FeatureIDs（代表种族特征），但只有4种独特的命名种族（德语，意大利语和法语瑞士语）和Rhaetoromanians）。所以下面的结果是基于名称而不是ID。

library(rgeos)    # for gIntersection(...), etc.
library(rgdal)    # for readOGR(...)

setwd("<directory to accept your files>")
CH.1903 <- "+proj=somerc +lat_0=46.95240555555556 +lon_0=7.439583333333333 +k_0=1 +x_0=600000 +y_0=200000 +ellps=bessel +towgs84=674.374,15.056,405.346,0,0,0,0 +units=m +no_defs"

print(load(url("http://gadm.org/data/rda/CHE_adm1.RData")))
gadm <- spTransform(gadm, CRS(CH.1903))
download.file("http://www.icr.ethz.ch/data/other/greg/GREG.zip","GREG.zip")
unzip("GREG.zip")
greg <- readOGR(dsn=".",layer="GREG")
greg <- spTransform(greg[greg$COW==225,],CRS(CH.1903))

gadm.ids <- gadm@data$ID_1               # Canton Nr.
greg.ids <- unique(greg@data$G1SHORTNAM) # ethnicity
get.area <- Vectorize(function(adm,reg){
  int <- gIntersection(gadm[gadm$ID_1==adm,],greg[greg$G1SHORTNAM==reg,],byid=TRUE)
  if (length(int)==0) return(0)
  gArea(int)
})
result <- outer(gadm.ids,greg.ids,FUN=get.area)
rownames(result) <- gadm.ids
colnames(result)  <- greg.ids
result <- as.data.frame(result)
totals <- rowSums(result)
result <- result/totals
result$totals <- totals/1e6
result$land.area <- sapply(rownames(result),function(p)gArea(gadm[gadm$ID_1==p,])/1e6)
result
#     German Swiss French Swiss Italian Swiss Rhaetoromanians     totals  land.area
# 531  1.000000000   0.00000000    0.00000000    0.000000e+00 1363.27027 1403.22192
# 532  1.000000000   0.00000000    0.00000000    0.000000e+00  244.32279  244.32279
# 533  1.000000000   0.00000000    0.00000000    0.000000e+00  172.40341  172.40341
# 534  1.000000000   0.00000000    0.00000000    0.000000e+00  522.12943  525.73449
# 535  1.000000000   0.00000000    0.00000000    0.000000e+00   70.03116   84.06481
# 536  0.902128658   0.09787134    0.00000000    0.000000e+00 5927.90740 5927.90847
# 537  0.188415744   0.81158426    0.00000000    0.000000e+00 1654.28729 1654.28729

在这里，我们将两个shapefile转换为CH.1903，这是一个以瑞士为中心的墨卡托投影，单位为米。然后我们确定了Nrs。和种族，并使用outer(...)在两个列表中循环，使用gArea(...)计算以平方公里（平方米/ 1e6）为单位的交叉区域。最终结果是每个州有一排，每个种族的百分比基于土地面积。 $totals是每个广州的交叉区域的总和，$land.area是广州的总地理区域。因此，这可以让您了解种族shapfile和gadm shapefile之间不完整重叠导致的错误。