如何解决我想使用R和栅格数据确定行政级别的长期每日温度
我希望获得一些帮助,以找到确定行政级别几个国家平均降水量的最佳方法。我从
那里得到了地图china<-raster::getData('GADM',country='CHN',level=1)
limits.dep<- raster::aggregate(china,'NAME_1')
并且数据存储在.tiff文件中。
data.rain<- function(year){
print(year)
dates <- seq(as.Date(paste0(year,"-01-01")),as.Date(paste0(year,"-01-31")),by="days")
dates <- gsub('-','.',as.character(dates))
paths <- paste0(CHIRPS,year,'/',dates,'.tif.gz')
lapply(1:length(paths),function(k){
download.file(url = paths[k],destfile = paste0('./',basename(paths[k])),mode = 'wb')
})
}
CHIRPS <- 'https://data.chc.ucsb.edu/products/CHIRPS-2.0/global_daily/tifs/p05/'
data.rain(year=2020)
我有很多文件(每日数据),所以我也在寻找可以为我所有文件运行的文件。
我在网上发现了一些行之有效的方法,但是对于大型数据集,仅更改文件就需要花费大量时间。我将格式从.tiff
更改为.asc
,但是现在我有更多的时间了,所以我认为这不是最好的方法。
我正在使用的当前代码如下
pacman::p_load(raster,rdgal,rgeos,stringr,sf,tidyverse,RColorBrewer,glue,cowplot,ggpubr,ggspatial,shadowtext)
china<-raster::getData('GADM','NAME_1')
mps<- sf::st_as_sf(china)
# this are the results for each month
crn <- list.files('./data/chirps',full.names = TRUE,pattern = '.asc$') %>%
grep(paste0(c('januaryRain.asc','FebRain.asc','March.asc','April.asc','May.asc','Jun.asc','July.asc'),collapse = '|'),.,value = TRUE) #%>%
stack() %>% #file are raster raster
raster::crop(.,limits.dep) %>%
raster::mask(.,limits.dep)
# had to run the function because I didn't know how to collect the monthly information from crn
makeDelta <- function(fls){
# fle <- fls[1]
ftr2 <- list.files(fls,full.names = TRUE) %>%
grep(paste0(c('januaryRain.asc',#grep(paste0(c('rain.asc'),value = TRUE) %>%
stack() %>%
raster::crop(.,limits.dep) %>%
raster::mask(.,limits.dep)
dfr <- crn + ftr2-ftr2 #crn having the information that i need
return(dfr)
} # I also had to put each data set in different files in one folder and give them the same name
gcm <- list.files('./samename',full.names = FALSE) #folder
fls<- paste0('./samename/',gcm) #full path to each folder
dfr<-map(.x=fls,.f=makeDelta)
april <- lapply(1:length(dfr),function(k) dfr[[k]][[1]]) %>%
stack() %>%
mean()
feb <- lapply(1:length(dfr),function(k) dfr[[k]][[2]]) %>%
stack() %>%
mean()
jan <- lapply(1:length(dfr),function(k) dfr[[k]][[3]]) %>%
stack() %>%
mean()
july <- lapply(1:length(dfr),function(k) dfr[[k]][[4]]) %>%
stack() %>%
mean()
jun <- lapply(1:length(dfr),function(k) dfr[[k]][[5]]) %>%
stack() %>%
mean()
mar <- lapply(1:length(dfr),function(k) dfr[[k]][[6]]) %>%
stack() %>%
mean()
may <- lapply(1:length(dfr),function(k) dfr[[k]][[7]]) %>%
stack() %>%
mean()
mps$gid<-1:nrow(mps)
lyr.china <- raster::rasterize(as(mps,'Spatial'),jan,field = 'gid')
#results for each province
znl_01 <- raster::zonal(jan,lyr.china,fun = 'mean') %>%
as_tibble(.) %>%
inner_join(.,mps,by = c('zone' = 'gid')) %>%
dplyr::select(zone,mean,NAME_1,NL_NAME_1,TYPE_1,mean)
如果您可以改进此代码,那就太好了。如果您知道执行此操作的其他方法,我将非常感谢您的所有帮助。
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。