Merge pull request #88 from r-spatial/v.1.0.4

working in rgee v.1.0.4

Author: csaybar

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: rgee
 Title: R Bindings for Calling the 'Earth Engine' API
-Version: 1.0.3
+Version: 1.0.4
 Authors@R: 
     c(person(given = "Cesar",
              family = "Aybar",

NEWS.md

@@ -11,6 +11,22 @@ vignette: >
   %\VignetteIndexEntry{NEWS}
   %\VignetteEncoding{UTF-8}
 ---
+# rgee 1.0.4
+- Add `ee_help` a new Rstudio addins that mimics the help Rstudio interface (F1).
+- Fix a bug that makes that `ee_as_sf` only supports `GeoJSON` format.
+- If `dsn` is not specified in `ee_as_sf`, it will create a temporary shapefile (in \tmp dir).
+- Fix a bug in `ee_imagecollection_to_local` (#87 Thanks @cedlfc44)
+- Fix a bug in `ee_image_local` (#88 Thanks @cedlfc44)
+- Fix a bug in `ee_create_credentials_drive` (#90 #78 Thanks @cedlfc44)
+
+# rgee 1.0.3
+- getPass library removed from `ee_Initialize`.
+- New argument `display` in `ee_Initialize` to return the authentication URI. Useful for `rgee` colab users.
+- Changes in some diagnostic messages to make possible to use `rgee` in colab.
+- `ee_help` returns a HTML file rather than TRUE. It also now supports characters (e.g. `ee_help("ee$Image")`).
+- Fix a strange bug when `ee_Initialize` tries to connect to reticulate the first time.
+- Fix small bugs in `ee_user_info` and `ee_users`
+
 # rgee 1.0.2
 - Earth Engine Python API updated to 0.1.229.
 - Fix a bug in `ee_Initialize`, that does not permit users to use `ee_createAssetHome` to define their *Earth Engine Assets home root folder*

R/addins.R

@@ -0,0 +1,160 @@
+#' Return documentation of Earth Engine modules, methods and classes
+#' @noRd
+ee_help_addins <- function() {
+  context <- rstudioapi::getSourceEditorContext()
+  selected_content <- context$selection[[1]]$text
+  if (selected_content == "") {
+    try(ee_help(ee_get_eefunc()), silent = TRUE)
+  } else {
+    selected_content_filtered <- gsub("\n|[[:space:]]","", selected_content)
+    try(ee_help(selected_content_filtered), silent = TRUE)
+  }
+}
+
+#' How many white space we deleted?
+#' @noRd
+ee_space_removed <- function(text, cursor) {
+  text <- strsplit(text,"")[[1]]
+  sum(grepl(" ",text[1:cursor]))
+}
+
+#' Merge forward and backward
+#' @noRd
+ee_get_funname <- function(text, cursor) {
+  text <- strsplit(text,"")[[1]]
+
+  if (length(text) < cursor) {
+    return(invisible(FALSE))
+  }
+
+  if (text[cursor] == "(") {
+    cursor <- cursor -1
+  }
+  if (cursor == 1) {
+    # the last word can not be a $
+    paste0(text[1:forward(text, cursor)], collapse = "")
+  } else {
+    # the last word can not be a $
+    paste0(text[backward(text, cursor):forward(text, cursor)], collapse = "")
+  }
+}
+
+#' Search words forward
+#' @noRd
+forward <- function(x, cursor) {
+  forward_range <- cursor:length(x)
+  for (index in forward_range) {
+    is_letter <- grepl("[a-zA-Z]", x[index])
+    if (!is_letter) {
+      index <- index - 1
+      break
+    }
+  }
+  if (is_letter <- grepl("\\$", x[index])) {
+    index - 1
+  } else {
+    index
+  }
+}
+
+#' Search words backward
+#' @noRd
+backward <- function(x, cursor) {
+  index <- cursor
+  repeat {
+    if (index == 1) {
+      break
+    }
+
+    # Just pass the letter if is inside a ()
+    if (x[index] == ")") {
+      count_par <- 1
+      counter <- 0
+      while (count_par != 0) {
+        if (x[index] == "(") {
+          count_par <- count_par - 1
+        } else if(x[index] == ")" & counter != 0) {
+          count_par <- count_par + 1
+        }
+        index <- index - 1
+        counter <- counter + 1
+        if (index == 1) {
+          break
+        }
+        # print(sprintf("%s:%s",counter,count_par))
+      }
+      index <- index - 1
+    }
+
+    if (grepl("[a-zA-Z]|\\$|\\)", x[index])) {
+      index <- index - 1
+    } else {
+      index <- index + 1
+      break
+    }
+  }
+  index
+}
+
+#' Aux function useful to know if a multiline (recursive)
+#' Returns a logical vector.
+#' @noRd
+is_multilines_r <- function(context, line) {
+  if (is_multilines(context, line)) {
+    c(TRUE, is_multilines_r(context, line - 1))
+  } else {
+    FALSE
+  }
+}
+
+#' Aux function useful to know if a multiline
+#' Returns a logical value.
+#' @noRd
+is_multilines <- function(context, line) {
+  if (line == 1) {
+    FALSE
+  } else {
+    line_of_code_1 <- context$contents[line]
+    text_1 <- strsplit(line_of_code_1, "")[[1]]
+    is_white_space <- text_1[1] == " "
+
+    line_of_code_2 <- context$contents[line - 1]
+    text_2 <- strsplit(line_of_code_2, "")[[1]]
+    is_dolar <- text_2[length(text_2)] == "$"
+    if (length(is_dolar ) == 0) {
+      is_dolar <- FALSE
+    }
+
+    if (is_dolar & is_white_space) {
+      TRUE
+    } else {
+      FALSE
+    }
+  }
+}
+
+#' Returns the EE function name
+#' @noRd
+ee_get_eefunc <- function() {
+  # get rstudio context
+  context <- rstudioapi::getSourceEditorContext()
+  cursor <- context$selection[[1]]$range[[1]][2]
+  line <- context$selection[[1]]$range[[1]][1]
+
+  # is a multiple line?
+  if (any(is_multilines_r(context, line))) {
+    # lines above!
+    number_of_extra_lineas <- sum(is_multilines_r(context, line))
+    lines <- (line - number_of_extra_lineas):line
+    # merge lines text in one character
+    text_merge <- paste0(gsub(" ", "", context$contents[lines]), collapse = "")
+    # upgrade cursor
+    extra_lines <- lines[-length(lines)]
+    previous_len <- paste0(context$contents[extra_lines], collapse = "")
+    space_removed <- ee_space_removed(text = context$contents[line], cursor =  cursor)
+    new_cursor <- nchar(previous_len) + cursor - space_removed
+    ee_get_funname(text = text_merge, cursor =  new_cursor)
+  } else {
+    ee_get_funname(text = context$contents[line], cursor =  cursor)
+  }
+}

R/ee_Initialize.R

@@ -259,9 +259,10 @@ ee_Initialize <- function(email = NULL,
   }
 
   # Root folder exist?
-  ee_user_assetroot <- try(ee$data$getAssetRoots()[[1]])
+  ee_user_assetroot <- ee$data$getAssetRoots()
+  assetroot_exist <- length(ee_user_assetroot) == 0
   # if ee_asset_home (list) length is zero
-  if (length(ee_user_assetroot) == 0 | class(ee_user_assetroot) == "try-error") {
+  if (assetroot_exist) {
     root_text <- paste(
       "Earth Engine Assets home root folder does not exist for the current user.",
       "Please enter your desired root folder name below. Take into consideration",
@@ -275,10 +276,10 @@ ee_Initialize <- function(email = NULL,
     )
     message(root_text)
     ee_createAssetHome()
-    ee_user_assetroot <- ee$data$getAssetRoots()[[1]]
+    ee_user_assetroot <- ee$data$getAssetRoots()
   }
-
-  ee_user <- ee_remove_project_chr(ee_user_assetroot$id)
+  ee_user_assetroot_id <- ee_user_assetroot[[1]]$id
+  ee_user <- ee_remove_project_chr(ee_user_assetroot_id)
 
   options(rgee.ee_user = ee_user)
   ee_sessioninfo(
@@ -375,16 +376,17 @@ ee_create_credentials_drive <- function(email) {
       call. = FALSE
     )
   }
-  # setting drive folder
+  # Set folder to save Google Drive Credentials
   oauth_func_path <- system.file("python/ee_utils.py", package = "rgee")
   utils_py <- ee_source_python(oauth_func_path)
   ee_path <- ee_utils_py_to_r(utils_py$ee_path())
   email_clean <- gsub("@gmail.com", "", email)
   ee_path_user <- sprintf("%s/%s", ee_path, email_clean)
-  # drive_credentials
+
+  # Load GD credentials (googledrive::drive_auth)
   repeat {
     full_credentials <- list.files(path = ee_path_user, full.names = TRUE)
-    drive_condition <- grepl("@gmail.com", full_credentials)
+    drive_condition <- grepl(".*_.*@.*", basename(full_credentials))
     if (!any(drive_condition)) {
       suppressMessages(
         googledrive::drive_auth(
@@ -404,8 +406,12 @@ ee_create_credentials_drive <- function(email) {
       break
     }
   }
-  # from user folder to EE folder
-  unlink(list.files(ee_path, "@gmail.com", full.names = TRUE))
+
+  # Clean previous and copy new GD credentials in ./earthengine folder
+  clean_drive <- list.files(ee_path, ".*_.*@.*", full.names = TRUE) %in% list.dirs(ee_path)
+  unlink(
+    list.files(ee_path, ".*_.*@.*", full.names = TRUE)[!clean_drive]
+  )
   file.copy(
     from = drive_credentials,
     to = sprintf("%s/%s", ee_path, basename(drive_credentials)),

R/ee_as_sf.R

@@ -3,7 +3,7 @@
 #' @param x Earth Engine table (ee$FeatureCollection) to be converted into a sf
 #' object.
 #' @param dsn Character. Output filename; in case \code{dsn} is missing
-#' \code{ee_as_sf} will create a temporary file.
+#' \code{ee_as_sf} will create a shapefile file in tmp() directory.
 #' @param crs Integer or character. coordinate reference system
 #' for the EE table. If is NULL, \code{ee_as_sf} will take the CRS of
 #' the first element.
@@ -101,7 +101,7 @@ ee_as_sf <- function(x,
   sp_eeobjects <- ee_get_spatial_objects('Table')
 
   if (missing(dsn)) {
-    dsn <- paste0(tempfile(),".geojson")
+    dsn <- paste0(tempfile(),".shp")
   }
 
   if (!any(class(x) %in% sp_eeobjects)) {
@@ -195,12 +195,21 @@ ee_as_sf <- function(x,
     file_name <- paste0(table_id, "_", time_format)
 
     # table to drive
+    table_format <- ee_get_table_format(dsn)
+    if (is.na(table_format)) {
+      stop(
+        'sf_as_ee(..., via = \"drive\"), only support the ',
+        'following output format: "CSV", "GeoJSON", "KML", "KMZ", "SHP"',
+        '. Use ee_table_to_drive and ee_drive_to_local to save in a TFRecord format.'
+      )
+    }
+
     table_task <- ee_table_to_drive(
       collection = x_fc,
       description = ee_description,
       folder = container,
       fileNamePrefix = file_name,
-      fileFormat = "GeoJSON",
+      fileFormat = table_format,
       selectors = selectors
     )
 
@@ -227,7 +236,12 @@ ee_as_sf <- function(x,
       overwrite = overwrite,
       consider = 'all'
     )
-    local_sf <- sf::read_sf(dsn, quiet = TRUE)
+
+    if (table_format == "CSV") {
+      return(read.csv(dsn, stringsAsFactors = FALSE))
+    } else {
+      local_sf <- sf::read_sf(dsn, quiet = TRUE)
+    }
   } else if (via == 'gcs') {
     # Creating name for temporal file; just for either drive or gcs
     time_format <- format(Sys.time(), "%Y-%m-%d-%H:%M:%S")
@@ -245,13 +259,22 @@ ee_as_sf <- function(x,
 
     file_name <- paste0(table_id, "_", time_format)
 
-    # table to drive
+    # table to gcs
+    table_format <- ee_get_table_format(dsn)
+    if (is.na(table_format)) {
+      stop(
+        'sf_as_ee(..., via = \"gcs\"), only support the ',
+        'following output format: "CSV", "GeoJSON", "KML", "KMZ", "SHP"',
+        '. Use ee_table_to_drive and ee_drive_to_local to save in a TFRecord format.'
+      )
+    }
+
     table_task <- ee_table_to_gcs(
       collection = x_fc,
       description = ee_description,
       bucket = container,
       fileNamePrefix = file_name,
-      fileFormat = "GeoJSON",
+      fileFormat = table_format,
       selectors = selectors
     )
 
@@ -271,7 +294,11 @@ ee_as_sf <- function(x,
       stop(table_task$status()$error_message)
     }
     ee_gcs_to_local(task = table_task,dsn = dsn, overwrite = overwrite)
-    local_sf <- sf::read_sf(dsn, quiet = TRUE)
+    if (table_format == "CSV") {
+      return(read.csv(dsn, stringsAsFactors = FALSE))
+    } else {
+      local_sf <- sf::read_sf(dsn, quiet = TRUE)
+    }
   } else {
     stop("via argument invalid.")
   }
@@ -313,7 +340,32 @@ ee_fc_to_sf_getInfo <- function(x_fc, dsn, maxFeatures, overwrite = TRUE) {
   if (missing(dsn)) {
     x_sf
   } else {
-    sf::write_sf(x_sf, dsn, delete_dsn = overwrite, quiet = TRUE)
+    suppressWarnings(
+      sf::write_sf(x_sf, dsn, delete_dsn = overwrite, quiet = TRUE)
+    )
     x_sf
   }
 }
+
+#' Sync sf and ee drivers
+#' @noRd
+ee_get_table_format <- function(dsn) {
+  table_format <- tolower(sub(".*([.*])", "\\1", basename(dsn)))
+  if (length(table_format) != 1) {
+    stop("dns must be a single-length character")
+  }
+
+  if (table_format == ".shp") {
+    "SHP"
+  } else if (table_format == ".geojson") {
+    "GeoJSON"
+  } else if (table_format == ".kml") {
+    "KML"
+  } else if (table_format == ".kmz") {
+    "KMZ"
+  } else if (table_format == ".csv") {
+    "CSV"
+  } else {
+    NA
+  }
+}