使用 R 语言计算工企周边一定范围内的平均 PM2.5 浓度

之前给大家分享过历年工企周边的 PM2.5 浓度数据,今天我们一起来看下这种数据是如何使用 R 语言计算的。

历年工企业周边年平均 PM2.5 浓度面板数据:https://rstata.duanshu.com/#/brief/course/96e2daf6e4d94af9baf7f98908d6c535

逐年计算

首先我在附件中给大家准备了大概 1 万条工企数据的样本:

library(tidyverse)
library(sf)
library(terra)

# 读取工企数据
haven::read_dta("工企样本.dta") -> df
# 生成年份变量
df %>%
mutate(year = as.numeric(str_sub(as.character(gqid), 1, 4))) -> df
df

#> # A tibble: 10,098 × 6
#> group gqid 企业名称 经度 纬度 year
#> <dbl> <dbl> <chr> <dbl> <dbl> <dbl>
#> 1 718200 2004002192 肇源县电业局 125. 45.5 2004
#> 2 718200 1998329797 肇源县电业局 125. 45.5 1998
#> 3 718200 2010055403 肇源县电业局 125. 45.5 2010
#> 4 718200 2000030231 黑龙江省大庆市肇源县电业局 125. 45.5 2000
#> 5 718200 2002029419 肇源县电业局 125. 45.5 2002
#> 6 718200 2009296420 肇源县电业局 125. 45.5 2009
#> 7 718200 2012040413 肇源县电业局 125. 45.5 2012
#> 8 718200 2014263271 肇源县电业局 125. 45.5 2014
#> 9 718200 2011161483 肇源县电业局 125. 45.5 2011
#> 10 718200 2007169319 肇源县电业局 125. 45.5 2007
#> # ℹ 10,088 more rows

转换成 sf 对象:

df %>%
fill(经度, 纬度, .direction = "updown") %>%
st_as_sf(coords = c("经度", "纬度"), crs = 4326) -> dfsf

dfsf
#> Simple feature collection with 10098 features and 4 fields
#> Geometry type: POINT
#> Dimension: XY
#> Bounding box: xmin: 106.7291 ymin: 31.78151 xmax: 129.6261 ymax: 49.56619
#> Geodetic CRS: WGS 84
#> # A tibble: 10,098 × 5
#> group gqid 企业名称 year geometry
#> * <dbl> <dbl> <chr> <dbl> <POINT [°]>
#> 1 718200 2004002192 肇源县电业局 2004 (125.0754 45.5125)
#> 2 718200 1998329797 肇源县电业局 1998 (125.0754 45.5125)
#> 3 718200 2010055403 肇源县电业局 2010 (125.0754 45.5125)
#> 4 718200 2000030231 黑龙江省大庆市肇源县电业局 2000 (125.0754 45.5125)
#> 5 718200 2002029419 肇源县电业局 2002 (125.0754 45.5125)
#> 6 718200 2009296420 肇源县电业局 2009 (125.0754 45.5125)
#> 7 718200 2012040413 肇源县电业局 2012 (125.0754 45.5125)
#> 8 718200 2014263271 肇源县电业局 2014 (125.0754 45.5125)
#> 9 718200 2011161483 肇源县电业局 2011 (125.0754 45.5125)
#> 10 718200 2007169319 肇源县电业局 2007 (125.0754 45.5125)
#> # ℹ 10,088 more rows

首先以 2004 年为例讲解计算过程:

dfsf %>%
filter(year == 2004) -> dfsf2004

dfsf2004

#> Simple feature collection with 594 features and 4 fields
#> Geometry type: POINT
#> Dimension: XY
#> Bounding box: xmin: 106.8158 ymin: 31.88336 xmax: 128.4702 ymax: 49.56619
#> Geodetic CRS: WGS 84
#> # A tibble: 594 × 5
#> group gqid 企业名称 year geometry
#> * <dbl> <dbl> <chr> <dbl> <POINT [°]>
#> 1 718200 2004002192 肇源县电业局 2004 (125.0754 45.5125)
#> 2 718201 2004002193 肇州县电业局 2004 (125.2614 45.70529)
#> 3 718203 2004002196 黑龙江省延寿县电业局 2004 (128.3165 45.44723)
#> 4 718204 2004002197 逊克县电业局 2004 (128.4702 49.56619)
#> 5 718257 2004002372 中国印刷总公司 2004 (116.3437 39.93172)
#> 6 718263 2004002380 常林股份有限公司 2004 (119.8291 31.88336)
#> 7 718264 2004002384 清华同方股份有限公司 2004 (116.3283 39.996)
#> 8 718268 2004002394 北京市热力集团有限公司 2004 (116.4297 39.95771)
#> 9 718271 2004002411 北京长亿参饮料有限公司 2004 (116.6549 40.09434)
#> 10 718272 2004002415 北京卷烟厂 2004 (116.573 39.91558)
#> # ℹ 584 more rows

生成坐标点周边 5km 的缓冲区(圆形区域):

dfsf2004 %>%
st_buffer(dist = units::set_units(5, km)) -> dfbuffer_5km

这个区域数据是这样的:

library(leaflet)
url <- "http://map.geoq.cn/ArcGIS/rest/services/ChinaOnlineStreetWarm/MapServer/tile/{z}/{y}/{x}"
leaflet() %>%
addTiles(url, attribution = "微信公众号 RStata") -> map

# 仅展示名称含有“北京”的
dfbuffer_5km %>%
filter(str_detect(企业名称, "北京")) %>%
mapview::mapview(map = map)

读取 2004 年的栅格数据:

rast("yeartif/cn2004.tif") -> rst
rst
#> class : SpatRaster
#> dimensions : 4724, 6159, 1 (nrow, ncol, nlyr)
#> resolution : 0.01, 0.01 (x, y)
#> extent : 73.5, 135.09, 6.320002, 53.56 (xmin, xmax, ymin, ymax)
#> coord. ref. : lon/lat WGS 84 (EPSG:4326)
#> source : cn2004.tif
#> name : cn2004
#> min value : 1
#> max value : 108

然后就可以提取各工企 5km 范围内的 PM2.5 浓度均值了:

terra::extract(rst, vect(dfbuffer_5km),
fun = "mean", na.rm = T, exact = T) %>%
as_tibble() -> res5km

再和原数据合并:

dfbuffer_5km %>%
st_drop_geometry() %>%
mutate(ID = row_number()) %>%
left_join(res5km) %>%
select(-ID) %>%
rename(PM25_5km = cn2004) -> df5km

df5km
#> # A tibble: 594 × 5
#> group gqid 企业名称 year PM25_5km
#> <dbl> <dbl> <chr> <dbl> <dbl>
#> 1 718200 2004002192 肇源县电业局 2004 32.1
#> 2 718201 2004002193 肇州县电业局 2004 31.5
#> 3 718203 2004002196 黑龙江省延寿县电业局 2004 34.5
#> 4 718204 2004002197 逊克县电业局 2004 18.1
#> 5 718257 2004002372 中国印刷总公司 2004 80.5
#> 6 718263 2004002380 常林股份有限公司 2004 62.3
#> 7 718264 2004002384 清华同方股份有限公司 2004 72.6
#> 8 718268 2004002394 北京市热力集团有限公司 2004 80.7
#> 9 718271 2004002411 北京长亿参饮料有限公司 2004 70.4
#> 10 718272 2004002415 北京卷烟厂 2004 78.6
#> # ℹ 584 more rows

对于多年数据,循环各年然后合并即可:

dfsf %>%
st_buffer(dist = units::set_units(5, km)) -> dfsfbuffer_5km

dfsfbuffer_5km
lapply(1998:2014, function(x){
print(x)
dfsfbuffer_5km %>%
filter(year == x) -> buffertemp
rast(paste0("yeartif/cn", x, ".tif")) -> rsttemp

terra::extract(rsttemp, vect(buffertemp),
fun = "mean", na.rm = T, exact = T) %>%
as_tibble() -> restemp
buffertemp %>%
st_drop_geometry() %>%
mutate(ID = row_number()) %>%
left_join(restemp) %>%
select(-ID) %>%
set_names("group", "gqid", "企业名称",
"year", "PM25_5km")
}) %>%
bind_rows() -> dfall

dfall
#> # A tibble: 10,098 × 5
#> group gqid 企业名称 year PM25_5km
#> <dbl> <dbl> <chr> <dbl> <dbl>
#> 1 718200 1998329797 肇源县电业局 1998 32.3
#> 2 718201 1998329798 肇州县电业局 1998 33.8
#> 3 718203 1998164685 延寿县电业局 1998 32.5
#> 4 718204 1998021653 逊克县电业局 1998 28.9
#> 5 718257 1998329958 中国印刷总公司 1998 65.9
#> 6 718263 1998164852 常林股份有限公司 1998 46.9
#> 7 718264 1998329970 清华同方股份有限公司 1998 60.2
#> 8 718268 1998329984 北京市热力公司 1998 66.0
#> 9 718271 1998330005 北京偿亿人参饮料有限公司 1998 58.0
#> 10 718272 1998164894 北京卷烟厂 1998 62.1
#> # ℹ 10,088 more rows

这样就得到了所有企业各年周边 5km 范围内的平均 PM2.5 浓度。

如果想要多个距离的,可以再嵌套一个循环,例如计算 5 和 10km 的:

lapply(c(5, 10), function(y){
print(y)
dfsf %>%
st_buffer(dist = units::set_units(y, km)) -> dfsfbuffer_temp
lapply(1998:2014, function(x){
dfsfbuffer_temp %>%
filter(year == x) -> buffertemp
rast(paste0("yeartif/cn", x, ".tif")) -> rsttemp

terra::extract(rsttemp, vect(buffertemp),
fun = "mean", na.rm = T, exact = T) %>%
as_tibble() -> restemp
suppressMessages({
buffertemp %>%
st_drop_geometry() %>%
mutate(ID = row_number()) %>%
left_join(restemp) %>%
select(-ID) %>%
set_names("group", "gqid", "企业名称",
"year", paste0("PM25_", y, "km"))
})
}) %>%
bind_rows()
}) -> resall

resall %>%
reduce(left_join) -> resalldf

resalldf

# 保存
resalldf %>%
haven::write_dta("1998~2014年部分工企周边的平均PM2.5浓度.dta")

绘图:

haven::read_dta("1998~2014年部分工企周边的平均PM2.5浓度.dta") -> resalldf
library(gghighlight)
ggplot(resalldf, aes(x = year, y = PM25_5km,
color = factor(group))) +
geom_line() +
gghighlight(group %in% sample(unique(resalldf$group),
size = 8),
label_params = list(family = cnfont,
label = "企业名称")) +
scale_color_brewer(palette = "Set1") +
ggthemes::theme_solarized_2(base_family = cnfont) +
theme(plot.background = element_rect(fill = "#fff5e3"),
plot.margin = grid::unit(rep(0.8, 4), "cm"),
axis.title.x = element_blank()) +
theme(legend.position = "none") +
scale_x_continuous(breaks = 1998:2014) +
scale_y_continuous(breaks = seq(0, 150, by = 20)) +
labs(y = "年均 PM2.5 质量浓度(µg/m3)",
title = "1998~2014年部分工企周边 5km 范围内的平均 PM2.5 浓度",
subtitle = "数据计算:微信公众号 RStata",
caption = "数据来源:工企数据库,经纬度根据高德地图地理编码接口解析,PM2.5 栅格数据来源于华盛顿大学圣路易斯分校") -> p

这个过程的计算原理可以通过下面的图理解:

library(raster)
read_sf("北京长条范围.geojson") -> fanwei
raster("yeartif/cn2004.tif") -> rst
rst %>%
raster::mask(fanwei) %>%
raster::crop(fanwei) %>%
rasterToPolygons() -> rstpoly

# 提取范围内的
dfbuffer_5km %>%
st_intersection(fanwei) -> dftemp
rstpoly %>%
st_as_sf() %>%
st_intersection(fanwei) -> rstpolytemp

library(mapview)
mapview(rstpolytemp,
layer.name = "NDVI") +
mapview(dftemp,
layer.name = "5 km", map = map)

再回想前面的提取代码为:

# terra::extract(rst, vect(dfbuffer_5km),
# fun = "mean", na.rm = T, exact = T) %>%
# as_tibble() -> res5km

也就是加总平均每个圆圈内的值,如果使用了 exact = T 参数,表示边缘的方块根据进入内部的比例计算,如果 exact = F,表示边缘的方块不作考虑,只计算内部的。

直接计算多年的

另外也可以使用这样的方法计算:

fs::dir_ls("yeartif")

rast(fs::dir_ls("yeartif")) -> rst

terra::extract(rst, vect(dfsfbuffer_5km),
fun = "mean", na.rm = T, exact = T) %>%
as_tibble() -> res5km

res5km

#> # A tibble: 10,098 × 18
#> ID cn1998 cn1999 cn2000 cn2001 cn2002 cn2003 cn2004 cn2005 cn2006 cn2007
#> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 1 32.3 27.9 33.8 34.5 36.9 43.9 32.1 34.7 42.1 38.9
#> 2 2 32.3 27.9 33.8 34.5 36.9 43.9 32.1 34.7 42.1 38.9
#> 3 3 32.3 27.9 33.8 34.5 36.9 43.9 32.1 34.7 42.1 38.9
#> 4 4 32.3 27.9 33.8 34.5 36.9 43.9 32.1 34.7 42.1 38.9
#> 5 5 32.3 27.9 33.8 34.5 36.9 43.9 32.1 34.7 42.1 38.9
#> 6 6 32.3 27.9 33.8 34.5 36.9 43.9 32.1 34.7 42.1 38.9
#> 7 7 32.3 27.9 33.8 34.5 36.9 43.9 32.1 34.7 42.1 38.9
#> 8 8 32.3 27.9 33.8 34.5 36.9 43.9 32.1 34.7 42.1 38.9
#> 9 9 32.3 27.9 33.8 34.5 36.9 43.9 32.1 34.7 42.1 38.9
#> 10 10 32.3 27.9 33.8 34.5 36.9 43.9 32.1 34.7 42.1 38.9
#> # ℹ 10,088 more rows
#> # ℹ 7 more variables: cn2008 <dbl>, cn2009 <dbl>, cn2010 <dbl>, cn2011 <dbl>,
#> # cn2012 <dbl>, cn2013 <dbl>, cn2014 <dbl>

再合并原数据、去除不同年份的结果即可:

dfsfbuffer_5km %>%
st_drop_geometry() %>%
mutate(ID = row_number()) %>%
left_join(res5km) %>%
select(-ID) %>%
gather(contains("cn"), key = "key", value = "PM25_5km") %>%
mutate(key = str_remove_all(key, "cn"),
key = as.numeric(key)) %>%
filter(year == key) %>%
slice(-key)
#> # A tibble: 10,081 × 6
#> group gqid 企业名称 year key PM25_5km
#> <dbl> <dbl> <chr> <dbl> <dbl> <dbl>
#> 1 718200 1998329797 肇源县电业局 1998 1998 32.3
#> 2 718201 1998329798 肇州县电业局 1998 1998 33.8
#> 3 718203 1998164685 延寿县电业局 1998 1998 32.5
#> 4 718204 1998021653 逊克县电业局 1998 1998 28.9
#> 5 718257 1998329958 中国印刷总公司 1998 1998 65.9
#> 6 718263 1998164852 常林股份有限公司 1998 1998 46.9
#> 7 718264 1998329970 清华同方股份有限公司 1998 1998 60.2
#> 8 718268 1998329984 北京市热力公司 1998 1998 66.0
#> 9 718271 1998330005 北京偿亿人参饮料有限公司 1998 1998 58.0
#> 10 718272 1998164894 北京卷烟厂 1998 1998 62.1
#> # ℹ 10,071 more rows

有时候我们也会遇到不同年份的栅格数据范围不一致、分辨率不一致的问题(会无法直接使用 rast 读取),这个时候可以先把各年的栅格数据重采样成一致的,然后再使用 rast() 读取:

fs::dir_ls("yeartif") -> fls
# 读取第一个
rast(fls[1]) -> rst1

# 然后循环所有的年份,都重采样成和第一年一样的
lapply(fls, function(x){
rast(x) %>%
terra::resample(rst1)
}) %>%
rast() -> rstnew

names(rstnew) <- 1998:2014
rstnew

#> class : SpatRaster
#> dimensions : 4724, 6159, 17 (nrow, ncol, nlyr)
#> resolution : 0.01, 0.01 (x, y)
#> extent : 73.5, 135.09, 6.320002, 53.56 (xmin, xmax, ymin, ymax)
#> coord. ref. : lon/lat WGS 84 (EPSG:4326)
#> source(s) : memory
#> names : 1998, 1999, 2000, 2001, 2002, 2003, ...
#> min values : 1.3, 1.4, 1.6, 1.3, 1.2, 1.0, ...
#> max values : 87.0, 91.8, 96.8, 115.5, 113.1, 104.4, ...

然后后面的操作就都一样了。

点击这里跳转到 RStata 短书平台获取附件:使用 R 语言计算工企周边一定范围内的平均 PM2.5 浓度

评论