Skip to content

Commit

Permalink
Merge pull request #88 from r-spatial/v.1.0.4
Browse files Browse the repository at this point in the history
working in rgee v.1.0.4
  • Loading branch information
csaybar authored Aug 8, 2020
2 parents 0d6c1ba + 43b0adb commit c7ffbf4
Show file tree
Hide file tree
Showing 10 changed files with 343 additions and 63 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -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",
Expand Down
16 changes: 16 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -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*
Expand Down
160 changes: 160 additions & 0 deletions R/addins.R
Original file line number Diff line number Diff line change
@@ -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)
}
}
26 changes: 16 additions & 10 deletions R/ee_Initialize.R
Original file line number Diff line number Diff line change
Expand Up @@ -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",
Expand All @@ -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(
Expand Down Expand Up @@ -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(
Expand All @@ -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)),
Expand Down
68 changes: 60 additions & 8 deletions R/ee_as_sf.R
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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)) {
Expand Down Expand Up @@ -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
)

Expand All @@ -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")
Expand All @@ -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
)

Expand All @@ -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.")
}
Expand Down Expand Up @@ -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
}
}
Loading

0 comments on commit c7ffbf4

Please sign in to comment.