R/ee_search.R

In ryali93/rgee: R bindings for calling the Earth Engine API

#' Interface to search into the Earth Engine Data Catalog
#'
#' R functions for searching in Earth Engine's public data archive.
#'
#' @param quiet logical. Suppress info message
#' @param ee_dataset data.frame. Generated by rgee::ee_search_Datasets().
#' It is automatically updated and expanded weekly.
#' @param stardate Character. Start date of dataset availability.
#' @param enddate Character. End date of dataset availability.
#' @param provider Character. Name of the dataset's provider. See
#' ee_search_provider_list()
#' @param type Character. "Image", "ImageCollection" or a "table".
#' @param ... Character vector. tags
#' @param logical_operator Character. Available just for rgee::ee_search_tags
#' and rgee::ee_search_title. 'AND' represents inclusiveness between tags in
#' searching and 'OR' exclusiveness.
#' @param upgrade Logical. If the dataset needs to be upgraded.
#' @param maxdisplay Numeric. Maximum number of tabs to display in their browser
#' @name ee_search-tools
#' @return a data.frame.
#' @examples
#' library(rgee)
#'
#' ee_reattach() # reattach ee as a reserved word
#' ee_Initialize()
#'
#' # ee_search_provider_list()
#' # ee_search_title_list()
#' myquery <- ee_dataset() %>%
#'   ee_search_type("Image") %>%
#'   ee_search_provider("WWF") %>%
#'   ee_search_tags("srtm", "flow", "direction", "dem") %>%
#'   ee_search_title("15", "Flow", logical_operator = "AND")
#' print(myquery$id)
#' @export
ee_dataset <- function(quiet = FALSE, upgrade = FALSE) {
  ee_date <- Sys.Date()
  ee_dataset_file <- sprintf("%s/ee_dataset.csv",
                             path.expand("~/.config/earthengine"))
  if (file.exists(ee_dataset_file) & !upgrade) {
    ee_dataset <- read.csv(ee_dataset_file, stringsAsFactors = FALSE)
  } else {
    user_samapriya <- 'https://raw.githubusercontent.com/csaybar/'
    ee_template <- "%sEarth-Engine-Datasets-List/master/eed-%s.csv"
    ee_dataset <- suppressWarnings(
      try(
        expr = read.csv(
          file = sprintf(ee_template,user_samapriya, ee_date),
          stringsAsFactors = FALSE),
        silent = TRUE
      )
    )
    ncount <- 1

    if (!quiet) {
      cat("Downloading(Upgrading) the Earth Engine catalog ... please wait\n")
    }

    while (class(ee_dataset) == "try-error" & ncount < 30) {
      ee_date <- ee_date - 1
      ee_dataset <- suppressWarnings(
        try(
          expr = read.csv(
            file = sprintf(ee_template,user_samapriya, ee_date),
            stringsAsFactors = FALSE),
          silent = TRUE
        )
      )
      ncount <- ncount + 1
    }
    write.csv(x = ee_dataset,file =  ee_dataset_file, row.names = FALSE)
  }
  return(ee_dataset)
}

#' @name ee_search-tools
#' @export
ee_search_startdate <- function(ee_dataset, stardate) {
  m <- gregexpr("[\\w']+", ee_dataset$start_date, perl = TRUE)
  ee_start_date <- ee_dataset$start_date %>%
    regmatches(m) %>%
    lapply(fix_date)
  m <- do.call(c, m)
  stardate <- as.Date(stardate)
  ee_dataset_q <- ee_dataset[which(ee_start_date > stardate), ]
  rownames(ee_dataset_q) <- NULL
  return(ee_dataset_q)
}

#' @name ee_search-tools
#' @export
ee_search_enddate <- function(ee_dataset, enddate = Sys.Date()) {
  m <- gregexpr("[\\w']+", ee_dataset$end_date, perl = TRUE)
  ee_end_date <- ee_dataset$end_date %>%
    regmatches(m) %>%
    lapply(fix_date)
  m <- do.call(c, m)
  enddate <- as.Date(enddate)
  ee_dataset_q <- ee_dataset[which(ee_end_date < enddate), ]
  rownames(ee_dataset_q) <- NULL
  return(ee_dataset_q)
}

#' @name ee_search-tools
#' @export
ee_search_type <- function(ee_dataset, type) {
  ee_dataset_type <- tolower(ee_dataset$type)
  type <- tolower(type)
  if (type %in% unique(ee_dataset_type)) {
    ee_dataset_q <- ee_dataset[ee_dataset_type %in% type, ]
    rownames(ee_dataset_q) <- NULL
    return(ee_dataset_q)
  } else {
    stop("type argument is not valid")
  }
}

#' @name ee_search-tools
#' @export
ee_search_provider <- function(ee_dataset, provider) {
  if (provider %in% unique(ee_dataset$provider)) {
    ee_dataset_q <- ee_dataset[ee_dataset$provider %in% provider, ]
    rownames(ee_dataset_q) <- NULL
    return(ee_dataset_q)
  } else {
    stop("provider argument is not valid")
  }
}

#' @name ee_search-tools
#' @export
ee_search_provider_list <- function(ee_dataset) {
  return(unique(ee_dataset$provider))
}

#' @name ee_search-tools
#' @export
ee_search_tags <- function(ee_dataset, ..., logical_operator = "OR") {
  tags <- tolower(c(...))
  ee_tags <- tolower(ee_dataset$tags)
  if (logical_operator == "OR") {
    cond <- mapply(function(x) grepl(x, ee_tags), tags) %>% apply(1, any)
  } else if (logical_operator == "AND") {
    cond <- mapply(function(x) grepl(x, ee_tags), tags) %>% apply(1, all)
  } else {
    stop("logical_operator argument is not valid")
  }
  ee_dataset_q <- ee_dataset[cond, ]
  rownames(ee_dataset_q) <- NULL
  return(ee_dataset_q)
}

#' @name ee_search-tools
#' @export
ee_search_title <- function(ee_dataset, ..., logical_operator = "OR") {
  tags <- tolower(c(...))
  ee_title <- tolower(ee_dataset$title)
  if (logical_operator == "OR") {
    cond <- mapply(function(x) grepl(x, ee_title), tags) %>% apply(1, any)
  } else if (logical_operator == "AND") {
    cond <- mapply(function(x) grepl(x, ee_title), tags) %>% apply(1, all)
  } else {
    stop("logical_operator argument is not valid")
  }
  ee_dataset_q <- ee_dataset[cond, ]
  rownames(ee_dataset_q) <- NULL
  return(ee_dataset_q)
}


#' @name ee_search-tools
#' @export
ee_search_tagstitle <- function(ee_dataset, ..., logical_operator = "OR") {
  tags <- tolower(c(...))
  ee_title <- tolower(ee_dataset$title)
  ee_tags <- tolower(ee_dataset$tags)
  if (logical_operator == "OR") {
    cond_1 <- mapply(function(x) grepl(x, ee_title), tags) %>% apply(1, any)
    cond_2 <- mapply(function(x) grepl(x, ee_tags), tags) %>% apply(1, any)
    cond_3 <- mapply(any, cond_1, cond_2)
  } else if (logical_operator == "AND") {
    cond_1 <- mapply(function(x) grepl(x, ee_title), tags) %>% apply(1, all)
    cond_2 <- mapply(function(x) grepl(x, ee_tags), tags) %>% apply(1, all)
    cond_3 <- mapply(any, cond_1, cond_2)
  } else {
    stop("logical_operator argument is not valid")
  }
  ee_dataset_q <- ee_dataset[cond_3, ]
  rownames(ee_dataset_q) <- NULL
  return(ee_dataset_q)
}

#' @name ee_search-tools
#' @export
ee_search_title_list <- function(ee_dataset) {
  return(unique(ee_dataset$provider))
}

#' Change the date format
#' @noRd
fix_date <- function(x) {
  month <- x[1]
  day <- x[2]
  year <- x[3]
  if (nchar(year) == 2 & as.integer(year) > 50) {
    year <- 1900 + as.integer(year)
  } else if (nchar(year) == 2 & as.integer(year) <= 50) {
    year <- 2000 + as.integer(year)
  } else {
    year <- as.integer(year)
  }
  final_date <- as.Date(sprintf("%s-%s-%s", year, month, day))
  return(final_date)
}

#' @name ee_search-tools
#' @export
ee_search_display <- function(ee_dataset, maxdisplay = 10){
  db_catalog <- "https://developers.google.com/earth-engine/datasets/catalog/"
  tag_name <- gsub("\\/","_",ee_dataset$id)
  catalog_uri <- paste0(db_catalog, tag_name) %>%
    '['(1:maxdisplay) %>%
    na.omit() %>%
    as.character()
  for (uri in catalog_uri) {
    browseURL(uri)
  }
  invisible(TRUE)
}