R/request_data.R

In JesJehle/GEE2R: Simplify the acquisition of remote sensing data

#' get_data
#' calls get_data_image or get_data_collections, dependent on the info object
#' @param info Data frame information generated gy ee_grab()
#' @param data_type either ImageCollection of Image,
#' @export
#' @noRd
get_data <- function(info, test = F) {
  #activate_environments("earthEngineGrabR")
  
  ee_helpers <-
    system.file("Python/ee_get_data.py", package = "earthEngineGrabR")
  load_test <- try(source_python(file = ee_helpers), silent = T)
  count <- 1
  while (class(load_test) == "try-error" & count < 5) {
    load_test <- try(source_python(file = ee_helpers), silent = T)
    count <- count + 1
  }
  
  
  if (info$data_type == "ImageCollection") {
    status <- tryCatch({
      get_data_collection(
        info$datasetID,
        info$productName,
        info$spatialReducer,
        info$ftID,
        info$outputFormat,
        info$resolution,
        info$temporalReducer,
        info$timeStart,
        info$timeEnd,
        info$bandSelection,
        test
      )
    }, error = function(err) {
      return(
        paste0(
          "Error on Earth Engine servers for data product: ",
          info$productName,
          "\n",
          err
        )
      )
    })
  }
  
  if (info$data_type == "Image") {
    status <- tryCatch({
      get_data_image(
        info$datasetID,
        info$productName,
        info$spatialReducer,
        info$ftID,
        info$outputFormat,
        info$resolution,
        info$bandSelection,
        test
      )
    }, error = function(err) {
      return(
        paste0(
          "Error on Earth Engine servers for data product: ",
          info$productName,
          "\n",
          err
        )
      )
    })
  }
  return(status)
}


#' set_resolution
#' set resolution of requested data if not set
#' @param datasetID String that speciefies the data in ee
#' @noRd
#' @export
set_resolution <- function(products) {
  # check if data is a list of lists, if not creat one.
  if (class(products[[1]]) != "list") {
    products <- list(products)
  }
  
  if (class(products[[1]]) != "list") {
    products <- list(products)
  }
  for (i in seq_along(products)) {
    if (is.null(products[[i]]$resolution)) {
      res <- earthEngineGrabR:::check_scale(products[[i]]$datasetID)
      products[[i]]$resolution <- res
    }
  }
  return(products)
}







#' check_scale
#' checks for equality in native resolutions among the Bands of a dataset.
#' @param datasetID String that speciefies the data in ee
#' @noRd
#' @export
check_scale <- function(datasetID) {
  earthEngineGrabR:::activate_environments("earthEngineGrabR")
  
  ee_helpers <-
    system.file("Python/ee_get_data.py", package = "earthEngineGrabR")
  load_test <- try(source_python(file = ee_helpers), silent = T)
  count <- 1
  while (class(load_test) == "try-error" & count < 5) {
    load_test <- try(source_python(file = ee_helpers), silent = T)
    count <- count + 1
  }
  
  product_scale <- get_scales(datasetID)
  
  if (length(product_scale) > 1) {
    scales_df <-
      data.frame('Bands' = names(product_scale),
                 'Resolution' = unlist(product_scale))
    rownames(scales_df) <- NULL
    
    stop(
      "Bands in ",
      datasetID,
      " have different native resolutions:\n",
      paste(capture.output(print(scales_df)), collapse = "\n"),
      "\n\n",
      "Apply a resolution to all bands by setting the resolution argument or choose only Bands with an equal resolution by selecting bands using the bandSelection argument.",
      call. = F
    )
  }
  return(product_scale)
}



#' get_data_info
#' retreves info with a given product ID over earthEngine
#' @param datasetID String that speciefies the data in ee
#' @noRd
get_data_info <- function(datasetID) {
  activate_environments("earthEngineGrabR")
  
  ee_helpers <-
    system.file("Python/ee_get_data.py", package = "earthEngineGrabR")
  load_test <- try(source_python(file = ee_helpers), silent = T)
  count <- 1
  while (class(load_test) == "try-error" & count < 5) {
    load_test <- try(source_python(file = ee_helpers), silent = T)
    count <- count + 1
  }
  
  
  product_info <- get_info(datasetID)
  return(product_info)
}



#' request_data
#' @description Starts processing on earth engine retrieves info from data product
#' @param product_info list object created by ee_product functions
#' @param target_id String of fusion table id created by upload_data()
#' @return ee_responses for each correctly exported data product
#' @export
request_data <-
  function(product_info,
           target_id,
           verbose = T,
           test = F) {
    # check if data is a list of lists, if not creat one.
    
    if (class(product_info[[1]]) != "list") {
      product_info <- list(product_info)
    }
    
    #activate_environments("earthEngineGrabR")
    
    ee_responses <- c()
    ee_taskIDs <- c()
    
    # loop over data
    
    for (i in seq_along(product_info)) {
      p <- product_info[[i]]
      p$ftID <- target_id
      
      # get data
      status <- earthEngineGrabR:::get_data(p, test = test)
      if (class(status) == "character") {
        if (verbose)
          warning(status, call. = F)
      } else {
        if (status$state == "READY") {
          if (verbose)
            cat("\nrequest:", product_info[[i]]$productName, "\n")
          ee_responses[i] <- p$productNameFull
          ee_taskIDs[i] <- status$id
        } else {
          if (verbose) {
            warning(
              paste(
                "Error on Earth Engine servers for data product :",
                product_info[[i]]$productName,
                "\nCould not export the data"
              ),
              call. = F
            )
          }
        }
      }
    }
    
    if (length(ee_responses) == 0)
      stop("With the given product argument no valid data could be requested.",
           call. = F)
    
    ee_responses_df <-
      list(
        "ee_response_names" = as.character(na.omit(ee_responses)),
        "ee_response_ids" = as.character(na.omit(ee_taskIDs))
      )
    
    ee_response <-
      earthEngineGrabR:::check_processing(ee_responses_df, verbose)
    
    return(ee_response)
  }



# check_processing for all active tasks on earth engine
#' @param status Output of get_data function loop
#' @noRd
#' @export
check_processing <- function(status, verbose) {
  check <- c()
  for (i in seq_along(status$ee_response_ids)) {
    check[i] <-
      check_status(status$ee_response_ids[i],
                   status$ee_response_names[i],
                   verbose)
  }
  
  ee_responses_checked <-
    status$ee_response_names[check == "COMPLETED"]
  if (length(ee_responses_checked) == 0)
    stop("With the given ee_data function no valid data could be requested.",
         call. = F)
  return(as.character(ee_responses_checked))
}

# check status of a running task on earth engine
#' @param taskID Task ID returned by get_data function.
#' @param taskName Task name returned by get_data function.
#' @noRd
#' @export
check_status <- function(taskID, taskName, verbose) {
  ee <- import("ee", delay_load = T)
  status <- ee$data$getTaskStatus(taskID)
  status_state <- status[[1]]$state
  counter <- 1
  while (!status_state == "COMPLETED") {
    counter <- counter + 1
    Sys.sleep(4)
    
    status <- ee$data$getTaskStatus(taskID)
    status_state <- status[[1]]$state
    if (counter > 4) {
      if (counter == 5) {
        cat(paste("\nWaiting for long running task: ",
                  taskName, "\n"))
      } else {
        cat(".")
      }
    }
    
    if (status_state == "FAILED") {
      if (verbose) {
        warning(
          paste(
            "Error on Earth Engine servers for data product :",
            taskName,
            "\nCould not export the data"
          ),
          call. = F
        )
      }
      break()
    }
  }
  
  return(status_state)
}