Codes for calculation of climate data

Codes for climate data calculation

If you wish to perform the dataset calculations independently, for example, with other methods or more annual data, please download the original data and refer to the code provided below. Due to high memory usage and time requirements, we have refrained from incorporating these codes as a package function.

The download link of original data as below:

2010-2019 monthly minimum temperature

2010-2019 monthly maximum temperature

2010-2019 monthly precipitation

The code for cacluation are as below:

imp_path: path of import Worldclim Historical monthly weather data, every kind of dataset(mintemp,maxtemp,prec)should be saparated in different folders
exp_path: path of export arranged data in format of .tif
name: the name of .tif file to differentiate the data
method: the method for calculating the raster,default is “mean” to calculate annual average climatic values. Set as “min” to calculate annual minimum climatic values for forsty month display.

#Please check whether you have installed these packages
library(raster)
library(sf)
library(plyr)
library(dplyr)
library(stringr)
library(future.apply)
library(parallel)

clim_cal <- function(imp_path,
                     exp_path,
                     name = NA,
                     method = "mean",
                     parallel = 1) {
  tifname <- list.files(imp_path, full.names = TRUE)

  rastermean <- function(num) {
    tif <- tifname[tifname %>% str_detect(pattern = paste0("-", num, ".tif"))]
    val <- lapply(tif, raster) %>%
      brick() %>%
      calc(mean)
    return(val)
  }

  rastermin <- function(num) {
    tif <- tifname[tifname %>% str_detect(pattern = paste0("-", num, ".tif"))]
    val <- lapply(tif, raster) %>%
      brick() %>%
      calc(min)
    return(val)
  }

  plan(multisession, workers = parallel)
  month <- c(1:12) %>% str_pad(2, side = "left", "0")

  if (method == "mean") {
    raster <- future_lapply(month, function(x) rastermean(x))
  } else if (method == "min") {
    raster <- future_lapply(month, function(x) rastermin(x))
  }

  rasterstack <- raster %>% stack()
  path <- exp_path
  for (i in 1:12) {
    ras <- raster(rasterstack, layer = i)
    # export the RasterLayer
    writeRaster(ras, file.path(path, paste0(name, "_", month[i], ".tif")))
  }
}

Then use the code below to extract the data.frames for climatic diagram plotting:

file: A data.frame. It must be the same as the import data of clim_extract with the five columns(please refer to the data locdata in this package).
mintemp_path: The path of export arranged data of monthly minimum temperature in format .tif
maxtemp_path : The path of export arranged data of monthly maximum temperature in format .tif
prec_path: The path of export arranged data of monthly precipitation in format .tif

clim_extract <- function(file,mintemp_path = NA,
                         maxtemp_path = NA,
                         prec_path = NA) {
  if (!is.numeric(file$lon)) {
    stop("The longitude should be numeric")
  }
  if (!is.numeric(file$lat)) {
    stop("The latitude should be numeric")
  }

  extract_one_location <- function(sub) {
    No <- sub$No
    lon <- sub$lon
    lat <- sub$lat
    
    mintemp <- list.files(mintemp_path,full.names = T) %>% stack()
    maxtemp <- list.files(maxtemp_path,full.names = T) %>% stack()
    avprec <- list.files(prec_path,full.names = T) %>% stack()
    
    if (is.null(mintemp) || is.null(maxtemp) || is.null(avprec)) {
      stop(paste("Can not find data for location", No))
    }
    
    
    point <- st_as_sf(sub, coords = c("lon", "lat"), crs = 4326)
    
    prec <- raster::extract(avprec, point) %>%
      as_tibble() 
    
    colnames(prec) <- as.character(c(1:12))
    
    avtemp1 <- raster::extract(mintemp, point) %>%
      as_tibble() 
    
    colnames(avtemp1) <- as.character(c(1:12))
    
    avtemp2 <- raster::extract(maxtemp, point) %>%
      as_tibble() 
    
    colnames(avtemp2) <- as.character(c(1:12))
    
    
      avtemp3 <- apply(rbind(avtemp1, avtemp2), 2, mean) %>%
        t() %>%
        as_tibble()
    
    avtemp1 <- avtemp1 %>% dplyr::mutate(
      No = sub$No,
      Altitude = sub$altitude,
      Location = sub$location,
      Lon = sub$lon,
      Lat = sub$lat,
      Type = "min_temp", .before = 1
    )
    
    avtemp2 <- avtemp2 %>% dplyr::mutate(
      No = sub$No,
      Altitude = sub$altitude,
      Location = sub$location,
      Lon = sub$lon,
      Lat = sub$lat,
      Type = "max_temp", .before = 1
    )
    
    avtemp3 <- avtemp3 %>% dplyr::mutate(
      No = sub$No,
      Altitude = sub$altitude,
      Location = sub$location,
      Lon = sub$lon,
      Lat = sub$lat,
      Type = "mean_temp", .before = 1
    )
    
    prec <- prec %>% dplyr::mutate(
      No = sub$No,
      Altitude = sub$altitude,
      Location = sub$location,
      Lon = sub$lon,
      Lat = sub$lat,
      Type = "prec", .before = 1
    )
    
    clidata <- rbind(prec, avtemp3, avtemp1, avtemp2) %>% arrange(No)
    
    return(clidata)
  }
  
  
  
  all_clidata <- ddply(file, ~No, extract_one_location)
  
  return(all_clidata)
}

Reference

Fick, S.E. and R.J. Hijmans, (2017). WorldClim 2: new 1km spatial resolution climate surfaces for global land areas. International Journal of Climatology 37 (12): 4302-4315.
Harris, I., Osborn, T.J., Jones, P.D., Lister, D.H. (2020). Version 4 of the CRU TS monthly high-resolution gridded multivariate climate dataset. Scientific Data 7: 109.

Auman Chan, PhD Candidate

2023-10-13

Codes for climate data calculation

Reference