diff --git a/.github/.gitignore b/.github/.gitignore old mode 100644 new mode 100755 diff --git a/.github/ISSUE_TEMPLATE.md b/.github/ISSUE_TEMPLATE.md old mode 100644 new mode 100755 diff --git a/.github/encrypt_secret.sh b/.github/encrypt_secret.sh old mode 100644 new mode 100755 diff --git a/.github/updated.R b/.github/updated.R old mode 100644 new mode 100755 diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml old mode 100644 new mode 100755 diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml old mode 100644 new mode 100755 index b753af8e..33d8a6d1 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -12,13 +12,13 @@ jobs: with: r-version: '3.6.1' - uses: r-lib/actions/setup-pandoc@master - + - name: INSTALL SYSTEM DEPENDENCIES [macOS] if: runner.os == 'macOS' env: RHUB_PLATFORM: osx-x86_64-clang run: | - brew cask install xquartz + brew cask install xquartz - name: Query dependencies run: | @@ -26,7 +26,7 @@ jobs: install.packages('remotes') saveRDS(remotes::dev_package_deps(dependencies = "Imports"), ".github/depends.Rds", version = 2) shell: Rscript {0} - + - name: Cache R packages uses: actions/cache@v1 with: diff --git a/.github/workflows/pr-commands.yaml b/.github/workflows/pr-commands.yaml old mode 100644 new mode 100755 diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml old mode 100644 new mode 100755 index 3a8c00f4..9389b539 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -48,6 +48,7 @@ jobs: env: RHUB_PLATFORM: osx-x86_64-clang run: | + rm '/usr/local/bin/gfortran' brew install udunits brew install gdal brew install freetype diff --git a/.github/workflows/updated.yaml b/.github/workflows/updated.yaml old mode 100644 new mode 100755 diff --git a/.gitignore b/.gitignore index 4b1f4c66..6b994fe2 100755 --- a/.gitignore +++ b/.gitignore @@ -9,3 +9,4 @@ docs static pkgdown/favicon revdep +build_package.R \ No newline at end of file diff --git a/CODE_OF_CONDUCT.md b/CODE_OF_CONDUCT.md old mode 100644 new mode 100755 diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md old mode 100644 new mode 100755 diff --git a/DESCRIPTION b/DESCRIPTION index ea131b25..7f105a9f 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: rgee Title: R Bindings for Calling the 'Earth Engine' API -Version: 1.0.6 +Version: 1.0.7 Authors@R: c(person(given = "Cesar", family = "Aybar", @@ -62,6 +62,10 @@ Authors@R: role = c("ctb"), email = "gabriel.carrasco@upch.pe", comment = c(ORCID = "0000-0002-6945-0419")), + person(given = "Henrik", + family = "Bengtsson", + role = c("ctb"), + email = "henrikb@braju.com"), person(given = "Jeffrey", family = "Hollister", role = c("rev"), @@ -100,7 +104,6 @@ Imports: Suggests: leaflet (>= 2.0.2), leaflet.extras2, - mapview, magick, geojsonio, sf, @@ -109,12 +112,14 @@ Suggests: googleCloudStorageR (>= 0.5.1), rstudioapi (>= 0.7), jsonlite, + leafem, raster, rgdal, httr, digest, spelling, testthat, + future, covr, knitr, rmarkdown, diff --git a/NAMESPACE b/NAMESPACE index 900f5e8d..22b331f8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,7 @@ # Generated by roxygen2: do not edit by hand +S3method("+",EarthEngineMap) +S3method("|",EarthEngineMap) S3method(ee_print,ee.feature.Feature) S3method(ee_print,ee.featurecollection.FeatureCollection) S3method(ee_print,ee.geometry.Geometry) @@ -10,7 +12,6 @@ export("%>%") export(Map) export(ee) export(ee_Initialize) -export(ee_as_mapview) export(ee_as_raster) export(ee_as_sf) export(ee_as_stars) @@ -72,12 +73,14 @@ export(ee_users) export(ee_utils_create_json) export(ee_utils_create_manifest_image) export(ee_utils_create_manifest_table) +export(ee_utils_future_value) export(ee_utils_get_crs) export(ee_utils_gif_annotate) export(ee_utils_gif_creator) export(ee_utils_gif_save) export(ee_utils_py_to_r) export(ee_utils_pyfunc) +export(ee_utils_search_display) export(ee_utils_shp_to_zip) export(ee_version) export(eedate_to_rdate) @@ -88,8 +91,6 @@ export(raster_as_ee) export(rdate_to_eedate) export(sf_as_ee) export(stars_as_ee) -exportClasses(EarthEngineMap) -exportClasses(mapview) importFrom(cli,cat_line) importFrom(cli,rule) importFrom(cli,symbol) diff --git a/NEWS.md b/NEWS.md index 265c5a89..d5bcfbe8 100755 --- a/NEWS.md +++ b/NEWS.md @@ -11,6 +11,25 @@ vignette: > %\VignetteIndexEntry{NEWS} %\VignetteEncoding{UTF-8} --- +# rgee 1.0.7 + +- Unit testing enhanced. +- More documentation related to credentials. +- Smoother connection with Python (reticulate). +- Now Map$... functions only depend on {leaflet}. +- Public argument added to `ee_as_sf`, `ee_as_raster`, `ee_as_stars`, `ee_imagecollection_to_local`, `ee_drive_to_local` and `ee_gcs_to_local` which permit to create a public link to the resources generated. +- A new argument "**metadata**" is added to `ee_as_sf`, `ee_as_raster`, `ee_as_stars`, `ee_drive_to_local`, `ee_imagecollection_to_local`, and `ee_gcs_to_local`. If TRUE, the metadata related to the export of the images will be added to raster/stars objects. +- Fix a bug in Rstudio `ee_help` addins. +- Fix a bug in `ee_extract` which adds the `system:index` to the colnames when the `x` argument is an `ee$ImageCollection`. +- Fix a bug that does not permit to `ee_as_raster` and `ee_as_stars` change the fileNamePrefix (#112). +- a stop added in `sf_as_ee` since {geojsonio} does not support POSIXt objects (#113). +- Lazy evaluation support to `ee_imagecollection_to_local`, `ee_as_sf`, `ee_as_raster` and `ee_as_stars`. +- Export images via 'getInfo' was removed from `ee_as_raster` and `ee_as_stars` to avoid problems related to geometric offset. +- Now `ee_monitoring` can also be invoked with the ID of a EE task started. +- `ee_search` module deprecated, it will be removed of rgee in version 1.0.8. +- New functions: `ee_utils_search_display` that display the website related to the Earth Engine dataset, and `ee_utils_future_value` that helps to run a {future} container. +- Earth Engine Python API test updated to 0.1.246. + # rgee 1.0.6 - Class method chaining (i.e. `x$size()$getInfo()`) were changed by pipes (i.e. ee_x %>% `ee$FeatureCollection$size() %>% ee$Number()`) in all the `rgee` functions. This solve the problem "OverflowError: python int too large to convert to C long" on Window systems. - rgee functions has a cleaner method to run system processes, {**processx**} @@ -29,6 +48,7 @@ same name. - Fix a bug in name creator in `ee_imagecollection_to_local`. - A new message more detailed when the Python path does not have the earth-engine Python API. - Earth Engine Python API updated to 0.1.235. + # rgee 1.0.5 - Important changes in the low level API to upload raster and vector with GCS. However, high upload API (`sf_as_ee`, `stars_as_ee`, and `raster_as_ee`) continue working in the same way. - Add the functions: `ee_utils_create_manifest_image` and `ee_utils_create_manifest_table` diff --git a/R/AAAMapclass.R b/R/AAAMapclass.R deleted file mode 100644 index 5f54a0f7..00000000 --- a/R/AAAMapclass.R +++ /dev/null @@ -1,27 +0,0 @@ -#' Class EarthEngineMap -#' -#' @slot object the spatial object -#' @slot map the leaflet map object -#' -#' @exportClass EarthEngineMap -setClass('EarthEngineMap', - slots = c(object = 'list', - map = 'ANY')) -NULL - -#' Class mapview -#' -#' @slot object the spatial object -#' @slot map the leaflet map object -#' -#' @exportClass mapview -setClass('mapview', - slots = c(object = 'list', - map = 'ANY')) -NULL - - -if ( !isGeneric('EarthEngineMap') ) { - setGeneric('EarthEngineMap', function(x, ...) - standardGeneric('EarthEngineMap')) -} diff --git a/R/Deprecated.R b/R/Deprecated.R old mode 100644 new mode 100755 index 9556cba9..6fa93d79 --- a/R/Deprecated.R +++ b/R/Deprecated.R @@ -1,608 +1,301 @@ -#' Passing an Earth Engine Image to Local using getinfo -#' @noRd +#' Interface to search into the Earth Engine Data Catalog +#' +#' R functions for searching in Earth Engine's public data archive. #' -ee_image_local_getInfo <- function(image, region, dsn, scale, maxPixels, - container, band_names, quiet) { +#' @param quiet logical. Suppress info message +#' @param ee_search_dataset data.frame generated by rgee::ee_search_Datasets() +#' or a character which represents the EE dataset ID. +#' @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 +#' @param path_dataset Path of the dataset. By default it will loaded +#' automatically. +#' @name ee_search-tools +#' @return A data.frame where rows represents public data archive. +#' @examples +#' \dontrun{ +#' library(rgee) +#' ee_Initialize() +#' +#' # ee_search_provider_list() +#' # ee_search_title_list() +#' myquery <- ee_search_dataset() %>% +#' ee_search_type("Image") %>% +#' ee_search_provider("WWF") %>% +#' ee_search_tags("srtm", "flow", "direction", "dem") %>% +#' ee_search_title("15", "Flow", logical_operator = "AND") %>% +#' ee_search_display() +#' } +#' @export +ee_search_dataset <- function(quiet = FALSE, + upgrade = FALSE, + path_dataset = NULL) { message_deprecated <- c( - "Downloading images via \"getInfo\" will not be available for rgee version 1.0.8 >." , - " Use ee_as_raster(..., via = \"drive\"), or ee_as_raster(..., via = \"gcs\") instead." + "\"ee_search_dataset\" will not be available for rgee version 1.0.8 ." ) - .Deprecated("ee_image_local_drive",msg = message_deprecated) - # If region is NULL get from images - if (is.null(region)) { - if (!quiet) { - message("region is not specified taking the image's region...") - } - region <- image$geometry() - } - - # If region is NULL get from images - if (is.null(scale)) { - scale <- tryCatch( - expr = image %>% - ee$Image$projection() %>% - ee$Projection$nominalScale() %>% - ee$Number$getInfo(), - error = function(e) { - message(paste0(e$message, " Trying only taking the first band ....")) - image %>% - ee$Image$select(0) %>% - ee$Image$projection() %>% - ee$Projection$nominalScale() %>% - ee$Number$getInfo() - }) - message(sprintf("scale argument was set at %s meters.", scale)) - } - - # Getting image ID if it is exist - image_id <- tryCatch( - expr = jsonlite::parse_json(image$id()$serialize())$ - scope[[1]][[2]][["arguments"]][["id"]], - error = function(e) "noid_image" + .Deprecated("ee_search_dataset", msg = message_deprecated) + + 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()) + ee_search_dataset_file <- sprintf( + "%s/ee_search_dataset.csv", + ee_path ) - if (is.null(image_id)) { - image_id <- "noid_image" - } - - # PROJ information about the image - init_proj <- image$projection()$getInfo() - init_proj_wkt <- image$projection()$wkt()$getInfo() - init_proj_nominal <- image$projection()$nominalScale()$getInfo() - - # PROJ information about the region - sf_region <- ee_as_sf(region) %>% - sf::st_bbox() %>% - sf::st_as_sfc() - - # region crs and image crs are equal?, otherwise force it. - if (sf::st_crs(sf_region)$Name != sf::st_crs(init_proj_wkt)$Name) { - if(!quiet) { - message("region and image do not have the same CRS. ", - "Transforming coordinates of region.... ") + if (file.exists(ee_search_dataset_file) & !upgrade) { + ee_search_dataset <- read.csv(ee_search_dataset_file, + stringsAsFactors = FALSE) + } else { + if (is.null(path_dataset)) { + user_samapriya <- "https://raw.githubusercontent.com/csaybar/" + ee_template <- "%sEarth-Engine-Datasets-List/master/%s" + ee_search_dataset_uri <- sprintf(ee_template, user_samapriya, + find_eedataset()) + } else { + ee_search_dataset_uri <- path_dataset } - sf_region <- sf::st_transform(sf_region, init_proj_wkt) - } - - # Image GEOTRANSFORM - xScale <- init_proj$transform[[1]] - yScale <- -abs(init_proj$transform[[5]]) #always negative - xshearing <- init_proj$transform[[2]] - yshearing <- init_proj$transform[[4]] - - # getInfo does not support xShearing and yShearing different to zero - if ((xshearing | yshearing) != 0) { - stop( - " 'getInfo' does not support xShearing and yShearing different", - " to zero. Use 'drive' or 'gcs' instead." + ee_search_dataset <- read.csv(ee_search_dataset_uri, + stringsAsFactors = FALSE) + if (!quiet) { + cat("Downloading(Upgrading) the Earth Engine catalog ... please wait\n") + } + write.csv( + x = ee_search_dataset, + file = ee_search_dataset_file, + row.names = FALSE ) } + return(ee_search_dataset) +} - # Changing scale - new_xScale <- xScale * scale/init_proj_nominal - new_yScale <- yScale * scale/init_proj_nominal - init_proj$transform[[1]] <- new_xScale - init_proj$transform[[5]] <- new_yScale - - # Image info - new_image <- image$reproject( - crs = init_proj_wkt, - crsTransform = init_proj$transform +#' @name ee_search-tools +#' @export +ee_search_startdate <- function(ee_search_dataset, stardate) { + message_deprecated <- c( + "\"ee_search_startdate\" will not be available for rgee version 1.0.8 ." ) + .Deprecated("ee_search_startdate", msg = message_deprecated) + + m <- gregexpr("[\\w']+", ee_search_dataset$start_date, perl = TRUE) + ee_start_date <- ee_search_dataset$start_date %>% + regmatches(m) %>% + lapply(fix_date) + m <- do.call(c, m) + stardate <- as.Date(stardate) + ee_search_dataset_q <- ee_search_dataset[which(ee_start_date > stardate), ] + rownames(ee_search_dataset_q) <- NULL + return(ee_search_dataset_q) +} - # Estimating the number of pixels (approximately) - # It is necessary just a single batch? (512x512) - total_pixel <- ee_approx_number_pixels(sf_region, init_proj) - if (total_pixel > maxPixels) { - stop( - "Export too large. Specified ", - total_pixel, - " pixels (max:", - maxPixels, - "). ", - "Specify higher maxPixels value if you", - "intend to export a large area." - ) - } - - # Warning message if your image is large than 512 * 512 * 3 pixels - ntile <- 512 - maxPixels_getInfo <- 1024*1024 - nbatch <- ceiling(sqrt(total_pixel / (ntile * ntile))) - if (nbatch > 3) { - message( - "Warning: getInfo is just for small images (max: ", - maxPixels_getInfo, - "). Use 'drive' or 'gcs' instead for faster download." - ) - } - - # Create a regular tesselation over the bounding box - # after that move to earth engine. - sf_region_gridded <- suppressMessages( - sf::st_make_grid(sf_region, n = nbatch) +#' @name ee_search-tools +#' @export +ee_search_enddate <- function(ee_search_dataset, enddate = Sys.Date()) { + message_deprecated <- c( + "\"ee_search_enddate\" will not be available for rgee version 1.0.8 ." ) - sf_region_fixed <- sf_region_gridded %>% - sf_as_ee(proj = init_proj_wkt, - quiet = TRUE) %>% - ee$FeatureCollection() - - # region parameters display - ee_geometry_message(region = region, sf_region = sf_region, quiet = quiet) + .Deprecated("ee_search_enddate", msg = message_deprecated) + m <- gregexpr("[\\w']+", ee_search_dataset$end_date, perl = TRUE) + ee_end_date <- ee_search_dataset$end_date %>% + regmatches(m) %>% + lapply(fix_date) + m <- do.call(c, m) + enddate <- as.Date(enddate) + ee_search_dataset_q <- ee_search_dataset[which(ee_end_date < enddate), ] + rownames(ee_search_dataset_q) <- NULL + return(ee_search_dataset_q) +} - # ee$FeatureCollection to ee$List - region_features <- sf_region_fixed$toList( - length(sf_region_gridded) +#' @name ee_search-tools +#' @export +ee_search_type <- function(ee_search_dataset, type) { + message_deprecated <- c( + "\"ee_search_type\" will not be available for rgee version 1.0.8 ." ) - - # Iterate for each tessellation - stars_img_list <- list() - if (!quiet) { - if (nbatch * nbatch > 1) { - cat( - "region is too large ... creating ", - length(sf_region_gridded), " patches.\n" - ) - } - } - for (r_index in seq_len(nbatch * nbatch)) { - if (!quiet) { - if (nbatch * nbatch > 1) { - cat( - sprintf( - "Getting data from the patch: %s/%s", - r_index, nbatch * nbatch - ), "\n" - ) - } - } - index <- r_index - 1 - feature <- ee$Feature(region_features$get(index))$geometry() - - # Extracts a rectangular region of pixels from an image - # into a 2D array per (return a Feature) - ee_image_array <- new_image$sampleRectangle( - region = feature, - defaultValue = -9999 - ) - # band_names <- c(band_names,"x", "y") - ee_image_array_local <- ee_image_array$getInfo() - ee_image_array_local_data <- ee_image_array_local[["properties"]][band_names] - nrow_array <- length(ee_image_array_local_data[[1]]) - ncol_array <- length(ee_image_array_local_data[[1]][[1]]) - - # Passing from an array to a stars object - # Create array from a list - image_array <- array( - data = unlist(ee_image_array_local_data), - dim = c(ncol_array, nrow_array, length(band_names)) - ) - - # Create stars object - image_stars <- image_array %>% - stars::st_as_stars() %>% - `names<-`(image_id) %>% - stars::st_set_dimensions(names = c("x", "y", "band")) - attr_dim <- attr(image_stars, "dimensions") - - ## Configure metadata of the local image and geotransform - sf_region_batch <- ee_as_sf(feature) - - # Fix the init_x and init_y of each image - init_offset <- ee_fix_offset( - img_transform = init_proj$transform, - sf_region = sf_region_batch - ) - - xTranslation_fixed <- init_offset[1] - yTranslation_fixed <- init_offset[4] - attr_dim$x$offset <- xTranslation_fixed - attr_dim$y$offset <- yTranslation_fixed - attr_dim$x$delta <- new_xScale - attr_dim$y$delta <- new_yScale - attr(image_stars, "dimensions") <- attr_dim - sf::st_crs(image_stars) <- init_proj_wkt - image_stars <- stars::st_set_dimensions( - .x = image_stars, which = 3, values = band_names - ) - stars_img_list[[r_index]] <- image_stars - } - - # Analizing the stars dimensions - dim_x <- stars::st_get_dimension_values(stars_img_list[[1]],"x") - dim_y <- stars::st_get_dimension_values(stars_img_list[[1]],"y") - - if (length(dim_x) == 1 | length(dim_y) == 1) { - stop( - "The number of pixels of the resulting image in x (y) is zero. ", - "Are you define the scale properly?" - ) + .Deprecated("ee_search_type", msg = message_deprecated) + ee_search_dataset_type <- tolower(ee_search_dataset$type) + type <- tolower(type) + if (type %in% unique(ee_search_dataset_type)) { + ee_search_dataset_q <- ee_search_dataset[ee_search_dataset_type %in% type, ] + rownames(ee_search_dataset_q) <- NULL + return(ee_search_dataset_q) } else { - # Upgrading metadata of mosaic - mosaic <- do.call(stars::st_mosaic, stars_img_list) - - # The stars object have bands dimensions? - if (!is.null(stars::st_get_dimension_values(mosaic,"bands"))) { - stars::st_set_dimensions(mosaic, 3, values = band_names) - } - - # Save results in dsn - stars::write_stars(mosaic, dsn) + stop("type argument is not valid") } } - -#' Create an R spatial gridded object from an EE thumbnail image -#' -#' Wrapper function around \code{ee$Image$getThumbURL} to create a stars or -#' RasterLayer R object from a -#' \href{https://developers.google.com/earth-engine/image_visualization#thumbnail-images}{EE thumbnail image}. -#' -#' @param image EE Image object to be converted into a stars object. -#' @param region EE Geometry Rectangle (\code{ee$Geometry$Rectangle}) specifying -#' the region to export.The CRS needs to be the same as the \code{x} argument, -#' otherwise, it will be forced. -#' @param dimensions Numeric vector of length 2. Thumbnail dimensions in pixel -#' units. If a single integer is provided, it defines the size of the -#' image's larger aspect dimension and scales the smaller dimension -#' proportionally. Defaults to 512 pixels for the larger image aspect dimension. -#' @param vizparams A list that contains the visualization parameters. -#' See details. -#' @param raster Logical. Should the thumbnail image be saved as a -#' RasterStack object? -#' @param quiet logical; suppress info messages. -#' @details -#' -#' \code{vizparams} set up the details of the thumbnail image. With -#' `ee_as_thumbnail` only is possible export one-band (G) or three-band -#' (RGB) images. Several parameters can be passed on to control color, -#' intensity, the maximum and minimum values, etc. The table below provides -#' all the parameters that admit `ee_as_thumbnail`. -#' -#' \tabular{lll}{ -#' \strong{Parameter} \tab \strong{Description} \tab \strong{Type}\cr -#' \strong{bands} \tab Comma-delimited list of -#' three band names to be mapped to RGB \tab list \cr -#' \strong{min} \tab Value(s) to map to 0 \tab -#' number or list of three numbers, one for each band \cr -#' \strong{max} \tab Value(s) to map to 1 \tab -#' number or list of three numbers, one for each band \cr -#' \strong{gain} \tab Value(s) by which to multiply each pixel value \tab -#' number or list of three numbers, one for each band \cr -#' \strong{bias} \tab Value(s) to add to each Digital Number (DN) -#' value \tab number or list of three numbers, one for each band \cr -#' \strong{gamma} \tab Gamma correction factor(s) \tab -#' number or list of three numbers, one for each band \cr -#' \strong{palette} \tab List of CSS-style color strings -#' (single-band images only) \tab comma-separated list of hex strings \cr -#' \strong{opacity} \tab The opacity of the layer -#' (0.0 is fully transparent and 1.0 is fully opaque) \tab -#' number \cr -#' } -#' -#' @return An stars or Raster object depending on the \code{raster} argument. -#' @family image download functions -#' -#' @importFrom methods as -#' @importFrom reticulate py_to_r -#' @importFrom utils download.file zip str -#' @examples -#' \dontrun{ -#' library(raster) -#' library(stars) -#' library(rgee) -#' -#' ee_Initialize() -#' -#' nc <- st_read(system.file("shp/arequipa.shp", package = "rgee")) -#' dem_palette <- c( -#' "#008435", "#1CAC17", "#48D00C", "#B3E34B", "#F4E467", -#' "#F4C84E", "#D59F3C", "#A36D2D", "#C6A889", "#FFFFFF" -#' ) -#' -#' ## DEM data -SRTM v4.0 -#' image <- ee$Image("CGIAR/SRTM90_V4") -#' world_region <- ee$Geometry$Rectangle( -#' coords = c(-180,-60,180,60), -#' proj = "EPSG:4326", -#' geodesic = FALSE -#' ) -#' -#' ## world - elevation -#' world_dem <- ee_as_thumbnail( -#' image = image, -#' region = world_region, -#' dimensions = 1024, -#' vizparams = list(min = 0, max = 5000) -#' ) -#' -#' world_dem[world_dem <= 0] <- NA -#' world_dem <- world_dem * 5000 -#' -#' plot( -#' x = world_dem, col = dem_palette, breaks = "equal", -#' reset = FALSE, main = "SRTM - World" -#' ) -#' -#' ## Arequipa-Peru -#' arequipa_region <- nc %>% -#' st_bbox() %>% -#' st_as_sfc() %>% -#' sf_as_ee() -#' -#' arequipa_dem <- ee_as_thumbnail( -#' image = image, -#' region = arequipa_region$buffer(1000)$bounds(), -#' dimensions = 512, -#' vizparams = list(min = 0, max = 5000) -#' ) -#' -#' arequipa_dem <- arequipa_dem * 5000 -#' st_crs(arequipa_dem) <- 4326 -#' plot( -#' x = arequipa_dem[nc], col = dem_palette, breaks = "equal", -#' reset = FALSE, main = "SRTM - Arequipa" -#' ) -#' -#' suppressWarnings(plot( -#' x = nc, col = NA, border = "black", add = TRUE, -#' lwd = 1.5 -#' )) -#' dev.off() -#' -#' ## LANDSAT 8 -#' img <- ee$Image("LANDSAT/LC08/C01/T1_SR/LC08_038029_20180810")$ -#' select(c("B4", "B3", "B2")) -#' Map$centerObject(img) -#' Map$addLayer(img, list(min = 0, max = 5000, gamma = 1.5)) -#' -#' ## Teton Wilderness -#' l8_img <- ee_as_thumbnail( -#' image = img, -#' region = img$geometry()$bounds(), -#' dimensions = 1024, -#' vizparams = list(min = 0, max = 5000, gamma = 1.5), -#' raster = TRUE -#' ) -#' crs(l8_img) <- "+proj=longlat +datum=WGS84 +no_defs" -#' plotRGB(l8_img, stretch = "lin") -#' } +#' @name ee_search-tools #' @export -ee_as_thumbnail <- function(image, region, dimensions, vizparams = NULL, - raster = FALSE, quiet = FALSE) { +ee_search_provider <- function(ee_search_dataset, provider) { message_deprecated <- c( - "Downloading images via \"ee_as_thumbnail\" will not be available for rgee version 1.0.8 >." , - " Use ee_as_raster(..., via = \"drive\"), or ee_as_raster(..., via = \"gcs\") instead." + "\"ee_search_provider\" will not be available for rgee version 1.0.8 ." ) - .Deprecated("ee_as_thumbnail",msg = message_deprecated) - if (!requireNamespace("sf", quietly = TRUE)) { - stop("package sf required, please install it first") - } - if (!requireNamespace("stars", quietly = TRUE)) { - stop("package stars required, please install it first") - } - if (!requireNamespace("raster", quietly = TRUE)) { - stop("package raster required, please install it first") - } - if (!requireNamespace("jsonlite", quietly = TRUE)) { - stop("package jsonlite required, please install it first") - } - if (!requireNamespace("png", quietly = TRUE)) { - stop("package png required, please install it first") - } - - # check viz parameters - ee_check_vizparam(vizparams) - - # is image an ee.image.Image? - if (!any(class(image) %in% "ee.image.Image")) { - stop("image argument is not an ee$image$Image") - } - - # is region an ee.geometry.Geometry? - if (!any(class(region) %in% "ee.geometry.Geometry")) { - stop("region argument is not an ee$geometry$Geometry") - } - - # From ee$Geometry$Rectangle to sf - sf_region <- ee_as_sf(x = region)["geometry"] - - ## region is a ee$Geometry$Rectangle? - if (any(class(region) %in% "ee.geometry.Geometry")) { - npoints <- nrow(sf::st_coordinates(sf_region)) - if (npoints != 5) { - stop( - stop("region needs to be a ee$Geometry$Rectangle.") - ) - } - } - - # is dimensions missing? - if (missing(dimensions)) { - dimensions <- 512L - if (!quiet) { - message("dimensions param is missing. Assuming 512", - " for the larger image aspect dimension.") - } - } - - # it is a large image? - if (max(dimensions) > 2048) { - if (!quiet) { - message( - "For large image is preferible use rgee::ee_download_*(...)", - "or rgee::ee_as_*(...)" - ) - } + .Deprecated("ee_search_provider", msg = message_deprecated) + if (provider %in% unique(ee_search_dataset$provider)) { + condition <- ee_search_dataset$provider %in% provider + ee_search_dataset_q <- ee_search_dataset[condition,] + rownames(ee_search_dataset_q) <- NULL + return(ee_search_dataset_q) + } else { + stop("provider argument is not valid") } +} - # Getting image ID if it is exist - image_id <- tryCatch( - expr = jsonlite::parse_json(image$id()$serialize())$ - scope[[1]][[2]][["arguments"]][["id"]], - error = function(e) "thumbnail" +#' @name ee_search-tools +#' @export +ee_search_provider_list <- function(ee_search_dataset) { + message_deprecated <- c( + "\"ee_search_provider_list\" will not be available for rgee version 1.0.8 ." ) - if (is.null(image_id)) image_id <- "thumbnail" + .Deprecated("ee_search_provider_list", msg = message_deprecated) + return(unique(ee_search_dataset$provider)) +} - # Metadata of the Geometry to display - ## is geodesic? - is_geodesic <- ee_utils_py_to_r(region$geodesic()$getInfo()) - ## is_evenodd? - query_params <- unlist(jsonlite::parse_json(region$serialize())$scope) - is_evenodd <- as.logical( - query_params[grepl("evenOdd", names(query_params))] +#' @name ee_search-tools +#' @export +ee_search_tags <- function(ee_search_dataset, ..., logical_operator = "OR") { + message_deprecated <- c( + "\"ee_search_tags\" will not be available for rgee version 1.0.8 ." ) - if (length(is_evenodd) == 0 | is.null(is_evenodd)) { - is_evenodd <- TRUE + .Deprecated("ee_search_tags", msg = message_deprecated) + tags <- tolower(c(...)) + ee_tags <- tolower(ee_search_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_search_dataset_q <- ee_search_dataset[cond, ] + rownames(ee_search_dataset_q) <- NULL + return(ee_search_dataset_q) +} - # bbox and CRS of the geometry - init_offset <- sf::st_bbox(sf_region) - ee_crs <- sf::st_crs(sf_region)$epsg - - if (!quiet) { - ee_geometry_message(region = region, - sf_region = sf_region[["geometry"]]) +#' @name ee_search-tools +#' @export +ee_search_title <- function(ee_search_dataset, ..., logical_operator = "OR") { + message_deprecated <- c( + "\"ee_search_title\" will not be available for rgee version 1.0.8." + ) + .Deprecated("ee_search_title", msg = message_deprecated) + tags <- tolower(c(...)) + ee_title <- tolower(ee_search_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_search_dataset_q <- ee_search_dataset[cond, ] + rownames(ee_search_dataset_q) <- NULL + return(ee_search_dataset_q) +} - # Preparing parameters - vizparams$dimensions <- dimensions - vizparams$region <- region - vizparams$format <- "png" - if (is.null(vizparams$min)) { - vizparams$min <- 0 - } - if (is.null(vizparams$max)) { - vizparams$min <- 1 - } - # Creating thumbnail in png format - if (!quiet) { - cat( - "Getting the thumbnail image ... please wait\n" - ) +#' @name ee_search-tools +#' @export +ee_search_tagstitle <- function(ee_search_dataset, ..., + logical_operator = "OR") { + message_deprecated <- c( + "\"ee_search_tagstitle\" will not be available for rgee version 1.0.8." + ) + .Deprecated("ee_search_tagstitle", msg = message_deprecated) + + tags <- tolower(c(...)) + ee_title <- tolower(ee_search_dataset$title) + ee_tags <- tolower(ee_search_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") } - thumbnail_url <- image$getThumbURL(vizparams) - - # Reading the png image - z <- tempfile() - download.file(thumbnail_url, z, mode = "wb", quiet = TRUE) - raw_image <- png::readPNG(z) + ee_search_dataset_q <- ee_search_dataset[cond_3, ] + rownames(ee_search_dataset_q) <- NULL + return(ee_search_dataset_q) +} - # matrix to array - if (length(dim(raw_image)) == 2) { - dim(raw_image) <- c(dim(raw_image), 1) - } +#' @name ee_search-tools +#' @export +ee_search_title_list <- function(ee_search_dataset) { + message_deprecated <- c( + "\"ee_search_title_list\" will not be available for rgee version 1.0.8." + ) + .Deprecated("ee_search_title_list", msg = message_deprecated) + return(unique(ee_search_dataset$provider)) +} - # It is a RGB or gray image? - if (dim(raw_image)[3] == 1) { - bands <- 1 - } else if (dim(raw_image)[3] == 2) { - bands <- 1 - } else if (dim(raw_image)[3] == 3) { - bands <- 3 - } else if (dim(raw_image)[3] == 4) { - bands <- 3 +#' 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) +} - # Create a stars object for RGB images - if (bands == 3) { - band_name <- c("R", "G", "B") - stars_png <- mapply(read_png_as_stars, - seq_len(bands), - band_name, - SIMPLIFY = FALSE, - MoreArgs = list(mtx = raw_image) - ) - add <- function(x) Reduce(c, x) - - stars_png %>% - add() %>% - merge() %>% - stars::st_set_dimensions(names = c("x", "y", "band")) -> stars_png - - attr_dim <- attr(stars_png, "dimensions") - attr_dim$x$offset <- init_offset[1] - attr_dim$y$offset <- init_offset[2] - attr_dim$x$delta <- (init_offset[3] - init_offset[1]) / attr_dim$x$to - attr_dim$y$delta <- (init_offset[4] - init_offset[2]) / attr_dim$y$to - - attr(stars_png, "dimensions") <- attr_dim - sf::st_crs(stars_png) <- ee_crs - if (isFALSE(raster)) { - thumbnail_stars <- stars::st_as_stars(as(stars_png, "Raster")) - names(thumbnail_stars) <- image_id - thumbnail_stars <- stars::st_set_dimensions( - .x = thumbnail_stars, - which = 3, - values = band_name - ) - thumbnail_stars - } else { - thumbnail_raster <- as(stars_png, "Raster") - names(thumbnail_raster) <- band_name - thumbnail_raster - } - } else if (bands == 1) { - # Create a stars object for single band image - stars_png <- mapply(read_png_as_stars, - bands, - image_id, - SIMPLIFY = FALSE, - MoreArgs = list(mtx = raw_image) - )[[1]] - stars_png <- stars::st_set_dimensions(.x = stars_png, names = c("x", "y")) +#' @name ee_search-tools +#' @export +ee_search_display <- function(ee_search_dataset, maxdisplay = 10) { + message_deprecated <- c( + "\"ee_search_title_list\" will not be available for rgee version 1.0.8.", + " Use ee_utils_search_display instead." + ) + .Deprecated("ee_search_title_list", msg = message_deprecated) - attr_dim <- attr(stars_png, "dimensions") - attr_dim$x$offset <- init_offset[1] - attr_dim$y$offset <- init_offset[2] - attr_dim$x$delta <- (init_offset[3] - init_offset[1]) / attr_dim$x$to - attr_dim$y$delta <- (init_offset[4] - init_offset[2]) / attr_dim$y$to - attr(stars_png, "dimensions") <- attr_dim - sf::st_crs(stars_png) <- ee_crs - if (isFALSE(raster)) { - thumbnail_stars <- stars_png %>% - as("Raster") %>% - stars::st_as_stars() - names(thumbnail_stars) <- image_id - thumbnail_stars - } else { - thumbnail_raster <- stars_png %>% - as("Raster") - names(thumbnail_raster) <- image_id - thumbnail_raster - } + if (is.character(ee_search_dataset)) { + tag_name <- gsub("\\/", "_", ee_search_dataset) } else { - stop("Number of bands not supported") + tag_name <- gsub("\\/", "_", ee_search_dataset$id) } + db_catalog <- "https://developers.google.com/earth-engine/datasets/catalog/" + catalog_uri <- paste0(db_catalog, tag_name) %>% + "["(1:maxdisplay) %>% + na.omit() %>% + as.character() + for (uri in catalog_uri) { + browseURL(uri) + } + invisible(TRUE) } -#' From R array to stars -#' @noRd -read_png_as_stars <- function(x, band_name, mtx) { - rotate <- function(x) t(apply(x, 2, rev)) - rotate_x <- rotate(mtx[, , x]) - dim_x <- dim(rotate_x) - array_x <- array(NA, dim = c(dim_x[1], dim_x[2], 1)) - array_x[, , 1] <- rotate_x - stars_object <- stars::st_as_stars(array_x) - stars_object <- stars_object[, , , 1, drop = TRUE] - names(stars_object) <- band_name - stars_object -} - - -#' Check the visualization parameters +#' Find the EE Dataset List on GitHub #' @noRd -ee_check_vizparam <- function(x) { - list_names <- c( - "bands", "min", "max", "gain", "bias", "gamma", "palette","opacity" +find_eedataset <- function() { + message_deprecated <- c( + "\"ee_search_title_list\" will not be available for rgee version 1.0.8." ) - check_listnames <- names(x) %in% list_names - if (any(!check_listnames)) { - stop( - "The following visualization parameters are not valid: ", - paste(names(x[!check_listnames]), collapse = ", ") - ) + .Deprecated("ee_search_title_list", msg = message_deprecated) + + if (!requireNamespace("httr", quietly = TRUE)) { + stop("package httr required, please install it first") } + git_repo <- "https://api.github.com/repos/csaybar/Earth-Engine-Datasets-List" + req <- httr::GET(sprintf("%s/git/trees/master?recursive=1", git_repo)) + httr::stop_for_status(req) + filelist <- lapply(httr::content(req)$tree, "[", "path") + filelist <- unlist(filelist, use.names = FALSE) + filelist[grepl("eed", filelist)] } - diff --git a/R/Map.R b/R/Map.R old mode 100644 new mode 100755 index 9478c4d2..01bd4247 --- a/R/Map.R +++ b/R/Map.R @@ -65,7 +65,7 @@ #' \href{https://developers.google.com/earth-engine/api_docs#ee.data.getmapid}{ #' getMapId} to fetch and return an ID dictionary being used to create #' layers in a \code{mapview} object. Users can specify visualization -#' parameters to Map\$addLayer by using the visParams argument. Each Earth +#' parameters to Map$addLayer by using the visParams argument. Each Earth #' Engine spatial object has a specific format. For #' \code{ee$Image}, the #' \href{https://developers.google.com/earth-engine/image_visualization}{ @@ -91,11 +91,12 @@ #' and 1.0 is fully opaque) \tab number \cr #' } #' -#' If you add an \code{ee$Image} to the map without any additional parameters, -#' by default `Map$addLayer()` assigns the first three bands to red, +#' If you add an \code{ee$Image} to Map$addLayer without any additional +#' parameters, by default it assigns the first three bands to red, #' green, and blue bands, respectively. The default stretch is based on the -#' min-max range. By the other hand, for \code{ee$Geometry}, \code{ee$Feature}, -#' and \code{ee$FeatureCollection} the available parameters are: +#' min-max range. On the other hand, the available parameters for +#' \code{ee$Geometry}, \code{ee$Feature}, and \code{ee$FeatureCollection} +#' are: #' #' \itemize{ #' \item \strong{color}: A hex string in the format RRGGBB specifying the @@ -104,9 +105,12 @@ #' \item \strong{strokeWidth}: The width of lines and polygon borders. By #' default 3. #' } +#' @returns Object of class leaflet, with the following extra parameters: tokens, name, +#' opacity, shown, min, max, palette, and legend. Use the $ method to retrieve +#' the data (e.g. m$rgee$min). +#' #' @examples #' \dontrun{ -#' library(mapview) #' library(rgee) #' library(sf) #' ee_Initialize() @@ -142,17 +146,16 @@ #' ), #' name = "SF" #' ) -#' m4 #' #' # Case 5: mapview + EarthEnginemap -#' library(sf) -#' nc <- st_read(system.file("shp/arequipa.shp", package="rgee")) -#' mapview(nc) + m2 -#' m2 + mapview(nc) +#' # library(mapview) +#' # library(sf) +#' # nc <- st_read(system.file("shp/arequipa.shp", package="rgee")) +#' # mapview(nc, m2) #' #' # Case 6: mapedit -#' library(mapedit) -#' # my_geometry <- m2 %>% ee_as_mapview() %>% editMap() +#' # library(mapedit) +#' # my_geometry <- m4 %>% editMap() #' #' # Case 7: ImageCollection #' nc <- st_read(system.file("shape/nc.shp", package = "sf")) %>% @@ -164,7 +167,8 @@ #' filterBounds(nc) %>% #' ee_get(0:4) #' Map$centerObject(nc$geometry()) -#' Map$addLayers(ee_s2) +#' m5 <- Map$addLayers(ee_s2, legend = TRUE) +#' m5 #' #' # Case 8: Map comparison #' image <- ee$Image("LANDSAT/LC08/C01/T1/LC08_044034_20140318") @@ -175,7 +179,12 @@ #' name = "SF_NDVI", #' legend = TRUE #' ) -#' m4 | m_ndvi +#' m6 <- m4 | m_ndvi +#' m6 +#' +#' # Case 9: digging up the metadata +#' m6$rgee$tokens +#' m5$rgee$tokens #' } #' @export Map <- function() { @@ -188,10 +197,6 @@ ee_set_methods <- function() { Map$setCenter <- ee_setCenter Map$setZoom <- ee_setZoom Map$centerObject <- ee_centerObject - # Map$getBounds <- ee_getBounds - # Map$getScale <- getScale - # Map$getCenter <- getCenter - # Map$getZoom <- getZoom # Init environment Map$setCenter() @@ -294,16 +299,8 @@ ee_addLayer <- function(eeObject, shown = TRUE, opacity = 1, legend = FALSE) { - if (!requireNamespace("jsonlite", quietly = TRUE)) { - stop("package jsonlite required, please install it first") - } - if (!requireNamespace("mapview", quietly = TRUE)) { - stop("package mapview required, please install it first") - } - if (!requireNamespace("leaflet", quietly = TRUE)) { - stop("package leaflet required, please install it first") - } - + # check packages + ee_check_packages("Map$addLayer", c("jsonlite", "leaflet", "leafem")) if (is.null(visParams)) { visParams <- list() } @@ -356,6 +353,7 @@ ee_addLayer <- function(eeObject, tile <- get_ee_image_url(image) map <- ee_addTile(tile = tile, name = name, shown = shown, opacity = opacity) + if (legend) { ee_add_legend(map, eeObject, visParams, name) } else { @@ -373,18 +371,8 @@ ee_addLayers <- function(eeObject, shown = TRUE, opacity = 1, legend = FALSE) { - - if (!requireNamespace("jsonlite", quietly = TRUE)) { - stop("package jsonlite required, please install it first") - } - - if (!requireNamespace("mapview", quietly = TRUE)) { - stop("package mapview required, please install it first") - } - - if (!requireNamespace("leaflet", quietly = TRUE)) { - stop("package leaflet required, please install it first") - } + # check packages + ee_check_packages("Map$addLayers", c("jsonlite", "leaflet")) # is an ee.imagecollection.ImageCollection? if (!any(class(eeObject) %in% "ee.imagecollection.ImageCollection")) { @@ -452,26 +440,22 @@ ee_addLayers <- function(eeObject, #' Basic base mapview object #' @noRd ee_mapview <- function() { - if (!requireNamespace("mapview", quietly = TRUE)) { - stop("package mapview required, please install it first") - } - m <- mapview::mapview() - m@map$x$setView[[1]] <- c(Map$lat, Map$lon) - m@map$x$setView[[2]] <- if (is.null(Map$zoom)) 1 else Map$zoom + # check packages + ee_check_packages("ee_mapview", "leaflet") + m <- leaflet_default() + m$x$setView[[1]] <- c(Map$lat, Map$lon) + m$x$setView[[2]] <- if (is.null(Map$zoom)) 1 else Map$zoom m } #' Add a mapview object based on a tile_fetcher #' @noRd ee_addTile <- function(tile, name, shown, opacity) { - if (!requireNamespace("mapview", quietly = TRUE)) { - stop("package mapview required, please install it first") - } - if (!requireNamespace("leaflet", quietly = TRUE)) { - stop("package leaflet required, please install it first") - } + # check packages + ee_check_packages("Map$addLayer", c("leaflet")) + m <- ee_mapview() - m@map <- m@map %>% + m <- m %>% leaflet::addTiles( urlTemplate = tile, layerId = name, @@ -481,11 +465,17 @@ ee_addTile <- function(tile, name, shown, opacity) { ee_mapViewLayersControl(names = name) %>% leaflet::hideGroup(if (!shown) name else NULL) - m@object$tokens <- tile - m@object$name <- name - m@object$opacity <- opacity - m@object$shown <- shown - m <- new("EarthEngineMap", object = m@object, map = m@map) + # map parameters + m$rgee$tokens <- tile + m$rgee$name <- name + m$rgee$opacity <- opacity + m$rgee$shown <- shown + + # legend parameters + m$rgee$min <- NA + m$rgee$max <- NA + m$rgee$palette <- list(NA) + m$rgee$legend <- FALSE m } @@ -520,7 +510,7 @@ ee_add_legend <- function(m, eeObject, visParams, name) { } visParams$palette <- sprintf("#%s", gsub("#", "",visParams$palette)) pal <- leaflet::colorNumeric(visParams$palette, c(visParams$min, visParams$max)) - map <- m@map %>% + m <- m %>% leaflet::addLegend( position = "bottomright", pal = pal, @@ -531,12 +521,10 @@ ee_add_legend <- function(m, eeObject, visParams, name) { # Extra parameters to EarthEngineMap objects that inherit from # one single-band ee$Image and active legend = TRUE - m@object$min <- visParams$min - m@object$max <- visParams$max - m@object$palette <- pal - m@object$legend <- TRUE - - m <- new("EarthEngineMap", object = m@object, map = map) + m$rgee$min <- visParams$min + m$rgee$max <- visParams$max + m$rgee$palette <- list(pal) + m$rgee$legend <- TRUE m } else { m @@ -546,11 +534,6 @@ ee_add_legend <- function(m, eeObject, visParams, name) { } } -if (!isGeneric("+")) { - setGeneric("+", function(x, y, ...) - standardGeneric("+")) -} - #' Get the tile_fetcher to display into ee_map #' @noRd get_ee_image_url <- function(image) { @@ -690,14 +673,66 @@ ee_get_system_id <- function(eeObject) { } } -#' Convert an EarthEngineMap object into a mapview object -#' @param x An EarthEngineMap object. -#' @importFrom methods new -#' @export -ee_as_mapview <- function(x) { - methods::new('mapview', object = x@object, map = x@map) + +#' Create a default leaflet +#' @noRd +leaflet_default <- function (default_maps = NULL) { + if (is.null(default_maps)) { + default_maps <- c( + "CartoDB.Positron", "OpenStreetMap", + "CartoDB.DarkMatter", "Esri.WorldImagery", + "OpenTopoMap" + ) + } + m <- initBaseMaps(default_maps) + m <- leaflet::setView(map = m, -76.942478, -12.172116, zoom = 18) + m <- leaflet::addLayersControl( + map = m, + baseGroups = default_maps, + position = "topleft" + ) + m <- leaflet::addScaleBar(map = m, position = "bottomleft") + m <- leafem::addMouseCoordinates(m) + m <- leafem::addCopyExtent(m) + class(m) <- append(class(m),"EarthEngineMap") + m } +#' Create a default leaflet with initBaseMaps +#' @noRd +initBaseMaps <- function (map.types, canvas = FALSE, viewer.suppress = FALSE) { + lid <- seq_along(map.types) + m <- leaflet::leaflet( + height = NULL, + width = NULL, + options = leaflet::leafletOptions( + minZoom = 1, maxZoom = 52, + bounceAtZoomLimits = FALSE, + maxBounds = list(list(c(-90,-370)), list(c(90, 370))), + preferCanvas = canvas), + sizingPolicy = leaflet::leafletSizingPolicy( + viewer.suppress = viewer.suppress, + browser.external = viewer.suppress)) + # add Tiles + m <- leaflet::addProviderTiles( + map = m, + provider = map.types[1], + layerId = map.types[1], + group = map.types[1], + options = leaflet::providerTileOptions(pane = "tilePane") + ) + for (i in 2:length(map.types)) { + m <- leaflet::addProviderTiles( + map = m, + provider = map.types[i], + layerId = map.types[i], + group = map.types[i], + options = leaflet::providerTileOptions(pane = "tilePane")) + } + return(m) +} + + # Create an Map env and set methods Map <- Map() ee_set_methods() diff --git a/R/Map_operators.R b/R/Map_operators.R old mode 100644 new mode 100755 index 420355fb..327c3ad3 --- a/R/Map_operators.R +++ b/R/Map_operators.R @@ -3,367 +3,188 @@ #' @author tim-salabim. Adapted from mapview code. #' @param e1 a EarthEngineMap map to which e2 should be added. #' @param e2 a EarthEngineMap map from which the objects should be added to e1. -#' -setMethod( - "+", - signature( - e1 = "EarthEngineMap", - e2 = "EarthEngineMap" - ), - function(e1, e2) { - e1_name <- e1@object$name - e2_name <- e2@object$name - e2_token <- e2@object$tokens - e2_opacity <- e2@object$opacity - e2_shown <- e2@object$shown - e2_min <- e2@object$min - e2_max <- e2@object$max - e2_pal <- e2@object$palette - e2_legend <- e2@object$legend - - if (e1_name == e2_name) { - e2_name <- paste0(e1_name,"_duplicated") - message_01 <- c( - "Both maps have the same name argument. The name of the second map was changed to:", - sprintf("m1 <- Map$addLayer(..., name = \"%s\")", e1_name), - sprintf("m2 <- Map$addLayer(..., name = \"%s\")", e2_name), - "m1 + m2" - ) - # message(paste0(message_01,collapse = "\n")) - } - - for (x in seq_len(length(e2_name))) { - e1@map <- e1@map %>% - leaflet::addTiles( - urlTemplate = e2_token[x], - layerId = e2_name[x], - group = e2_name[x], - options = leaflet::tileOptions(opacity = e2_opacity[x]) - ) %>% - ee_mapViewLayersControl(names = e2_name[x]) %>% - leaflet::hideGroup(if (!e2_shown[x]) e2_name[x] else NULL) - } - - if (isTRUE(e2_legend)) { - e1@map <- e1@map %>% - leaflet::addLegend( - position = "bottomright", - pal = e2_pal, - values = c(e2_min, e2_max), - opacity = 1, - title = e2_name - ) - } - out_obj <- append(e1@object, e2@object) - out_obj <- out_obj[lengths(out_obj) != 0] - methods::new('EarthEngineMap', object = out_obj, map = e1@map) +#' @name null-default +#' @export +'+.EarthEngineMap' <- function(e1, e2) { + if (!any(class(e2) %in% "EarthEngineMap")) { + stop("right map is not an EarthEngineMap object") } -) -#' EarthEngineMap + ANY; adds data from the second map to the first -#' -#' @author tim-salabim Adapted from mapview code. -#' @param e1 a EarthEngineMap map to which e2 should be added. -#' @param e2 a EarthEngineMap map from which the objects should be added to e1. -#' -setMethod( - "+", - signature( - e1 = "EarthEngineMap", - e2 = "mapview" - ), - function(e1, e2) { - e1_name <- e1@object$name - e2_name <- ee_getLayerNamesFromMap(e2@map) - if (e1_name == e2_name) { - e2_name <- paste0(e1_name,"_duplicated") - message_01 <- c( - "Both maps have the same name argument. The name of the second map was changed to:", - sprintf("m1 <- Map$addLayer(..., name = \"%s\")", e1_name), - sprintf("m2 <- Map$addLayer(..., name = \"%s\")", e2_name), - "m1 + m2" - ) - # message(paste0(message_01, collapse = "\n")) + # e1 metadata + e1_max <- e1$rgee$max + e1_min <- e1$rgee$min + e1_name <- e1$rgee$name + e1_pal <- e1$rgee$palette + e1_legend <- e1$rgee$legend + e1_shown <- e1$rgee$shown + e1_token <- e1$rgee$tokens + e1_opacity <- e1$rgee$opacity + + # e2 metadata + e2_max <- e2$rgee$max + e2_min <- e2$rgee$min + e2_name <- e2$rgee$name + e2_pal <- e2$rgee$palette + e2_shown <- e2$rgee$shown + e2_token <- e2$rgee$tokens + e2_opacity <- e2$rgee$opacity + e2_legend <- e2$rgee$legend + + # If e1 and e2 have the same name add to $rgee$name the suffix _duplicated + if (any(e1_name %in% e2_name)) { + positions <- which(e1_name %in% e2_name) + for (index in positions) { + e2_name[index] <- paste0(e1_name[index],"_duplicated") } - - mapview_e1 <- ee_as_mapview(e1) - idx <- ee_getCallEntryFromMap(e2@map, "addProviderTiles") - if (length(idx) > 0) { - e2@map$x$calls[idx] = NULL - } - idx = ee_getCallEntryFromMap(e2@map, "addLayersControl") - if (length(idx) > 0) { - e2@map$x$calls[idx][[1]]$args[[1]] = character(0) - } - m <- ee_appendMapCallEntries_lf(map1 = mapview_e1@map, map2 = e2@map) - - out_obj <- append(e1@object, e2@object) - out_obj <- out_obj[lengths(out_obj) != 0] - methods::new('EarthEngineMap', object = out_obj, map = m) } -) - + # Add all the tokens in the same leaflet map + for (x in seq_len(length(e2_name))) { + e1 <- e1 %>% + leaflet::addTiles( + urlTemplate = e2_token[x], + layerId = e2_name[x], + group = e2_name[x], + options = leaflet::tileOptions(opacity = e2_opacity[x]) + ) %>% + ee_mapViewLayersControl(names = e2_name[x]) %>% + leaflet::hideGroup(if (!e2_shown[x]) e2_name[x] else NULL) + } -#' ANY + EarthEngineMap; adds data from the second map to the first -#' -#' @author tim-salabim Adapted from mapview code. -#' @param e1 a EarthEngineMap map to which e2 should be added. -#' @param e2 a EarthEngineMap map from which the objects should be added to e1. -#' -setMethod( - "+", - signature( - e1 = "mapview", - e2 = "EarthEngineMap" - ), - function(e1, e2) { - e1_name <- ee_getLayerNamesFromMap(e1@map) - e2_name <- e2@object$name - - if (e1_name == e2_name) { - e2_name <- paste0(e1_name,"_duplicated") - message_01 <- c( - "Both maps have the same name argument. The name of the second map was changed to:", - sprintf("m1 <- Map$addLayer(..., name = \"%s\")", e1_name), - sprintf("m2 <- Map$addLayer(..., name = \"%s\")", e2_name), - "m1 + m2" + # Add the legend of e2 + if (isTRUE(e2_legend)) { + e1 <- e1 %>% + leaflet::addLegend( + position = "bottomright", + pal = e2_pal[[1]], + values = c(e2_min, e2_max), + opacity = 1, + title = e2_name ) - # message(paste0(message_01,collapse = "\n")) - } - - mapview_e2 <- ee_as_mapview(e2) - idx <- ee_getCallEntryFromMap(e2@map, "addProviderTiles") - if (length(idx) > 0) { - e2@map$x$calls[idx] = NULL - } - idx = ee_getCallEntryFromMap(e2@map, "addLayersControl") - if (length(idx) > 0) { - e2@map$x$calls[idx][[1]]$args[[1]] = character(0) - } - m <- ee_appendMapCallEntries_lf(map1 = e1@map, map2 = mapview_e2@map) - out_obj <- append(e1@object, e2@object) - out_obj <- out_obj[lengths(out_obj) != 0] - methods::new('EarthEngineMap', object = out_obj, map = m) } -) - -if ( !isGeneric('|') ) { - setGeneric('|', function(x, y, ...) - standardGeneric('|')) + # Save metadata + e1$rgee$tokens <- c(e1_token, e2_token) + e1$rgee$name <- c(e1_name, e2_name) + e1$rgee$opacity <- c(e1_opacity, e2_opacity) + e1$rgee$shown <- c(e1_shown, e2_shown) + + e1$rgee$min <- c(e1_min, e2_min) + e1$rgee$max <- c(e1_max, e2_max) + e1$rgee$palette <- do.call(c, unlist(list(e1_pal, e2_pal), recursive=FALSE)) + e1$rgee$legend <- c(e1_legend, e2_legend) + e1 } #' EarthEngineMap | EarthEngineMap provides a slider in the middle to compare two maps. +#' #' @author tim-salabim. Adapted from mapview code. -#' @param e1 a leaflet or mapview map, or NULL. -#' @param e2 a leaflet or mapview map, or NULL. -#' @name slider -#' @aliases |,EarthEngineMap,EarthEngineMap-method -setMethod( - "|", - signature( - e1 = "EarthEngineMap", - e2 = "EarthEngineMap" - ), function(e1, e2) { - if (!requireNamespace("leaflet", quietly = TRUE)) { - stop("package leaflet required, please install it first") - } - if (!requireNamespace("leaflet.extras2", quietly = TRUE)) { - stop("package leaflet.extras2 required, please install it first") - } - - # e1 properties - e1_name <- e1@object$name - e1_token <- e1@object$tokens - e1_opacity <- e1@object$opacity - e1_shown <- e1@object$shown - e1_min <- e1@object$min - e1_max <- e1@object$max - e1_pal <- e1@object$palette - e1_legend <- e1@object$legend - - # e2 properties - e2_name <- e2@object$name - e2_token <- e2@object$tokens - e2_opacity <- e2@object$opacity - e2_shown <- e2@object$shown - e2_min <- e2@object$min - e2_max <- e2@object$max - e2_pal <- e2@object$palette - e2_legend <- e2@object$legend - - if (e1_name == e2_name) { - e2_name <- paste0(e2_name,"_duplicated") - message_01 <- c( - "Both map have the same name argument. The name of the second map was changed to:", - sprintf("m1 <- Map$addLayer(..., name = \"%s\")", e1_name), - sprintf("m2 <- Map$addLayer(..., name = \"%s\")", e2_name), - "m1 | m2" - ) - # message(paste0(message_01,collapse = "\n")) - } +#' @param e1 an EarthEngineMap object. +#' @param e2 an EarthEngineMap object. +#' @name null-default +#' @aliases |, EarthEngineMap, EarthEngineMap-method +#' @export +'|.EarthEngineMap' <- function(e1, e2) { + #check packages + ee_check_packages("| operator", c("leaflet", "leaflet.extras2")) + + if (!any(class(e2) %in% "EarthEngineMap")) { + stop("right map is not an EarthEngineMap object") + } - # Create map with addSidebyside - m <- mapview::mapview()@map %>% - leaflet::setView(Map$lon, Map$lat, zoom = Map$zoom) %>% - leaflet::addMapPane("right", zIndex = 402) %>% - leaflet::addMapPane("left", zIndex = 403) %>% - leaflet::addTiles( - urlTemplate = e2_token, - layerId = e2_name, - group = e2_name, - options = c( - leaflet::pathOptions(pane = "right"), - leaflet::tileOptions(opacity = e2_opacity) - ) - ) %>% - leaflet::addTiles( - urlTemplate = e1_token, - layerId = e1_name, - group = e1_name, - options = c( - leaflet::pathOptions(pane = "left"), - leaflet::tileOptions(opacity = e1_opacity) - ) - ) %>% - ee_mapViewLayersControl(names = e1_name) %>% - ee_mapViewLayersControl(names = e2_name) %>% - leaflet.extras2::addSidebyside(layerId = "e3", leftId = e1_name, - rightId = e2_name) - if (isTRUE(e1_legend)) { - m <- m %>% - leaflet::addLegend( - position = "bottomright", - pal = e1_pal, - values = c(e1_min, e1_max), - opacity = 1, - title = e1_name - ) + # e1 metadata + e1_max <- e1$rgee$max + e1_min <- e1$rgee$min + e1_name <- e1$rgee$name + e1_pal <- e1$rgee$palette + e1_legend <- e1$rgee$legend + e1_shown <- e1$rgee$shown + e1_token <- e1$rgee$tokens + e1_opacity <- e1$rgee$opacity + + # e2 metadata + e2_max <- e2$rgee$max + e2_min <- e2$rgee$min + e2_name <- e2$rgee$name + e2_pal <- e2$rgee$palette + e2_shown <- e2$rgee$shown + e2_token <- e2$rgee$tokens + e2_opacity <- e2$rgee$opacity + e2_legend <- e2$rgee$legend + + if (any(e1_name %in% e2_name)) { + positions <- which(e1_name %in% e2_name) + for (index in positions) { + e2_name[index] <- paste0(e1_name[index],"_duplicated") } - if (isTRUE(e2_legend)) { - m <- m %>% - leaflet::addLegend( - position = "bottomright", - pal = e2_pal, - values = c(e2_min, e2_max), - opacity = 1, - title = e2_name - ) - } - out_obj <- append(e1@object, e2@object) - out_obj <- out_obj[lengths(out_obj) != 0] - methods::new('EarthEngineMap', object = out_obj, map = m) } -) -#' Comparison operator to EarthEngineMap | mapview -#' @author tim-salabim. Adapted from mapview code. -#' @param e1 a EarthEngineMap. -#' @param e2 a leaflet or mapview map, or NULL. -#' @name slider -#' @aliases |,EarthEngineMap,mapview-method -# setMethod( -# "|", -# signature( -# e1 = "EarthEngineMap", -# e2 = "mapview" -# ), function(e1, e2) { -# if (!requireNamespace("leaflet", quietly = TRUE)) { -# stop("package leaflet required, please install it first") -# } -# if (!requireNamespace("leaflet.extras2", quietly = TRUE)) { -# stop("package leaflet.extras2 required, please install it first") -# } -# e1_name <- e1@object$name -# e2_name <- ee_getLayerNamesFromMap(e2@map) -# -# if (e1_name == e2_name) { -# message_01 <- c( -# "Both map have the same name argument, run to fix:", -# "m1 <- Map$addLayer(..., name = \"map_01\")", -# "m2 <- mapview(..., layer.name = \"map_02\")", -# "m1 | m2" -# ) -# stop(paste0(message_01,collapse = "\n")) -# } -# -# mapview_e1 <- ee_as_mapview(e1) -# idx <- ee_getCallEntryFromMap(e2@map, "addProviderTiles") -# if (length(idx) > 0) { -# e2@map$x$calls[idx] = NULL -# } -# idx = ee_getCallEntryFromMap(e2@map, "addLayersControl") -# if (length(idx) > 0) { -# e2@map$x$calls[idx][[1]]$args[[1]] = character(0) -# } -# m <- ee_appendMapCallEntries_lf(map1 = mapview_e1@map, map2 = e2@map) -# m <- m %>% -# leaflet::addMapPane("right", zIndex = 0) %>% -# leaflet::addMapPane("left", zIndex = 0) %>% -# add_basemaps(pane = "right") %>% -# ee_mapViewLayersControl(names = e1_name) %>% -# ee_mapViewLayersControl(names = e2_name) %>% -# leaflet.extras2::addSidebyside(layerId = "e3", leftId = e1_name, -# rightId = e2_name) -# out_obj <- append(e1@object, e2@object) -# out_obj <- out_obj[lengths(out_obj) != 0] -# methods::new('EarthEngineMap', object = out_obj, map = m) -# } -# ) + # Create map with addSidebyside + m <- leaflet_default() %>% + leaflet::setView(Map$lon, Map$lat, zoom = Map$zoom) %>% + leaflet::addMapPane("right", zIndex = 402) %>% + leaflet::addMapPane("left", zIndex = 403) %>% + leaflet::addTiles( + urlTemplate = e2_token, + layerId = e2_name, + group = e2_name, + options = c( + leaflet::pathOptions(pane = "right"), + leaflet::tileOptions(opacity = e2_opacity) + ) + ) %>% + leaflet::addTiles( + urlTemplate = e1_token, + layerId = e1_name, + group = e1_name, + options = c( + leaflet::pathOptions(pane = "left"), + leaflet::tileOptions(opacity = e1_opacity) + ) + ) %>% + ee_mapViewLayersControl(names = e1_name) %>% + ee_mapViewLayersControl(names = e2_name) %>% + leaflet.extras2::addSidebyside( + layerId = "e3", + leftId = e1_name, + rightId = e2_name) + + # Save metadata + m$rgee$tokens <- c(e1_token, e2_token) + m$rgee$name <- c(e1_name, e2_name) + m$rgee$opacity <- c(e1_opacity, e2_opacity) + m$rgee$shown <- c(e1_shown, e2_shown) + + m$rgee$min <- c(e1_min, e2_min) + m$rgee$max <- c(e1_max, e2_max) + m$rgee$palette <- do.call(c, unlist(list(e1_pal, e2_pal), recursive=FALSE)) + m$rgee$legend <- c(e1_legend, e2_legend) + if (e2_legend[1]) { + e2_min <- e2_min[1] + e2_max <- e2_max[1] + e2_pal <- e2_pal[[1]] + e2_name <- e2_name[1] + m <- m %>% leaflet::addLegend( + position = "bottomright", + pal = e2_pal, + values = c(e2_min, e2_max), + opacity = 1, + title = e2_name + ) + } -#' Comparison operator to mapview | EarthEngineMap -#' @author tim-salabim. Adapted from mapview code. -#' @param e1 a leaflet or mapview map, or NULL. -#' @param e2 a EarthEngineMap. -#' @name slider -#' @aliases |,mapview,EarthEngineMap-method -#' -# setMethod( -# "|", -# signature( -# e1 = "mapview", -# e2 = "EarthEngineMap" -# ), function(e1, e2) { -# if (!requireNamespace("leaflet", quietly = TRUE)) { -# stop("package leaflet required, please install it first") -# } -# if (!requireNamespace("leaflet.extras2", quietly = TRUE)) { -# stop("package leaflet.extras2 required, please install it first") -# } -# e1_name <- ee_getLayerNamesFromMap(e1@map) -# e2_name <- e2@object$name -# -# if (e1_name == e2_name) { -# message_01 <- c( -# "Both map have the same name argument, run to fix:", -# "m1 <- mapview(..., name = \"map_01\")", -# "m2 <- Map$addLayer(..., layer.name = \"map_02\")", -# "m1 | m2" -# ) -# stop(paste0(message_01,collapse = "\n")) -# } -# -# mapview_e1 <- ee_as_mapview(e1) -# idx <- ee_getCallEntryFromMap(e2@map, "addProviderTiles") -# if (length(idx) > 0) { -# e2@map$x$calls[idx] = NULL -# } -# idx = ee_getCallEntryFromMap(e2@map, "addLayersControl") -# if (length(idx) > 0) { -# e2@map$x$calls[idx][[1]]$args[[1]] = character(0) -# } -# m <- ee_appendMapCallEntries_lf(map1 = mapview_e1@map, map2 = e2@map) -# m <- m %>% -# leaflet::addMapPane("right", zIndex = 0) %>% -# leaflet::addMapPane("left", zIndex = 0) %>% -# add_basemaps(pane = "right") %>% -# ee_mapViewLayersControl(names = e1_name) %>% -# ee_mapViewLayersControl(names = e2_name) %>% -# leaflet.extras2::addSidebyside(layerId = "e3", leftId = e1_name, -# rightId = e2_name) -# out_obj <- append(e1@object, e2@object) -# out_obj <- out_obj[lengths(out_obj) != 0] -# methods::new('EarthEngineMap', object = out_obj, map = m) -# } -# ) + if (e1_legend[1]) { + e1_min <- e1_min[1] + e1_max <- e1_max[1] + e1_pal <- e1_pal[[1]] + e1_name <- e1_name[1] + m <- m %>% leaflet::addLegend( + position = "bottomleft", + pal = e1_pal, + values = c(e1_min, e1_max), + opacity = 1, + title = e1_name + ) + } + m +} diff --git a/R/addins.R b/R/addins.R old mode 100644 new mode 100755 index b0e0ccf6..ac55a5a1 --- a/R/addins.R +++ b/R/addins.R @@ -3,8 +3,10 @@ ee_help_addins <- function() { context <- rstudioapi::getSourceEditorContext() selected_content <- context$selection[[1]]$text + # If press Ctrl + Enter if (selected_content == "") { try(ee_help(ee_get_eefunc()), silent = TRUE) + # If first select the text and after that Ctrl + Enter } else { selected_content_filtered <- gsub("\n|[[:space:]]","", selected_content) try(ee_help(selected_content_filtered), silent = TRUE) @@ -44,7 +46,7 @@ ee_get_funname <- function(text, cursor) { forward <- function(x, cursor) { forward_range <- cursor:length(x) for (index in forward_range) { - is_letter <- grepl("[a-zA-Z]", x[index]) + is_letter <- grepl("[a-zA-Z_]", x[index]) if (!is_letter) { index <- index - 1 break @@ -65,7 +67,6 @@ backward <- function(x, cursor) { if (index == 1) { break } - # Just pass the letter if is inside a () if (x[index] == ")") { count_par <- 1 @@ -86,7 +87,7 @@ backward <- function(x, cursor) { index <- index - 1 } - if (grepl("[a-zA-Z]|\\$|\\)", x[index])) { + if (grepl("[a-zA-Z_]|\\$|\\)", x[index])) { index <- index - 1 } else { index <- index + 1 @@ -158,3 +159,4 @@ ee_get_eefunc <- function() { ee_get_funname(text = context$contents[line], cursor = cursor) } } + diff --git a/R/ee_Date.R b/R/ee_Date.R old mode 100644 new mode 100755 diff --git a/R/ee_Initialize.R b/R/ee_Initialize.R old mode 100644 new mode 100755 index 8dc934f6..64d82185 --- a/R/ee_Initialize.R +++ b/R/ee_Initialize.R @@ -130,12 +130,7 @@ ee_Initialize <- function(email = NULL, gcs_credentials <- list(path = NA, message = NA) if (drive) { - if (!requireNamespace("googledrive", quietly = TRUE)) { - stop("The googledrive package is not installed. Try", - ' install.packages("googledrive")', - call. = FALSE - ) - } + ee_check_packages("ee_Initialize", "googledrive") if (!quiet) { cat( "", @@ -156,12 +151,7 @@ ee_Initialize <- function(email = NULL, } if (gcs) { - if (!requireNamespace("googleCloudStorageR", quietly = TRUE)) { - stop("The googleCloudStorageR package is not installed. Try", - ' install.packages("googleCloudStorageR")', - call. = FALSE - ) - } + ee_check_packages("ee_Initialize", "googleCloudStorageR") if (!quiet) { cat( "", @@ -328,12 +318,7 @@ ee_save_eecredentials <- function(url, code_verifier, main_ee_credential, user_e #' Create credentials - Google Drive #' @noRd ee_create_credentials_drive <- function(email) { - if (!requireNamespace("googledrive", quietly = TRUE)) { - stop("The googledrive package is not installed. ", - 'Try install.packages("googledrive")', - call. = FALSE - ) - } + ee_check_packages("ee_Initialize", "googledrive") # 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) @@ -390,27 +375,27 @@ ee_create_credentials_drive <- function(email) { #' Is necessary to save it (manually) inside the folder ~/.R/earthengine/USER/. #' @noRd ee_create_credentials_gcs <- function(email) { - if (!requireNamespace("googleCloudStorageR", quietly = TRUE)) { - stop("The googleCloudStorageR package is not installed. Try", - ' install.packages("googleCloudStorageR")', - call. = FALSE - ) - } + # check packages + ee_check_packages("ee_Initialize", "googleCloudStorageR") + + #get ee path 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()) + # setting gcs folder email_clean <- gsub("@gmail.com", "", email) ee_path_user <- sprintf("%s/%s", ee_path, email_clean) + # gcs_credentials full_credentials <- list.files(path = ee_path_user, full.names = TRUE) gcs_condition <- grepl(".json", full_credentials) if (!any(gcs_condition)) { gcs_text <- paste( sprintf("Unable to find a service account key (SAK) file in: %s", bold(ee_path_user)), - "Please, download and save it manually on the path mentioned", - "above. A compressible tutorial to obtain a SAK file are available at:", - "> https://github.com/csaybar/GCS_AUTH_FILE.json", + "Please, download and save the key manually on the path mentioned", + "before. A compressible tutorial to obtain their SAK file is available in:", + "> https://github.com/r-spatial/rgee/tree/help/gcs", "> https://cloud.google.com/iam/docs/creating-managing-service-account-keys", "> https://console.cloud.google.com/apis/credentials/serviceaccountkey", bold("Until you do not save a SKA file, the following functions will not work:"), @@ -761,3 +746,27 @@ ee_connect_to_py <- function(path, n = 5) { return(ee_utils) } + +#' Display required packages error message +#' @noRd +ee_check_packages <- function(fn_name, packages) { + pkg_exists <- rep(NA, length(packages)) + counter <- 0 + for(package in packages) { + counter <- counter + 1 + pkg_exists[counter] <- requireNamespace(package, quietly = TRUE) + } + + if (!all(pkg_exists)) { + to_install <- packages[!pkg_exists] + to_install_len <- length(to_install) + error_msg <- sprintf( + "%s required the %s: %s. Please install %s first.", + bold(fn_name), + if (to_install_len == 1) "package" else "packages", + paste0(bold(to_install), collapse = ", "), + if (to_install_len == 1) "it" else "them" + ) + stop(error_msg) + } +} diff --git a/R/ee_as_sf.R b/R/ee_as_sf.R index 76d5451a..ef3f5aba 100755 --- a/R/ee_as_sf.R +++ b/R/ee_as_sf.R @@ -1,39 +1,85 @@ #' Convert an Earth Engine table in a sf object #' -#' @param x Earth Engine table (ee$FeatureCollection) to be converted into a sf +#' @param x Earth Engine table (ee$FeatureCollection) to be converted in a sf #' object. #' @param dsn Character. Output filename; in case \code{dsn} is missing -#' \code{ee_as_sf} will create a shapefile file in tmp() directory. +#' a shapefile will be created in the \code{tmp()} directory. +#' @param overwrite Logical. Delete data source \code{dsn} before attempting +#' to write?. +#' @param via Character. Method to export the image. Three method are +#' implemented: "getInfo", "drive", "gcs". See details. +#' @param container Character. Name of the folder ('drive') or bucket ('gcs') +#' to be exported into (ignore if \code{via} is not defined as "drive" or +#' "gcs"). #' @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. #' @param maxFeatures Numeric. The maximum allowed number of features to #' export (ignore if \code{via} is not set as "getInfo"). The task will fail #' if the exported region covers more features. Defaults to 5000. -#' @param overwrite Logical. Delete data source \code{dsn} before attempting -#' to write?. -#' @param via Character. Method to fetch data about the object. Multiple -#' options supported. See details. -#' @param container Character. Name of the folder ('drive') or bucket ('gcs') -#' to be exported into (ignore if \code{via} is not defined as "drive" or -#' "gcs"). #' @param selectors The list of properties to include in the output, as a #' list of strings or a comma-separated string. By default, all properties are #' included. -#' @param quiet logical. Suppress info message +#' @param lazy Logical. If TRUE, a \code{\link[future:sequential]{ +#' future::sequential}} object is created to evaluate the task in the future. +#' Ignore if \code{via} is set as "getInfo". See details. +#' @param public Logical. If TRUE, a public link to the image will be created. +#' @param add_metadata Add metadata to the sf object. See details. +#' @param timePrefix Logical. Add current date and time (\code{Sys.time()}) as +#' a prefix to files to export. This parameter helps to avoid exported files +#' with the same name. By default TRUE. +#' @param quiet logical. Suppress info message. #' @importFrom methods as setMethod new is setGeneric #' @details -#' \code{ee_as_sf} supports the download of \code{ee$FeatureCollection}, -#' \code{ee$Feature} and \code{ee$Geometry} by three different options: -#' "getInfo", "drive", and "gcs". When "getInfo" is set in the \code{via} -#' argument, \code{ee_as_sf} will make an REST call to retrieve -#' all the known information about the object. The advantage of use -#' "getInfo" is a direct and faster download. However, there is a limitation of +#' \code{ee_as_sf} supports the download of \code{ee$Geometry}, \code{ee$Feature}, +#' and \code{ee$FeatureCollection} by three different options: +#' "getInfo" (which make an REST call to retrieve the data), "drive" +#' (which use \href{https://CRAN.R-project.org/package=googledrive}{Google Drive}) +#' and "gcs" (which use \href{https://CRAN.R-project.org/package=googleCloudStorageR}{ +#' Google Cloud Storage}). The advantage of use "getInfo" is a +#' direct and faster download. However, there is a limitation of #' 5000 features by request which makes it not recommendable for large -#' collections. Instead of "getInfo", the options: "drive" and "gcs" are -#' suitable for large collections since they use an intermediate container, -#' which may be Google Drive and Google Cloud Storage respectively. For getting -#' more information about exporting data from Earth Engine, take a look at the +#' FeatureCollections. Instead of "getInfo", the options: "drive" and "gcs" +#' are suitable for large FeatureCollections since the use of an intermediate +#' container. They work as follow: +#' \itemize{ +#' \item{1. }{A task will be started (i.e. \code{ee$batch$Task$start()}) to +#' move the EE Table from Earth Engine to the intermediate container +#' specified in argument \code{via}.} +#' \item{2. }{If the argument \code{lazy} is TRUE, the task will not be +#' monitored. This is useful to lunch several tasks at the same time and +#' call them later using \code{\link{ee_utils_future_value}} or +#' \code{\link[future:value]{future::value}}. At the end of this step, +#' the EE Table will be stored on the path specified in the argument +#' \code{dsn}.} +#' \item{3. }{Finally if the argument \code{add_metadata} is TRUE, a list +#' with the following elements will be added to the sf object. +#' \itemize{ +#' \item{\bold{if via is "drive":}} +#' \itemize{ +#' \item{\bold{ee_id: }}{Name of the Earth Engine task.} +#' \item{\bold{drive_name: }}{Name of the Table in Google Drive.} +#' \item{\bold{drive_id: }}{Id of the Table in Google Drive.} +#' \item{\bold{drive_download_link: }}{Download link to the table.} +#' } +#' } +#' \itemize{ +#' \item{\bold{if via is "gcs":}} +#' \itemize{ +#' \item{\bold{ee_id: }}{Name of the Earth Engine task.} +#' \item{\bold{gcs_name: }}{Name of the Table in Google Cloud Storage.} +#' \item{\bold{gcs_bucket: }}{Name of the bucket.} +#' \item{\bold{gcs_fileFormat: }}{Format of the table.} +#' \item{\bold{gcs_public_link: }}{Download link to the table.} +#' \item{\bold{gcs_URI: }}{gs:// link to the table.} +#' } +#' } +#' Run \code{attr(sf, "metadata")} to get the list. +#' } +#' } +#' +#' For getting more information about exporting data from Earth Engine, take +#' a look at the #' \href{https://developers.google.com/earth-engine/exporting}{Google #' Earth Engine Guide - Export data}. #' @return An sf object. @@ -84,265 +130,248 @@ ee_as_sf <- function(x, dsn, overwrite = TRUE, - crs = NULL, via = "getInfo", - maxFeatures = 5000, container = "rgee_backup", + crs = NULL, + maxFeatures = 5000, selectors = NULL, + lazy = FALSE, + public = TRUE, + add_metadata = TRUE, + timePrefix = TRUE, quiet = FALSE) { - if (!requireNamespace("sf", quietly = TRUE)) { - stop("package sf required, please install it first") - } - - if (!requireNamespace("geojsonio", quietly = TRUE)) { - stop("package geojsonio required, please install it first") - } + #check packages + ee_check_packages("ee_as_sf", c("sf", "geojsonio")) + # Is a geometry, feature, or fc? sp_eeobjects <- ee_get_spatial_objects('Table') - - if (missing(dsn)) { - dsn <- paste0(tempfile(),".shp") - } - if (!any(class(x) %in% sp_eeobjects)) { stop("x is not a Earth Engine table\n") } - # Load ee_Initialize() session; just for either drive or gcs - 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()) - ee_user <- read.table( - file = sprintf("%s/rgee_sessioninfo.txt", ee_path), - header = TRUE, - stringsAsFactors = FALSE - ) - - # Geometry or Feature --> FeatureCollection + # From ee$Geometry or ee$Feature to ee$FeatureCollection x_fc <- ee$FeatureCollection(x) - if (via == "getInfo") { - fc_size <- 5000 - if (maxFeatures > 5000) { - if (!quiet) { - cat("Number of features: Calculating ...") - } + # Getting image ID if it is exist + # table_id is the name of the table in the container + if (missing(dsn)) { + table_id <- tryCatch( + expr = { + x %>% + ee$FeatureCollection$get("system:id") %>% + ee$ComputedObject$getInfo() %>% + basename() + }, error = function(e) "no_tableid" + ) + if (is.null(table_id)) { + table_id <- "no_tableid" + } + dsn <- sprintf("%s/%s.shp",tempdir(), table_id) + } else { + table_id <- sub(pattern = "(.*)\\..*$", replacement = "\\1", basename(dsn)) + } - # number of features - fc_size <- x_fc %>% - ee$FeatureCollection$size() %>% - ee$Number$getInfo() + # Have you loaded the necessary credentials? + # Only important for drive or gcs. + ee_user <- ee_exist_credentials() - if (!quiet) { - cat(sprintf("\rNumber of features: %s \n", fc_size)) - } + if (via == "getInfo") { + ee_fc_to_sf_getInfo_batch( + x_fc = x_fc, + dsn = dsn, + maxFeatures = maxFeatures, + overwrite = overwrite, + quiet = quiet + ) + } else if (via == "drive") { + # From Earth Engine to drive + table_task <- ee_init_task_drive_fc( + x_fc = x_fc, + dsn = dsn, + container = container, + table_id = table_id, + ee_user = ee_user, + selectors = selectors, + timePrefix = timePrefix, + quiet = quiet + ) - if (maxFeatures < fc_size) { - stop( - "Export too large. Specified ", - fc_size, - " features (max: ", - maxFeatures, - "). Specify a higher maxFeatures value", - " if you intend to export a large area." + if(lazy) { + prev_plan <- future::plan(future::sequential, .skip = TRUE) + on.exit(future::plan(prev_plan, .skip = TRUE), add = TRUE) + future::future({ + # From googledrive to the client-side + ee_sf_drive_local( + table_task = table_task, + dsn = dsn, + metadata = add_metadata, + public = public, + overwrite = overwrite, + quiet = quiet ) - } - } - - nbatch <- ceiling(fc_size / 5000) - if (nbatch >= 3) { - message( - "Warning: getInfo is just for small tables (max: ", - 5000*3, - "). Use 'drive' or 'gcs' instead for faster download." + }, lazy = TRUE) + } else { + # From googledrive to the client-side + ee_sf_drive_local( + table_task = table_task, + dsn = dsn, + metadata = add_metadata, + public = public, + overwrite = overwrite, + quiet = quiet ) } + } else if (via == 'gcs') { + # From Earth Engine to gcs + table_task <- ee_init_task_gcs_fc( + x_fc = x_fc, + dsn = dsn, + container = container, + table_id = table_id, + ee_user = ee_user, + selectors = selectors, + timePrefix = timePrefix, + quiet = quiet + ) - if (fc_size > 5000) { - sf_list <- list() - for (r_index in seq_len(nbatch)) { - index <- r_index - 1 - if (!quiet) { - cat( - sprintf( - "Getting data from the patch: %s/%s", - r_index, nbatch - ), "\n" - ) - } - if (r_index == 1) { - crs_sf <- x_fc %>% - ee$FeatureCollection$geometry() %>% - ee$Geometry$projection() %>% - ee$Projection$wkt() %>% - ee$String$getInfo() - } - x_fc_batch <- ee$FeatureCollection(x_fc) %>% - ee$FeatureCollection$toList(count = 5000, offset = 5000*index) %>% - ee$FeatureCollection() - sf_list[[r_index]] <- ee_fc_to_sf_getInfo( - x_fc = x_fc_batch, + if(lazy) { + prev_plan <- future::plan(future::sequential, .skip = TRUE) + on.exit(future::plan(prev_plan, .skip = TRUE), add = TRUE) + future::future({ + # From gcs to the client-side + ee_sf_gcs_local( + table_task = table_task, + dsn = dsn, + metadata = add_metadata, + public = public, overwrite = overwrite, - maxFeatures = maxFeatures + quiet = quiet ) - } - local_sf <- do.call(rbind, sf_list) - suppressWarnings(sf::st_crs(local_sf) <- crs_sf) - suppressWarnings( - sf::st_write(local_sf, dsn, delete_dsn = overwrite, quiet = TRUE) - ) + }, lazy = TRUE) } else { - crs_sf <- x_fc %>% - ee$FeatureCollection$geometry() %>% - ee$Geometry$projection() %>% - ee$Projection$wkt() %>% - ee$String$getInfo() - local_sf <- ee_fc_to_sf_getInfo(x_fc, dsn, maxFeatures, overwrite) - suppressWarnings(sf::st_crs(local_sf) <- crs_sf) - } - } else if (via == "drive") { - # Creating name for temporal file; just for either drive or gcs - time_format <- format(Sys.time(), "%Y-%m-%d-%H:%M:%S") - ee_description <- paste0("ee_as_stars_task_", time_format) - - # Getting table ID if it is exist - table_id <- tryCatch( - expr = jsonlite::parse_json(ee$FeatureCollection$serialize(x))$ - scope[[1]][[2]][["arguments"]][["tableId"]], - error = function(e) "no_tableid" - ) - if (is.null(table_id)) { - table_id <- "no_id" - } - 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.' + # From gcs to the client-side + ee_sf_gcs_local( + table_task = table_task, + dsn = dsn, + metadata = add_metadata, + public = public, + overwrite = overwrite, + quiet = quiet ) } + } else { + stop("via argument invalid.") + } +} - table_task <- ee_table_to_drive( - collection = x_fc, - description = ee_description, - folder = container, - fileNamePrefix = file_name, - fileFormat = table_format, - selectors = selectors - ) +#' Convert a FeatureCollection to sf via getInfo (support batch) +#' @noRd +ee_fc_to_sf_getInfo_batch <- function(x_fc, dsn, maxFeatures, overwrite, quiet) { + # fc_size is the number of elements in the collection + # If the users does not change the maxFeatures argument + # by a value greater than 5000 rgee assume a initial value + # of 5000 for fc_size. + fc_size <- 5000 + + # If maxFeatures is greather than 5000 estimate the number of elements. + if (maxFeatures > 5000) { if (!quiet) { - cat( - "\n- download parameters (Google Drive)\n", - "Table ID :", table_id,"\n", - "Google user :", ee_user[["email"]],"\n", - "Folder name :", container, "\n", - "Date :", time_format, "\n" - ) + cat("Number of features: Calculating ...") } - - ee$batch$Task$start(table_task) - ee_monitoring(task = table_task, quiet = quiet) - - if (ee$batch$Task$status(table_task)[["state"]] != "COMPLETED") { - stop(ee$batch$Task$status(table_task)[["error_message"]]) + # get the number of features + fc_size <- x_fc %>% + ee$FeatureCollection$size() %>% + ee$Number$getInfo() + if (!quiet) { + cat(sprintf("\rNumber of features: %s \n", fc_size)) } + } - ee_drive_to_local( - table_task, - dsn = dsn, - overwrite = overwrite, - consider = 'all' + if (maxFeatures < fc_size) { + stop( + "Export too large. Specified ", + fc_size, + " features (max: ", + maxFeatures, + "). Specify a higher maxFeatures value", + " if you intend to export a large area." ) + } - 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") - ee_description <- paste0("ee_as_stars_task_", time_format) - - # Getting table ID if it is exist - table_id <- tryCatch( - expr = jsonlite::parse_json(ee$FeatureCollection$serialize(x))$ - scope[[1]][[2]][["arguments"]][["tableId"]], - error = function(e) "no_id" + # Only three batches it is recommended with getInfo + nbatch <- ceiling(fc_size / 5000) + if (nbatch >= 3) { + message( + "Warning: getInfo is just for small tables (max: ", + 5000*3, + "). Use 'drive' or 'gcs' instead for a faster download." ) - if (is.null(table_id)) { - table_id <- "no_id" - } - - file_name <- paste0(table_id, "_", time_format) + } - # 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.' + if (fc_size > 5000) { + sf_list <- list() + for (r_index in seq_len(nbatch)) { + index <- r_index - 1 + if (!quiet) { + cat( + sprintf( + "Getting data from the patch: %s/%s", + r_index, nbatch + ), "\n" + ) + } + if (r_index == 1) { + crs_sf <- x_fc %>% + ee$FeatureCollection$geometry() %>% + ee$Geometry$projection() %>% + ee$Projection$wkt() %>% + ee$String$getInfo() + } + x_fc_batch <- ee$FeatureCollection(x_fc) %>% + ee$FeatureCollection$toList(count = 5000, offset = 5000*index) %>% + ee$FeatureCollection() + sf_list[[r_index]] <- ee_fc_to_sf_getInfo( + x_fc = x_fc_batch, + overwrite = overwrite, + maxFeatures = maxFeatures ) } - - table_task <- ee_table_to_gcs( - collection = x_fc, - description = ee_description, - bucket = container, - fileNamePrefix = file_name, - fileFormat = table_format, - selectors = selectors + local_sf <- do.call(rbind, sf_list) + suppressWarnings(sf::st_crs(local_sf) <- crs_sf) + suppressWarnings( + sf::st_write(local_sf, dsn, delete_dsn = overwrite, quiet = TRUE) ) - - if (!quiet) { - cat( - "\n- download parameters (Google Cloud Storage)\n", - "Table ID :", table_id, "\n", - "Google user :", ee_user[["email"]], "\n", - "Folder name :", container, "\n", - "Date :", time_format, "\n" - ) - } - ee$batch$Task$start(table_task) - ee_monitoring(task = table_task, quiet = quiet) - if (ee$batch$Task$status(table_task)[["state"]] != "COMPLETED") { - stop(ee$batch$Task$status(table_task)[["error_message"]]) - } - ee_gcs_to_local(task = table_task,dsn = dsn, overwrite = overwrite) - if (table_format == "CSV") { - return(read.csv(dsn, stringsAsFactors = FALSE)) - } else { - local_sf <- sf::read_sf(dsn, quiet = TRUE) - } + local_sf } else { - stop("via argument invalid.") + crs_sf <- x_fc %>% + ee$FeatureCollection$geometry() %>% + ee$Geometry$projection() %>% + ee$Projection$wkt() %>% + ee$String$getInfo() + local_sf <- ee_fc_to_sf_getInfo(x_fc, dsn, maxFeatures, overwrite) + suppressWarnings(sf::st_crs(local_sf) <- crs_sf) + local_sf } - local_sf } #' Convert a FeatureCollection to sf via getInfo #' @noRd ee_fc_to_sf_getInfo <- function(x_fc, dsn, maxFeatures, overwrite = TRUE) { - if (!requireNamespace("sf", quietly = TRUE)) { - stop("package sf required, please install it first") - } + # check packages + ee_check_packages("ee_fc_to_sf_getInfo", "sf") + x_list <- tryCatch( expr = ee$FeatureCollection$getInfo(x_fc), error = function(e) { - feature_len <- ee$FeatureCollection$size(x_fc) %>% - ee$Number$getInfo() - stop( - "Specify higher maxFeatures value if you", - " intend to export a large area via getInfo.", - "\nEntered: ", feature_len, - "\nmaxFeatures: ", maxFeatures - ) + feature_len <- ee$FeatureCollection$size(x_fc) %>% + ee$Number$getInfo() + stop( + "Specify higher maxFeatures value if you", + " intend to export a large area via getInfo.", + "\nEntered: ", feature_len, + "\nmaxFeatures: ", maxFeatures + ) } ) class(x_list) <- "geo_list" @@ -379,3 +408,200 @@ ee_get_table_format <- function(dsn) { NA } } + +#' Create a Export task to GD +#' @noRd +ee_init_task_drive_fc <- function(x_fc, dsn, container, table_id, + ee_user, selectors, timePrefix, quiet) { + # Create description (Human-readable name of the task) + # Relevant for either drive or gcs. + time_format <- format(Sys.time(), "%Y_%m_%d_%H_%M_%S") + ee_description <- paste0("rgeeTable_", time_format) + if (timePrefix) { + file_name <- paste0(table_id, "_", time_format) + } else { + file_name <- table_id + } + + # Are GD credentials loaded? + if (is.na(ee_user$drive_cre)) { + drive_credential <- ee_create_credentials_drive(ee_user$email) + ee_save_credential(pdrive = drive_credential) + # ee_Initialize(email = ee_user$email, drive = TRUE) + message( + "\nNOTE: Google Drive credentials were not loaded.", + " Running ee_Initialize(email = '",ee_user$email,"', drive = TRUE)", + " to fix." + ) + } + + # The file format specified in dsn exist is suppoted by GEE? + 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 = table_format, + selectors = selectors, + timePrefix = FALSE + ) + + if (!quiet) { + cat( + "\n- download parameters (Google Drive)\n", + "Table ID :", table_id,"\n", + "Google user :", ee_user[["email"]],"\n", + "Folder name :", container, "\n", + "Date :", time_format, "\n" + ) + } + ee$batch$Task$start(table_task) + table_task +} + +#' from drive to local +#' @noRd +ee_sf_drive_local <- function(table_task, dsn, metadata, public, overwrite, quiet) { + ee_monitoring(task = table_task, quiet = quiet) + + if (ee$batch$Task$status(table_task)[["state"]] != "COMPLETED") { + stop(ee$batch$Task$status(table_task)[["error_message"]]) + } + + local_files <- ee_drive_to_local( + task = table_task, + dsn = dsn, + overwrite = overwrite, + consider = 'all', + metadata = metadata, + public = public, + quiet = quiet + ) + if (is.character(local_files)) { + local_files <- list(dsn = local_files) + } + + 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.' + ) + } + + if (table_format == "CSV") { + local_files + } else { + local_sf <- sf::read_sf(dsn, quiet = TRUE) + attr(local_sf, "metadata") <- local_files$metadata + local_sf + } +} + +#' Create a Export task to GCS +#' @noRd +ee_init_task_gcs_fc <- function(x_fc, dsn, container, table_id, + ee_user, selectors, timePrefix, quiet) { + # Create description (Human-readable name of the task) + # Relevant for either drive or gcs. + time_format <- format(Sys.time(), "%Y_%m_%d_%H_%M_%S") + ee_description <- paste0("rgeeTable_", time_format) + if (timePrefix) { + file_name <- paste0(table_id, "_", time_format) + } else { + file_name <- table_id + } + + # Are GCS credentials loaded? + if (is.na(ee_user$gcs_cre)) { + gcs_credential <- ee_create_credentials_gcs(ee_user$email) + ee_save_credential(pgcs = gcs_credential$path) + message( + "\nGoogle Cloud Storage credentials were not loaded.", + " Running ee_Initialize(email = '",ee_user$email,"', gcs = TRUE)", + " to fix." + ) + } + + + # The file format specified in dsn exist is suppoted by GEE? + 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_gcs( + collection = x_fc, + description = ee_description, + bucket = container, + fileNamePrefix = file_name, + fileFormat = table_format, + selectors = selectors, + timePrefix = FALSE + ) + + if (!quiet) { + cat( + "\n- download parameters (Google Drive)\n", + "Table ID :", table_id,"\n", + "Google user :", ee_user[["email"]],"\n", + "Folder name :", container, "\n", + "Date :", time_format, "\n" + ) + } + ee$batch$Task$start(table_task) + table_task +} + +#' from GCS to local +#' @noRd +ee_sf_gcs_local <- function(table_task, dsn, metadata, public, overwrite, quiet) { + ee_monitoring(task = table_task, quiet = quiet) + + if (ee$batch$Task$status(table_task)[["state"]] != "COMPLETED") { + stop(ee$batch$Task$status(table_task)[["error_message"]]) + } + + local_files <- ee_gcs_to_local( + task = table_task, + dsn = dsn, + metadata = metadata, + public = public, + overwrite = overwrite, + quiet = quiet + ) + if (is.character(local_files)) { + local_files <- list(dsn = local_files) + } + + 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.' + ) + } + + if (table_format == "CSV") { + local_files + } else { + local_sf <- sf::read_sf(dsn, quiet = TRUE) + attr(local_sf, "metadata") <- local_files$metadata + local_sf + } +} diff --git a/R/ee_as_thumbnail.R b/R/ee_as_thumbnail.R new file mode 100644 index 00000000..89be820d --- /dev/null +++ b/R/ee_as_thumbnail.R @@ -0,0 +1,370 @@ + +#' Create an R spatial gridded object from an EE thumbnail image +#' +#' Wrapper function around \code{ee$Image$getThumbURL} to create a stars or +#' RasterLayer R object from a +#' \href{https://developers.google.com/earth-engine/image_visualization#thumbnail-images}{EE thumbnail image}. +#' +#' @param image EE Image object to be converted into a stars object. +#' @param region EE Geometry Rectangle (\code{ee$Geometry$Rectangle}) specifying +#' the region to export.The CRS needs to be the same as the \code{x} argument, +#' otherwise, it will be forced. +#' @param dimensions Numeric vector of length 2. Thumbnail dimensions in pixel +#' units. If a single integer is provided, it defines the size of the +#' image's larger aspect dimension and scales the smaller dimension +#' proportionally. Defaults to 512 pixels for the larger image aspect dimension. +#' @param vizparams A list that contains the visualization parameters. +#' See details. +#' @param raster Logical. Should the thumbnail image be saved as a +#' RasterStack object? +#' @param quiet logical; suppress info messages. +#' @details +#' +#' \code{vizparams} set up the details of the thumbnail image. With +#' `ee_as_thumbnail` only is possible export one-band (G) or three-band +#' (RGB) images. Several parameters can be passed on to control color, +#' intensity, the maximum and minimum values, etc. The table below provides +#' all the parameters that admit `ee_as_thumbnail`. +#' +#' \tabular{lll}{ +#' \strong{Parameter} \tab \strong{Description} \tab \strong{Type}\cr +#' \strong{bands} \tab Comma-delimited list of +#' three band names to be mapped to RGB \tab list \cr +#' \strong{min} \tab Value(s) to map to 0 \tab +#' number or list of three numbers, one for each band \cr +#' \strong{max} \tab Value(s) to map to 1 \tab +#' number or list of three numbers, one for each band \cr +#' \strong{gain} \tab Value(s) by which to multiply each pixel value \tab +#' number or list of three numbers, one for each band \cr +#' \strong{bias} \tab Value(s) to add to each Digital Number (DN) +#' value \tab number or list of three numbers, one for each band \cr +#' \strong{gamma} \tab Gamma correction factor(s) \tab +#' number or list of three numbers, one for each band \cr +#' \strong{palette} \tab List of CSS-style color strings +#' (single-band images only) \tab comma-separated list of hex strings \cr +#' \strong{opacity} \tab The opacity of the layer +#' (0.0 is fully transparent and 1.0 is fully opaque) \tab +#' number \cr +#' } +#' +#' @return An stars or Raster object depending on the \code{raster} argument. +#' @family image download functions +#' +#' @importFrom methods as +#' @importFrom reticulate py_to_r +#' @importFrom utils download.file zip str +#' @examples +#' \dontrun{ +#' library(raster) +#' library(stars) +#' library(rgee) +#' +#' ee_Initialize() +#' +#' nc <- st_read(system.file("shp/arequipa.shp", package = "rgee")) +#' dem_palette <- c( +#' "#008435", "#1CAC17", "#48D00C", "#B3E34B", "#F4E467", +#' "#F4C84E", "#D59F3C", "#A36D2D", "#C6A889", "#FFFFFF" +#' ) +#' +#' ## DEM data -SRTM v4.0 +#' image <- ee$Image("CGIAR/SRTM90_V4") +#' world_region <- ee$Geometry$Rectangle( +#' coords = c(-180,-60,180,60), +#' proj = "EPSG:4326", +#' geodesic = FALSE +#' ) +#' +#' ## world - elevation +#' world_dem <- ee_as_thumbnail( +#' image = image, +#' region = world_region, +#' dimensions = 1024, +#' vizparams = list(min = 0, max = 5000) +#' ) +#' +#' world_dem[world_dem <= 0] <- NA +#' world_dem <- world_dem * 5000 +#' +#' plot( +#' x = world_dem, col = dem_palette, breaks = "equal", +#' reset = FALSE, main = "SRTM - World" +#' ) +#' +#' ## Arequipa-Peru +#' arequipa_region <- nc %>% +#' st_bbox() %>% +#' st_as_sfc() %>% +#' sf_as_ee() +#' +#' arequipa_dem <- ee_as_thumbnail( +#' image = image, +#' region = arequipa_region$buffer(1000)$bounds(), +#' dimensions = 512, +#' vizparams = list(min = 0, max = 5000) +#' ) +#' +#' arequipa_dem <- arequipa_dem * 5000 +#' st_crs(arequipa_dem) <- 4326 +#' plot( +#' x = arequipa_dem[nc], col = dem_palette, breaks = "equal", +#' reset = FALSE, main = "SRTM - Arequipa" +#' ) +#' +#' suppressWarnings(plot( +#' x = nc, col = NA, border = "black", add = TRUE, +#' lwd = 1.5 +#' )) +#' dev.off() +#' +#' ## LANDSAT 8 +#' img <- ee$Image("LANDSAT/LC08/C01/T1_SR/LC08_038029_20180810")$ +#' select(c("B4", "B3", "B2")) +#' Map$centerObject(img) +#' Map$addLayer(img, list(min = 0, max = 5000, gamma = 1.5)) +#' +#' ## Teton Wilderness +#' l8_img <- ee_as_thumbnail( +#' image = img, +#' region = img$geometry()$bounds(), +#' dimensions = 1024, +#' vizparams = list(min = 0, max = 5000, gamma = 1.5), +#' raster = TRUE +#' ) +#' crs(l8_img) <- "+proj=longlat +datum=WGS84 +no_defs" +#' plotRGB(l8_img, stretch = "lin") +#' } +#' @export +ee_as_thumbnail <- function(image, region, dimensions, vizparams = NULL, + raster = FALSE, quiet = FALSE) { + if (!quiet) { + message_deprecated <- c( + "NOTE: ee_as_thumbnail can not determine the level of the scale. Is ", + "possible that the results present geometric offset. ", + "See https://developers.google.com/earth-engine/guides/scale to get ", + "more details." + ) + message(message_deprecated) + } + + # check packages dependencies + ee_check_packages( + fn_name = "ee_as_thumbnail", + packages = c("sf", "stars", "raster", "jsonlite", "png") + ) + + # check viz parameters + ee_check_vizparam(vizparams) + + # is image an ee.image.Image? + if (!any(class(image) %in% "ee.image.Image")) { + stop("image argument is not an ee$image$Image") + } + + # is region an ee.geometry.Geometry? + if (!any(class(region) %in% "ee.geometry.Geometry")) { + stop("region argument is not an ee$geometry$Geometry") + } + + # From ee$Geometry$Rectangle to sf + sf_region <- ee_as_sf(x = region)["geometry"] + + ## region is a ee$Geometry$Rectangle? + if (any(class(region) %in% "ee.geometry.Geometry")) { + npoints <- nrow(sf::st_coordinates(sf_region)) + if (npoints != 5) { + stop( + stop("region needs to be a ee$Geometry$Rectangle.") + ) + } + } + + # is dimensions missing? + if (missing(dimensions)) { + dimensions <- 512L + if (!quiet) { + message("dimensions param is missing. Assuming 512", + " for the larger image aspect dimension.") + } + } + + # it is a large image? + if (max(dimensions) > 2048) { + if (!quiet) { + message( + "For large image is preferible use rgee::ee_download_*(...)", + "or rgee::ee_as_*(...)" + ) + } + } + + # Getting image ID if it is exist + image_id <- tryCatch( + expr = jsonlite::parse_json(image$id()$serialize())$ + scope[[1]][[2]][["arguments"]][["id"]], + error = function(e) "thumbnail" + ) + if (is.null(image_id)) image_id <- "thumbnail" + + # Metadata of the Geometry to display + ## is geodesic? + is_geodesic <- ee_utils_py_to_r(region$geodesic()$getInfo()) + ## is_evenodd? + query_params <- unlist(jsonlite::parse_json(region$serialize())$scope) + is_evenodd <- as.logical( + query_params[grepl("evenOdd", names(query_params))] + ) + if (length(is_evenodd) == 0 | is.null(is_evenodd)) { + is_evenodd <- TRUE + } + + # bbox and CRS of the geometry + init_offset <- sf::st_bbox(sf_region) + ee_crs <- sf::st_crs(sf_region)$epsg + + if (!quiet) { + ee_geometry_message(region = region, + sf_region = sf_region[["geometry"]]) + } + + # Preparing parameters + vizparams$dimensions <- dimensions + vizparams$region <- region + vizparams$format <- "png" + if (is.null(vizparams$min)) { + vizparams$min <- 0 + } + if (is.null(vizparams$max)) { + vizparams$min <- 1 + } + + # Creating thumbnail in png format + if (!quiet) { + cat( + "Getting the thumbnail image ... please wait\n" + ) + } + thumbnail_url <- image$getThumbURL(vizparams) + + # Reading the png image + z <- tempfile() + download.file(thumbnail_url, z, mode = "wb", quiet = TRUE) + raw_image <- png::readPNG(z) + + # matrix to array + if (length(dim(raw_image)) == 2) { + dim(raw_image) <- c(dim(raw_image), 1) + } + + # It is a RGB or gray image? + if (dim(raw_image)[3] == 1) { + bands <- 1 + } else if (dim(raw_image)[3] == 2) { + bands <- 1 + } else if (dim(raw_image)[3] == 3) { + bands <- 3 + } else if (dim(raw_image)[3] == 4) { + bands <- 3 + } + + # Create a stars object for RGB images + if (bands == 3) { + band_name <- c("R", "G", "B") + stars_png <- mapply(read_png_as_stars, + seq_len(bands), + band_name, + SIMPLIFY = FALSE, + MoreArgs = list(mtx = raw_image) + ) + add <- function(x) Reduce(c, x) + + stars_png %>% + add() %>% + merge() %>% + stars::st_set_dimensions(names = c("x", "y", "band")) -> stars_png + + attr_dim <- attr(stars_png, "dimensions") + attr_dim$x$offset <- init_offset[1] + attr_dim$y$offset <- init_offset[2] + attr_dim$x$delta <- (init_offset[3] - init_offset[1]) / attr_dim$x$to + attr_dim$y$delta <- (init_offset[4] - init_offset[2]) / attr_dim$y$to + + attr(stars_png, "dimensions") <- attr_dim + sf::st_crs(stars_png) <- ee_crs + if (isFALSE(raster)) { + thumbnail_stars <- stars::st_as_stars(as(stars_png, "Raster")) + names(thumbnail_stars) <- image_id + thumbnail_stars <- stars::st_set_dimensions( + .x = thumbnail_stars, + which = 3, + values = band_name + ) + thumbnail_stars + } else { + thumbnail_raster <- as(stars_png, "Raster") + names(thumbnail_raster) <- band_name + thumbnail_raster + } + } else if (bands == 1) { + # Create a stars object for single band image + stars_png <- mapply(read_png_as_stars, + bands, + image_id, + SIMPLIFY = FALSE, + MoreArgs = list(mtx = raw_image) + )[[1]] + stars_png <- stars::st_set_dimensions(.x = stars_png, names = c("x", "y")) + + attr_dim <- attr(stars_png, "dimensions") + attr_dim$x$offset <- init_offset[1] + attr_dim$y$offset <- init_offset[2] + attr_dim$x$delta <- (init_offset[3] - init_offset[1]) / attr_dim$x$to + attr_dim$y$delta <- (init_offset[4] - init_offset[2]) / attr_dim$y$to + attr(stars_png, "dimensions") <- attr_dim + sf::st_crs(stars_png) <- ee_crs + if (isFALSE(raster)) { + thumbnail_stars <- stars_png %>% + as("Raster") %>% + stars::st_as_stars() + names(thumbnail_stars) <- image_id + thumbnail_stars + } else { + thumbnail_raster <- stars_png %>% + as("Raster") + names(thumbnail_raster) <- image_id + thumbnail_raster + } + } else { + stop("Number of bands not supported") + } +} + +#' From R array to stars +#' @noRd +read_png_as_stars <- function(x, band_name, mtx) { + rotate <- function(x) t(apply(x, 2, rev)) + rotate_x <- rotate(mtx[, , x]) + dim_x <- dim(rotate_x) + array_x <- array(NA, dim = c(dim_x[1], dim_x[2], 1)) + array_x[, , 1] <- rotate_x + stars_object <- stars::st_as_stars(array_x) + stars_object <- stars_object[, , , 1, drop = TRUE] + names(stars_object) <- band_name + stars_object +} + + +#' Check the visualization parameters +#' @noRd +ee_check_vizparam <- function(x) { + list_names <- c( + "bands", "min", "max", "gain", "bias", "gamma", "palette","opacity" + ) + check_listnames <- names(x) %in% list_names + if (any(!check_listnames)) { + stop( + "The following visualization parameters are not valid: ", + paste(names(x[!check_listnames]), collapse = ", ") + ) + } +} diff --git a/R/ee_clean.R b/R/ee_clean.R old mode 100644 new mode 100755 index 19dff43f..94936b09 --- a/R/ee_clean.R +++ b/R/ee_clean.R @@ -144,12 +144,7 @@ ee_clean_container <- function(name = "rgee_backup", ee_user <- ee_exist_credentials() if (type == "drive") { - if (!requireNamespace("googledrive", quietly = TRUE)) { - stop( - "The googledrive package is required to use rgee::ee_download_drive", - call. = FALSE - ) - } + ee_check_packages("ee_download_drive", "googledrive") if (is.na(ee_user[["drive_cre"]])) { stop( "Google Drive credentials were not loaded.", @@ -170,13 +165,9 @@ ee_clean_container <- function(name = "rgee_backup", count <- count + 1 } } else if (type == "gcs") { - if (!requireNamespace("googleCloudStorageR", quietly = TRUE)) { - stop( - "The googleCloudStorageR package is required to use", - " rgee::ee_download_gcs", - call. = FALSE - ) - } + # check if googleCloudStorageR is installed + ee_check_packages("ee_download_gcs", "googleCloudStorageR") + if (is.na(ee_user[["gcs_cre"]])) { stop( "Google Drive credentials were not loaded.", diff --git a/R/ee_download.R b/R/ee_download.R index 1c912dbc..150bb53f 100755 --- a/R/ee_download.R +++ b/R/ee_download.R @@ -123,9 +123,8 @@ ee_image_to_drive <- function(image, skipEmptyTiles = NULL, fileFormat = NULL, formatOptions = NULL) { - - timePrefix_chr <- gsub("\\s","_",format(Sys.time(), "%Y_%m_%d_%H_%M_%S")) if (isTRUE(timePrefix)) { + timePrefix_chr <- gsub("\\s","_",format(Sys.time(), "%Y_%m_%d_%H_%M_%S")) if (is.null(fileNamePrefix)) { fileNamePrefix <- sprintf("%s_%s", description, timePrefix_chr) } else { @@ -281,8 +280,8 @@ ee_image_to_gcs <- function(image, if (is.null(bucket)) { stop("Cloud Storage bucket was not defined") } - timePrefix_chr <- gsub("\\s","_", format(Sys.time(), "%Y_%m_%d_%H_%M_%S")) if (isTRUE(timePrefix)) { + timePrefix_chr <- gsub("\\s","_", format(Sys.time(), "%Y_%m_%d_%H_%M_%S")) if (is.null(fileNamePrefix)) { fileNamePrefix <- sprintf("%s_%s", description, timePrefix_chr) } else { @@ -511,8 +510,8 @@ ee_table_to_drive <- function(collection, timePrefix = TRUE, fileFormat = NULL, selectors = NULL) { - timePrefix_chr <- gsub("\\s","_", format(Sys.time(), "%Y_%m_%d_%H_%M_%S")) if (isTRUE(timePrefix)) { + timePrefix_chr <- gsub("\\s","_", format(Sys.time(), "%Y_%m_%d_%H_%M_%S")) if (is.null(fileNamePrefix)) { fileNamePrefix <- sprintf("%s_%s", description, timePrefix_chr) } else { @@ -600,8 +599,8 @@ ee_table_to_gcs <- function(collection, if (is.null(bucket)) { stop("Cloud Storage bucket was not defined") } - timePrefix_chr <- gsub("\\s","_", format(Sys.time(), "%Y_%m_%d_%H_%M_%S")) if (isTRUE(timePrefix)) { + timePrefix_chr <- gsub("\\s","_", format(Sys.time(), "%Y_%m_%d_%H_%M_%S")) if (is.null(fileNamePrefix)) { fileNamePrefix <- sprintf("%s_%s", description, timePrefix_chr) } else { @@ -703,6 +702,8 @@ ee_table_to_asset <- function(collection, #' @param overwrite A boolean argument which indicates indicating #' whether "filename" should be overwritten. By default TRUE. #' @param consider Interactive. See details. +#' @param public Logical. If TRUE, a public link to the image will be created. +#' @param metadata Logical. If TRUE, export the metadata related to the image. #' @param quiet logical. Suppress info message #' #' @details @@ -718,7 +719,10 @@ ee_table_to_asset <- function(collection, #' #' @importFrom utils menu #' -#' @return filename character vector. +#' @return If \code{metadata} is FALSE will return the filename of the image. +#' Otherwise, a list with two elements (\code{dns} and \code{metadata}) will +#' be returned. +#' #' @family generic download functions #' #' @examples @@ -788,122 +792,144 @@ ee_drive_to_local <- function(task, dsn, overwrite = TRUE, consider = TRUE, + public = FALSE, + metadata = FALSE, quiet = FALSE) { - if (!requireNamespace("googledrive", quietly = TRUE)) { - stop("The googledrive package is required to use rgee::ee_download_drive", - call. = FALSE + # Check packages + ee_check_packages("ee_drive_to_local", "googledrive") + + # Check credentials + ee_user <- ee_exist_credentials() + if (is.na(ee_user[["drive_cre"]])) { + drive_credential <- ee_create_credentials_drive(ee_user$email) + ee_save_credential(pdrive = drive_credential) + message( + "Google Drive credentials were not loaded.", + " Running ee_Initialize(email = '",ee_user[["email"]],"', drive = TRUE)", + " to fix." ) - } else { - ee_user <- ee_exist_credentials() - if (is.na(ee_user[["drive_cre"]])) { - ee_Initialize(email = ee_user[["email"]], drive = TRUE) - message( - "Google Drive credentials were not loaded.", - " Running ee_Initialize(email = '",ee_user[["email"]],"', drive = TRUE)", - " to fix it." - ) - } - # global parameter of a task - gd_folder <- basename(ee$batch$Task$status(task)[["destination_uris"]]) - gd_ExportOptions <- task[["config"]][["fileExportOptions"]] - gd_filename <- gd_ExportOptions[["driveDestination"]][["filenamePrefix"]] + } + + # global parameter of a task + gd_folder <- basename(ee$batch$Task$status(task)[["destination_uris"]]) + gd_ExportOptions <- task[["config"]][["fileExportOptions"]] + gd_filename <- gd_ExportOptions[["driveDestination"]][["filenamePrefix"]] + + # Select a google drive file considering the filename and folder + count <- 1 + files_gd <- try(googledrive::drive_find( + q = sprintf("'%s' in parents", gd_folder), + q = sprintf("name contains '%s'", gd_filename) + ), silent = TRUE) - # Select a google drive file considering the filename and folder - count <- 1 + while (any(class(files_gd) %in% "try-error") & count < 5) { files_gd <- try(googledrive::drive_find( q = sprintf("'%s' in parents", gd_folder), q = sprintf("name contains '%s'", gd_filename) ), silent = TRUE) - while (any(class(files_gd) %in% "try-error") & count < 5) { - files_gd <- try(googledrive::drive_find( - q = sprintf("'%s' in parents", gd_folder), - q = sprintf("name contains '%s'", gd_filename) - ), silent = TRUE) - count <- count + 1 - } + count <- count + 1 + } - # (Problem) Google Drive support files with the same name - if (nrow(files_gd) > 0) { - ee_getTime <- function(x) { - gd_file_date <- files_gd[["drive_resource"]][[x]][["createdTime"]] - as.POSIXct(gd_file_date) - } - createdTime <- vapply(seq_len(nrow(files_gd)), ee_getTime, 0) - files_gd <- files_gd[order(createdTime, decreasing = TRUE), ] - if (isTRUE(consider)) { - choices <- c(files_gd[["name"]],'last','all') - if (nrow(files_gd) == 1) { - file_selected <- 1 - } else { - file_selected <- menu( - choices = choices, - title = paste0( - "Multiple files with the same name", - " (sorted according to the created time argument):" - ) + if (public) { + files_gd <- googledrive::drive_share_anyone(files_gd, verbose = FALSE) + } + + # (Problem) Google Drive support files with the same name + if (nrow(files_gd) > 0) { + ee_getTime <- function(x) { + gd_file_date <- files_gd[["drive_resource"]][[x]][["createdTime"]] + as.POSIXct(gd_file_date) + } + createdTime <- vapply(seq_len(nrow(files_gd)), ee_getTime, 0) + files_gd <- files_gd[order(createdTime, decreasing = TRUE), ] + if (isTRUE(consider)) { + choices <- c(files_gd[["name"]],'last','all') + if (nrow(files_gd) == 1) { + file_selected <- 1 + } else { + file_selected <- menu( + choices = choices, + title = paste0( + "Multiple files with the same name", + " (sorted according to the created time argument):" ) - } - if (choices[file_selected] == 'last') { - files_gd <- files_gd[1,] - } else if (choices[file_selected] == 'all') { - files_gd <- files_gd - } else { - files_gd <- files_gd[file_selected, ] - } - } else if (consider == "last") { - files_gd <- files_gd[1, ] - } else if (consider == "all") { + ) + } + if (choices[file_selected] == 'last') { + files_gd <- files_gd[1,] + } else if (choices[file_selected] == 'all') { files_gd <- files_gd } else { - stop("consider argument was not defined properly.") + files_gd <- files_gd[file_selected, ] } + } else if (consider == "last") { + files_gd <- files_gd[1, ] + } else if (consider == "all") { + files_gd <- files_gd } else { - stop( - "File does not exist in Google Drive.", - " Please verify if the task finished properly." - ) + stop("consider argument was not defined properly.") } + } else { + stop( + "File does not exist in Google Drive.", + " Please verify if the task finished properly." + ) + } - # Choose the right file using the driver_resource["originalFilename"] - fileformat <- toupper(gd_ExportOptions[["fileFormat"]]) + # Choose the right file using the driver_resource["originalFilename"] + fileformat <- toupper(gd_ExportOptions[["fileFormat"]]) - if (missing(dsn)) { - ee_tempdir <- tempdir() - filenames_local <- sprintf("%s/%s", ee_tempdir, basename(files_gd$name)) + if (missing(dsn)) { + ee_tempdir <- tempdir() + filenames_local <- sprintf("%s/%s", ee_tempdir, basename(files_gd$name)) + } else { + pattern <- "(.*)(\\..*)$" + element_len <- length(files_gd$name) + # Neccesary for large GEOTIFF and TFRecord files + if (task$task_type == "EXPORT_IMAGE" & element_len > 1) { + file_ft <- sprintf( + "-%04d%s", + seq_len(element_len), + sub(pattern, "\\2", files_gd$name) + ) } else { - pattern <- "(.*)(\\..*)$" - element_len <- length(files_gd$name) - # Neccesary for large GEOTIFF and TFRecord files - if (task$task_type == "EXPORT_IMAGE" & element_len > 1) { - file_ft <- sprintf( - "-%04d%s", - seq_len(element_len), - sub(pattern, "\\2", files_gd$name) - ) - } else { - file_ft <- sub(pattern, "\\2", files_gd$name) - } - dsn_n <- sub(pattern,"\\1",basename(dsn)) - filenames_local <- sprintf("%s/%s%s",dirname(dsn), dsn_n, file_ft) + file_ft <- sub(pattern, "\\2", files_gd$name) } - # it is necessary for ESRI shapefiles - filenames_local <- ee_sort_localfiles(filenames_local, fileformat) - to_download <- sort_drive_files(files_gd, fileformat) + dsn_n <- sub(pattern,"\\1",basename(dsn)) + filenames_local <- sprintf("%s/%s%s",dirname(dsn), dsn_n, file_ft) + } + # it is necessary for ESRI shapefiles + filenames_local <- ee_sort_localfiles(filenames_local, fileformat) + to_download <- sort_drive_files(files_gd, fileformat) + + # if (nrow(to_download) > 4) { + # stop( + # "Impossible to download multiple geometries as SHP.", + # " Try to define the fileFormat argument as GEO_JSON" + # ) + # } + for (index in seq_len(nrow(to_download))) { + googledrive::drive_download( + file = to_download[index, ], + path = filenames_local[index], + overwrite = overwrite, + verbose = !quiet + ) + } - # if (nrow(to_download) > 4) { - # stop( - # "Impossible to download multiple geometries as SHP.", - # " Try to define the fileFormat argument as GEO_JSON" - # ) - # } - for (index in seq_len(nrow(to_download))) { - googledrive::drive_download( - file = to_download[index, ], - path = filenames_local[index], - overwrite = overwrite, - verbose = !quiet + if (metadata) { + list( + dsn = filenames_local, + metadata = list( + ee_id = task$id, + drive_name = to_download$name, + drive_id = to_download$id, + drive_download_link = sprintf( + "https://drive.google.com/uc?id=%s&export=download", + to_download$id) ) - } + ) + } else { filenames_local } } @@ -916,8 +942,10 @@ ee_drive_to_local <- function(task, #' @param task List generated after finished correctly a EE task. See details. #' @param dsn Character. Output filename. If missing, a temporary #' file will be assigned. -#' @param overwrite Logical. A boolean indicating whether the file should -#' be overwritten. +#' @param overwrite A boolean argument which indicates indicating +#' whether "filename" should be overwritten. By default TRUE. +#' @param public Logical. If TRUE, a public link to the image will be created. +#' @param metadata Logical. If TRUE, export the metadata related to the image. #' @param quiet Logical. Suppress info message #' @details #' @@ -992,32 +1020,40 @@ ee_drive_to_local <- function(task, #' @export ee_gcs_to_local <- function(task, dsn, + public = FALSE, + metadata = FALSE, overwrite = TRUE, quiet = FALSE) { - if (!requireNamespace("googleCloudStorageR", quietly = TRUE)) { - stop( - "The googleCloudStorageR package is required to use", - " rgee::ee_download_gcs", - call. = FALSE + # Check packages + ee_check_packages("ee_gcs_to_local", "googleCloudStorageR") + + # Check credentials + ee_user <- ee_exist_credentials() + if (is.na(ee_user[["gcs_cre"]])) { + gcs_credential <- ee_create_credentials_gcs(ee_user$email) + ee_save_credential(pgcs = gcs_credential[["path"]]) + message( + "Google Cloud Storage credentials were not loaded.", + " Running ee_Initialize(email = '",ee_user[["email"]],"', gcs = TRUE)", + " to fix." ) - } else { - ee_user <- ee_exist_credentials() - if (is.na(ee_user[["gcs_cre"]])) { - ee_Initialize(email = ee_user[["email"]], gcs = TRUE) - message( - "Google Cloud Storage credentials were not loaded.", - " Running ee_Initialize(email = '",ee_user[["email"]],"', gcs = TRUE)", - " to fix it." - ) - } - # Getting bucket name and filename - gcs_ExportOptions <- task[["config"]][["fileExportOptions"]] - gcs_bucket <- gcs_ExportOptions[["gcsDestination"]][["bucket"]] - gcs_filename <- gcs_ExportOptions[["gcsDestination"]][["filenamePrefix"]] - gcs_fileFormat <- gcs_ExportOptions[["fileFormat"]] + } + # Getting bucket name and filename + gcs_ExportOptions <- task[["config"]][["fileExportOptions"]] + gcs_bucket <- gcs_ExportOptions[["gcsDestination"]][["bucket"]] + gcs_filename <- gcs_ExportOptions[["gcsDestination"]][["filenamePrefix"]] + gcs_fileFormat <- gcs_ExportOptions[["fileFormat"]] - # Select a gcs file considering the filename and bucket - count <- 1 + # Select a gcs file considering the filename and bucket + count <- 1 + files_gcs <- try( + expr = googleCloudStorageR::gcs_list_objects( + bucket = gcs_bucket, + prefix = gcs_filename + ), + silent = TRUE + ) + while (any(class(files_gcs) %in% "try-error") & count < 5) { files_gcs <- try( expr = googleCloudStorageR::gcs_list_objects( bucket = gcs_bucket, @@ -1025,61 +1061,81 @@ ee_gcs_to_local <- function(task, ), silent = TRUE ) - while (any(class(files_gcs) %in% "try-error") & count < 5) { - files_gcs <- try( - expr = googleCloudStorageR::gcs_list_objects( - bucket = gcs_bucket, - prefix = gcs_filename - ), - silent = TRUE + count <- count + 1 + } + + if (public) { + for (name in files_gcs$name) { + googleCloudStorageR::gcs_update_object_acl( + object_name = name, + bucket = gcs_bucket, + entity_type = "allUsers" ) - count <- count + 1 } + } - # Choose the right file using the driver_resource["originalFilename"] - fileformat <- toupper(gcs_fileFormat) - if (missing(dsn)) { - ee_tempdir <- tempdir() - filenames_local <- sprintf("%s/%s", ee_tempdir, basename(files_gcs[["name"]])) + # Choose the right file using the driver_resource["originalFilename"] + fileformat <- toupper(gcs_fileFormat) + if (missing(dsn)) { + ee_tempdir <- tempdir() + filenames_local <- sprintf("%s/%s", ee_tempdir, basename(files_gcs[["name"]])) + } else { + pattern <- "(.*)(\\..*)$" + element_len <- length(files_gcs[["name"]]) + # Neccesary for large GEOTIFF and TFRecord files + if (task$task_type == "EXPORT_IMAGE" & element_len > 1) { + file_ft <- sprintf( + "-%04d%s", + seq_len(element_len), + sub(pattern, "\\2", files_gcs[["name"]]) + ) } else { - pattern <- "(.*)(\\..*)$" - element_len <- length(files_gcs[["name"]]) - # Neccesary for large GEOTIFF and TFRecord files - if (task$task_type == "EXPORT_IMAGE" & element_len > 1) { - file_ft <- sprintf( - "-%04d%s", - seq_len(element_len), - sub(pattern, "\\2", files_gcs[["name"]]) - ) - } else { - file_ft <- sub(pattern, "\\2", files_gcs[["name"]]) - } - dsn_n <- sub(pattern,"\\1",basename(dsn)) - filenames_local <- sprintf("%s/%s%s",dirname(dsn), dsn_n, file_ft) + file_ft <- sub(pattern, "\\2", files_gcs[["name"]]) } - # it is necessary for ESRI shapefiles - filenames_local <- ee_sort_localfiles(filenames_local, fileformat) - to_download <- sort_drive_files(files_gcs, fileformat) + dsn_n <- sub(pattern,"\\1",basename(dsn)) + filenames_local <- sprintf("%s/%s%s",dirname(dsn), dsn_n, file_ft) + } - for (index in seq_along(filenames_local)) { - if (isTRUE(quiet)) { - suppressMessages( - googleCloudStorageR::gcs_get_object( - object_name = to_download[index,][["name"]], - bucket = gcs_bucket, - saveToDisk = filenames_local[index], - overwrite = TRUE - ) - ) - } else { + # it is necessary for ESRI shapefiles + filenames_local <- ee_sort_localfiles(filenames_local, fileformat) + to_download <- sort_drive_files(files_gcs, fileformat) + + for (index in seq_along(filenames_local)) { + if (isTRUE(quiet)) { + suppressMessages( googleCloudStorageR::gcs_get_object( - object_name = to_download[index,][["name"]], - bucket = gcs_bucket, - saveToDisk = filenames_local[index], - overwrite = TRUE + object_name = to_download[index,][["name"]], + bucket = gcs_bucket, + saveToDisk = filenames_local[index], + overwrite = overwrite ) - } + ) + } else { + googleCloudStorageR::gcs_get_object( + object_name = to_download[index,][["name"]], + bucket = gcs_bucket, + saveToDisk = filenames_local[index], + overwrite = overwrite + ) } + } + + if (metadata) { + list( + dsn = filenames_local, + metadata = list( + ee_id = task$id, + gcs_name = to_download$name, + gcs_bucket = gcs_bucket, + gcs_fileFormat = gcs_fileFormat, + gcs_public_link = sprintf( + "https://storage.googleapis.com/%s/%s", + gcs_bucket, to_download$name + ), + gcs_URI = sprintf("gs://%s/%s", gcs_bucket, to_download$name) + ) + ) + } else { filenames_local } } diff --git a/R/ee_extract.R b/R/ee_extract.R index a98507bf..82024c33 100755 --- a/R/ee_extract.R +++ b/R/ee_extract.R @@ -79,13 +79,15 @@ #' ee_Initialize() #' #' # Define a Image or ImageCollection: Terraclimate -#' terraclimate <- ee$ImageCollection("IDAHO_EPSCOR/TERRACLIMATE")$ -#' filterDate("2001-01-01", "2002-01-01")$ -#' map(function(x){ -#' date <- ee$Date(x$get("system:time_start"))$format('YYYY_MM_dd') -#' name <- ee$String$cat("Terraclimate_pp_", date) -#' x$select("pr")$reproject("EPSG:4326")$set("RGEE_NAME", name) -#' }) +#' terraclimate <- ee$ImageCollection("IDAHO_EPSCOR/TERRACLIMATE") %>% +#' ee$ImageCollection$filterDate("2001-01-01", "2002-01-01") %>% +#' ee$ImageCollection$map( +#' function(x) { +#' date <- ee$Date(x$get("system:time_start"))$format('YYYY_MM_dd') +#' name <- ee$String$cat("Terraclimate_pp_", date) +#' x$select("pr")$rename(name) +#' } +#' ) #' #' # Define a geometry #' nc <- st_read( @@ -94,7 +96,9 @@ #' quiet = TRUE #' ) #' +#' #' # Extract values +#' #' ee_nc_rain <- ee_extract( #' x = terraclimate, #' y = nc, @@ -105,7 +109,7 @@ #' #' # Spatial plot #' plot( -#' ee_nc_rain["X200110_pr"], +#' ee_nc_rain["Terraclimate_pp_2001_11_01"], #' main = "2001 Jan Precipitation - Terraclimate", #' reset = FALSE #' ) @@ -118,28 +122,28 @@ ee_extract <- function(x, sf = FALSE, quiet = FALSE, ...) { + ee_check_packages("ee_extract", c("geojsonio", "sf")) + + # print scale if (!quiet & is.null(scale)) { scale <- 1000 message(sprintf("The image scale is set to %s.", scale)) } - if (!requireNamespace("geojsonio", quietly = TRUE)) { - stop("package geojsonio required, please install it first") - } - if (!requireNamespace("sf", quietly = TRUE)) { - stop("package sf required, please install it first") - } + # Is x a Image or ImageCollection? if (!any(class(x) %in% ee_get_spatial_objects("i+ic"))) { stop("x is neither an ee$Image nor ee$ImageCollection") } + # Is x a ImageCollection? if (any(class(x) %in% "ee.imagecollection.ImageCollection")) { - if (!quiet) { - message("x is an ImageCollection, running 'x$toBands()' to ", - "convert it into an Image") - } + # if (!quiet) { + # message("x is an ImageCollection, running 'x$toBands()' to ", + # "convert it into an Image") + # } x <- ee$ImageCollection$toBands(x) } + # Load Python module oauth_func_path <- system.file("python/ee_extract.py", package = "rgee") extract_py <- ee_source_python(oauth_func_path) @@ -154,17 +158,17 @@ ee_extract <- function(x, # If y is a sf object convert into a ee$FeatureCollection object if (any("sf" %in% class(y))) { sf_y <- y - if (!quiet) { - message("y is an sf object, running 'sf_as_ee(y$geometry)' to ", - "convert it into an ee$FeatureCollection object.") - } + # if (!quiet) { + # message("NOTE: y is an sf object, running 'sf_as_ee(y$geometry)' to ", + # "convert in an ee$FeatureCollection object.") + # } ee_y <- sf_as_ee(y[["geometry"]], quiet = TRUE) } else if(any("sfc" %in% class(y))) { sf_y <- sf::st_sf(id = seq_along(y), geometry = y) - if (!quiet) { - message("y is an sfc object, running 'sf_as_ee(y)' to ", - "convert it into an ee$FeatureCollection object.") - } + # if (!quiet) { + # message("y is an sfc object, running 'sf_as_ee(y)' to ", + # "convert it into an ee$FeatureCollection object.") + # } ee_y <- sf_as_ee(y, quiet = TRUE) # If y is a ee$FeatureCollection object and 'sf' arg is TRUE convert it to an # sf object @@ -231,6 +235,9 @@ ee_extract <- function(x, table_sf["id"] <- NULL table_sf["ee_ID"] <- NULL + # Remove system:index prefix + colnames(table_sf) <- gsub("^[^_]*_","", colnames(table_sf)) + if (isTRUE(sf)) { table_geometry <- sf::st_geometry(sf_y) table_sf <- sf_y %>% diff --git a/R/ee_get.R b/R/ee_get.R old mode 100644 new mode 100755 diff --git a/R/ee_help.R b/R/ee_help.R old mode 100644 new mode 100755 index 801b2d35..335663d6 --- a/R/ee_help.R +++ b/R/ee_help.R @@ -98,9 +98,8 @@ ee_help <- function(eeobject, browser = FALSE) { # Are you in Rstudio? if (.Platform$GUI == "RStudio" & isFALSE(browser)) { - if (!requireNamespace("rstudioapi", quietly = TRUE)) { - stop("package rstudioapi required, please install it first") - } + # check rstudioapi + ee_check_packages("ee_help", "rstudioapi") writeLines( text = c( ee_html_head_rstudio(doc_to_display$qualified_name), diff --git a/R/ee_image.R b/R/ee_image.R old mode 100644 new mode 100755 index a8d35db0..ad9dfe22 --- a/R/ee_image.R +++ b/R/ee_image.R @@ -1,35 +1,78 @@ -#' Convert an Earth Engine (EE) image into a stars object +#' Convert an Earth Engine (EE) image in a stars object #' -#' Convert an ee$Image into a stars object +#' Convert an ee$Image in a stars object. #' -#' @param image ee$Image to be converted into a stars object +#' @param image ee$Image to be converted into a stars object. #' @param region EE Geometry (ee$Geometry$Polygon) which specify the region -#' to export. CRS needs to be the same that the x argument otherwise it will be -#' forced. If not specified image bounds will be taken. -#' @param dsn Character. Output filename. If missing, -#' \code{ee_as_stars} will create a temporary file. +#' to export. CRS needs to be the same that the argument \code{image}, +#' otherwise, it will be forced. If not specified, image bounds will be taken. +#' @param dsn Character. Output filename. If missing, a temporary file will be +#' created. +#' @param via Character. Method to export the image. Two method are +#' implemented: "drive", "gcs". See details. +#' @param container Character. Name of the folder ('drive') or bucket ('gcs') +#' to be exported into. #' @param scale Numeric. The resolution in meters per pixel. Defaults -#' to the native resolution of the image asset. +#' to the native resolution of the image. #' @param maxPixels Numeric. The maximum allowed number of pixels in the #' exported image. The task will fail if the exported region covers #' more pixels in the specified projection. Defaults to 100,000,000. -#' @param via Character. Method to fetch data about the object. Two methods -#' are implemented: "drive", "gcs". See details. -#' @param container Character. Name of the folder ('drive') or bucket ('gcs') -#' to be exported into (ignored if \code{via} is not defined as "drive" or -#' "gcs"). +#' @param lazy Logical. If TRUE, a \code{\link[future:sequential]{ +#' future::sequential}} object is created to evaluate the task in the future. +#' See details. +#' @param public Logical. If TRUE, a public link to the image will be created. +#' @param add_metadata Add metadata to the stars_proxy object. See details. +#' @param timePrefix Logical. Add current date and time (\code{Sys.time()}) as +#' a prefix to files to export. This parameter helps to avoid exported files +#' with the same name. By default TRUE. #' @param quiet Logical. Suppress info message #' @param ... Extra exporting argument. See \link{ee_image_to_drive} and #' \link{ee_image_to_gcs}. #' #' @details -#' \code{ee_as_stars} supports the download of \code{ee$Image} -#' by two different options: "drive" that use Google Drive and "gcs" -#' that use Google Cloud Storage. Previously, it is necessary to install the -#' R packages \href{ https://CRAN.R-project.org/package=googledrive}{googledrive} -#' or \href{https://CRAN.R-project.org/package=googleCloudStorageR}{ -#' googleCloudStorageR} respectively. For getting more information about -#' exporting data from Earth Engine, take a look at the +#' \code{ee_as_stars} supports the download of \code{ee$Images} +#' by two different options: "drive" +#' (\href{https://CRAN.R-project.org/package=googledrive}{Google Drive}) and "gcs" +#' (\href{https://CRAN.R-project.org/package=googleCloudStorageR}{ +#' Google Cloud Storage}). In both cases \code{ee_as_stars} works as follow: +#' \itemize{ +#' \item{1. }{A task will be started (i.e. \code{ee$batch$Task$start()}) to +#' move the \code{ee$Image} from Earth Engine to the intermediate container +#' specified in argument \code{via}.} +#' \item{2. }{If the argument \code{lazy} is TRUE, the task will not be +#' monitored. This is useful to lunch several tasks at the same time and +#' call them later using \code{\link{ee_utils_future_value}} or +#' \code{\link[future:value]{future::value}}. At the end of this step, +#' the \code{ee$Image} will be stored on the path specified in the argument +#' \code{dsn}.} +#' \item{3. }{Finally if the argument \code{add_metadata} is TRUE, a list +#' with the following elements will be added to the stars-proxy object. +#' \itemize{ +#' \item{\bold{if via is "drive":}} +#' \itemize{ +#' \item{\bold{ee_id: }}{Name of the Earth Engine task.} +#' \item{\bold{drive_name: }}{Name of the Image in Google Drive.} +#' \item{\bold{drive_id: }}{Id of the Image in Google Drive.} +#' \item{\bold{drive_download_link: }}{Download link to the image.} +#' } +#' } +#' \itemize{ +#' \item{\bold{if via is "gcs":}} +#' \itemize{ +#' \item{\bold{ee_id: }}{Name of the Earth Engine task.} +#' \item{\bold{gcs_name: }}{Name of the Image in Google Cloud Storage.} +#' \item{\bold{gcs_bucket: }}{Name of the bucket.} +#' \item{\bold{gcs_fileFormat: }}{Format of the image.} +#' \item{\bold{gcs_public_link: }}{Download link to the image.} +#' \item{\bold{gcs_URI: }}{gs:// link to the image.} +#' } +#' } +#' Run \code{attr(stars, "metadata")} to get the list. +#' } +#' } +#' +#' For getting more information about exporting data from Earth Engine, take +#' a look at the #' \href{https://developers.google.com/earth-engine/exporting}{Google #' Earth Engine Guide - Export data}. #' @return A stars-proxy object @@ -59,21 +102,47 @@ #' ) #' #' ## drive - Method 01 +#' # Simple #' img_02 <- ee_as_stars( #' image = img, #' region = geometry, #' via = "drive" #' ) #' -#' ## gcs - Method 02 +#' # Lazy +#' img_02 <- ee_as_stars( +#' image = img, +#' region = geometry, +#' via = "drive", +#' lazy = TRUE +#' ) +#' +#' img_02_result <- img_02 %>% ee_utils_future_value() +#' attr(img_02_result, "metadata") # metadata +#' +#' # ## gcs - Method 02 +#' # # Simple +#' # img_03 <- ee_as_stars( +#' # image = img, +#' # region = geometry, +#' # container = "rgee_dev", +#' # via = "gcs" +#' # ) +#' # +#' # # Lazy #' # img_03 <- ee_as_stars( #' # image = img, -#' # region = geometry, +#' # region = geometry, #' # container = "rgee_dev", -#' # via = "gcs" -#' #) -#' -#' # OPTIONAL: Delete containers +#' # lazy = TRUE, +#' # via = "gcs" +#' # ) +#' # +#' # img_03_result <- img_03 %>% ee_utils_future_value() +#' # attr(img_03_result, "metadata") # metadata +#' # +#' # +#' # # OPTIONAL: clean containers #' # ee_clean_container(name = "rgee_backup", type = "drive") #' # ee_clean_container(name = "rgee_dev", type = "gcs") #' } @@ -82,19 +151,21 @@ ee_as_stars <- function(image, region = NULL, dsn = NULL, via = "drive", + container = "rgee_backup", scale = NULL, maxPixels = 1e9, - container = "rgee_backup", + lazy = FALSE, + public = TRUE, + add_metadata = TRUE, + timePrefix = TRUE, quiet = FALSE, ...) { - if (!requireNamespace("stars", quietly = TRUE)) { - stop("package stars required, please install it first") - } - if (!requireNamespace("sf", quietly = TRUE)) { - stop("package sf required, please install it first") - } + ee_check_packages("ee_as_stars", c("stars", "sf", "future")) - img_files <- ee_image_local( + # 1. From Earth Engine to the container (drive or gcs) + # Initialize the task! depending of the argument "via", the arguments + # of ee_image_to_drive or ee_image_to_gcs could be passed. + ee_task <- ee_init_task( image = image, region = region, dsn = dsn, @@ -102,52 +173,119 @@ ee_as_stars <- function(image, scale = scale, maxPixels = maxPixels, container = container, + timePrefix = timePrefix, quiet = quiet, ... ) - img_stars <- stars::read_stars(img_files$file, proxy = TRUE) + to_evaluate <- function() { + # 2. From the container to the client-side. + img_dsn <- ee_image_local( + task = ee_task$task, + dsn = ee_task$dsn, + via = via, + metadata = add_metadata, + public = public, + quiet = quiet + ) + + # Copy band names + band_names <- image %>% + ee$Image$bandNames() %>% + ee$List$getInfo() - # It's a single image? - if (length(stars::st_dimensions(img_stars)) < 3) { - img_stars + # Create a proxy-star object + ee_read_stars(img_dsn$dsn, band_names, img_dsn$metadata) + } + + + if (lazy) { + prev_plan <- future::plan(future::sequential, .skip = TRUE) + on.exit(future::plan(prev_plan, .skip = TRUE), add = TRUE) + future::future({ + to_evaluate() + }, lazy = TRUE) } else { - stars::st_set_dimensions(img_stars, 3, values = img_files$band_names) + to_evaluate() } } -#' Convert an Earth Engine (EE) image into a raster object + +#' Convert an Earth Engine (EE) image in a raster object #' -#' Convert an ee$Image into a raster object +#' Convert an ee$Image in a raster object #' #' @param image ee$Image to be converted into a raster object #' @param region EE Geometry (ee$Geometry$Polygon) which specify the region -#' to export. CRS needs to be the same that the x argument otherwise it will be -#' forced. If not specified image bounds will be taken. -#' @param dsn Character. Output filename. If missing, -#' \code{ee_as_raster} will create a temporary file. +#' to export. CRS needs to be the same that the argument \code{image}, +#' otherwise, it will be forced. If not specified, image bounds will be taken. +#' @param dsn Character. Output filename. If missing, a temporary file will be +#' created. +#' @param via Character. Method to export the image. Two method are +#' implemented: "drive", "gcs". See details. +#' @param container Character. Name of the folder ('drive') or bucket ('gcs') +#' to be exported into. #' @param scale Numeric. The resolution in meters per pixel. Defaults -#' to the native resolution of the image asset. +#' to the native resolution of the image. #' @param maxPixels Numeric. The maximum allowed number of pixels in the #' exported image. The task will fail if the exported region covers #' more pixels in the specified projection. Defaults to 100,000,000. -#' @param via Character. Method to fetch data about the object. Two methods -#' are implemented: "drive", "gcs". See details. -#' @param container Character. Name of the folder ('drive') or bucket ('gcs') -#' to be exported into (ignored if \code{via} is not defined as "drive" or -#' "gcs"). +#' @param lazy Logical. If TRUE, a \code{\link[future:sequential]{ +#' future::sequential}} object is created to evaluate the task in the future. +#' See details. +#' @param public Logical. If TRUE, a public link to the image will be created. +#' @param add_metadata Add metadata to the stars_proxy object. See details. +#' @param timePrefix Logical. Add current date and time (\code{Sys.time()}) as +#' a prefix to files to export. This parameter helps to avoid exported files +#' with the same name. By default TRUE. #' @param quiet Logical. Suppress info message #' @param ... Extra exporting argument. See \link{ee_image_to_drive} and #' \link{ee_image_to_gcs}. #' @details -#' \code{ee_as_raster} supports the download of \code{ee$Image} -#' by two different options: "drive" that use Google Drive and "gcs" -#' that use Google Cloud Storage. Previously, it is necessary to install the -#' R packages \href{ https://CRAN.R-project.org/package=googledrive}{googledrive} -#' or \href{https://CRAN.R-project.org/package=googleCloudStorageR}{ -#' googleCloudStorageR} respectively. For getting more information about -#' exporting data from Earth Engine, take a look at the +#' \code{ee_as_raster} supports the download of \code{ee$Images} +#' by two different options: "drive" +#' (\href{https://CRAN.R-project.org/package=googledrive}{Google Drive}) and "gcs" +#' (\href{https://CRAN.R-project.org/package=googleCloudStorageR}{ +#' Google Cloud Storage}). In both cases \code{ee_as_stars} works as follow: +#' \itemize{ +#' \item{1. }{A task will be started (i.e. \code{ee$batch$Task$start()}) to +#' move the \code{ee$Image} from Earth Engine to the intermediate container +#' specified in argument \code{via}.} +#' \item{2. }{If the argument \code{lazy} is TRUE, the task will not be +#' monitored. This is useful to lunch several tasks at the same time and +#' call them later using \code{\link{ee_utils_future_value}} or +#' \code{\link[future:value]{future::value}}. At the end of this step, +#' the \code{ee$Image} will be stored on the path specified in the argument +#' \code{dsn}.} +#' \item{3. }{Finally if the argument \code{add_metadata} is TRUE, a list +#' with the following elements will be added to the stars-proxy object. +#' \itemize{ +#' \item{\bold{if via is "drive":}} +#' \itemize{ +#' \item{\bold{ee_id: }}{Name of the Earth Engine task.} +#' \item{\bold{drive_name: }}{Name of the Image in Google Drive.} +#' \item{\bold{drive_id: }}{Id of the Image in Google Drive.} +#' \item{\bold{drive_download_link: }}{Download link to the image.} +#' } +#' } +#' \itemize{ +#' \item{\bold{if via is "gcs":}} +#' \itemize{ +#' \item{\bold{ee_id: }}{Name of the Earth Engine task.} +#' \item{\bold{gcs_name: }}{Name of the Image in Google Cloud Storage.} +#' \item{\bold{gcs_bucket: }}{Name of the bucket.} +#' \item{\bold{gcs_fileFormat: }}{Format of the image.} +#' \item{\bold{gcs_public_link: }}{Download link to the image.} +#' \item{\bold{gcs_URI: }}{gs:// link to the image.} +#' } +#' } +#' Run \code{raster@history@metadata} to get the list. +#' } +#' } +#' +#' For getting more information about exporting data from Earth Engine, take +#' a look at the #' \href{https://developers.google.com/earth-engine/exporting}{Google #' Earth Engine Guide - Export data}. #' @return A RasterStack object @@ -176,85 +314,123 @@ ee_as_stars <- function(image, #' ) #' #' ## drive - Method 01 +#' # Simple #' img_02 <- ee_as_raster( #' image = img, #' region = geometry, #' via = "drive" #' ) #' -#' ## gcs - Method 02 +#' # Lazy +#' img_02 <- ee_as_raster( +#' image = img, +#' region = geometry, +#' via = "drive", +#' lazy = TRUE +#' ) +#' +#' img_02_result <- img_02 %>% ee_utils_future_value() +#' img_02_result@history$metadata # metadata +#' +#' # ## gcs - Method 02 +#' # # Simple #' # img_03 <- ee_as_raster( #' # image = img, #' # region = geometry, #' # container = "rgee_dev", #' # via = "gcs" #' # ) +#' # +#' # # Lazy +#' # img_03 <- ee_as_raster( +#' # image = img, +#' # region = geometry, +#' # container = "rgee_dev", +#' # lazy = TRUE, +#' # via = "gcs" +#' # ) +#' # +#' # img_03_result <- img_03 %>% ee_utils_future_value() +#' # img_03_result@history$metadata # metadata #' -#' # OPTIONAL: Delete containers +#' # OPTIONAL: clean containers #' # ee_clean_container(name = "rgee_backup", type = "drive") #' # ee_clean_container(name = "rgee_dev", type = "gcs") #' } #' @export -ee_as_raster <- function(image, - region = NULL, - dsn = NULL, - via = "drive", - scale = NULL, - maxPixels = 1e9, - container = "rgee_backup", - quiet = FALSE, - ...) { - if (!requireNamespace("raster", quietly = TRUE)) { - stop("package raster required, please install it first") - } - img_files <- ee_image_local( +ee_as_raster <- function(image, + region = NULL, + dsn = NULL, + via = "drive", + container = "rgee_backup", + scale = NULL, + maxPixels = 1e9, + lazy = FALSE, + public = TRUE, + add_metadata = TRUE, + timePrefix = TRUE, + quiet = FALSE, + ...) { + ee_check_packages("ee_as_raster", c("raster")) + + ee_task <- ee_init_task( image = image, region = region, dsn = dsn, via = via, scale = scale, - maxPixels = maxPixels, container = container, + maxPixels = maxPixels, + timePrefix = timePrefix, quiet = quiet, ... ) - if (length(img_files$file) > 1) { - message("NOTE: To avoid memory excess problems, ee_as_raster will", - " not build Raster objects for large images.") - img_files[["file"]] + to_evaluate <- function() { + # 2. From the container to the client-side. + img_dsn <- ee_image_local( + task = ee_task$task, + dsn = ee_task$dsn, + via = via, + metadata = add_metadata, + public = public, + quiet = quiet + ) + + # Copy band names + band_names <- image %>% + ee$Image$bandNames() %>% + ee$List$getInfo() + + # Create a proxy-star object + ee_read_raster(img_dsn$dsn, band_names, img_dsn$metadata) + } + + if (lazy) { + prev_plan <- future::plan(future::sequential, .skip = TRUE) + on.exit(future::plan(prev_plan, .skip = TRUE), add = TRUE) + future::future({ + to_evaluate() + }, lazy = TRUE) } else { - img_raster <- raster::stack(img_files[["file"]]) - names(img_raster) <- img_files[["band_names"]] - img_raster + to_evaluate() } } + #' Passing an Earth Engine Image to Local #' @noRd -ee_image_local <- function(image, - region, - dsn = NULL, - via = "drive", - scale = NULL, - maxPixels = 1e9, - container = "rgee_backup", - quiet = FALSE, - ...) { - if (!requireNamespace("sf", quietly = TRUE)) { - stop("package sf required, please install it first") - } - if (!requireNamespace("jsonlite", quietly = TRUE)) { - stop("package jsonlite required, please install it first") - } - if (!requireNamespace("stars", quietly = TRUE)) { - stop("package stars required, please install it first") - } - - # if dsn is NULL, dsn will be a /tempfile. - if (is.null(dsn)) { - dsn <- paste0(tempfile(),".tif") - } +ee_init_task <- function(image, + region, + dsn = NULL, + via = "drive", + scale = NULL, + maxPixels = 1e9, + timePrefix = TRUE, + container = "rgee_backup", + quiet = FALSE, + ...) { + ee_check_packages("ee_init_task", c("sf", "jsonlite", "stars")) # is image an ee.image.Image? if (!any(class(image) %in% "ee.image.Image")) { @@ -267,57 +443,77 @@ ee_image_local <- function(image, } # Get bandnames - band_names <- image %>% + band_names <- image %>% ee$Image$bandNames() %>% ee$List$getInfo() - if (via == "getInfo") { - ee_image_local_getInfo(image, region, dsn, scale, maxPixels, - container, band_names, quiet) - } else if (via == "drive") { - ee_image_local_drive(image, region, dsn, scale, maxPixels, - container, quiet, ...) + if (via == "drive") { + ee_init_task_drive(image, region, dsn, scale, maxPixels, + timePrefix, container, quiet, ...) } else if (via == "gcs") { - ee_image_local_gcs(image, region, dsn, scale, maxPixels, - container, quiet, ...) + ee_init_task_gcs(image, region, dsn, scale, maxPixels, + timePrefix, container, quiet, ...) } else { stop("via argument invalid") } - list(file = dsn, band_names = band_names) } -#' Passing an Earth Engine Image to Local using drive +#' Create a Export task to GD #' @noRd -ee_image_local_drive <- function(image, region, dsn, scale, maxPixels, - container, quiet, ...) { +ee_init_task_drive <- function(image, region, dsn, scale, maxPixels, timePrefix, + container, quiet, ...) { + + extras <- list(...) + + # folder is container + if (any(names(extras) %in% "folder")) { + stop( + "To specify the folder where to export files", + " use the argument container instead of folder." + ) + } # Have you loaded the necessary credentials? # Relevant for either drive or gcs. ee_user <- ee_exist_credentials() - # Getting image ID if it is exist - image_id <- tryCatch( - expr = jsonlite::parse_json(ee$String$serialize(ee$Image$id(image)))$ - scope[[1]][[2]][["arguments"]][["id"]], - error = function(e) "noid_image" - ) - if (is.null(image_id)) { - image_id <- "noid_image" + if (is.null(dsn)) { + # Getting image ID if it is exist + image_id <- tryCatch( + expr = { + image %>% + ee$Image$get("system:id") %>% + ee$ComputedObject$getInfo() %>% + basename() + }, error = function(e) "noid_image" + ) + if (is.null(image_id)) { + image_id <- "noid_image" + } + dsn <- sprintf("%s/%s.tif",tempdir(), image_id) + } else { + image_id <- sub(pattern = "(.*)\\..*$", replacement = "\\1", basename(dsn)) } # Create description (Human-readable name of the task) # Relevant for either drive or gcs. time_format <- format(Sys.time(), "%Y_%m_%d_%H_%M_%S") - ee_description <- paste0("ee_as_stars_task_", time_format) - file_name <- paste0(image_id, "_", time_format) + ee_description <- paste0("rgeeImage_", time_format) + if (timePrefix) { + file_name <- paste0(image_id, "_", time_format) + } else { + file_name <- image_id + } # Are GD credentials loaded? if (is.na(ee_user$drive_cre)) { - ee_Initialize(email = ee_user$email, drive = TRUE) + drive_credential <- ee_create_credentials_drive(ee_user$email) + ee_save_credential(pdrive = drive_credential) + # ee_Initialize(email = ee_user$email, drive = TRUE) message( - "Google Drive credentials were not loaded.", + "\nNOTE: Google Drive credentials were not loaded.", " Running ee_Initialize(email = '",ee_user$email,"', drive = TRUE)", - " to fix it." + " to fix." ) } @@ -329,6 +525,7 @@ ee_image_local_drive <- function(image, region, dsn, scale, maxPixels, # From Google Earth Engine to Google Drive img_task <- ee_image_to_drive( image = image, + timePrefix = FALSE, description = ee_description, scale = scale, folder = container, @@ -350,36 +547,35 @@ ee_image_local_drive <- function(image, region, dsn, scale, maxPixels, ) } ee$batch$Task$start(img_task) - ee_monitoring(task = img_task, quiet = quiet) - - # From Google Drive to local - if (isFALSE(quiet)) { - cat('Moving image from Google Drive to Local ... Please wait \n') - } - - dsn <- ee_drive_to_local( - task = img_task, - dsn = dsn, - consider = 'all', - quiet = quiet - ) - invisible(dsn) + list(task = img_task, dsn = dsn) } -#' Passing an Earth Engine Image to Local using gcs + +#' Create a Export task to GCS #' @noRd -ee_image_local_gcs <- function(image, region, dsn, scale, maxPixels, - container, quiet, ...) { +ee_init_task_gcs <- function(image, region, dsn, scale, maxPixels, + timePrefix, container, quiet, ...) { + extras <- list(...) + + # bucket is container + if (any(names(extras) %in% "bucket")) { + stop( + "To specify the bucket where to export files", + " use the argument container instead of bucket." + ) + } + # Have you loaded the necessary credentials? # Relevant for either drive or gcs. ee_user <- ee_exist_credentials() if (is.na(ee_user$gcs_cre)) { - ee_Initialize(email = ee_user$email, gcs = TRUE) + gcs_credential <- ee_create_credentials_gcs(ee_user$email) + ee_save_credential(pgcs = gcs_credential$path) message( - "Google Cloud Storage credentials were not loaded.", + "\nGoogle Cloud Storage credentials were not loaded.", " Running ee_Initialize(email = '",ee_user$email,"', gcs = TRUE)", - " to fix it." + " to fix." ) } @@ -400,21 +596,38 @@ ee_image_local_gcs <- function(image, region, dsn, scale, maxPixels, } # Getting image ID if it is exist - image_id <- tryCatch( - expr = jsonlite::parse_json(image$id()$serialize())$ - scope[[1]][[2]][["arguments"]][["id"]], - error = function(e) "noid_image" - ) + if (is.null(dsn)) { + # Getting image ID if it is exist + image_id <- tryCatch( + expr = { + image %>% + ee$Image$get("system:id") %>% + ee$ComputedObject$getInfo() %>% + basename() + }, error = function(e) "noid_image" + ) + if (is.null(image_id)) { + image_id <- "noid_image" + } + dsn <- sprintf("%s/%s.tif",tempdir(), image_id) + } else { + image_id <- sub(pattern = "(.*)\\..*$", replacement = "\\1", basename(dsn)) + } # Relevant for either drive or gcs. time_format <- format(Sys.time(), "%Y_%m_%d_%H_%M_%S") - ee_description <- paste0("ee_as_stars_task_", time_format) - file_name <- paste0(image_id, "_", time_format) + ee_description <- paste0("rgeeImage_", time_format) + if (timePrefix) { + file_name <- paste0(image_id, "_", time_format) + } else { + file_name <- image_id + } # From Earth Engine to Google Cloud Storage img_task <- ee_image_to_gcs( image = image, description = ee_description, + timePrefix = FALSE, bucket = container, fileFormat = "GEO_TIFF", region = region, @@ -435,11 +648,68 @@ ee_image_local_gcs <- function(image, region, dsn, scale, maxPixels, ) } img_task$start() - ee_monitoring(task = img_task, quiet = quiet) + list(task = img_task, dsn = dsn) +} + +#' Passing an Earth Engine Image to Local +#' @noRd +ee_image_local <- function(task, dsn, via, metadata, public, quiet) { + if (via == "drive") { + ee_image_local_drive(task, dsn, metadata, public, quiet) + } else if (via == "gcs") { + ee_image_local_gcs(task, dsn, metadata, public, quiet) + } else { + stop("via argument invalid") + } +} + + +#' Passing an Earth Engine Image from GD to Local +#' @noRd +ee_image_local_drive <- function(task, dsn, metadata, public, quiet) { + ee_monitoring(task = task, quiet = quiet) + # From Google Drive to local + if (isFALSE(quiet)) { + cat('Moving image from Google Drive to Local ... Please wait \n') + } + dsn <- ee_drive_to_local( + task = task, + dsn = dsn, + consider = 'all', + metadata = metadata, + public = public, + quiet = quiet + ) + if (is.character(dsn)) { + dsn <- list(dsn = dsn) + } + invisible(dsn) +} + + +#' Passing an Earth Engine Image from GCS to Local +#' @noRd +ee_image_local_gcs <- function(task, dsn, metadata, public, quiet) { + # earth engine monitoring + ee_monitoring(task = task, quiet = quiet) # From Google Cloud Storage to local - cat('Moving image from GCS to Local ... Please wait \n') - dsn <- ee_gcs_to_local(img_task, dsn = dsn, quiet = quiet) + if(isFALSE(quiet)) { + cat('Moving image from GCS to Local ... Please wait \n') + } + + dsn <- ee_gcs_to_local( + task = task, + dsn = dsn, + metadata = metadata, + public = public, + quiet = quiet + ) + + if (is.character(dsn)) { + dsn <- list(dsn = dsn) + } + invisible(dsn) } @@ -476,9 +746,9 @@ ee_image_info <- function(image, getsize = TRUE, compression_ratio = 20, quiet = FALSE) { - if (!requireNamespace("sf", quietly = TRUE)) { - stop("package sf required, please install it first") - } + #check packages + ee_check_packages("ee_image_info", "sf") + band_length <- length(image$bandNames()$getInfo()) # if (band_length != 1) { @@ -578,3 +848,97 @@ ee_approx_number_pixels <- function(region, geotransform) { y_npixel <- tail(abs(y_diff / yScale)) round(x_npixel * y_npixel) # approximately } + +#' The value of a future or the values of all elements in a container +#' +#' Gets the value of a future or the values of all elements (including futures) +#' in a container such as a list, an environment, or a list environment. +#' If one or more futures is unresolved, then this function blocks until all +#' queried futures are resolved. +#' +#' @author Henrik Bengtsson +#' +#' @param future, x A Future, an environment, a list, or a list environment. +#' +#' @param stdout If TRUE, standard output captured while resolving futures +#' is relayed, otherwise not. +#' +#' @param signal If TRUE, \link[base]{conditions} captured while resolving +#' futures are relayed, otherwise not. +#' +#' @param \dots All arguments used by the S3 methods. +#' +#' @return +#' `value()` of a Future object returns the value of the future, which can +#' be any type of \R object. +#' +#' `value()` of a list, an environment, or a list environment returns an +#' object with the same number of elements and of the same class. +#' Names and dimension attributes are preserved, if available. +#' All future elements are replaced by their corresponding `value()` values. +#' For all other elements, the existing object is kept as-is. +#' +#' If `signal` is TRUE and one of the futures produces an error, then +#' that error is produced. +#' +#' @export +ee_utils_future_value <- function(future, stdout = TRUE, signal = TRUE, ...) { + ee_check_packages("ee_utils_future_value", "future") + if (is.list(future)) { + # if all the elements in a list are of the class SequentialFuture. + condition1 <- all( + sapply(future, function(x) any(class(x) %in% "SequentialFuture")) + ) + if (condition1) { + lazy_batch_extract <- future %>% + future::value(stdout = stdout, signal = signal, ...) + # Is the list a results of run ee_imagecollection_to_local? + if(is(future, "ee_imagecollection")) { + dsn <- lapply(lazy_batch_extract, '[[', 1) + metadata <- lapply(lazy_batch_extract, function(x) attr(x, "metadata")) + # If metadata is NULL means that the user run: + # ee_imagecollection_to_local(..., add_metadata=FALSE) + if (any(sapply(metadata, is.null))) { + unlist(dsn) + } else { + mapply( + function(x, y) list(dsn = x, metadata = y), + dsn, metadata, + SIMPLIFY=FALSE + ) + } + } + } else { + stop("Impossible to use ee_utils_future_value in a list ", + "with elements of a class different from SequentialFuture.") + } + } else { + future %>% future::value(stdout = stdout, signal = signal, ...) + } +} + +#' helper function to read raster (ee_read_stars) +#' @noRd +ee_read_stars <- function(img_dsn, band_names, metadata) { + img_stars <- stars::read_stars(img_dsn, proxy = TRUE) + attr(img_stars, "metadata") <- metadata + if (length(stars::st_dimensions(img_stars)) < 3) { + img_stars + } else { + stars::st_set_dimensions(img_stars, 3, values = band_names) + } +} + +#' helper function to read raster (ee_as_raster) +#' @noRd +ee_read_raster <- function(img_dsn, band_names, metadata) { + if (length(img_dsn) > 1) { + message("NOTE: To avoid memory excess problems, ee_as_raster will", + " not build Raster objects for large images.") + img_dsn + } else { + dsn_raster <- raster::stack(img_dsn) + dsn_raster@history <- list(metadata = metadata) + dsn_raster + } +} diff --git a/R/ee_imagecollection.R b/R/ee_imagecollection.R old mode 100644 new mode 100755 index 5966c191..43a6460f --- a/R/ee_imagecollection.R +++ b/R/ee_imagecollection.R @@ -1,36 +1,81 @@ #' Save an EE ImageCollection in their local system #' #' @param ic ee$ImageCollection to be saved in the system. -#' @param region EE Geometry Rectangle (ee$Geometry$Rectangle). The -#' CRS needs to be the same that the ic argument otherwise it will be +#' @param region EE Geometry (ee$Geometry$Polygon). The +#' CRS needs to be the same that the \code{ic} argument otherwise it will be #' forced. -#' @param dsn Character. Output filename. If missing, -#' \code{ee_imagecollection_to_local} will create a temporary file. +#' @param dsn Character. Output filename. If missing, a temporary file will +#' be created for each image. +#' @param via Character. Method to export the image. Two method are implemented: +#' "drive", "gcs". See details. +#' @param container Character. Name of the folder ('drive') or bucket ('gcs') +#' to be exported into (ignored if \code{via} is not defined as "drive" or +#' "gcs"). #' @param scale Numeric. The resolution in meters per pixel. Defaults -#' to the native resolution of the image assset. +#' to the native resolution of the image. #' @param maxPixels Numeric. The maximum allowed number of pixels in the #' exported image. The task will fail if the exported region covers #' more pixels in the specified projection. Defaults to 100,000,000. -#' @param via Character. Method to fetch data about the object. Multiple -#' options supported. See details. -#' @param container Character. Name of the folder ('drive') or bucket ('gcs') -#' to be exported into (ignored if \code{via} is not defined as "drive" or -#' "gcs"). -#' @param quiet logical. Suppress info message +#' @param lazy Logical. If TRUE, a \code{\link[future:sequential]{ +#' future::sequential}} object is created to evaluate the task in the future. +#' See details. +#' @param public Logical. If TRUE, a public link to the image will be created. +#' @param add_metadata Add metadata to the stars_proxy object. See details. +#' @param timePrefix Logical. Add current date and time (\code{Sys.time()}) as +#' a prefix to files to export. This parameter helps to avoid exported files +#' with the same name. By default TRUE. +#' @param quiet Logical. Suppress info message #' @param ... Extra exporting argument. See \link{ee_image_to_drive} and -#' \link{ee_image_to_gcs}. #' @details -#' \code{ee_imagecollection_to_local} supports the download of \code{ee$Image} -#' by two different options: "drive" that use Google Drive and "gcs" -#' that use Google Cloud Storage. Previously, it is necessary to install the -#' R packages \href{ https://CRAN.R-project.org/package=googledrive}{googledrive} -#' or \href{https://CRAN.R-project.org/package=googleCloudStorageR}{ -#' googleCloudStorageR} respectively. For getting more information about -#' exporting data from Earth Engine, take a look at the +#' \code{ee_imagecollection_to_local} supports the download of \code{ee$Images} +#' by two different options: "drive" +#' (\href{https://CRAN.R-project.org/package=googledrive}{Google Drive}) and "gcs" +#' (\href{https://CRAN.R-project.org/package=googleCloudStorageR}{ +#' Google Cloud Storage}). In both cases \code{ee_imagecollection_to_local} +#' works as follow: +#' \itemize{ +#' \item{1. }{A task will be started (i.e. \code{ee$batch$Task$start()}) to +#' move the \code{ee$Image} from Earth Engine to the intermediate container +#' specified in argument \code{via}.} +#' \item{2. }{If the argument \code{lazy} is TRUE, the task will not be +#' monitored. This is useful to lunch several tasks at the same time and +#' call them later using \code{\link{ee_utils_future_value}} or +#' \code{\link[future:value]{future::value}}. At the end of this step, +#' the \code{ee$Images} will be stored on the path specified in the argument +#' \code{dsn}.} +#' \item{3. }{Finally if the argument \code{add_metadata} is TRUE, a list +#' with the following elements will be added to the argument \code{dsn}. +#' \itemize{ +#' \item{\bold{if via is "drive":}} +#' \itemize{ +#' \item{\bold{ee_id: }}{Name of the Earth Engine task.} +#' \item{\bold{drive_name: }}{Name of the Image in Google Drive.} +#' \item{\bold{drive_id: }}{Id of the Image in Google Drive.} +#' \item{\bold{drive_download_link: }}{Download link to the image.} +#' } +#' } +#' \itemize{ +#' \item{\bold{if via is "gcs":}} +#' \itemize{ +#' \item{\bold{ee_id: }}{Name of the Earth Engine task.} +#' \item{\bold{gcs_name: }}{Name of the Image in Google Cloud Storage.} +#' \item{\bold{gcs_bucket: }}{Name of the bucket.} +#' \item{\bold{gcs_fileFormat: }}{Format of the image.} +#' \item{\bold{gcs_public_link: }}{Download link to the image.} +#' \item{\bold{gcs_URI: }}{gs:// link to the image.} +#' } +#' } +#' } +#' } +#' +#' For getting more information about exporting data from Earth Engine, take +#' a look at the #' \href{https://developers.google.com/earth-engine/exporting}{Google #' Earth Engine Guide - Export data}. #' @importFrom crayon green -#' @return Character vector containing the filename of the images downloaded. +#' @return If add_metadata is FALSE, a character vector containing the filename +#' of the images downloaded. Otherwise a list adding information related to +#' the exportation (see details). #' @family image download functions #' @examples #' \dontrun{ @@ -51,24 +96,44 @@ #' tmp <- tempdir() #' #' ## Using drive -#' ic_drive_files <- ee_imagecollection_to_local( +#' # one by once +#' ic_drive_files_1 <- ee_imagecollection_to_local( +#' ic = collection, +#' region = geometry, +#' scale = 250, +#' dsn = file.path(tmp, "drive_") +#' ) +#' +#' # all at once +#' ic_drive_files_2 <- ee_imagecollection_to_local( #' ic = collection, #' region = geometry, -#' scale = 100, +#' scale = 250, +#' lazy = TRUE, #' dsn = file.path(tmp, "drive_") #' ) #' +#' # From Google Drive to client-side +#' doqq_dsn <- ic_drive_files_2 %>% ee_utils_future_value() +#' sapply(doqq_dsn, '[[', 1) #' } #' @export ee_imagecollection_to_local <- function(ic, region, dsn = NULL, via = "drive", + container = "rgee_backup", scale = NULL, maxPixels = 1e9, - container = "rgee_backup", + lazy = FALSE, + public = TRUE, + add_metadata = TRUE, + timePrefix = TRUE, quiet = FALSE, ...) { + # check packages + ee_check_packages("ee_imagecollection_to_local", "sf") + # is image an ee.image.Image? if (!any(class(ic) %in% "ee.imagecollection.ImageCollection")) { stop("ic argument is not an ee$imagecollection$ImageCollection") @@ -80,7 +145,7 @@ ee_imagecollection_to_local <- function(ic, } ic_names <- NULL - ic_count <- ic %>% + ic_count <- ic %>% ee$ImageCollection$size() %>% ee$Number$getInfo() @@ -142,32 +207,44 @@ ee_imagecollection_to_local <- function(ic, if (!quiet) { cat(blue$bold("\nDownloading:"), green(ic_names[r_index])) } - ee_image_local( + + img_stars <- ee_as_stars( image = image, region = region, dsn = ic_names[r_index], via = via, + container = container, scale = scale, maxPixels = maxPixels, - container = container, - quiet = TRUE, - ... + lazy = lazy, + public = public, + add_metadata = add_metadata, + timePrefix = timePrefix, + quiet = TRUE ) - ic_files[[r_index]] <- ic_names[r_index] + + if (!lazy) { + if (add_metadata) { + ic_files[[r_index]] <- list(dsn = img_stars[[1]], + metadata = attr(img_stars, "metadata")) + } else { + ic_files[[r_index]] <- img_stars[[1]] + } + } else { + ic_files[[r_index]] <- img_stars + class(ic_files) <- append(class(ic_files), "ee_imagecollection") + } } if (!quiet) { cat("\n", rule()) } - as.character(ic_files) + ic_files } #' geometry message #' @importFrom crayon bold #' @noRd ee_geometry_message <- function(region, sf_region = NULL, quiet = FALSE) { - if (!requireNamespace("sf", quietly = TRUE)) { - stop("package sf required, please install it first") - } # From geometry to sf if (is.null(sf_region)) { sf_region <- ee_as_sf(x = region)[["geometry"]] diff --git a/R/ee_install.R b/R/ee_install.R index 9d0e03c6..356a506e 100755 --- a/R/ee_install.R +++ b/R/ee_install.R @@ -35,26 +35,29 @@ ee_install <- function(py_env = "rgee", earthengine_version = ee_version(), confirm = interactive()) { - if (!requireNamespace("rstudioapi", quietly = TRUE)) { - stop("package rstudioapi required, please install it first") - } + #check packages + ee_check_packages("ee_install", "rstudioapi") # If Python not found install miniconda if ((!reticulate::py_available(initialize = TRUE))) { text <- paste( - "No non-system installation of Python could be found.", - "Would you like to download and install Miniconda?", + sprintf("%s did not find any Python ENV on your system.", + bold("reticulate")), + "", + bold("Would you like to download and install Miniconda?"), "Miniconda is an open source environment management system for Python.", "See https://docs.conda.io/en/latest/miniconda.html for more details.", + sprintf("%s install miniconda/anaconda to use rgee!", + bold("Windows users must")), "", - "If you think it is an error since you previously created a Python", - sprintf( - "environment in your system. Run %s to remove rgee", - bold('rgee::ee_clean_pyenv()') - ), - "environment variables. After this, restart the R session and try", - "again.", - "", + "If you think it is an error since you know you have a Python environment", + "in your system. Run as follow to solve:", + bold("- Using the rgee API:"), + "1. rgee::ee_clean_pyenv()", + "2. rgee::ee_install_set_pyenv(py_path = \"YOUR_PYTHON_PATH_GOES_HERE\")", + "3. Restart your system.", + bold("- Using Rstudio 1.4:"), + " https://github.com/r-spatial/rgee/tree/help/rstudio", sep = "\n" ) message(text) @@ -65,7 +68,8 @@ ee_install <- function(py_env = "rgee", reticulate::install_miniconda() message( "Miniconda was successfully installed, please restart R and run", - " again rgee::ee_install") + " again rgee::ee_install" + ) return(TRUE) } else if (ch == "n") { message("Installation aborted.") @@ -146,12 +150,14 @@ ee_install <- function(py_env = "rgee", "\n", paste( sprintf( - "ee_install want to store the environment variables: %s ", + "%s want to store the environment variables: %s ", + bold("rgee::ee_install"), bold("EARTHENGINE_PYTHON") ), sprintf( - "and %s in your .Renviron file to use the Python path:", - bold("EARTHENGINE_PYTHON_ENV") + "and %s in your %s to use the Python path:", + bold("EARTHENGINE_ENV"), + bold(".Renviron file") ), sprintf("%s in future sessions.", py_path), sep = "\n" @@ -161,7 +167,7 @@ ee_install <- function(py_env = "rgee", repeat { ch <- tolower(substring(response, 1, 1)) if (ch == "y" || ch == "") { - ee_install_set_pyenv(py_path = py_path, py_env = py_env) + ee_install_set_pyenv(py_path = py_path, py_env = py_env, quiet = TRUE) message( "\n", paste( @@ -169,9 +175,9 @@ ee_install <- function(py_env = "rgee", bold("3. The Environment Variable 'EARTHENGINE_PYTHON=%s' "), py_path ), - "has been stored in your .Renviron file. Remember that you", - "can remove EARTHENGINE_PYTHON and EARTHENGINE_ENV using", - " rgee::ee_clean_pyenv().", + "was stored in the .Renviron file. Remember that you", + "could remove EARTHENGINE_PYTHON and EARTHENGINE_ENV using", + bold("rgee::ee_clean_pyenv()."), sep = "\n" ) ) @@ -185,8 +191,8 @@ ee_install <- function(py_env = "rgee", sprintf("Sys.setenv(\"RETICULATE_PYTHON\" = \"%s\")",py_path), "ee_Initialize()", "----------------------------------", - "To install EARTHENGINE_PYTHON for use in future sessions, run", - sprintf("rgee::ee_install_set_pyenv(py_path = \"%s\")",py_path), + "To save the virtual environment \"EARTHENGINE_PYTHON\", run: ", + sprintf(bold("rgee::ee_install_set_pyenv(py_path = \"%s\")"),py_path), sep = "\n" ) ) @@ -219,7 +225,7 @@ ee_install <- function(py_env = "rgee", "", bold("Well done! rgee was successfully set up in your system."), "You need restart R to see changes. After doing that, we recommend", - "run ee_check() to perform a full check of all non-R dependencies.", + "run ee_check() to perform a full check of all non-R rgee dependencies.", "Do you want restart your R session?", sep = "\n" ) @@ -243,11 +249,12 @@ ee_install <- function(py_env = "rgee", #' It is used to set the Python environment to be used by rgee. #' EARTHENGINE_PYTHON is saved into the file .Renviron. #' -#' @param py_path The path to a Python interpreter. +#' @param py_path The path to a Python interpreter #' @param py_env The name of the environment +#' @param quiet Logical. Suppress info message #' @family ee_install functions #' @export -ee_install_set_pyenv <- function(py_path = NULL, py_env = NULL) { +ee_install_set_pyenv <- function(py_path = NULL, py_env = NULL, quiet = FALSE) { ee_clean_pyenv() # Trying to get the env from the py_path home <- Sys.getenv("HOME") @@ -288,6 +295,9 @@ ee_install_set_pyenv <- function(py_path = NULL, py_env = NULL) { to_remote <- c(to_remote, ret_python) } system_vars <- c(lines, ret_python, ret_env) + if (!quiet) { + message("rgee needs to restart the R session to see changes.\n") + } writeLines(system_vars, con) close(con) invisible(TRUE) diff --git a/R/ee_mapViewLayersControl.R b/R/ee_mapViewLayersControl.R index 19915ecd..d0185b29 100755 --- a/R/ee_mapViewLayersControl.R +++ b/R/ee_mapViewLayersControl.R @@ -31,7 +31,7 @@ ee_mapViewLayersControl <- function(map, map.types, names, native.crs = FALSE) { } if (!native.crs) { m <- leaflet::addLayersControl( - map = map, position = mapview::mapviewGetOption("layers.control.pos"), + map = map, position = "topleft", baseGroups = bgm, overlayGroups = c( ee_getLayerNamesFromMap(map), names @@ -40,7 +40,7 @@ ee_mapViewLayersControl <- function(map, map.types, names, native.crs = FALSE) { } else { m <- leaflet::addLayersControl( - map = map, position = mapview::mapviewGetOption("layers.control.pos"), + map = map, position = "topleft", overlayGroups = c(ee_getLayerNamesFromMap(map), names) ) } @@ -71,91 +71,3 @@ ee_getLayerControlEntriesFromMap <- function(map) { ) } -# Add leaflet control button to map --------------------------------------- -#' @author \href{https://github.com/tim-salabim}{Tim Appelhans} -#' @noRd -ee_appendMapCallEntries_lf <- function(map1, map2) { - ## calls - m1_calls = map1$x$calls - m2_calls = map2$x$calls - - ## dependencies - m1_deps = map1$dependencies - m2_deps = map2$dependencies - - mp_deps = append(m1_deps, m2_deps) - mp_deps = mp_deps[!duplicated(mp_deps)] - - ## base map controls - ctrls1 <- ee_getLayerControlEntriesFromMap(map1) - ctrls2 <- ee_getLayerControlEntriesFromMap(map2) - bmaps1 <- m1_calls[[ctrls1[1]]]$args[[1]] - bmaps2 <- m2_calls[[ctrls2[1]]]$args[[1]] - bmaps <- c(bmaps1, bmaps2)[!duplicated(c(bmaps1, bmaps2))] - - ## layer controls - len1 <- ctrls1[length(ctrls1)] - lyrs1 = if (length(len1) != 0) m1_calls[[len1]]$args[[2]] else NULL - len2 <- ctrls2[length(ctrls2)] - lyrs2 = if (length(len2) != 0) m2_calls[[len2]]$args[[2]] else NULL - # lyrs1 <- getLayerNamesFromMap(map1) - # lyrs2 <- getLayerNamesFromMap(map2) - lyrs <- c(lyrs1, lyrs2) - # dup <- duplicated(lyrs) - # lyrs[dup] <- sapply(seq(lyrs[dup]), - # function(i) paste0(lyrs[dup][[i]], ".", as.character(i + 1))) - - ## merge - mpcalls <- append(m1_calls, m2_calls) - mpcalls <- mpcalls[!duplicated(mpcalls)] - mpcalls[[ctrls1[1]]]$args[[1]] <- bmaps - mpcalls[[ctrls1[1]]]$args[[2]] <- lyrs - - # ind <- which(sapply(mpcalls, function(i) { - # i$method == "addLayersControl" - # })) - - ind <- grep( - pattern = "addLayersControl", - x = sapply(mpcalls, "[[", "method"), - fixed = TRUE, - useBytes = TRUE - ) - - # ind <- seq_along(mpcalls)[sapply(mpcalls, - # FUN = function(X) { - # "addLayersControl" %in% X - # })] - ind1 <- ind[1] - ind2 <- ind[length(ind)] - try({ - mpcalls[[ind2]] <- mpcalls[[ind1]] - mpcalls[[ind1]] <- NULL - }, silent = TRUE) - map1$x$calls <- mpcalls - - map1$x$calls <- mpcalls - map1$dependencies = mp_deps - return(map1) -} - -# Add basemap to leaflet --------------------------------------- -#' @noRd -add_basemaps <- function(map, pane = "right") { - bgm <- c("CartoDB.Positron", "CartoDB.DarkMatter", "OpenStreetMap", - "Esri.WorldImagery", "OpenTopoMap") - leaflet::leaflet() %>% - leaflet::addProviderTiles(bgm[1], group = bgm[1], - options = leaflet::pathOptions(pane = pane)) %>% - leaflet::addProviderTiles(bgm[2], group = bgm[2], - options = leaflet::pathOptions(pane = pane)) %>% - leaflet::addProviderTiles(bgm[3], group = bgm[3], - options = leaflet::pathOptions(pane = pane)) %>% - leaflet::addProviderTiles(bgm[4], group = bgm[4], - options = leaflet::pathOptions(pane = pane)) %>% - leaflet::addProviderTiles(bgm[5], group = bgm[5], - options = leaflet::pathOptions(pane = pane)) %>% - leaflet::addLayersControl( - baseGroups = bgm - ) -} diff --git a/R/ee_module.R b/R/ee_module.R old mode 100644 new mode 100755 diff --git a/R/ee_print.R b/R/ee_print.R index b9bff941..dc0e3213 100755 --- a/R/ee_print.R +++ b/R/ee_print.R @@ -65,9 +65,7 @@ #' } #' @export ee_print <- function(eeobject, ...) { - if (!requireNamespace("digest", quietly = TRUE)) { - stop("package digest required, please install it first") - } + ee_check_packages("ee_install", c("digest", "sf")) UseMethod("ee_print") } @@ -77,9 +75,6 @@ ee_print.ee.geometry.Geometry <- function(eeobject, ..., clean = FALSE, quiet = FALSE) { - if (!requireNamespace("sf", quietly = TRUE)) { - stop("package sf required, please install it first") - } # 1. Search if Geometry metadata exist in the /tempdir past_eeobject <- NULL metadata_file <- sprintf("%s/%s", tempdir(), ee_hash(eeobject)) @@ -149,9 +144,6 @@ ee_print.ee.feature.Feature <- function(eeobject, ..., clean = FALSE, quiet = FALSE) { - if (!requireNamespace("sf", quietly = TRUE)) { - stop("package sf required, please install it first") - } # 1. Search if FeatureCollection metadata exist in the /tempdir past_eeobject <- NULL metadata_file <- sprintf("%s/%s", tempdir(), ee_hash(eeobject)) @@ -231,10 +223,6 @@ ee_print.ee.featurecollection.FeatureCollection <- function(eeobject, f_index = 0, clean = FALSE, quiet = FALSE) { - if (!requireNamespace("sf", quietly = TRUE)) { - stop("package sf required, please install it first") - } - # 1. Search if FeatureCollection metadata exist in the /tempdir past_eeobject <- NULL metadata_file <- sprintf("%s/%s", tempdir(), ee_hash(eeobject, f_index)) @@ -345,10 +333,6 @@ ee_print.ee.image.Image <- function(eeobject, compression_ratio = 20, clean = FALSE, quiet = FALSE) { - if (!requireNamespace("sf", quietly = TRUE)) { - stop("package sf required, please install it first") - } - # 1. Fetch and Return bandname about ee$Image img_bandNames <- eeobject %>% ee$Image$bandNames() %>% diff --git a/R/ee_search.R b/R/ee_search.R deleted file mode 100755 index bcdef816..00000000 --- a/R/ee_search.R +++ /dev/null @@ -1,247 +0,0 @@ -#' 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_search_dataset data.frame generated by rgee::ee_search_Datasets() -#' or a character which represents the EE dataset ID. -#' @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 -#' @param path_dataset Path of the dataset. By default it will loaded -#' automatically. -#' @name ee_search-tools -#' @return A data.frame where rows represents public data archive. -#' @examples -#' \dontrun{ -#' library(rgee) -#' ee_Initialize() -#' -#' # ee_search_provider_list() -#' # ee_search_title_list() -#' myquery <- ee_search_dataset() %>% -#' ee_search_type("Image") %>% -#' ee_search_provider("WWF") %>% -#' ee_search_tags("srtm", "flow", "direction", "dem") %>% -#' ee_search_title("15", "Flow", logical_operator = "AND") %>% -#' ee_search_display() -#' } -#' @export -ee_search_dataset <- function(quiet = FALSE, - upgrade = FALSE, - path_dataset = NULL) { - 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()) - ee_search_dataset_file <- sprintf( - "%s/ee_search_dataset.csv", - ee_path - ) - if (file.exists(ee_search_dataset_file) & !upgrade) { - ee_search_dataset <- read.csv(ee_search_dataset_file, - stringsAsFactors = FALSE) - } else { - if (is.null(path_dataset)) { - user_samapriya <- "https://raw.githubusercontent.com/csaybar/" - ee_template <- "%sEarth-Engine-Datasets-List/master/%s" - ee_search_dataset_uri <- sprintf(ee_template, user_samapriya, - find_eedataset()) - } else { - ee_search_dataset_uri <- path_dataset - } - ee_search_dataset <- read.csv(ee_search_dataset_uri, - stringsAsFactors = FALSE) - if (!quiet) { - cat("Downloading(Upgrading) the Earth Engine catalog ... please wait\n") - } - write.csv( - x = ee_search_dataset, - file = ee_search_dataset_file, - row.names = FALSE - ) - } - return(ee_search_dataset) -} - -#' @name ee_search-tools -#' @export -ee_search_startdate <- function(ee_search_dataset, stardate) { - m <- gregexpr("[\\w']+", ee_search_dataset$start_date, perl = TRUE) - ee_start_date <- ee_search_dataset$start_date %>% - regmatches(m) %>% - lapply(fix_date) - m <- do.call(c, m) - stardate <- as.Date(stardate) - ee_search_dataset_q <- ee_search_dataset[which(ee_start_date > stardate), ] - rownames(ee_search_dataset_q) <- NULL - return(ee_search_dataset_q) -} - -#' @name ee_search-tools -#' @export -ee_search_enddate <- function(ee_search_dataset, enddate = Sys.Date()) { - m <- gregexpr("[\\w']+", ee_search_dataset$end_date, perl = TRUE) - ee_end_date <- ee_search_dataset$end_date %>% - regmatches(m) %>% - lapply(fix_date) - m <- do.call(c, m) - enddate <- as.Date(enddate) - ee_search_dataset_q <- ee_search_dataset[which(ee_end_date < enddate), ] - rownames(ee_search_dataset_q) <- NULL - return(ee_search_dataset_q) -} - -#' @name ee_search-tools -#' @export -ee_search_type <- function(ee_search_dataset, type) { - ee_search_dataset_type <- tolower(ee_search_dataset$type) - type <- tolower(type) - if (type %in% unique(ee_search_dataset_type)) { - ee_search_dataset_q <- ee_search_dataset[ee_search_dataset_type %in% type, ] - rownames(ee_search_dataset_q) <- NULL - return(ee_search_dataset_q) - } else { - stop("type argument is not valid") - } -} - -#' @name ee_search-tools -#' @export -ee_search_provider <- function(ee_search_dataset, provider) { - if (provider %in% unique(ee_search_dataset$provider)) { - condition <- ee_search_dataset$provider %in% provider - ee_search_dataset_q <- ee_search_dataset[condition,] - rownames(ee_search_dataset_q) <- NULL - return(ee_search_dataset_q) - } else { - stop("provider argument is not valid") - } -} - -#' @name ee_search-tools -#' @export -ee_search_provider_list <- function(ee_search_dataset) { - return(unique(ee_search_dataset$provider)) -} - -#' @name ee_search-tools -#' @export -ee_search_tags <- function(ee_search_dataset, ..., logical_operator = "OR") { - tags <- tolower(c(...)) - ee_tags <- tolower(ee_search_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_search_dataset_q <- ee_search_dataset[cond, ] - rownames(ee_search_dataset_q) <- NULL - return(ee_search_dataset_q) -} - -#' @name ee_search-tools -#' @export -ee_search_title <- function(ee_search_dataset, ..., logical_operator = "OR") { - tags <- tolower(c(...)) - ee_title <- tolower(ee_search_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_search_dataset_q <- ee_search_dataset[cond, ] - rownames(ee_search_dataset_q) <- NULL - return(ee_search_dataset_q) -} - - -#' @name ee_search-tools -#' @export -ee_search_tagstitle <- function(ee_search_dataset, ..., - logical_operator = "OR") { - tags <- tolower(c(...)) - ee_title <- tolower(ee_search_dataset$title) - ee_tags <- tolower(ee_search_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_search_dataset_q <- ee_search_dataset[cond_3, ] - rownames(ee_search_dataset_q) <- NULL - return(ee_search_dataset_q) -} - -#' @name ee_search-tools -#' @export -ee_search_title_list <- function(ee_search_dataset) { - return(unique(ee_search_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_search_dataset, maxdisplay = 10) { - if (is.character(ee_search_dataset)) { - tag_name <- gsub("\\/", "_", ee_search_dataset) - } else { - tag_name <- gsub("\\/", "_", ee_search_dataset$id) - } - db_catalog <- "https://developers.google.com/earth-engine/datasets/catalog/" - catalog_uri <- paste0(db_catalog, tag_name) %>% - "["(1:maxdisplay) %>% - na.omit() %>% - as.character() - for (uri in catalog_uri) { - browseURL(uri) - } - invisible(TRUE) -} - -#' Find the EE Dataset List on GitHub -#' @noRd -find_eedataset <- function() { - if (!requireNamespace("httr", quietly = TRUE)) { - stop("package httr required, please install it first") - } - git_repo <- "https://api.github.com/repos/csaybar/Earth-Engine-Datasets-List" - req <- httr::GET(sprintf("%s/git/trees/master?recursive=1", git_repo)) - httr::stop_for_status(req) - filelist <- lapply(httr::content(req)$tree, "[", "path") - filelist <- unlist(filelist, use.names = FALSE) - filelist[grepl("eed", filelist)] -} diff --git a/R/ee_utils.R b/R/ee_utils.R old mode 100644 new mode 100755 index c9739d36..a58bd4c5 --- a/R/ee_utils.R +++ b/R/ee_utils.R @@ -39,9 +39,9 @@ ee_utils_shp_to_zip <- function(x, filename, SHP_EXTENSIONS = c("dbf", "prj", "shp", "shx")) { - if (!requireNamespace("sf", quietly = TRUE)) { - stop("package sf required, please install it first") - } + # check packages + ee_check_packages("ee_utils_shp_to_zip", "sf") + if (missing(filename)) { filename <- sprintf("%s%s",tempfile(),'.shp') } @@ -193,9 +193,9 @@ ee_utils_pyfunc <- reticulate::py_func #' @family GIF functions #' @export ee_utils_gif_creator <- function(ic, parameters, quiet = FALSE, ...) { - if (!requireNamespace("magick", quietly = TRUE)) { - stop("package magick required, please install it first") - } + # check packages + ee_check_packages("ee_utils_gif_creator", "magick") + if (!quiet) { message("1. Creating gif ... please wait ....") } @@ -310,9 +310,9 @@ ee_utils_gif_annotate <- function(image, color = NULL, strokecolor = NULL, boxcolor = NULL) { - if (!requireNamespace("magick", quietly = TRUE)) { - stop("package magick required, please install it first") - } + # check packages + ee_check_packages("ee_utils_gif_annotate", "magick") + if (length(text) == 1) { image <- magick::image_annotate(image, text, gravity = gravity, location = location, degrees = degrees, size = size, @@ -416,10 +416,35 @@ ee_utils_gif_save <- function(image, density = NULL, comment = NULL, flatten = FALSE) { - if (!requireNamespace("magick", quietly = TRUE)) { - stop("package magick required, please install it first") - } + + # check packages + ee_check_packages("ee_utils_gif_save", "magick") magick::image_write(image = image, path = path, format = format, quality = quality, depth = depth, density = density, comment = comment, flatten = flatten) } + + +#' Search into the Earth Engine Data Catalog +#' +#' @param ee_search_dataset character which represents the EE dataset ID. +#' @examples +#' \dontrun{ +#' library(rgee) +#' +#' ee_datasets <- c("WWF/HydroSHEDS/15DIR", "WWF/HydroSHEDS/03DIR") +#' ee_utils_search_display(ee_datasets) +#' } +#' @export +ee_utils_search_display <- function(ee_search_dataset) { + tag_name <- gsub("\\/", "_", ee_search_dataset) + db_catalog <- "https://developers.google.com/earth-engine/datasets/catalog/" + catalog_uri <- paste0(db_catalog, tag_name) %>% + na.omit() %>% + as.character() + for (uri in catalog_uri) { + browseURL(uri) + } + invisible(TRUE) +} + diff --git a/R/ee_version.R b/R/ee_version.R old mode 100644 new mode 100755 index 1844f1ff..b70f9508 --- a/R/ee_version.R +++ b/R/ee_version.R @@ -5,5 +5,5 @@ #' @return Character. Earth Engine Python API version used to build rgee. #' @export ee_version <- function() { - '0.1.235' + '0.1.246' } diff --git a/R/print.R b/R/print.R old mode 100644 new mode 100755 index 9988f0fc..c7d56f41 --- a/R/print.R +++ b/R/print.R @@ -14,13 +14,3 @@ print.ee.computedobject.ComputedObject <- ee_print(x) } } - - -#' Method for printing EarthEngineMap objects (show) -#' @param object a EarthEngineMap object -setMethod("show", signature(object = "EarthEngineMap"), - function(object) - { - print(methods::slot(object, "map")) - } -) diff --git a/R/raster_as_ee.R b/R/raster_as_ee.R old mode 100644 new mode 100755 diff --git a/R/sf_as_ee.R b/R/sf_as_ee.R index 5609a434..c2d385b6 100755 --- a/R/sf_as_ee.R +++ b/R/sf_as_ee.R @@ -128,15 +128,28 @@ sf_as_ee <- function(x, geodesic = NULL, quiet = FALSE, ...) { - - if (!requireNamespace("sf", quietly = TRUE)) { - stop("package sf required, please install it first") - } + # check packages + ee_check_packages("sf_as_ee", "sf") if (!any(class(x) %in% c("sf", "sfc", "sfg"))) { stop("x needs to be an object of class sf, sfc, sfg") } + # sf_as_ee does not support POSIXlt, POSIXct and POSIXt columns + df_classes <- as.character(x %>% lapply(class) %>% unlist()) + is_POSIX <- df_classes %in% c("POSIXlt", "POSIXct", "POSIXt") + if (any(is_POSIX)) { + posix_column_names <- paste0(names(x)[is_POSIX], collapse = ", ") + pos_msg <- sprintf( + "%s does not support %s. Convert the %s: %s to character.", + "sf_as_ee", + "POSIXt, POSIXct or POSIXlt", + if (sum(is_POSIX) == 1) "column" else "columns", + bold(posix_column_names) + ) + stop(pos_msg) + } + if (any(class(x) %in% "sfg")) { x <- sf::st_sfc(x, crs = proj) } diff --git a/R/utils-download.R b/R/utils-download.R old mode 100644 new mode 100755 index 17c13c11..2094eff6 --- a/R/utils-download.R +++ b/R/utils-download.R @@ -1,6 +1,8 @@ #' Monitoring Earth Engine task progress #' -#' @param task List generated after an created an EE task. +#' @param task List generated after a task is started (i.e. after run +#' `ee$batch$Task$start()`) or a character that represents the ID of a EE +#' task started. #' @param task_time Numeric. How often (in seconds) should a task be polled? #' @param eeTaskList Logical. If \code{TRUE}, all Earth Engine tasks will be #' listed. @@ -16,10 +18,24 @@ #' } #' @export ee_monitoring <- function(task, task_time = 5, eeTaskList = FALSE, quiet = FALSE) { + # if task is missing if (missing(task)) { all_task <- ee_utils_py_to_r(ee$batch$Task$list()) task <- all_task[[1]] } + + # if task is character(ID) + if (is.character(task)) { + all_task <- ee_utils_py_to_r(ee$batch$Task$list()) + id_tasks <- lapply(all_task, function(task) task[["id"]]) %>% unlist() + if (any(id_tasks %in% task)) { + task <- all_task[[which(id_tasks %in% task)]] + } else { + stop("Undefined Task ID entered") + } + } + + # List all the EE tasks if (eeTaskList) { if (!quiet) { cat("EETaskList:\n") @@ -32,6 +48,8 @@ ee_monitoring <- function(task, task_time = 5, eeTaskList = FALSE, quiet = FALSE cat("\n") } } + + # Start to monitoring the task ... counter <- 0 while (ee_utils_py_to_r(ee$batch$Task$active(task)) & task[["state"]] != "CANCEL_REQUESTED") { @@ -53,6 +71,7 @@ ee_monitoring <- function(task, task_time = 5, eeTaskList = FALSE, quiet = FALSE ) stop("ee_monitoring was forced to stop before getting results") } + invisible(task) } #' Sort google drives files @@ -84,7 +103,7 @@ ee_sort_localfiles <- function(filenames, fileformat) { } -#' GCS or Google Drive Exist credentials? +#' (GCS or Google Drive) Exist external credentials? #' @noRd ee_exist_credentials <- function() { oauth_func_path <- system.file("python/ee_utils.py", package = "rgee") @@ -97,71 +116,24 @@ ee_exist_credentials <- function() { ) } - - -#' Fix offset of stars object -#' @noRd -ee_fix_offset <- function(img_transform, sf_region) { - if (!requireNamespace("sf", quietly = TRUE)) { - stop("package sf required, please install it first") - } - if (all(img_transform %in% c(1, 0, 0, 0, 1, 0))) { - sf::st_bbox(sf_region) - } else { - rectangle_coord <- sf::st_coordinates(sf_region) - # image spatial parameters - img_x_scale <- img_transform[1][[1]] - img_x_offset <- img_transform[3][[1]] - img_y_scale <- img_transform[5][[1]] - img_y_offset <- img_transform[6][[1]] - # X offset fixed - sf_x_min <- min(rectangle_coord[, "X"]) - x_min <- ee_fix_x_coord(img_x_offset, sf_x_min, img_x_scale, option = 'min') - sf_x_max <- max(rectangle_coord[, "X"]) - x_max <- ee_fix_x_coord(img_x_offset, sf_x_max, img_x_scale, option = 'max') - - # Y offset fixed - sf_y_min <- min(rectangle_coord[, "Y"]) - y_min <- ee_fix_y_coord(img_y_offset, sf_y_min, img_y_scale, option = 'min') - sf_y_max <- max(rectangle_coord[, "Y"]) - y_max <- ee_fix_y_coord(img_y_offset, sf_y_max, img_y_scale, option = 'max') - c(xmin = x_min, ymin = y_min, xmax = x_max, ymax = y_max) - } -} - -#' Fix x coordinates +#' Save external credentials #' @noRd -ee_fix_x_coord <- function(img_offset, sf_offset, scale, option) { - # fix the offset - if (img_offset <= sf_offset) { - if (option == "min") { - n <- floor(abs((img_offset - sf_offset)/scale)) - } else if (option == "max") { - n <- ceiling(abs((img_offset - sf_offset)/scale)) - } - img_offset + n * scale - } else { - n <- ceiling(abs((img_offset - sf_offset)/scale)) - img_offset - n * scale - } -} - - -#' Fix y coordinates -#' @noRd -ee_fix_y_coord <- function(img_offset, sf_offset, scale, option) { - # fix the offset - if (img_offset > sf_offset) { - if (option == "min") { - n <- ceiling(abs((sf_offset - img_offset)/scale)) - } else if (option == "max") { - n <- floor(abs((sf_offset - img_offset)/scale)) - } - img_offset + n * scale - } else { - n <- ceiling(abs((sf_offset - img_offset)/scale)) - img_offset - n * scale +ee_save_credential <- function(pdrive = NULL, pgcs = NULL) { + 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()) + sessioninfo <- sprintf("%s/rgee_sessioninfo.txt", ee_path) + cre_table <- read.table( + file = sprintf("%s/rgee_sessioninfo.txt", ee_path), + header = TRUE, + stringsAsFactors = FALSE + ) + if (!is.null(pdrive)) { + cre_table[["drive_cre"]] <- pdrive + } else if (!is.null(pgcs)) { + cre_table[["gcs_cre"]] <- pgcs } + write.table(cre_table, sessioninfo, row.names = FALSE) } #' type of an Earth Engine Image diff --git a/R/utils-upload.R b/R/utils-upload.R index ea7df7dc..7db5a70f 100755 --- a/R/utils-upload.R +++ b/R/utils-upload.R @@ -25,60 +25,67 @@ local_to_gcs <- function(x, bucket = NULL, quiet = FALSE) { - if (!requireNamespace("googleCloudStorageR", quietly = TRUE)) { + # check packages + ee_check_packages("rgee::ee_download_gcs", "googleCloudStorageR") + + if (is.null(bucket)) { + stop("Cloud Storage bucket was not defined") + } + + if (is.na(getOption("rgee.gcs.auth"))) { stop( - "The googleCloudStorageR package is required to use ", - "rgee::ee_download_gcs", - call. = FALSE + "Google Cloud Storage credentials were not loaded.", + ' Run ee_Initialize(..., gcs = TRUE)', + " to fix." ) - } else { - if (is.null(bucket)) { - stop("Cloud Storage bucket was not defined") - } - - if (is.na(getOption("rgee.gcs.auth"))) { - stop( - "Google Cloud Storage credentials were not loaded.", - ' Run ee_Initialize(..., gcs = TRUE)', - " to fix it" - ) + } + count <- 1 + + googleCloudStorageR::gcs_auth(getOption("rgee.gcs.auth")) + if (isFALSE(quiet)) { + files_gcs <- try( + googleCloudStorageR::gcs_upload( + file = x, + bucket = bucket, + name = basename(x)), + silent = TRUE + ) + while (any(class(files_gcs) %in% "try-error") & count < 5) { + files_gcs <- try( + googleCloudStorageR::gcs_upload( + file = x, + bucket = bucket, + name = basename(x)), + silent = TRUE + ) + count <- count + 1 } - count <- 1 - - googleCloudStorageR::gcs_auth(getOption("rgee.gcs.auth")) - if (isFALSE(quiet)) { + } else { + files_gcs <- try( + suppressMessages( + googleCloudStorageR::gcs_upload( + file = x, + bucket = bucket, + name = basename(x) + ) + ), + silent = TRUE + ) + while (any(class(files_gcs) %in% "try-error") & count < 5) { files_gcs <- try( - googleCloudStorageR::gcs_upload(file = x, - bucket = bucket, - name = basename(x)), + suppressMessages( + googleCloudStorageR::gcs_upload( + file = x, + bucket = bucket, + name = basename(x) + ) + ), silent = TRUE ) - while (any(class(files_gcs) %in% "try-error") & count < 5) { - files_gcs <- try( - googleCloudStorageR::gcs_upload(file = x, - bucket = bucket, - name = basename(x)), - silent = TRUE - ) - count <- count + 1 - } - } else { - files_gcs <- try(suppressMessages( - googleCloudStorageR::gcs_upload(file = x, - bucket = bucket, - name = basename(x)) - ), silent = TRUE) - while (any(class(files_gcs) %in% "try-error") & count < 5) { - files_gcs <- try(suppressMessages( - googleCloudStorageR::gcs_upload(file = x, - bucket = bucket, - name = basename(x)) - ), silent = TRUE) - count <- count + 1 - } + count <- count + 1 } - sprintf("gs://%s/%s", bucket, basename(x)) } + sprintf("gs://%s/%s", bucket, basename(x)) } #' Move a zipped shapefile from GCS to their EE Assets @@ -131,9 +138,8 @@ gcs_to_ee_table <- function(manifest, command_line_tool_path = NULL, overwrite = FALSE, quiet = FALSE) { - if (!requireNamespace("jsonlite", quietly = TRUE)) { - stop("package jsonlite required, please install it first") - } + # check packages + ee_check_packages("gcs_to_ee_table", "jsonlite") manifest_list <- jsonlite::read_json(manifest) assetId <- ee_remove_project_chr(manifest_list$name) @@ -227,9 +233,8 @@ gcs_to_ee_image <- function(manifest, overwrite = FALSE, command_line_tool_path = NULL, quiet = FALSE) { - if (!requireNamespace("jsonlite", quietly = TRUE)) { - stop("package jsonlite required, please install it first") - } + # check packages + ee_check_packages("gcs_to_ee_image", "jsonlite") manifest_list <- jsonlite::read_json(manifest) assetId <- ee_remove_project_chr(manifest_list$name) @@ -274,12 +279,8 @@ gcs_to_ee_image <- function(manifest, #' From sf object to Earth Engine FeatureCollection #' @noRd ee_sf_to_fc <- function(x, proj, geodesic, evenOdd) { - if (!requireNamespace("sf", quietly = TRUE)) { - stop("package sf required, please install it first") - } - if (!requireNamespace("geojsonio", quietly = TRUE)) { - stop("package geojsonio required, please install it first") - } + # check packages + ee_check_packages("sf_as_ee", c("sf", "geojsonio")) # Load python module oauth_func_path <- system.file("python/sf_as_ee.py", package = "rgee") @@ -340,10 +341,8 @@ ee_sf_to_fc <- function(x, proj, geodesic, evenOdd) { #' Pass a character or stars object to stars-proxy #' @noRd ee_as_proxystars <- function(x, temp_dir = tempdir()) { - - if (!requireNamespace("stars", quietly = TRUE)) { - stop("package stars required, please install it first") - } + # check packages + ee_check_packages("stars_as_ee", "stars") if (is.character(x)) { stars::read_stars(x, proxy = TRUE) @@ -354,9 +353,8 @@ ee_as_proxystars <- function(x, temp_dir = tempdir()) { stars::write_stars(x, tiff_filename) stars::read_stars(tiff_filename, proxy = TRUE) } else if (is(x,"Raster")) { - if (!requireNamespace("raster", quietly = TRUE)) { - stop("package raster required, please install it first") - } + # check packages + ee_check_packages("raster_as_ee", "raster") time_format <- format(Sys.time(), "%Y-%m-%d-%H%M%S") ee_description <- paste0("ee_as_stars_task_", time_format) tiff_filename <- sprintf("%s/%s.tif", temp_dir, ee_description) diff --git a/codecov.yml b/codecov.yml old mode 100644 new mode 100755 diff --git a/inst/CITATION b/inst/CITATION old mode 100644 new mode 100755 diff --git a/inst/WORDLIST b/inst/WORDLIST old mode 100644 new mode 100755 index afc1aeae..2461c120 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -274,3 +274,9 @@ tmp OGC processx magrittr +ee_as_raster +ee_as_sf +ee_as_stars +ee_imagecollection_to_local +fileNamePrefix +fileFormat diff --git a/inst/python/ee_utils.py b/inst/python/ee_utils.py old mode 100644 new mode 100755 diff --git a/inst/rstudio/addins.dcf b/inst/rstudio/addins.dcf old mode 100644 new mode 100755 diff --git a/inst/shp/arequipa.dbf b/inst/shp/arequipa.dbf old mode 100644 new mode 100755 diff --git a/inst/shp/arequipa.prj b/inst/shp/arequipa.prj old mode 100644 new mode 100755 diff --git a/inst/shp/arequipa.shp b/inst/shp/arequipa.shp old mode 100644 new mode 100755 diff --git a/inst/shp/arequipa.shx b/inst/shp/arequipa.shx old mode 100644 new mode 100755 diff --git a/man/EarthEngineMap-class.Rd b/man/EarthEngineMap-class.Rd deleted file mode 100644 index 05675ac6..00000000 --- a/man/EarthEngineMap-class.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/AAAMapclass.R -\docType{class} -\name{EarthEngineMap-class} -\alias{EarthEngineMap-class} -\title{Class EarthEngineMap} -\description{ -Class EarthEngineMap -} -\section{Slots}{ - -\describe{ -\item{\code{object}}{the spatial object} - -\item{\code{map}}{the leaflet map object} -}} - diff --git a/man/Map.Rd b/man/Map.Rd index 759d3f30..e90b864b 100644 --- a/man/Map.Rd +++ b/man/Map.Rd @@ -65,6 +65,11 @@ requested result projection or geodesic state. \usage{ Map } +\value{ +Object of class leaflet, with the following extra parameters: tokens, name, +opacity, shown, min, max, palette, and legend. Use the $ method to retrieve +the data (e.g. m$rgee$min). +} \description{ Create interactive visualizations of spatial EE objects (ee$Geometry, ee$Image, ee$Feature, and ee$FeatureCollection) @@ -75,7 +80,7 @@ using \code{mapview}. \href{https://developers.google.com/earth-engine/api_docs#ee.data.getmapid}{ getMapId} to fetch and return an ID dictionary being used to create layers in a \code{mapview} object. Users can specify visualization -parameters to Map\$addLayer by using the visParams argument. Each Earth +parameters to Map$addLayer by using the visParams argument. Each Earth Engine spatial object has a specific format. For \code{ee$Image}, the \href{https://developers.google.com/earth-engine/image_visualization}{ @@ -101,11 +106,12 @@ three numbers, one for each band \cr and 1.0 is fully opaque) \tab number \cr } -If you add an \code{ee$Image} to the map without any additional parameters, -by default \code{Map$addLayer()} assigns the first three bands to red, +If you add an \code{ee$Image} to Map$addLayer without any additional +parameters, by default it assigns the first three bands to red, green, and blue bands, respectively. The default stretch is based on the -min-max range. By the other hand, for \code{ee$Geometry}, \code{ee$Feature}, -and \code{ee$FeatureCollection} the available parameters are: +min-max range. On the other hand, the available parameters for +\code{ee$Geometry}, \code{ee$Feature}, and \code{ee$FeatureCollection} +are: \itemize{ \item \strong{color}: A hex string in the format RRGGBB specifying the @@ -117,7 +123,6 @@ default 3. } \examples{ \dontrun{ -library(mapview) library(rgee) library(sf) ee_Initialize() @@ -153,17 +158,16 @@ m4 <- Map$addLayer( ), name = "SF" ) -m4 # Case 5: mapview + EarthEnginemap -library(sf) -nc <- st_read(system.file("shp/arequipa.shp", package="rgee")) -mapview(nc) + m2 -m2 + mapview(nc) +# library(mapview) +# library(sf) +# nc <- st_read(system.file("shp/arequipa.shp", package="rgee")) +# mapview(nc, m2) # Case 6: mapedit -library(mapedit) -# my_geometry <- m2 \%>\% ee_as_mapview() \%>\% editMap() +# library(mapedit) +# my_geometry <- m4 \%>\% editMap() # Case 7: ImageCollection nc <- st_read(system.file("shape/nc.shp", package = "sf")) \%>\% @@ -175,7 +179,8 @@ ee_s2 <- ee$ImageCollection("COPERNICUS/S2")$ filterBounds(nc) \%>\% ee_get(0:4) Map$centerObject(nc$geometry()) -Map$addLayers(ee_s2) +m5 <- Map$addLayers(ee_s2, legend = TRUE) +m5 # Case 8: Map comparison image <- ee$Image("LANDSAT/LC08/C01/T1/LC08_044034_20140318") @@ -186,7 +191,12 @@ m_ndvi <- Map$addLayer( name = "SF_NDVI", legend = TRUE ) -m4 | m_ndvi +m6 <- m4 | m_ndvi +m6 + +# Case 9: digging up the metadata +m6$rgee$tokens +m5$rgee$tokens } } \keyword{datasets} diff --git a/man/ee_as_mapview.Rd b/man/ee_as_mapview.Rd deleted file mode 100644 index 3a810fb3..00000000 --- a/man/ee_as_mapview.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Map.R -\name{ee_as_mapview} -\alias{ee_as_mapview} -\title{Convert an EarthEngineMap object into a mapview object} -\usage{ -ee_as_mapview(x) -} -\arguments{ -\item{x}{An EarthEngineMap object.} -} -\description{ -Convert an EarthEngineMap object into a mapview object -} diff --git a/man/ee_as_raster.Rd b/man/ee_as_raster.Rd index d6c8dafc..3b25025c 100644 --- a/man/ee_as_raster.Rd +++ b/man/ee_as_raster.Rd @@ -2,16 +2,20 @@ % Please edit documentation in R/ee_image.R \name{ee_as_raster} \alias{ee_as_raster} -\title{Convert an Earth Engine (EE) image into a raster object} +\title{Convert an Earth Engine (EE) image in a raster object} \usage{ ee_as_raster( image, region = NULL, dsn = NULL, via = "drive", + container = "rgee_backup", scale = NULL, maxPixels = 1e+09, - container = "rgee_backup", + lazy = FALSE, + public = TRUE, + add_metadata = TRUE, + timePrefix = TRUE, quiet = FALSE, ... ) @@ -20,25 +24,36 @@ ee_as_raster( \item{image}{ee$Image to be converted into a raster object} \item{region}{EE Geometry (ee$Geometry$Polygon) which specify the region -to export. CRS needs to be the same that the x argument otherwise it will be -forced. If not specified image bounds will be taken.} +to export. CRS needs to be the same that the argument \code{image}, +otherwise, it will be forced. If not specified, image bounds will be taken.} -\item{dsn}{Character. Output filename. If missing, -\code{ee_as_raster} will create a temporary file.} +\item{dsn}{Character. Output filename. If missing, a temporary file will be +created.} -\item{via}{Character. Method to fetch data about the object. Two methods -are implemented: "drive", "gcs". See details.} +\item{via}{Character. Method to export the image. Two method are +implemented: "drive", "gcs". See details.} + +\item{container}{Character. Name of the folder ('drive') or bucket ('gcs') +to be exported into.} \item{scale}{Numeric. The resolution in meters per pixel. Defaults -to the native resolution of the image asset.} +to the native resolution of the image.} \item{maxPixels}{Numeric. The maximum allowed number of pixels in the exported image. The task will fail if the exported region covers more pixels in the specified projection. Defaults to 100,000,000.} -\item{container}{Character. Name of the folder ('drive') or bucket ('gcs') -to be exported into (ignored if \code{via} is not defined as "drive" or -"gcs").} +\item{lazy}{Logical. If TRUE, a \code{\link[future:sequential]{ +future::sequential}} object is created to evaluate the task in the future. +See details.} + +\item{public}{Logical. If TRUE, a public link to the image will be created.} + +\item{add_metadata}{Add metadata to the stars_proxy object. See details.} + +\item{timePrefix}{Logical. Add current date and time (\code{Sys.time()}) as +a prefix to files to export. This parameter helps to avoid exported files +with the same name. By default TRUE.} \item{quiet}{Logical. Suppress info message} @@ -49,16 +64,52 @@ to be exported into (ignored if \code{via} is not defined as "drive" or A RasterStack object } \description{ -Convert an ee$Image into a raster object +Convert an ee$Image in a raster object } \details{ -\code{ee_as_raster} supports the download of \code{ee$Image} -by two different options: "drive" that use Google Drive and "gcs" -that use Google Cloud Storage. Previously, it is necessary to install the -R packages \href{ https://CRAN.R-project.org/package=googledrive}{googledrive} -or \href{https://CRAN.R-project.org/package=googleCloudStorageR}{ -googleCloudStorageR} respectively. For getting more information about -exporting data from Earth Engine, take a look at the +\code{ee_as_raster} supports the download of \code{ee$Images} +by two different options: "drive" +(\href{https://CRAN.R-project.org/package=googledrive}{Google Drive}) and "gcs" +(\href{https://CRAN.R-project.org/package=googleCloudStorageR}{ +Google Cloud Storage}). In both cases \code{ee_as_stars} works as follow: +\itemize{ +\item{1. }{A task will be started (i.e. \code{ee$batch$Task$start()}) to +move the \code{ee$Image} from Earth Engine to the intermediate container +specified in argument \code{via}.} +\item{2. }{If the argument \code{lazy} is TRUE, the task will not be +monitored. This is useful to lunch several tasks at the same time and +call them later using \code{\link{ee_utils_future_value}} or +\code{\link[future:value]{future::value}}. At the end of this step, +the \code{ee$Image} will be stored on the path specified in the argument +\code{dsn}.} +\item{3. }{Finally if the argument \code{add_metadata} is TRUE, a list +with the following elements will be added to the stars-proxy object. +\itemize{ +\item{\bold{if via is "drive":}} +\itemize{ +\item{\bold{ee_id: }}{Name of the Earth Engine task.} +\item{\bold{drive_name: }}{Name of the Image in Google Drive.} +\item{\bold{drive_id: }}{Id of the Image in Google Drive.} +\item{\bold{drive_download_link: }}{Download link to the image.} +} +} +\itemize{ +\item{\bold{if via is "gcs":}} +\itemize{ +\item{\bold{ee_id: }}{Name of the Earth Engine task.} +\item{\bold{gcs_name: }}{Name of the Image in Google Cloud Storage.} +\item{\bold{gcs_bucket: }}{Name of the bucket.} +\item{\bold{gcs_fileFormat: }}{Format of the image.} +\item{\bold{gcs_public_link: }}{Download link to the image.} +\item{\bold{gcs_URI: }}{gs:// link to the image.} +} +} +Run \code{raster@history@metadata} to get the list. +} +} + +For getting more information about exporting data from Earth Engine, take +a look at the \href{https://developers.google.com/earth-engine/exporting}{Google Earth Engine Guide - Export data}. } @@ -86,21 +137,46 @@ geometry <- ee$Geometry$Rectangle( ) ## drive - Method 01 +# Simple img_02 <- ee_as_raster( image = img, region = geometry, via = "drive" ) -## gcs - Method 02 +# Lazy +img_02 <- ee_as_raster( + image = img, + region = geometry, + via = "drive", + lazy = TRUE +) + +img_02_result <- img_02 \%>\% ee_utils_future_value() +img_02_result@history$metadata # metadata + +# ## gcs - Method 02 +# # Simple +# img_03 <- ee_as_raster( +# image = img, +# region = geometry, +# container = "rgee_dev", +# via = "gcs" +# ) +# +# # Lazy # img_03 <- ee_as_raster( # image = img, # region = geometry, # container = "rgee_dev", +# lazy = TRUE, # via = "gcs" # ) +# +# img_03_result <- img_03 \%>\% ee_utils_future_value() +# img_03_result@history$metadata # metadata -# OPTIONAL: Delete containers +# OPTIONAL: clean containers # ee_clean_container(name = "rgee_backup", type = "drive") # ee_clean_container(name = "rgee_dev", type = "gcs") } diff --git a/man/ee_as_sf.Rd b/man/ee_as_sf.Rd index 1ec4e4f8..4d0b5642 100644 --- a/man/ee_as_sf.Rd +++ b/man/ee_as_sf.Rd @@ -8,44 +8,60 @@ ee_as_sf( x, dsn, overwrite = TRUE, - crs = NULL, via = "getInfo", - maxFeatures = 5000, container = "rgee_backup", + crs = NULL, + maxFeatures = 5000, selectors = NULL, + lazy = FALSE, + public = TRUE, + add_metadata = TRUE, + timePrefix = TRUE, quiet = FALSE ) } \arguments{ -\item{x}{Earth Engine table (ee$FeatureCollection) to be converted into a sf +\item{x}{Earth Engine table (ee$FeatureCollection) to be converted in a sf object.} \item{dsn}{Character. Output filename; in case \code{dsn} is missing -\code{ee_as_sf} will create a shapefile file in tmp() directory.} +a shapefile will be created in the \code{tmp()} directory.} \item{overwrite}{Logical. Delete data source \code{dsn} before attempting to write?.} +\item{via}{Character. Method to export the image. Three method are +implemented: "getInfo", "drive", "gcs". See details.} + +\item{container}{Character. Name of the folder ('drive') or bucket ('gcs') +to be exported into (ignore if \code{via} is not defined as "drive" or +"gcs").} + \item{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.} -\item{via}{Character. Method to fetch data about the object. Multiple -options supported. See details.} - \item{maxFeatures}{Numeric. The maximum allowed number of features to export (ignore if \code{via} is not set as "getInfo"). The task will fail if the exported region covers more features. Defaults to 5000.} -\item{container}{Character. Name of the folder ('drive') or bucket ('gcs') -to be exported into (ignore if \code{via} is not defined as "drive" or -"gcs").} - \item{selectors}{The list of properties to include in the output, as a list of strings or a comma-separated string. By default, all properties are included.} -\item{quiet}{logical. Suppress info message} +\item{lazy}{Logical. If TRUE, a \code{\link[future:sequential]{ +future::sequential}} object is created to evaluate the task in the future. +Ignore if \code{via} is set as "getInfo". See details.} + +\item{public}{Logical. If TRUE, a public link to the image will be created.} + +\item{add_metadata}{Add metadata to the sf object. See details.} + +\item{timePrefix}{Logical. Add current date and time (\code{Sys.time()}) as +a prefix to files to export. This parameter helps to avoid exported files +with the same name. By default TRUE.} + +\item{quiet}{logical. Suppress info message.} } \value{ An sf object. @@ -54,17 +70,55 @@ An sf object. Convert an Earth Engine table in a sf object } \details{ -\code{ee_as_sf} supports the download of \code{ee$FeatureCollection}, -\code{ee$Feature} and \code{ee$Geometry} by three different options: -"getInfo", "drive", and "gcs". When "getInfo" is set in the \code{via} -argument, \code{ee_as_sf} will make an REST call to retrieve -all the known information about the object. The advantage of use -"getInfo" is a direct and faster download. However, there is a limitation of +\code{ee_as_sf} supports the download of \code{ee$Geometry}, \code{ee$Feature}, +and \code{ee$FeatureCollection} by three different options: +"getInfo" (which make an REST call to retrieve the data), "drive" +(which use \href{https://CRAN.R-project.org/package=googledrive}{Google Drive}) +and "gcs" (which use \href{https://CRAN.R-project.org/package=googleCloudStorageR}{ +Google Cloud Storage}). The advantage of use "getInfo" is a +direct and faster download. However, there is a limitation of 5000 features by request which makes it not recommendable for large -collections. Instead of "getInfo", the options: "drive" and "gcs" are -suitable for large collections since they use an intermediate container, -which may be Google Drive and Google Cloud Storage respectively. For getting -more information about exporting data from Earth Engine, take a look at the +FeatureCollections. Instead of "getInfo", the options: "drive" and "gcs" +are suitable for large FeatureCollections since the use of an intermediate +container. They work as follow: +\itemize{ +\item{1. }{A task will be started (i.e. \code{ee$batch$Task$start()}) to +move the EE Table from Earth Engine to the intermediate container +specified in argument \code{via}.} +\item{2. }{If the argument \code{lazy} is TRUE, the task will not be +monitored. This is useful to lunch several tasks at the same time and +call them later using \code{\link{ee_utils_future_value}} or +\code{\link[future:value]{future::value}}. At the end of this step, +the EE Table will be stored on the path specified in the argument +\code{dsn}.} +\item{3. }{Finally if the argument \code{add_metadata} is TRUE, a list +with the following elements will be added to the sf object. +\itemize{ +\item{\bold{if via is "drive":}} +\itemize{ +\item{\bold{ee_id: }}{Name of the Earth Engine task.} +\item{\bold{drive_name: }}{Name of the Table in Google Drive.} +\item{\bold{drive_id: }}{Id of the Table in Google Drive.} +\item{\bold{drive_download_link: }}{Download link to the table.} +} +} +\itemize{ +\item{\bold{if via is "gcs":}} +\itemize{ +\item{\bold{ee_id: }}{Name of the Earth Engine task.} +\item{\bold{gcs_name: }}{Name of the Table in Google Cloud Storage.} +\item{\bold{gcs_bucket: }}{Name of the bucket.} +\item{\bold{gcs_fileFormat: }}{Format of the table.} +\item{\bold{gcs_public_link: }}{Download link to the table.} +\item{\bold{gcs_URI: }}{gs:// link to the table.} +} +} +Run \code{attr(sf, "metadata")} to get the list. +} +} + +For getting more information about exporting data from Earth Engine, take +a look at the \href{https://developers.google.com/earth-engine/exporting}{Google Earth Engine Guide - Export data}. } diff --git a/man/ee_as_stars.Rd b/man/ee_as_stars.Rd index 5e13d952..fd429080 100644 --- a/man/ee_as_stars.Rd +++ b/man/ee_as_stars.Rd @@ -2,43 +2,58 @@ % Please edit documentation in R/ee_image.R \name{ee_as_stars} \alias{ee_as_stars} -\title{Convert an Earth Engine (EE) image into a stars object} +\title{Convert an Earth Engine (EE) image in a stars object} \usage{ ee_as_stars( image, region = NULL, dsn = NULL, via = "drive", + container = "rgee_backup", scale = NULL, maxPixels = 1e+09, - container = "rgee_backup", + lazy = FALSE, + public = TRUE, + add_metadata = TRUE, + timePrefix = TRUE, quiet = FALSE, ... ) } \arguments{ -\item{image}{ee$Image to be converted into a stars object} +\item{image}{ee$Image to be converted into a stars object.} \item{region}{EE Geometry (ee$Geometry$Polygon) which specify the region -to export. CRS needs to be the same that the x argument otherwise it will be -forced. If not specified image bounds will be taken.} +to export. CRS needs to be the same that the argument \code{image}, +otherwise, it will be forced. If not specified, image bounds will be taken.} -\item{dsn}{Character. Output filename. If missing, -\code{ee_as_stars} will create a temporary file.} +\item{dsn}{Character. Output filename. If missing, a temporary file will be +created.} -\item{via}{Character. Method to fetch data about the object. Two methods -are implemented: "drive", "gcs". See details.} +\item{via}{Character. Method to export the image. Two method are +implemented: "drive", "gcs". See details.} + +\item{container}{Character. Name of the folder ('drive') or bucket ('gcs') +to be exported into.} \item{scale}{Numeric. The resolution in meters per pixel. Defaults -to the native resolution of the image asset.} +to the native resolution of the image.} \item{maxPixels}{Numeric. The maximum allowed number of pixels in the exported image. The task will fail if the exported region covers more pixels in the specified projection. Defaults to 100,000,000.} -\item{container}{Character. Name of the folder ('drive') or bucket ('gcs') -to be exported into (ignored if \code{via} is not defined as "drive" or -"gcs").} +\item{lazy}{Logical. If TRUE, a \code{\link[future:sequential]{ +future::sequential}} object is created to evaluate the task in the future. +See details.} + +\item{public}{Logical. If TRUE, a public link to the image will be created.} + +\item{add_metadata}{Add metadata to the stars_proxy object. See details.} + +\item{timePrefix}{Logical. Add current date and time (\code{Sys.time()}) as +a prefix to files to export. This parameter helps to avoid exported files +with the same name. By default TRUE.} \item{quiet}{Logical. Suppress info message} @@ -49,16 +64,52 @@ to be exported into (ignored if \code{via} is not defined as "drive" or A stars-proxy object } \description{ -Convert an ee$Image into a stars object +Convert an ee$Image in a stars object. } \details{ -\code{ee_as_stars} supports the download of \code{ee$Image} -by two different options: "drive" that use Google Drive and "gcs" -that use Google Cloud Storage. Previously, it is necessary to install the -R packages \href{ https://CRAN.R-project.org/package=googledrive}{googledrive} -or \href{https://CRAN.R-project.org/package=googleCloudStorageR}{ -googleCloudStorageR} respectively. For getting more information about -exporting data from Earth Engine, take a look at the +\code{ee_as_stars} supports the download of \code{ee$Images} +by two different options: "drive" +(\href{https://CRAN.R-project.org/package=googledrive}{Google Drive}) and "gcs" +(\href{https://CRAN.R-project.org/package=googleCloudStorageR}{ +Google Cloud Storage}). In both cases \code{ee_as_stars} works as follow: +\itemize{ +\item{1. }{A task will be started (i.e. \code{ee$batch$Task$start()}) to +move the \code{ee$Image} from Earth Engine to the intermediate container +specified in argument \code{via}.} +\item{2. }{If the argument \code{lazy} is TRUE, the task will not be +monitored. This is useful to lunch several tasks at the same time and +call them later using \code{\link{ee_utils_future_value}} or +\code{\link[future:value]{future::value}}. At the end of this step, +the \code{ee$Image} will be stored on the path specified in the argument +\code{dsn}.} +\item{3. }{Finally if the argument \code{add_metadata} is TRUE, a list +with the following elements will be added to the stars-proxy object. +\itemize{ +\item{\bold{if via is "drive":}} +\itemize{ +\item{\bold{ee_id: }}{Name of the Earth Engine task.} +\item{\bold{drive_name: }}{Name of the Image in Google Drive.} +\item{\bold{drive_id: }}{Id of the Image in Google Drive.} +\item{\bold{drive_download_link: }}{Download link to the image.} +} +} +\itemize{ +\item{\bold{if via is "gcs":}} +\itemize{ +\item{\bold{ee_id: }}{Name of the Earth Engine task.} +\item{\bold{gcs_name: }}{Name of the Image in Google Cloud Storage.} +\item{\bold{gcs_bucket: }}{Name of the bucket.} +\item{\bold{gcs_fileFormat: }}{Format of the image.} +\item{\bold{gcs_public_link: }}{Download link to the image.} +\item{\bold{gcs_URI: }}{gs:// link to the image.} +} +} +Run \code{attr(stars, "metadata")} to get the list. +} +} + +For getting more information about exporting data from Earth Engine, take +a look at the \href{https://developers.google.com/earth-engine/exporting}{Google Earth Engine Guide - Export data}. } @@ -86,21 +137,47 @@ geometry <- ee$Geometry$Rectangle( ) ## drive - Method 01 +# Simple img_02 <- ee_as_stars( image = img, region = geometry, via = "drive" ) -## gcs - Method 02 +# Lazy +img_02 <- ee_as_stars( + image = img, + region = geometry, + via = "drive", + lazy = TRUE +) + +img_02_result <- img_02 \%>\% ee_utils_future_value() +attr(img_02_result, "metadata") # metadata + +# ## gcs - Method 02 +# # Simple # img_03 <- ee_as_stars( # image = img, -# region = geometry, +# region = geometry, # container = "rgee_dev", -# via = "gcs" -#) - -# OPTIONAL: Delete containers +# via = "gcs" +# ) +# +# # Lazy +# img_03 <- ee_as_stars( +# image = img, +# region = geometry, +# container = "rgee_dev", +# lazy = TRUE, +# via = "gcs" +# ) +# +# img_03_result <- img_03 \%>\% ee_utils_future_value() +# attr(img_03_result, "metadata") # metadata +# +# +# # OPTIONAL: clean containers # ee_clean_container(name = "rgee_backup", type = "drive") # ee_clean_container(name = "rgee_dev", type = "gcs") } diff --git a/man/ee_as_thumbnail.Rd b/man/ee_as_thumbnail.Rd index 81428ad3..17b50b46 100644 --- a/man/ee_as_thumbnail.Rd +++ b/man/ee_as_thumbnail.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Deprecated.R +% Please edit documentation in R/ee_as_thumbnail.R \name{ee_as_thumbnail} \alias{ee_as_thumbnail} \title{Create an R spatial gridded object from an EE thumbnail image} diff --git a/man/ee_drive_to_local.Rd b/man/ee_drive_to_local.Rd index 407a5098..b2b697b9 100644 --- a/man/ee_drive_to_local.Rd +++ b/man/ee_drive_to_local.Rd @@ -4,7 +4,15 @@ \alias{ee_drive_to_local} \title{Move results from Google Drive to a local directory} \usage{ -ee_drive_to_local(task, dsn, overwrite = TRUE, consider = TRUE, quiet = FALSE) +ee_drive_to_local( + task, + dsn, + overwrite = TRUE, + consider = TRUE, + public = FALSE, + metadata = FALSE, + quiet = FALSE +) } \arguments{ \item{task}{List generated after finished correctly a EE task. See details.} @@ -17,10 +25,16 @@ whether "filename" should be overwritten. By default TRUE.} \item{consider}{Interactive. See details.} +\item{public}{Logical. If TRUE, a public link to the image will be created.} + +\item{metadata}{Logical. If TRUE, export the metadata related to the image.} + \item{quiet}{logical. Suppress info message} } \value{ -filename character vector. +If \code{metadata} is FALSE will return the filename of the image. +Otherwise, a list with two elements (\code{dns} and \code{metadata}) will +be returned. } \description{ Move results of an EE task saved in Google Drive to a local directory. diff --git a/man/ee_extract.Rd b/man/ee_extract.Rd index dc5935b9..6e17de75 100644 --- a/man/ee_extract.Rd +++ b/man/ee_extract.Rd @@ -103,13 +103,15 @@ library(sf) ee_Initialize() # Define a Image or ImageCollection: Terraclimate -terraclimate <- ee$ImageCollection("IDAHO_EPSCOR/TERRACLIMATE")$ - filterDate("2001-01-01", "2002-01-01")$ - map(function(x){ - date <- ee$Date(x$get("system:time_start"))$format('YYYY_MM_dd') - name <- ee$String$cat("Terraclimate_pp_", date) - x$select("pr")$reproject("EPSG:4326")$set("RGEE_NAME", name) - }) +terraclimate <- ee$ImageCollection("IDAHO_EPSCOR/TERRACLIMATE") \%>\% + ee$ImageCollection$filterDate("2001-01-01", "2002-01-01") \%>\% + ee$ImageCollection$map( + function(x) { + date <- ee$Date(x$get("system:time_start"))$format('YYYY_MM_dd') + name <- ee$String$cat("Terraclimate_pp_", date) + x$select("pr")$rename(name) + } + ) # Define a geometry nc <- st_read( @@ -118,7 +120,9 @@ nc <- st_read( quiet = TRUE ) + # Extract values + ee_nc_rain <- ee_extract( x = terraclimate, y = nc, @@ -129,7 +133,7 @@ ee_nc_rain <- ee_extract( # Spatial plot plot( - ee_nc_rain["X200110_pr"], + ee_nc_rain["Terraclimate_pp_2001_11_01"], main = "2001 Jan Precipitation - Terraclimate", reset = FALSE ) diff --git a/man/ee_gcs_to_local.Rd b/man/ee_gcs_to_local.Rd index 20b17a90..c9b7f1bc 100644 --- a/man/ee_gcs_to_local.Rd +++ b/man/ee_gcs_to_local.Rd @@ -4,7 +4,14 @@ \alias{ee_gcs_to_local} \title{Move results from Google Cloud Storage to a local directory} \usage{ -ee_gcs_to_local(task, dsn, overwrite = TRUE, quiet = FALSE) +ee_gcs_to_local( + task, + dsn, + public = FALSE, + metadata = FALSE, + overwrite = TRUE, + quiet = FALSE +) } \arguments{ \item{task}{List generated after finished correctly a EE task. See details.} @@ -12,8 +19,12 @@ ee_gcs_to_local(task, dsn, overwrite = TRUE, quiet = FALSE) \item{dsn}{Character. Output filename. If missing, a temporary file will be assigned.} -\item{overwrite}{Logical. A boolean indicating whether the file should -be overwritten.} +\item{public}{Logical. If TRUE, a public link to the image will be created.} + +\item{metadata}{Logical. If TRUE, export the metadata related to the image.} + +\item{overwrite}{A boolean argument which indicates indicating +whether "filename" should be overwritten. By default TRUE.} \item{quiet}{Logical. Suppress info message} } diff --git a/man/ee_imagecollection_to_local.Rd b/man/ee_imagecollection_to_local.Rd index 8fc9d8df..da6e6960 100644 --- a/man/ee_imagecollection_to_local.Rd +++ b/man/ee_imagecollection_to_local.Rd @@ -9,9 +9,13 @@ ee_imagecollection_to_local( region, dsn = NULL, via = "drive", + container = "rgee_backup", scale = NULL, maxPixels = 1e+09, - container = "rgee_backup", + lazy = FALSE, + public = TRUE, + add_metadata = TRUE, + timePrefix = TRUE, quiet = FALSE, ... ) @@ -19,46 +23,95 @@ ee_imagecollection_to_local( \arguments{ \item{ic}{ee$ImageCollection to be saved in the system.} -\item{region}{EE Geometry Rectangle (ee$Geometry$Rectangle). The -CRS needs to be the same that the ic argument otherwise it will be +\item{region}{EE Geometry (ee$Geometry$Polygon). The +CRS needs to be the same that the \code{ic} argument otherwise it will be forced.} -\item{dsn}{Character. Output filename. If missing, -\code{ee_imagecollection_to_local} will create a temporary file.} +\item{dsn}{Character. Output filename. If missing, a temporary file will +be created for each image.} + +\item{via}{Character. Method to export the image. Two method are implemented: +"drive", "gcs". See details.} -\item{via}{Character. Method to fetch data about the object. Multiple -options supported. See details.} +\item{container}{Character. Name of the folder ('drive') or bucket ('gcs') +to be exported into (ignored if \code{via} is not defined as "drive" or +"gcs").} \item{scale}{Numeric. The resolution in meters per pixel. Defaults -to the native resolution of the image assset.} +to the native resolution of the image.} \item{maxPixels}{Numeric. The maximum allowed number of pixels in the exported image. The task will fail if the exported region covers more pixels in the specified projection. Defaults to 100,000,000.} -\item{container}{Character. Name of the folder ('drive') or bucket ('gcs') -to be exported into (ignored if \code{via} is not defined as "drive" or -"gcs").} +\item{lazy}{Logical. If TRUE, a \code{\link[future:sequential]{ +future::sequential}} object is created to evaluate the task in the future. +See details.} + +\item{public}{Logical. If TRUE, a public link to the image will be created.} + +\item{add_metadata}{Add metadata to the stars_proxy object. See details.} + +\item{timePrefix}{Logical. Add current date and time (\code{Sys.time()}) as +a prefix to files to export. This parameter helps to avoid exported files +with the same name. By default TRUE.} -\item{quiet}{logical. Suppress info message} +\item{quiet}{Logical. Suppress info message} -\item{...}{Extra exporting argument. See \link{ee_image_to_drive} and -\link{ee_image_to_gcs}.} +\item{...}{Extra exporting argument. See \link{ee_image_to_drive} and} } \value{ -Character vector containing the filename of the images downloaded. +If add_metadata is FALSE, a character vector containing the filename +of the images downloaded. Otherwise a list adding information related to +the exportation (see details). } \description{ Save an EE ImageCollection in their local system } \details{ -\code{ee_imagecollection_to_local} supports the download of \code{ee$Image} -by two different options: "drive" that use Google Drive and "gcs" -that use Google Cloud Storage. Previously, it is necessary to install the -R packages \href{ https://CRAN.R-project.org/package=googledrive}{googledrive} -or \href{https://CRAN.R-project.org/package=googleCloudStorageR}{ -googleCloudStorageR} respectively. For getting more information about -exporting data from Earth Engine, take a look at the +\code{ee_imagecollection_to_local} supports the download of \code{ee$Images} +by two different options: "drive" +(\href{https://CRAN.R-project.org/package=googledrive}{Google Drive}) and "gcs" +(\href{https://CRAN.R-project.org/package=googleCloudStorageR}{ +Google Cloud Storage}). In both cases \code{ee_imagecollection_to_local} +works as follow: +\itemize{ +\item{1. }{A task will be started (i.e. \code{ee$batch$Task$start()}) to +move the \code{ee$Image} from Earth Engine to the intermediate container +specified in argument \code{via}.} +\item{2. }{If the argument \code{lazy} is TRUE, the task will not be +monitored. This is useful to lunch several tasks at the same time and +call them later using \code{\link{ee_utils_future_value}} or +\code{\link[future:value]{future::value}}. At the end of this step, +the \code{ee$Images} will be stored on the path specified in the argument +\code{dsn}.} +\item{3. }{Finally if the argument \code{add_metadata} is TRUE, a list +with the following elements will be added to the argument \code{dsn}. +\itemize{ +\item{\bold{if via is "drive":}} +\itemize{ +\item{\bold{ee_id: }}{Name of the Earth Engine task.} +\item{\bold{drive_name: }}{Name of the Image in Google Drive.} +\item{\bold{drive_id: }}{Id of the Image in Google Drive.} +\item{\bold{drive_download_link: }}{Download link to the image.} +} +} +\itemize{ +\item{\bold{if via is "gcs":}} +\itemize{ +\item{\bold{ee_id: }}{Name of the Earth Engine task.} +\item{\bold{gcs_name: }}{Name of the Image in Google Cloud Storage.} +\item{\bold{gcs_bucket: }}{Name of the bucket.} +\item{\bold{gcs_fileFormat: }}{Format of the image.} +\item{\bold{gcs_public_link: }}{Download link to the image.} +\item{\bold{gcs_URI: }}{gs:// link to the image.} +} +} +} +} + +For getting more information about exporting data from Earth Engine, take +a look at the \href{https://developers.google.com/earth-engine/exporting}{Google Earth Engine Guide - Export data}. } @@ -81,13 +134,26 @@ geometry <- collection$first()$geometry(proj = ee_crs)$bounds() tmp <- tempdir() ## Using drive -ic_drive_files <- ee_imagecollection_to_local( +# one by once +ic_drive_files_1 <- ee_imagecollection_to_local( + ic = collection, + region = geometry, + scale = 250, + dsn = file.path(tmp, "drive_") +) + +# all at once +ic_drive_files_2 <- ee_imagecollection_to_local( ic = collection, region = geometry, - scale = 100, + scale = 250, + lazy = TRUE, dsn = file.path(tmp, "drive_") ) +# From Google Drive to client-side +doqq_dsn <- ic_drive_files_2 \%>\% ee_utils_future_value() +sapply(doqq_dsn, '[[', 1) } } \seealso{ diff --git a/man/ee_install_set_pyenv.Rd b/man/ee_install_set_pyenv.Rd index 2cbe7969..45843d27 100644 --- a/man/ee_install_set_pyenv.Rd +++ b/man/ee_install_set_pyenv.Rd @@ -4,12 +4,14 @@ \alias{ee_install_set_pyenv} \title{Set the Python environment to be used by rgee} \usage{ -ee_install_set_pyenv(py_path = NULL, py_env = NULL) +ee_install_set_pyenv(py_path = NULL, py_env = NULL, quiet = FALSE) } \arguments{ -\item{py_path}{The path to a Python interpreter.} +\item{py_path}{The path to a Python interpreter} \item{py_env}{The name of the environment} + +\item{quiet}{Logical. Suppress info message} } \description{ This function create a new environment variable called 'EARTHENGINE_PYTHON'. diff --git a/man/ee_monitoring.Rd b/man/ee_monitoring.Rd index b24d1535..4e52c095 100644 --- a/man/ee_monitoring.Rd +++ b/man/ee_monitoring.Rd @@ -7,7 +7,9 @@ ee_monitoring(task, task_time = 5, eeTaskList = FALSE, quiet = FALSE) } \arguments{ -\item{task}{List generated after an created an EE task.} +\item{task}{List generated after a task is started (i.e. after run +\code{ee$batch$Task$start()}) or a character that represents the ID of a EE +task started.} \item{task_time}{Numeric. How often (in seconds) should a task be polled?} diff --git a/man/ee_search-tools.Rd b/man/ee_search-tools.Rd index 40e1a185..2f80b954 100644 --- a/man/ee_search-tools.Rd +++ b/man/ee_search-tools.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ee_search.R +% Please edit documentation in R/Deprecated.R \name{ee_search-tools} \alias{ee_search-tools} \alias{ee_search_dataset} diff --git a/man/ee_utils_future_value.Rd b/man/ee_utils_future_value.Rd new file mode 100644 index 00000000..3a2eb211 --- /dev/null +++ b/man/ee_utils_future_value.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ee_image.R +\name{ee_utils_future_value} +\alias{ee_utils_future_value} +\title{The value of a future or the values of all elements in a container} +\usage{ +ee_utils_future_value(future, stdout = TRUE, signal = TRUE, ...) +} +\arguments{ +\item{future, }{x A Future, an environment, a list, or a list environment.} + +\item{stdout}{If TRUE, standard output captured while resolving futures +is relayed, otherwise not.} + +\item{signal}{If TRUE, \link[base]{conditions} captured while resolving +futures are relayed, otherwise not.} + +\item{\dots}{All arguments used by the S3 methods.} +} +\value{ +\code{value()} of a Future object returns the value of the future, which can +be any type of \R object. + +\code{value()} of a list, an environment, or a list environment returns an +object with the same number of elements and of the same class. +Names and dimension attributes are preserved, if available. +All future elements are replaced by their corresponding \code{value()} values. +For all other elements, the existing object is kept as-is. + +If \code{signal} is TRUE and one of the futures produces an error, then +that error is produced. +} +\description{ +Gets the value of a future or the values of all elements (including futures) +in a container such as a list, an environment, or a list environment. +If one or more futures is unresolved, then this function blocks until all +queried futures are resolved. +} +\author{ +Henrik Bengtsson \url{https://github.com/HenrikBengtsson} +} diff --git a/man/ee_utils_search_display.Rd b/man/ee_utils_search_display.Rd new file mode 100644 index 00000000..ce67103f --- /dev/null +++ b/man/ee_utils_search_display.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ee_utils.R +\name{ee_utils_search_display} +\alias{ee_utils_search_display} +\title{Search into the Earth Engine Data Catalog} +\usage{ +ee_utils_search_display(ee_search_dataset) +} +\arguments{ +\item{ee_search_dataset}{character which represents the EE dataset ID.} +} +\description{ +Search into the Earth Engine Data Catalog +} +\examples{ +\dontrun{ + library(rgee) + + ee_datasets <- c("WWF/HydroSHEDS/15DIR", "WWF/HydroSHEDS/03DIR") + ee_utils_search_display(ee_datasets) +} +} diff --git a/man/figures/logo.png b/man/figures/logo.png old mode 100644 new mode 100755 diff --git a/man/mapview-class.Rd b/man/mapview-class.Rd deleted file mode 100644 index 83dd4654..00000000 --- a/man/mapview-class.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/AAAMapclass.R -\docType{class} -\name{mapview-class} -\alias{mapview-class} -\title{Class mapview} -\description{ -Class mapview -} -\section{Slots}{ - -\describe{ -\item{\code{object}}{the spatial object} - -\item{\code{map}}{the leaflet map object} -}} - diff --git a/man/null-default.Rd b/man/null-default.Rd new file mode 100644 index 00000000..c41d104d --- /dev/null +++ b/man/null-default.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Map_operators.R +\name{null-default} +\alias{null-default} +\alias{+.EarthEngineMap} +\alias{|.EarthEngineMap} +\alias{|,} +\alias{EarthEngineMap,} +\alias{EarthEngineMap-method} +\title{EarthEngineMap + EarthEngineMap; adds data from the second map to the first} +\usage{ +\method{+}{EarthEngineMap}(e1, e2) + +\method{|}{EarthEngineMap}(e1, e2) +} +\arguments{ +\item{e1}{an EarthEngineMap object.} + +\item{e2}{an EarthEngineMap object.} +} +\description{ +EarthEngineMap + EarthEngineMap; adds data from the second map to the first + +EarthEngineMap | EarthEngineMap provides a slider in the middle to compare two maps. +} +\author{ +tim-salabim. Adapted from mapview code. + +tim-salabim. Adapted from mapview code. +} diff --git a/man/plus-EarthEngineMap-EarthEngineMap-method.Rd b/man/plus-EarthEngineMap-EarthEngineMap-method.Rd deleted file mode 100644 index 119e49fc..00000000 --- a/man/plus-EarthEngineMap-EarthEngineMap-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Map_operators.R -\name{+,EarthEngineMap,EarthEngineMap-method} -\alias{+,EarthEngineMap,EarthEngineMap-method} -\title{EarthEngineMap + EarthEngineMap; adds data from the second map to the first} -\usage{ -\S4method{+}{EarthEngineMap,EarthEngineMap}(e1, e2) -} -\arguments{ -\item{e1}{a EarthEngineMap map to which e2 should be added.} - -\item{e2}{a EarthEngineMap map from which the objects should be added to e1.} -} -\description{ -EarthEngineMap + EarthEngineMap; adds data from the second map to the first -} -\author{ -tim-salabim. Adapted from mapview code. -} diff --git a/man/plus-EarthEngineMap-mapview-method.Rd b/man/plus-EarthEngineMap-mapview-method.Rd deleted file mode 100644 index 99b89cc5..00000000 --- a/man/plus-EarthEngineMap-mapview-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Map_operators.R -\name{+,EarthEngineMap,mapview-method} -\alias{+,EarthEngineMap,mapview-method} -\title{EarthEngineMap + ANY; adds data from the second map to the first} -\usage{ -\S4method{+}{EarthEngineMap,mapview}(e1, e2) -} -\arguments{ -\item{e1}{a EarthEngineMap map to which e2 should be added.} - -\item{e2}{a EarthEngineMap map from which the objects should be added to e1.} -} -\description{ -EarthEngineMap + ANY; adds data from the second map to the first -} -\author{ -tim-salabim Adapted from mapview code. -} diff --git a/man/plus-mapview-EarthEngineMap-method.Rd b/man/plus-mapview-EarthEngineMap-method.Rd deleted file mode 100644 index 863fe099..00000000 --- a/man/plus-mapview-EarthEngineMap-method.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Map_operators.R -\name{+,mapview,EarthEngineMap-method} -\alias{+,mapview,EarthEngineMap-method} -\title{ANY + EarthEngineMap; adds data from the second map to the first} -\usage{ -\S4method{+}{mapview,EarthEngineMap}(e1, e2) -} -\arguments{ -\item{e1}{a EarthEngineMap map to which e2 should be added.} - -\item{e2}{a EarthEngineMap map from which the objects should be added to e1.} -} -\description{ -ANY + EarthEngineMap; adds data from the second map to the first -} -\author{ -tim-salabim Adapted from mapview code. -} diff --git a/man/rgee-package.Rd b/man/rgee-package.Rd index dd1fe555..26848d7b 100644 --- a/man/rgee-package.Rd +++ b/man/rgee-package.Rd @@ -40,6 +40,7 @@ Other contributors: \item Samapriya Roy \email{samapriya.roy@gmail.com} [contributor] \item MariaElena Adauto \email{2a.mariaelena@gmail.com} (\href{https://orcid.org/0000-0002-2154-2429}{ORCID}) [contributor] \item Gabriel Carrasco \email{gabriel.carrasco@upch.pe} (\href{https://orcid.org/0000-0002-6945-0419}{ORCID}) [contributor] + \item Henrik Bengtsson \email{henrikb@braju.com} [contributor] \item Jeffrey Hollister \email{hollister.jeff@epa.gov} (Hollister reviewed the package for JOSS, see https://github.com/openjournals/joss-reviews/issues/2272) [reviewer] \item Gennadii Donchyts (Gena reviewed the package for JOSS, see diff --git a/man/show-EarthEngineMap-method.Rd b/man/show-EarthEngineMap-method.Rd deleted file mode 100644 index bc2b727f..00000000 --- a/man/show-EarthEngineMap-method.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/print.R -\name{show,EarthEngineMap-method} -\alias{show,EarthEngineMap-method} -\title{Method for printing EarthEngineMap objects (show)} -\usage{ -\S4method{show}{EarthEngineMap}(object) -} -\arguments{ -\item{object}{a EarthEngineMap object} -} -\description{ -Method for printing EarthEngineMap objects (show) -} diff --git a/man/slider.Rd b/man/slider.Rd deleted file mode 100644 index 4c66886a..00000000 --- a/man/slider.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Map_operators.R -\name{slider} -\alias{slider} -\alias{|,EarthEngineMap,EarthEngineMap-method} -\title{EarthEngineMap | EarthEngineMap provides a slider in the middle to compare two maps.} -\usage{ -\S4method{|}{EarthEngineMap,EarthEngineMap}(e1, e2) -} -\arguments{ -\item{e1}{a leaflet or mapview map, or NULL.} - -\item{e2}{a leaflet or mapview map, or NULL.} -} -\description{ -EarthEngineMap | EarthEngineMap provides a slider in the middle to compare two maps. -} -\author{ -tim-salabim. Adapted from mapview code. -} diff --git a/paper/README.md b/paper/README.md old mode 100644 new mode 100755 diff --git a/paper/paper.bib b/paper/paper.bib old mode 100644 new mode 100755 diff --git a/paper/paper.md b/paper/paper.md old mode 100644 new mode 100755 diff --git a/paper/paper.pdf b/paper/paper.pdf old mode 100644 new mode 100755 diff --git a/paper/rgee_paper_00.png b/paper/rgee_paper_00.png old mode 100644 new mode 100755 diff --git a/paper/rgee_paper_00.svg b/paper/rgee_paper_00.svg old mode 100644 new mode 100755 diff --git a/paper/rgee_paper_01.png b/paper/rgee_paper_01.png old mode 100644 new mode 100755 diff --git a/paper/rgee_paper_01.svg b/paper/rgee_paper_01.svg old mode 100644 new mode 100755 diff --git a/paper/rgee_paper_02.png b/paper/rgee_paper_02.png old mode 100644 new mode 100755 diff --git a/paper/rgee_paper_mapview.png b/paper/rgee_paper_mapview.png old mode 100644 new mode 100755 diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml deleted file mode 100644 index b4eac5bf..00000000 --- a/pkgdown/_pkgdown.yml +++ /dev/null @@ -1,176 +0,0 @@ -title: rgee -url: http://r-spatial.github.io/rgee -template: - params: - bootswatch: flatly - -navbar: - left: - - icon: fa-home - href: index.html - right: - - text: "Articles" - icon: fas fa-book - menu: - - text: Setup and details - href: articles/setup.html - - text: Consideration - href: articles/considerations.html - - text: Best Practices - href: articles/BestPractices.html - - text: rgee examples - href: http://csaybar.github.io/rgee-examples/ - - icon: fa-newspaper-o - text: "news" - href: news/index.html - - icon: fa-file-code-o - text: "functions" - href: reference/index.html - - icon: fa-github fa-lg - text: "github" - href: https://github.com/r-spatial/rgee/ - -reference: - - title: "Earth Engine module" - contents: - - ee - - title: "Install" - contents: - - ee_install - - ee_install_set_pyenv - - ee_install_upgrade - - - title: "Checking" - contents: - - ee_check - - ee_check_python - - ee_check_credentials - - - title: "Clean" - contents: - - ee_clean_container - - ee_clean_credentials - - ee_clean_pyenv - - - title: "Session management" - contents: - - ee_Initialize - - ee_version - - ee_user_info - - ee_users - - - title: "Path utils" - contents: - - ee_get_assethome - - ee_get_earthengine_path - - - title: "Date" - contents: - - eedate_to_rdate - - rdate_to_eedate - - ee_get_date_img - - ee_get_date_ic - - - title: "Visualization" - contents: - - Map - - ee_as_mapview - - EarthEngineMap-class - - +,EarthEngineMap,EarthEngineMap-method - - +,mapview,EarthEngineMap-method - - show,EarthEngineMap-method - - mapview-class - - +,EarthEngineMap,mapview-method - - slider - - - title: "Image download" - contents: - - ee_as_raster - - ee_as_stars - - ee_as_thumbnail - - ee_image_to_asset - - ee_image_to_drive - - ee_image_to_gcs - - ee_image_info - - ee_imagecollection_to_local - - - title: "Vector download" - contents: - - ee_as_sf - - ee_table_to_asset - - ee_table_to_drive - - ee_table_to_gcs - - - title: "Generic download" - contents: - - ee_drive_to_local - - ee_gcs_to_local - - - title: "Assets management" - contents: - - ee_manage_create - - ee_manage_delete - - ee_manage_assetlist - - ee_manage_quota - - ee_manage_copy - - ee_manage_move - - ee_manage_set_properties - - ee_manage_delete_properties - - ee_manage_asset_access - - ee_manage_task - - ee_manage_cancel_all_running_task - - ee_manage_asset_size - - - title: "Upload raster" - contents: - - stars_as_ee - - raster_as_ee - - gcs_to_ee_image - - - title: "Upload vector" - contents: - - gcs_to_ee_table - - sf_as_ee - - - title: "Upload generic" - contents: - - local_to_gcs - - - title: "Extract values" - contents: - - ee_extract - - - title: "Helper functions" - contents: - - ee_help - - ee_print - - print.ee.computedobject.ComputedObject - - ee_monitoring - - ee_get - - - title: "Utils" - contents: - - ee_utils_py_to_r - - ee_utils_pyfunc - - ee_utils_shp_to_zip - - ee_utils_create_json - - ee_utils_create_manifest_image - - ee_utils_create_manifest_table - - ee_utils_get_crs - - ee_utils_gif_annotate - - ee_utils_gif_creator - - ee_utils_gif_save - - - title: "Search dataset" - contents: - - ee_search_dataset - - ee_search_startdate - - ee_search_enddate - - ee_search_type - - ee_search_provider - - ee_search_provider_list - - ee_search_tags - - ee_search_title - - ee_search_tagstitle - - ee_search_title_list - - ee_search_display diff --git a/tests/credentials/GCS_AUTH_FILE.json.gpg b/tests/credentials/GCS_AUTH_FILE.json.gpg old mode 100644 new mode 100755 diff --git a/tests/spelling.R b/tests/spelling.R old mode 100644 new mode 100755 diff --git a/tests/testthat.R b/tests/testthat.R old mode 100644 new mode 100755 index ce71f67b..e3e7c4a0 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,5 +1,4 @@ library(testthat) -library(mapview) library(raster) library(stars) library(rgee) diff --git a/tests/testthat/test-clean.R b/tests/testthat/test-clean.R old mode 100644 new mode 100755 diff --git a/tests/testthat/test-date.R b/tests/testthat/test-date.R old mode 100644 new mode 100755 diff --git a/tests/testthat/test-download.R b/tests/testthat/test-download.R index 9194a070..0895627b 100755 --- a/tests/testthat/test-download.R +++ b/tests/testthat/test-download.R @@ -30,7 +30,6 @@ fc_test <- ee_geom %>% ee$Feature(list("test" = "feature")) %>% ee$FeatureCollection() - image_test <- mean_srtm_Amarakaeri imageExportFormatOptions_1 <- list( patchDimensions = c(10L, 10L), @@ -66,13 +65,16 @@ test_that("GEOTIFF_DRIVE", { fileNamePrefix = "test_image_GEOTIFF" ) task_img$start() - ee_monitoring(task_img) + ee_monitoring(task_img$id) + full_list <- ee_monitoring(eeTaskList = TRUE) img <- ee_drive_to_local( task = task_img, consider = 'last', + public = TRUE, + metadata = TRUE, dsn = tempfile() ) - expect_is(img, "character") + expect_is(img, "list") }) # # 2. CTFRECORD_IMAGE - DRIVE @@ -127,7 +129,9 @@ test_that("GEOTIFF_GCS", { ) task_img$start() ee_monitoring(task_img) - img <- ee_gcs_to_local(task = task_img, dsn = tempfile()) + img <- ee_gcs_to_local(task = task_img, dsn = tempfile(), + public = TRUE, + metadata = TRUE) img <- ee_gcs_to_local(task = task_img, dsn = tempfile(), quiet = TRUE) expect_is(img, "character") }) @@ -334,8 +338,10 @@ test_that("KMZ_VECTOR_GCS",{ ) task_vector$start() ee_monitoring(task_vector) - vector <- ee_gcs_to_local(task = task_vector) - expect_is(vector, "character") + vector <- ee_gcs_to_local(task = task_vector, + public = TRUE, + metadata = TRUE) + expect_is(vector, "list") }) # # 18. GEOJSON_VECTOR - GCS @@ -349,8 +355,10 @@ test_that("GEOJSON_VECTOR_GCS",{ ) task_vector$start() ee_monitoring(task_vector) - vector <- ee_gcs_to_local(task = task_vector) - expect_is(vector, "character") + vector <- ee_gcs_to_local(task = task_vector, + public = TRUE, + metadata = TRUE) + expect_is(vector, "list") }) # # 19. CTFRECORD_VECTOR - GCS # test_that("CTFRECORD_VECTOR_GCS",{ @@ -374,6 +382,11 @@ test_that("table to asset",{ collection = fc_test, assetId = assetid ) + task_vector <- ee_table_to_asset( + collection = fc_test, + assetId = assetid, + overwrite = TRUE + ) task_vector$start() ee_monitoring(task_vector) mess <- ee_manage_delete(assetid) @@ -386,6 +399,11 @@ test_that("image to asset",{ image = image_test, assetId = assetid ) + task_img <- ee_image_to_asset( + image = image_test, + assetId = assetid, + overwrite = TRUE + ) task_img$start() ee_monitoring(task_img) mess <- ee_manage_delete(assetid) diff --git a/tests/testthat/test-ee_extract.R b/tests/testthat/test-ee_extract.R index 8fe5d3f8..8beddb1c 100755 --- a/tests/testthat/test-ee_extract.R +++ b/tests/testthat/test-ee_extract.R @@ -7,7 +7,7 @@ filename <- system.file("external/lux.shp", package="raster") terraclimate_raw <- ee$ImageCollection("IDAHO_EPSCOR/TERRACLIMATE") terraclimate <- ee$ImageCollection("IDAHO_EPSCOR/TERRACLIMATE")$ filterDate("2000-01-01", "2001-01-01")$ - map(function(x) x$select("pr")$reproject("EPSG:4326")) + map(function(x) x$select("pr")) nc <- st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE) %>% st_transform(4326) @@ -16,7 +16,7 @@ test_that("ee_extract ee$ImageCollection",{ y = nc, fun = ee$Reducer$max(), sf = TRUE) - expect_equal(mean(ee_nc_rain$X200012), 50.47) + expect_equal(mean(ee_nc_rain$pr), 124.87) }) test_that("ee_extract ee$Image",{ @@ -24,7 +24,7 @@ test_that("ee_extract ee$Image",{ y = sf_as_ee(nc), fun = ee$Reducer$max(), sf = TRUE) - expect_equal(mean(ee_nc_rain$X200012_pr), 50.47) + expect_equal(mean(ee_nc_rain$pr), 124.87) }) test_that("ee_extract - error ",{ diff --git a/tests/testthat/test-ee_get.R b/tests/testthat/test-ee_get.R old mode 100644 new mode 100755 diff --git a/tests/testthat/test-ee_help.R b/tests/testthat/test-ee_help.R old mode 100644 new mode 100755 diff --git a/tests/testthat/test-ee_image.R b/tests/testthat/test-ee_image.R old mode 100644 new mode 100755 index 8617bbb0..8d0fa5f9 --- a/tests/testthat/test-ee_image.R +++ b/tests/testthat/test-ee_image.R @@ -114,16 +114,6 @@ test_that("ee_as_stars - simple ", { # expect_type(ee_image_03,'character') # }) -test_that("ee_as_raster", { - img_01 <- ee_as_raster( - image = image_srtm, - region = geometry, - scale = 10, - via = "getInfo" - ) - expect_s4_class(img_01, "RasterStack") -}) - # world image thumbnail ----------------------------------------------- region <- ee$Geometry$Rectangle( coords = c(-180,-60,180,60), @@ -158,7 +148,6 @@ test_that("ee_image_local error 1", { } ) - test_that("ee_image_local error 2", { expect_error( rgee:::ee_image_local( diff --git a/tests/testthat/test-eeprint.R b/tests/testthat/test-eeprint.R old mode 100644 new mode 100755 diff --git a/tests/testthat/test-imagecollection.R b/tests/testthat/test-imagecollection.R old mode 100644 new mode 100755 index 7c0a3806..8020c96a --- a/tests/testthat/test-imagecollection.R +++ b/tests/testthat/test-imagecollection.R @@ -21,8 +21,8 @@ test_that("ee_imagecollection_to_local - simple dsn", { dsn = tmp, quiet = TRUE ) - raster(ic_getinfo_files[1]) - expect_type(ic_getinfo_files, "character") + raster(ic_getinfo_files[[1]]$dsn) + expect_type(ic_getinfo_files, "list") } ) @@ -34,7 +34,7 @@ test_that("ee_imagecollection_to_local - simple dsn", { dsn = file.path(tmp, "drive_"), quiet = FALSE ) - expect_type(ic_getinfo_files, "character") + expect_type(ic_getinfo_files, "list") } ) @@ -44,13 +44,14 @@ test_that("ee_imagecollection_to_local - simple dsn", { ic = ic, scale = 200, dsn = c("lesly_01.tif", "lesly_02.tif"), - region = geometry + region = geometry, + add_metadata = FALSE ) ic_getinfo_files <- ee_imagecollection_to_local( ic = ic, scale = 200, region = geometry ) - expect_type(ic_getinfo_files, "character") + expect_type(ic_getinfo_files, "list") } ) diff --git a/tests/testthat/test-map.R b/tests/testthat/test-map.R index aa0ae961..7a7f87ec 100755 --- a/tests/testthat/test-map.R +++ b/tests/testthat/test-map.R @@ -13,7 +13,7 @@ collection <- ee$ImageCollection("LANDSAT/LC08/C01/T1_TOA")$ # testing ----------------------------------------------------------------- test_that("Map default", { - expect_s4_class(rgee:::ee_mapview(),'mapview') + expect_s3_class(rgee:::ee_mapview(),'EarthEngineMap') }) test_that("Map default", { @@ -50,18 +50,18 @@ test_that("Map geometry", { geom, list(pointRadius = 10, color = "FF0000"), "Geometry-Arequipa-test") - m1_noviz <- rgee:::ee_addLayer(geom,name = "Geometry-Arequipa") - expect_equal(m1@object$name, "Geometry-Arequipa-test") - expect_equal(m1_noviz@object$name, "Geometry-Arequipa") + m1_noviz <- rgee:::ee_addLayer(geom, name = "Geometry-Arequipa") + expect_equal(m1$rgee$name, "Geometry-Arequipa-test") + expect_equal(m1_noviz$rgee$name, "Geometry-Arequipa") }) test_that("Map geometry", { m1 <- rgee:::ee_addLayer(geom, list(pointRadius = 10, color = "FF0000"), "Geometry-Arequipa-test") - m1_noviz <- rgee:::ee_addLayer(geom,name = "Geometry-Arequipa") - expect_equal(m1@object$name, "Geometry-Arequipa-test") - expect_equal(m1_noviz@object$name, "Geometry-Arequipa") + m1_noviz <- rgee:::ee_addLayer(geom, name = "Geometry-Arequipa") + expect_equal(m1$rgee$name, "Geometry-Arequipa-test") + expect_equal(m1_noviz$rgee$name, "Geometry-Arequipa") }) test_that("Map feature", { @@ -69,7 +69,7 @@ test_that("Map feature", { ee$Feature(geom), name = "Feature-Arequipa-test" ) - expect_equal(m2@object$name,"Feature-Arequipa-test") + expect_equal(m2$rgee$name,"Feature-Arequipa-test") }) # Case: FeatureCollection @@ -78,7 +78,7 @@ test_that("Map FeatureCollection", { eeObject = eeobject_fc, name = "FeatureCollection" ) - expect_equal(m3@object$name,"FeatureCollection") + expect_equal(m3$rgee$name,"FeatureCollection") }) # Case: Image @@ -146,3 +146,74 @@ test_that("messages 01", { eeObject = eeobject_fc$first()$geometry()) expect_type(message,"environment") }) + +# Test impossible to get center +test_that("Map ee$Image(0)", { + img <- ee$Image(0) + m1 <- rgee:::ee_centerObject(img) + expect_equal(m1$lat,0) + expect_equal(m1$lon,0) +}) + +# Test viz Map +test_that("Map ee$Image", { + img <- image + Map$centerObject(img) + m1 <- rgee:::ee_addLayer(img$normalizedDifference(c("B5", "B4")), + legend = TRUE) + expect_s3_class(m1, "leaflet") +}) + +# ee_get_system_id +test_that("Map ee$Image", { + # img + img <- ee$Image(0)$set("system:id", "cesar") + img_name <- ee_get_system_id(img) + # feat + ft <- ee$Feature(ee$Geometry$Rectangle(0,0,0,0))$set("system:id", "cesar") + ft_name <- ee_get_system_id(ft) + # fc + fc <- ee$FeatureCollection(ft)$set("system:id", "cesar") + fc_name <- ee_get_system_id(fc) + # ic + ic <- ee$ImageCollection(list(ee$Image(0), ee$Image(0)))$ + set("system:id", "cesar") + ic_name <- ee_get_system_id(ic) + + expect_equal(ic_name, "cesar") + expect_equal(img_name, "cesar") + expect_equal(ft_name, "cesar") + expect_equal(fc_name, "cesar") +}) + +# ImageCollection +test_that("Map ee$ImageCollection", { + ic <- ee$ImageCollection(list(ee$Image(0), ee$Image(0))) + mx <- Map$addLayers(ic) + expect_s3_class(mx, "leaflet") +}) + +# ImageCollection +test_that("Map ee$ImageCollection", { + e1 <- ee$Image(0) + e2 <- ee$Image(0) + mx <- Map$addLayer(e1, name = "Lesly") + + Map$addLayer(e2, name = "Lesly", legend = TRUE) + expect_s3_class(mx, "leaflet") +}) + +test_that("Map + same name & legend", { + e1 <- Map$addLayer(ee$Image(0), name = "Lesly") + e2 <- Map$addLayer(ee$Image(0), name = "Lesly", legend = TRUE) + m1 <- e1 + e2 + expect_s3_class(m1, "leaflet") +}) + +test_that("Map | comparison operator", { + e1 <- Map$addLayer(ee$Image(0), name = "Lesly") + e2 <- Map$addLayer(ee$Image(0), name = "Lesly", legend = TRUE) + mc1 <- e1 | e2 + mc2 <- e2 | e1 + expect_s3_class(mc1, "leaflet") + expect_s3_class(mc2, "leaflet") +}) diff --git a/tests/testthat/test-search.R b/tests/testthat/test-search.R deleted file mode 100644 index 823b4a86..00000000 --- a/tests/testthat/test-search.R +++ /dev/null @@ -1,108 +0,0 @@ -context("rgee: test-search test") -skip_if_no_pypkg() -# ------------------------------------------------------------------------- - -db <- paste0( - "https://raw.githubusercontent.com/csaybar/Earth-Engine-Datasets-List/", - "10c09b65e93d156c297628f035bf372b101867d3/eed-2020-03-30.csv", - collapse = "" -) - -test_that("simple search",{ - myquery <- ee_search_dataset(path_dataset = db, upgrade = TRUE) %>% - ee_search_type("Image") %>% - ee_search_provider("WWF") %>% - ee_search_tags("srtm", "flow", "direction", "dem") %>% - ee_search_tagstitle("srtm", "flow", "direction", "dem") %>% - ee_search_title("15", "Flow", logical_operator = "AND") - expect_type(myquery$id[1],"character") -}) - -test_that("testing date queries",{ - myquery <- ee_search_dataset() %>% - ee_search_type("Image") %>% - ee_search_startdate('2010-01-01') %>% - ee_search_enddate('2010-12-31') - extract_year <- regmatches(x = myquery$start_date, - m = regexpr( - pattern = "..$", - text = myquery$start_date) - ) - expect_equal(mean(as.numeric(extract_year)),10) -}) - - -test_that("Get title",{ - tl <- ee_search_title_list(ee_search_dataset()) - expect_type(tl,'character') -}) - -test_that("ee_search_tagstitle - AND",{ - my_db <- ee_search_dataset() %>% - ee_search_tagstitle("srtm",logical_operator = 'AND') - expect_type(my_db$id,'character') -}) - -test_that("provider list",{ - expect_type( - ee_search_dataset() %>% ee_search_provider_list(), - "character" - ) -}) - -# ERROR ee_search --------------------------------------------------------- -test_that("error 01",{ - expect_error( - ee_search_dataset() %>% ee_search_type("XxX") - ) -}) - -test_that("error 02",{ - expect_error( - ee_search_dataset() %>% ee_search_provider("peru") - ) -}) - -test_that("error 03",{ - ee_s_search <- ee_search_dataset() %>% - ee_search_tags("srtm", "flow", "direction", "dem", logical_operator = "OR") - expect_s3_class(ee_s_search,"data.frame") - ee_s_search <- ee_search_dataset() %>% - ee_search_tags("srtm", "flow", "direction", "dem", logical_operator = "AND") - expect_s3_class(ee_s_search,"data.frame") - expect_error(ee_search_dataset() %>% - ee_search_tags("srtm", "flow", "direction", "dem", logical_operator = "ORd") - ) -}) - -test_that("error 04",{ - ee_s_search <- ee_search_dataset() %>% - ee_search_title("srtm", "flow", "direction", "dem", logical_operator = "OR") - expect_s3_class(ee_s_search,"data.frame") - expect_error(ee_search_dataset() %>% - ee_search_title("srtm", "flow", "direction", "dem", - logical_operator = "ORd") - ) -}) - -test_that("error 05", { - expect_error( - ee_search_dataset() %>% - ee_search_tagstitle("srtm", "flow", logical_operator = "ORd") - ) -}) - -test_that("error 05", { - expect_error( - ee_search_dataset() %>% - ee_search_tagstitle("srtm", "flow", logical_operator = "ORd") - ) -}) - -test_that("ee_search_display", { - ss <- ee_search_dataset() %>% - ee_search_tagstitle("srtm", "flow", logical_operator = "OR") %>% - ee_search_display(maxdisplay = 1) - expect_equal(ss, TRUE) -}) - diff --git a/tests/testthat/test-thumbnail.R b/tests/testthat/test-thumbnail.R old mode 100644 new mode 100755 diff --git a/tests/testthat/test-upload.R b/tests/testthat/test-upload.R old mode 100644 new mode 100755 diff --git a/vignettes/.gitignore b/vignettes/.gitignore old mode 100644 new mode 100755 diff --git a/vignettes/BestPractices.Rmd b/vignettes/BestPractices.Rmd old mode 100644 new mode 100755 diff --git a/vignettes/BestPractices.md b/vignettes/BestPractices.md old mode 100644 new mode 100755 diff --git a/vignettes/considerations.Rmd b/vignettes/considerations.Rmd old mode 100644 new mode 100755 diff --git a/vignettes/considerations.md b/vignettes/considerations.md old mode 100644 new mode 100755 diff --git a/vignettes/setup.md b/vignettes/setup.md old mode 100644 new mode 100755 diff --git a/vignettes/thumb_down.png b/vignettes/thumb_down.png old mode 100644 new mode 100755 diff --git a/vignettes/thumb_up.png b/vignettes/thumb_up.png old mode 100644 new mode 100755