R/mf_list_variables.R

In ptaconet/opendapr: Fast and Efficient Access to MODIS Earth Observation Data

#' @name mf_list_variables
#' @aliases mf_list_variables
#' @title Get information for the variables (bands) available for a given collection
#' @description Get the variables available for a given collection, along with a set of related information for each.
#'
#' @inheritParams mf_get_url
#'
#' @return A data.frame with the variables available for the collection, and a set of related information for each variable.
#' The variables marked as "extractable" in the column "extractable_with_modisfast" can be provided as input parameter \code{variables} of the function \link{mf_get_url}
#'
#' @export
#'
#' @importFrom rvest html_table
#' @importFrom xml2 read_html
#' @importFrom stringr str_match word
#' @import purrr dplyr httr
#' @examples
#' \dontrun{
#' # login to Earthdata
#' log <- mf_login(c("earthdata_un", "earthdata_pw"))
#'
#' # Get the variables available for the collection MOD11A1.061
#' (df_varinfo <- mf_list_variables("MOD11A1.061"))
#' }
#'
mf_list_variables <- function(collection, credentials = NULL, verbose = "inform") { # for a given collection, get the available variables and associated information

  .testIfCollExists(collection)
  .testInternetConnection()
  .testLogin(credentials)

  httr::set_config(httr::authenticate(user = getOption("earthdata_user"), password = getOption("earthdata_pass"), type = "basic"))

  opendapMetadata <- opendapMetadata_internal[which(opendapMetadata_internal$collection == collection), ]

  URL <- opendapMetadata$url_opendapexample

  InfoURL <- paste0(URL, ".info")
  vector_response <- httr::GET(InfoURL)
  f <- function() {
    httr::GET(vector_response$url)
  }
  if(verbose %in% c("quiet","inform")){
    vector_response <- f()
  } else if (verbose == "debug"){
    vector_response <- httr::with_verbose(f())
  }
  httr::stop_for_status(vector_response)
  httr::warn_for_status(vector_response)
  if (vector_response$status_code == 400) {
    stop("Bad request\n")
  }
  vector_content <- httr::content(vector_response, "text", encoding = "UTF-8")
  vector_html <- xml2::read_html(vector_content)
  tab <- rvest::html_table(vector_html)
  if (purrr::is_empty(tab)) {
    stop("The server might be temporarily unavailable. Try again later. Paste ", InfoURL, " to check the error message in your brower\n")
  }
  tab <- tab[[length(tab)]]
  colnames(tab) <- c("name", "all_info")
  tab$name <- gsub(":", "", tab$name)
  tab$long_name <- stringr::str_match(tab$all_info, "long_name: (.*?)\n")[, 2]
  tab$units <- stringr::str_match(tab$all_info, "units: (.*?)\n")[, 2]

  DdsURL <- paste0(URL, ".dds")
  vector_response <- httr::GET(DdsURL)

  if(verbose %in% c("quiet","inform")){
    vector_response <- f()
  } else if (verbose == "debug"){
    vector_response <- httr::with_verbose(f())
  }
  httr::stop_for_status(vector_response)
  httr::warn_for_status(vector_response)

  vector <- httr::content(vector_response, "text", encoding = "UTF-8")
  vector <- strsplit(vector, "\n")
  vector <- vector[[1]][-length(vector[[1]])]
  vector <- vector[-1]
  vector <- gsub("    ", "", vector)
  vector <- gsub(";", "", vector)

  variables <- gsub("\\[", " \\[", vector)

  indices <- gsub(" = ", "=", variables)
  indices <- purrr::map_chr(indices, ~ stringr::word(., 3, -1))
  indices <- gsub("=", " = ", indices)

  variables <- purrr::map_chr(variables, ~ stringr::word(., 2))

  variables_indices <- data.frame(name = variables, indices = indices, stringsAsFactors = FALSE)

  tab <- dplyr::left_join(tab, variables_indices, by = "name")

  # add a column to specify whether the variable is extractable or not with modisfast

  dim_lon <- opendapMetadata$dim_lon
  dim_lat <- opendapMetadata$dim_lat
  dim_time <- opendapMetadata$dim_time
  dim_proj <- opendapMetadata$dim_proj

  tab <- tab %>%
    dplyr::mutate(extractable_with_modisfast = dplyr::case_when(
      name %in% c(dim_lon, dim_lat, dim_time, dim_proj) ~ "automatically extracted",
      grepl(dim_lon, tab$indices) & grepl(dim_lat, tab$indices) & grepl(dim_time, tab$indices) & !is.na(dim_time) ~ "extractable",
      grepl(dim_lon, tab$indices) & grepl(dim_lat, tab$indices) & is.na(dim_time) ~ "extractable"
    ))

  tab$extractable_with_modisfast[which(is.na(tab$extractable_with_modisfast))] <- "not extractable"

  if (opendapMetadata$source == "SMAP") {
    tab$extractable_with_modisfast[which(tab$extractable_with_modisfast == "not extractable")] <- "extractable"
  }


  tab <- tab[c("name", "long_name", "units", "indices", "all_info", "extractable_with_modisfast")]

  return(tab)
}