我想使用R和栅格数据确定行政级别的长期每日温度

编程问答 2022-08-13

问题描述

我希望获得一些帮助，以找到确定行政级别几个国家平均降水量的最佳方法。我从

那里得到了地图 
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 @R_755_4045@ion 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 @R_755_4045@ion 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 (将#修改为@）

functionfunctiongeospatialrrr-rasterspatial