R/available_data.R

In cft: Climate Futures Toolbox

#' @title Available data
#'
#' @description Using the default web link, this package retrieves daily gridded data sets of General Circulation Model
#' (GCM) runs clipped to areas of interest and returns a data frame of the
#' file names and they're storage paths. Each of these data sets represent
#' a single GCM, climate variable and Representative Concentration Pathway (RCP)
#' from 1950 to 2099. The 1950 to 2005 portion of this time period represents
#' historical data while the 2006 to 2099 portion represents modeled data. 
#' The original data sets may be found at
#' \url{http://thredds.northwestknowledge.net:8080/thredds/reacch_climate_CMIP5_aggregated_macav2_catalog.html}
#'
#' @param web_link A web link to the api data source you want to read (character)
#' @param verbose Should the api outputs be combined with internal metadata? (logical)
#'
#' @importFrom magrittr %>%
#' @importFrom rlang .data
#' @import epitools
#' @import tidync 
#' @import tidyr
#' @importFrom dplyr select left_join
#' @return Data.frame of requested data
#' @export
available_data <- function(web_link = "https://cida.usgs.gov/thredds/dodsC/macav2metdata_daily_future",
verbose = TRUE){
    message('Trying to connect to the USGS.gov API')
    
    src <- tidync::tidync(web_link)
    
    message('Reading results')
    
    variable_names <- src$variable %>% dplyr::select(.data$name) 
    variable_names <- variable_names[-1:-4,]
    
    available_times <- src %>% activate("D3") %>% hyper_tibble()
    
    colnames(variable_names) <- "Available variable"
    colnames(available_times) <- "Available times"
    available_times$`Available times` <- as.numeric(available_times$`Available times`)
    if(verbose==FALSE){
      return(list(
        "variable_names" = variable_names, 
        "available_times" = available_times,
        "src" = src
      ))  
    }else{
      message('Converting into an R data.table')
      
      
      mydates <- seq.Date(as.Date("2006-01-01"), 
                          as.Date("2099-12-31"), 
                          by = 1)
      
      myjulian <- julian(mydates, origin=as.Date("1900-01-01"))
      time_library <- as.data.frame(cbind("Available times" = myjulian, dates = as.character(epitools::julian2date(myjulian))))
      time_library$`Available times` <- as.numeric(time_library$`Available times`)
      
      available_times <- as.data.frame(available_times) %>% dplyr::left_join(time_library, by = "Available times")
      
      available_times$`Available times` <- as.numeric(available_times$`Available times`)
      
      
      scenarios <- as.data.frame(matrix(c("rcp45", "rcp85", "RCP 4.5", "RCP 8.5"), 2,2, byrow=FALSE))
      colnames(scenarios) <- c("scenario_abbreviation","scenario_name")
      
      labels <- as.data.frame(matrix(c("tasmin" , "Minimum Temperature",
                                       "tasmax" , "Maximum Temperature",
                                       "rhsmin" , "Minimum Relative Humidity",
                                       "rhsmax" , "Maximum Relative Humidity",
                                       "pr" , "Precipitation",
                                       "rsds" , "Surface Downswelling Shortwave Flux",
                                       "uas" , "Eastward Wind",
                                       "vas" , "Northward Wind",
                                       "huss" , "Specific Humidity",
                                       "vpd" , "Vapor Pressure Deficit",
                                       "rcp45" , "Representative Concentration Pathway 4.5",
                                       "rcp85" , "Representative Concentration Pathway 8.5",
                                       "bcc-csm1-1" , "Beijing Climate Center - Climate System Model 1.1",
                                       "bcc-csm1-1m" , "Beijing Climate Center - Climate System Model 1.1 Moderate Resolution",
                                       "BNU-ESM" , "Beijing Normal University - Earth System Model",
                                       "CanESM2" , "Canadian Earth System Model 2",
                                       "CCSM4" , "Community Climate System Model 4",
                                       "CNRM-CM5" , "Centre National de Recherches M\U00E9t\U00E9orologiques - Climate Model 5",
                                       "CSIRO-Mk3-6-0" , "Commonwealth Scientific and Industrial Research Organisation - Mk3.6.0",
                                       "GFDL-ESM2M" , "Geophysical Fluid Dynamics Laboratory - Earth System Model 2 Modular Ocean",  
                                       "GFDL-ESM2G" , "Geophysical Fluid Dynamics Laboratory - Earth System Model 2 Generalized Ocean Layer Dynamics",
                                       "HadGEM2-ES365" , "Hadley Global Environment Model 2 - Earth System 365 (day)",
                                       "HadGEM2-CC365" , "Hadley Global Environment Model 2 - Climate Chemistry 365 (day) ", 
                                       "inmcm4" , "Institute of Numerical Mathematics Climate Model 4",
                                       "IPSL-CM5A-LR" , "Institut Pierre Simon Laplace (IPSL) - Climate Model 5A - Low Resolution",
                                       "IPSL-CM5A-MR" , "Institut Pierre Simon Laplace (IPSL) - Climate Model 5A - Medium Resolution",
                                       "IPSL-CM5B-LR" , "Institut Pierre Simon Laplace (IPSL) - Climate Model 5B - Low Resolution",
                                       "MIROC5" , "Model for Interdisciplinary Research On Climate 5",      
                                       "MIROC-ESM" , "Model for Interdisciplinary Research On Climate - Earth System Model",
                                       "MIROC-ESM-CHEM" , "Model for Interdisciplinary Research On Climate - Earth System Model - Chemistry",
                                       "MRI-CGCM3" , "Meteorological Research Institute - Coupled Global Climate Model 3",
                                       "NorESM1-M" , "Norwegian Earth System Model 1 - Medium Resolution"), 32, 2, byrow=TRUE))
      
      labels <- as.data.frame(cbind(labels[,1], labels[,1], labels[,2]))
      colnames(labels) <- c("variable_abbreviation","model_abbreviation","name")
      
      units <- as.data.frame(matrix(c("Minimum Temperature" , "K",
                                      "Maximum Temperature" , "K",
                                      "Minimum Relative Humidity" , "%",
                                      "Maximum Relative Humidity" , "%",
                                      "Precipitation" , "mm",
                                      "Surface Downswelling Shortwave Flux" , "W m-2",
                                      "Eastward Wind" , "m s-1",
                                      "Northward Wind" , "m s-1",
                                      "Specific Humidity" , "kg kg-1",
                                      "Vapor Pressure Deficit" , "kPa"), 10,2, byrow=TRUE))
      colnames(units) <- c("Variable","Units")
      
      
      
      variable_names_verbose  <- variable_names %>% tidyr::separate("Available variable", "_",
                                                                    into = c("variable_abbreviation", "model_abbreviation", "ensemble","scenario_abbreviation"), 
                                                                    remove = FALSE)
      
      variable_names_verbose <- variable_names_verbose  %>% 
        dplyr::left_join(labels %>% dplyr::select("variable_abbreviation","name"), by=c("variable_abbreviation")) %>% 
        dplyr::left_join(labels %>% dplyr::select("model_abbreviation","name"), by=c("model_abbreviation")) %>% 
        dplyr::left_join(scenarios, by=c("scenario_abbreviation")) 
      
      
      
      
      
      names(variable_names_verbose) <- c("Available variable", "Variable abbreviation",
                                         "Model abbreviation",
                                         "Model ensemble type (only CCSM4 relevant)",
                                         "Scenario abbreviation",
                                         "Variable",
                                         "Model",
                                         "Scenario")
      
      variable_names_verbose <- variable_names_verbose  %>% 
        dplyr::left_join(units, by=c("Variable"))
      
      
      variable_names_verbose <- variable_names_verbose %>% dplyr::select("Available variable",
                                                                         "Variable",
                                                                         "Units",
                                                                         "Model",
                                                                         "Model ensemble type (only CCSM4 relevant)",
                                                                         "Scenario",
                                                                         "Variable abbreviation",
                                                                         "Model abbreviation",
                                                                         "Scenario abbreviation"
      )
      
      
      
      variable_names <- variable_names_verbose
      
      return(list(
        "variable_names" = variable_names, 
        "available_times" = available_times,
        "src" = src
      ))   
  }}