R/Daily_climNASA.R

In gcostaneto/envirotype: GIS platforms to support envirorytping in breeding programs

#'@title  Getting daily-scale weather data
#'
#'
#' @description Imports daily-scale weather data from the NASA POWER GIS database
#' @author Germano Martins F Costa Neto
#' @param .env vector containg site identification
#' @param .lat vector (numeric) containing latitude values
#' @param .lon vector (numeric) containing longitude values
#' @param .variables list of variables names
#' @param .start start point
#' @param .end end point
#' @param .path output directorie
#' @importFrom utils write.csv
#' @importFrom nasapower get_power
#' @importFrom utils install.packages

#'----------------------------------------------------------------------------------------
#' getting weather data from NASAPOWER GIS database
#' adaptation from nansapower package's get_power function
#'----------------------------------------------------------------------------------------
get_weather = function(.env=NULL,
                      .lat=NULL,
                      .lon=NULL,
                      .start=NULL,
                      .end=NULL,
                      .variables=NULL,
                      .path=NULL,
                      .save=FALSE,
                      .dataframe=FALSE,
                      .temporal = 'DAILY'){
  
  #' if nasapower is not installed, the CRAN version will be installed
  if (!require(nasapower)) {install.packages("nasapower")}
  
  #' if output .path is null, the current directorie folder will be used
  if(is.null(.path)){.path = getwd()}
  
  #' if variables is null, the default list will be used
  if(is.null(.variables)){
    .variables = c("T2M","T2M_MAX","T2M_MIN","PRECTOT",
                   "WS2M","RH2M","T2MDEW","ALLSKY_SFC_LW_DWN",
                   "ALLSKY_SFC_SW_DWN","ALLSKY_TOA_SW_DWN")
  }
  
  #' preapring outputs
  .env = as.factor(.env)
  .Ne = length(.env)
  .C = vector(length = .Ne,"list")
  
  for(.E in 1:.Ne){
    CL = data.frame(nasapower::get_power(community = "AG",lonlat = c(.lon[.E], .lat[.E]),
                              pars = .variables,
                              dates = c(.start[.E],.end[.E]),
                              temporal_average = .temporal))
    CL$daysFromStart = 1:nrow(CL)
    .C[[.E]] = CL
    names(.C)[[.E]] = .env[.E]
    
    #' if .save is true, write the weather into csv files
    if(isTRUE(.save)){write.csv(file=paste(.env[.E],".csv",sep=""), x= CL)}
    
  }
  
  names(.C) = .env
  #' if .dataframe is true, df_convert function will be used
  if(isTRUE(.dataframe)){ .C = ldply(.C)}
  return(.C)
}

#'----------------------------------------------------------------------------------------
#' convert list of weather data into workable dataframe
#'----------------------------------------------------------------------------------------
df_convert = function(.dailyclim){
  df.clim = NULL
  for(K in 1:length(.dailyclim)){
    df.clim = rbind(df.clim,data.frame(.dailyclim[[K]],
                                       dayFromStart=1:nrow(.dailyclim[[K]]),
                                       environment =names(.dailyclim)[K]))}
  return(df.clim)}

#'----------------------------------------------------------------------------------------  
#' adjusting developmental stages
#'----------------------------------------------------------------------------------------
stage.by.dae = function(.dae=NULL, .breaks=NULL, .names=NULL){
  if(is.null(.dae)){stop(".dae is missing")}
  if(is.null(.breaks)){.breaks<-seq(from=1-min(.dae),to=max(.dae)+10,by=10)}
  if(is.null(.names)){.names <-paste0("stage_",.breaks)}
  pstage = cut(x = .dae,breaks=.breaks,right = F)
  levels(pstage) = .names
  return(pstage)
}

#'----------------------------------------------------------------------------------------  
#' degree-days sum
#'----------------------------------------------------------------------------------------
gdd <- function(tmax, tmin, tbase, tbase_max) {
  adjust_for_tbase <- function(x, tbase) {
    ifelse(test = x < tbase, yes = tbase, no = x)
  }
  adjust_for_tbase_max <- function(x, tbase_max) {
    ifelse(test = x > tbase_max, yes = tbase_max, no = x)
  }
  
  tmax_adjusted <- adjust_for_tbase(tmax, tbase)
  tmin_adjusted <- adjust_for_tbase(tmin, tbase)
  
  tmax_adjusted <- adjust_for_tbase_max(tmax_adjusted, tbase_max)
  tmin_adjusted <- adjust_for_tbase_max(tmin_adjusted, tbase_max)
  
  gdd_temp <- (tmax_adjusted + tmin_adjusted) / 2 - tbase
  cumsum(gdd_temp)
}