计算shapefile的百分比覆盖率

Question

我通常不使用shapefile，所以我在这里有点迷失。我有两个shapefile，每个shapefile都有多个对象。第一个是一组32个多边形（每个都是一个图）。第二个shapefile具有> 10,000个对象，这些对象表示每个图中不同大小的植被群。我想弄清楚。

1）如何计算每个站点内总植被覆盖率？

2）每个地块的植被覆盖面积小于5米的百分比是多少？

这是我在ArcGIS中为单个图表显示的数据。

Answer 1

我认为以下代码可以满足您的需求。

注意：这使用存储在shapefile多边形中的区域信息（如下所述）。它不使用植被shapefile数据部分中的Area列。在大多数情况下，您的Area与shapefile中存储的区域相同，但在某些情况下，您的Area要大得多。由于我不知道您的Area数据来自何处，因此使用与shapefile多边形一起存储的信息似乎更安全。

library(rgdal)
library(ggplot2)

setwd("<directory containing all your shapefiles>")
plt.map <- readOGR(dsn=".",layer="plots")
veg.map <- readOGR(dsn=".",layer="veg_in_plots")
# associate LocCode with polygon IDs
plt.data <- cbind(id=rownames(plt.map@data), LocCode=plt.map@data$LocCode)
veg.data <- cbind(id=rownames(veg.map@data), LocCode=veg.map@data$LocCode)
# function to extract area from polygon data
get.area <- function(polygon) {
  row <- data.frame(id=polygon@ID, area=polygon@area, stringsAsFactors=F)
  return(row)
}
# area of each plot polygon
plt.areas <- do.call(rbind,lapply(plt.map@polygons, get.area))
plt.data  <- merge(plt.data,plt.areas, by="id")  # append area column to plt.data
# area of each vegetation polygon
veg.areas <- do.call(rbind,lapply(veg.map@polygons, get.area))
veg.data  <- merge(veg.data,veg.areas, by="id")  # append area column to veg.data
# total area of vegetation polygons by LocCode
veg.smry  <- aggregate(area~LocCode,data=veg.data,sum)
smry      <- merge(plt.data,veg.smry,by="LocCode")
smry$coverage <- with(smry,100*area.y/area.x)    # coverage percentage
# total area for vegetation object with A < 5 msq
veg.lt5   <- aggregate(area~LocCode,data=veg.data[veg.data$area<5,],sum)
smry      <- merge(smry, veg.lt5, by="LocCode") 
# fraction of covered area coming from veg. obj. with A < 5 msq
smry$pct.lt5 <- with(smry, 100*area/area.y)

产生这个：

# head(smry)
#   LocCode id   area.x   area.y coverage      area  pct.lt5
# 1       1  3 1165.916 259.2306 22.23408  60.98971 23.52720
# 2      10 11 1242.770 366.3222 29.47626  88.21827 24.08216
# 3      11 12 1181.366 213.2105 18.04779 129.21612 60.60496
# 4      12 13 1265.352 577.6037 45.64767 236.83946 41.00380
# 5      13 14 1230.662 226.2686 18.38593  48.09509 21.25575
# 6      14 15 1274.538 252.0577 19.77640  46.94874 18.62619

<强>解释

可以使用readOGR(...)包中的rgdal将Shapefile导入R中。导入多边形shapefile时，结果是“SpatialPolygonDataFrame”对象。这些对象基本上有两个部分：一个多边形部分，它具有绘制每个多边形所需的坐标;一个数据部分，它包含每个多边形的数据（因此，每个多边形一行）。如果shapefile导入为例如map，

map <- readOGR(dsn=".",layer="myShapeFile")

然后可以访问多边形和数据部分map@polygon和map@data。事实证明，多边形区域存储在多边形部分中。为了获得这些区域，我们定义了一个函数get.area(...)，它从多边形中提取区域和多边形ID。然后我们使用lapply(...)为所有多边形调用该函数，并使用rbind(...)将所有返回的值绑定在一起：

plt.areas <- do.call(rbind,lapply(plt.map@polygons, get.area))
veg.areas <- do.call(rbind,lapply(veg.map@polygons, get.area))

现在我们需要将植被区域与绘图多边形相关联。这是通过列LocCode完成的，该列存在于每个shapefile的数据部分中。因此，我们首先将多边形ID与LocCode关联，用于绘图和植被区域：

plt.data <- cbind(id=rownames(plt.map@data), LocCode=plt.map@data$LocCode)
veg.data <- cbind(id=rownames(veg.map@data), LocCode=veg.map@data$LocCode)

然后我们根据多边形ID附加区域列：

plt.data  <- merge(plt.data,plt.areas, by="id")  # append area column to plt.data
veg.data  <- merge(veg.data,veg.areas, by="id")  # append area column to veg.data

然后我们需要通过LocCode对植被区域求和：

veg.smry  <- aggregate(area~LocCode,data=veg.data,sum)

最后将其与绘图多边形区域合并：

smry      <- merge(plt.data,veg.smry,by="LocCode")

在smry数据框中，area.x是绘图的区域，area.y是该绘图中植被覆盖的总面积。因为，对于两个shapefile，投影是：

 +proj=utm +zone=13 +datum=NAD83 +units=m +no_defs +ellps=GRS80 +towgs84=0,0,0

单位为米，面积为msq。确定有多少植被来自＆lt; 5 msq，我们将植被面积计算为面积<1。 5并将该结果与smry合并：

veg.lt5   <- aggregate(area~LocCode,data=veg.data[veg.data$area<5,],sum)
smry      <- merge(smry, veg.lt5, by="LocCode") 

最后，通过数据，我们可以直接为每个绘图区域渲染地图：

cols   <- c("id","LocCode")
plt.df <- fortify(plt.map)
plt.df <- merge(plt.df,plt.data[cols],by="id")
veg.df <- fortify(veg.map)
veg.df <- merge(veg.df,veg.data[cols],by="id")
ggp <- ggplot(plt.df, aes(x=long, y=lat, group=group))
ggp <- ggp + geom_path()
ggp <- ggp + geom_polygon(data=veg.df, fill="green")
ggp <- ggp + facet_wrap(~LocCode,scales="free")
ggp <- ggp + theme(axis.text=element_blank())
ggp <- ggp + labs(x="",y="")
ggp <- ggp + coord_fixed()
ggp