├── .github ├── .gitignore └── workflows │ ├── test-coverage.yaml │ └── R-CMD-check.yaml ├── vignettes ├── .gitignore ├── aa-tidyverbs.Rmd ├── ac-summarise-purrring.Rmd └── ab-tidyee-class-framework.Rmd ├── LICENSE ├── data └── bgd_msna.rda ├── .gitignore ├── .Rbuildignore ├── NEWS.md ├── R ├── archive │ ├── summarise_ic_old.R │ ├── zzz.R │ ├── group_by_ic_old.R │ ├── filter_imageCollection_old.R │ └── ee_extract.R ├── ungroup.R ├── as_ee.R ├── print.R ├── bind.R ├── mutate.R ├── bgd_msna.R ├── add_date_to_bandname.R ├── slice.R ├── set_idx.R ├── group_by.R ├── filter.R ├── select.R ├── filter-helpers.R ├── as_tidyee.R ├── group_split.R ├── inner_join.R ├── mutate_extra.R ├── ee_temporal_filters.R ├── filter_bounds.R ├── summarise.R ├── clip.R ├── utils.R ├── ee_extract_tidy.R └── ee_temporal_composites.R ├── man ├── ic_list_to_ic.Rd ├── print.tidyee.Rd ├── add_date_to_bandname.Rd ├── ungroup.Rd ├── rename_stdDev_bands.Rd ├── create_tidyee.Rd ├── ee_month_filter.Rd ├── ee_year_filter.Rd ├── ee_year_month_filter.Rd ├── as_ee.Rd ├── bind_ics.Rd ├── ee_composite.Rd ├── set_idx.Rd ├── mutate.Rd ├── inner_join.Rd ├── as_tidyee.Rd ├── select.Rd ├── ee_month_composite.Rd ├── ee_year_composite.Rd ├── slice.Rd ├── filter.Rd ├── group_split.Rd ├── ee_year_month_composite.Rd ├── bgd_msna.Rd ├── group_by.Rd ├── summarise.Rd ├── filter_bounds.Rd ├── ee_extract_tidy.Rd └── clip.Rd ├── tests ├── testthat │ ├── test-as_ee.R │ ├── test-year_month_composite.R │ ├── test-tidyee.R │ ├── test-summarise.R │ ├── test-group_by.R │ ├── test-filter.R │ └── test-filters.R └── testthat.R ├── tidyrgee.Rproj ├── inst └── WORDLIST ├── LICENSE.md ├── DESCRIPTION ├── dev_history.R ├── NAMESPACE ├── cran-comments.md ├── README.Rmd └── README.md /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /vignettes/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | *.R 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2022 2 | COPYRIGHT HOLDER: tidyrgee authors 3 | -------------------------------------------------------------------------------- /data/bgd_msna.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-tidy-remote-sensing/tidyrgee/HEAD/data/bgd_msna.rda -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | data/dat.rda 6 | inst/doc 7 | /doc/ 8 | /Meta/ 9 | reprex/* 10 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^tidyrgee\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^README\.Rmd$ 4 | ^\.github$ 5 | ^dev_history\.R$ 6 | ^LICENSE\.md$ 7 | ^doc$ 8 | ^Meta$ 9 | ^vignettes/aa-tidyverbs\.Rmd$ 10 | ^R/archive$ 11 | ^R/mutate_extra.R$ 12 | ^vignettes$ 13 | ^vignettes/* 14 | v 15 | ^reprex$ 16 | ^cran-comments\.md$ 17 | ^\.covrignore$ 18 | ^CRAN-SUBMISSION$ 19 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # tidyrgee 0.1.1 2 | 3 | ## Bug fixes 4 | 5 | * Fixed missing package anchor in documentation cross-reference for `dplyr::group_by_drop_default()` in `group_by.Rd` 6 | * Moved `reticulate` from Imports to Suggests, as it is only used in tests 7 | 8 | # tidyrgee 0.1.0 9 | 10 | * Added a `NEWS.md` file to track changes to the package. 11 | 12 | First release 13 | -------------------------------------------------------------------------------- /R/archive/summarise_ic_old.R: -------------------------------------------------------------------------------- 1 | summarise.grouped_imageCol <- function(x,stat,...){ 2 | date_range <- date_range_imageCol(x) 3 | start_year <- lubridate::year(date_range[1]) 4 | end_year <- lubridate::year(date_range[2]) 5 | year <- c(start_year,end_year) 6 | if(attributes(x)$grouped_vars =="year"){ 7 | ee_year_composite(imageCol = x,year = year,stat = stat) 8 | } 9 | } 10 | -------------------------------------------------------------------------------- /man/ic_list_to_ic.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{ic_list_to_ic} 4 | \alias{ic_list_to_ic} 5 | \title{ic_list_to_ic} 6 | \usage{ 7 | ic_list_to_ic(x) 8 | } 9 | \arguments{ 10 | \item{x}{ee list made up of imageCollections} 11 | } 12 | \value{ 13 | imageCollection 14 | } 15 | \description{ 16 | ic_list_to_ic 17 | } 18 | -------------------------------------------------------------------------------- /man/print.tidyee.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/print.R 3 | \name{print.tidyee} 4 | \alias{print.tidyee} 5 | \title{print tidyee} 6 | \usage{ 7 | \method{print}{tidyee}(x, ...) 8 | } 9 | \arguments{ 10 | \item{x}{tidyee object} 11 | 12 | \item{...}{additional arguments} 13 | } 14 | \value{ 15 | printed tidyee object 16 | } 17 | \description{ 18 | print tidyee 19 | } 20 | -------------------------------------------------------------------------------- /man/add_date_to_bandname.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add_date_to_bandname.R 3 | \name{add_date_to_bandname} 4 | \alias{add_date_to_bandname} 5 | \title{add_date_to_band_name} 6 | \usage{ 7 | add_date_to_bandname(x) 8 | } 9 | \arguments{ 10 | \item{x}{ee$ImageCollection or ee$Image} 11 | } 12 | \value{ 13 | a date to band name in x. 14 | } 15 | \description{ 16 | append date to band name 17 | } 18 | -------------------------------------------------------------------------------- /man/ungroup.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ungroup.R 3 | \name{ungroup} 4 | \alias{ungroup} 5 | \title{ungroup} 6 | \arguments{ 7 | \item{x}{tidyee object} 8 | 9 | \item{...}{ungroup args} 10 | } 11 | \value{ 12 | tidyee class object with vrt ungrouped. 13 | } 14 | \description{ 15 | ungroup 16 | } 17 | \seealso{ 18 | \code{\link[dplyr]{ungroup}} for information about ungroup on normal data tables. 19 | } 20 | -------------------------------------------------------------------------------- /man/rename_stdDev_bands.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{rename_stdDev_bands} 4 | \alias{rename_stdDev_bands} 5 | \title{rename_stdDev_bands} 6 | \usage{ 7 | rename_stdDev_bands(x) 8 | } 9 | \arguments{ 10 | \item{x}{ee$ImageCollection} 11 | } 12 | \value{ 13 | x ee$Image/ImageCollection with \verb{.*_stdDev$} bands renamed to \verb{.*_sd$} 14 | } 15 | \description{ 16 | rename_stdDev_bands 17 | } 18 | -------------------------------------------------------------------------------- /man/create_tidyee.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/as_tidyee.R 3 | \name{create_tidyee} 4 | \alias{create_tidyee} 5 | \title{create_tidyee} 6 | \usage{ 7 | create_tidyee(x, vrt) 8 | } 9 | \arguments{ 10 | \item{x}{ee$ImageCollection} 11 | 12 | \item{vrt}{virtual table} 13 | } 14 | \value{ 15 | tidyee class list object 16 | } 17 | \description{ 18 | helper function to assign new tidyee when running \code{as_tidyee} 19 | } 20 | -------------------------------------------------------------------------------- /R/ungroup.R: -------------------------------------------------------------------------------- 1 | 2 | #' @export 3 | ungroup.tidyee <- function(x,...){ 4 | vrt <- x$vrt |> 5 | dplyr::ungroup(...) 6 | create_tidyee(x$ee_ob,vrt) 7 | } 8 | #' ungroup 9 | #' @name ungroup 10 | #' @rdname ungroup 11 | #' @param x tidyee object 12 | #' @param ... ungroup args 13 | #' @return tidyee class object with vrt ungrouped. 14 | #' @seealso \code{\link[dplyr]{ungroup}} for information about ungroup on normal data tables. 15 | #' @export 16 | #' @importFrom dplyr ungroup 17 | NULL 18 | -------------------------------------------------------------------------------- /tests/testthat/test-as_ee.R: -------------------------------------------------------------------------------- 1 | skip_if_no_pypkg() 2 | 3 | test_that("getting back ee object", { 4 | 5 | modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 6 | 7 | # create tidyee class 8 | modis_ic_tidy <- as_tidyee(modis_ic) 9 | # convert back to origina ee$ImageCollection class 10 | now_a_ee <- modis_ic_tidy |> 11 | as_ee() 12 | 13 | expect_equal(class(now_a_ee)[1], 'ee.imagecollection.ImageCollection') 14 | 15 | now_a_ee_image <- now_a_ee$mean() 16 | 17 | expect_equal(class(now_a_ee_image)[1], 'ee.image.Image') 18 | 19 | }) 20 | -------------------------------------------------------------------------------- /man/ee_month_filter.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ee_temporal_filters.R 3 | \name{ee_month_filter} 4 | \alias{ee_month_filter} 5 | \title{ee_month_filter} 6 | \usage{ 7 | ee_month_filter(imageCol, month, ...) 8 | } 9 | \arguments{ 10 | \item{imageCol}{ee$ImageCollection} 11 | 12 | \item{month}{\code{numeric} vector containing month values (1-12)} 13 | 14 | \item{...}{other arguments} 15 | } 16 | \value{ 17 | ee$ImageCollection or ee$Image filtered by month 18 | } 19 | \description{ 20 | ee_month_filter 21 | } 22 | -------------------------------------------------------------------------------- /man/ee_year_filter.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ee_temporal_filters.R 3 | \name{ee_year_filter} 4 | \alias{ee_year_filter} 5 | \title{ee_year_filter} 6 | \usage{ 7 | ee_year_filter(imageCol, year, ...) 8 | } 9 | \arguments{ 10 | \item{imageCol}{ee$ImageCollection} 11 | 12 | \item{year}{\code{numeric} vector containing years (i.e c(2001,2002,2003))} 13 | 14 | \item{...}{other arguments} 15 | } 16 | \value{ 17 | ee$ImageCollection or ee$Image filtered by year 18 | } 19 | \description{ 20 | ee_year_filter 21 | } 22 | -------------------------------------------------------------------------------- /R/archive/zzz.R: -------------------------------------------------------------------------------- 1 | .onAttach <- function(libname, pkgname) { 2 | options(rgee.print.option = "simply") 3 | } 4 | 5 | .onLoad <- function(libname, pkgname) { 6 | # # if EARTHENGINE_PYTHON is defined then forward it to RETICULATE_PYTHON 7 | # earthengine_python <- Sys.getenv("EARTHENGINE_PYTHON", unset = NA) 8 | # if (!is.na(earthengine_python)) 9 | # Sys.setenv(RETICULATE_PYTHON = earthengine_python) 10 | 11 | # delay load earthengine-api 12 | # ee <<- reticulate::import("ee", delay_load = TRUE) 13 | #ee <<- reticulate::import("ee", delay_load = list(priority = 30)) 14 | library(rgee) 15 | 16 | } 17 | -------------------------------------------------------------------------------- /R/as_ee.R: -------------------------------------------------------------------------------- 1 | #' @title as_ee tidyee to ee$ImageCollection or ee$Image 2 | #' 3 | #' @param x tidyee 4 | #' 5 | #' @return ee$ImageCollection or ee$Image 6 | #' @export 7 | #' 8 | #' @examples \dontrun{ 9 | #' library(rgee) 10 | #' library(tidyrgee) 11 | #' 12 | #' modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 13 | #' 14 | #' # create tidyee class 15 | #' modis_ic_tidy <- as_tidyee(modis_ic) 16 | #' # convert back to origina ee$ImageCollection class 17 | #' modis_ic_tidy |> 18 | #' as_ee() 19 | #' } 20 | as_ee <- function(x) { 21 | UseMethod("as_ee") 22 | } 23 | 24 | 25 | #' @export 26 | as_ee.tidyee <- function(x) { 27 | x$ee_ob 28 | } 29 | -------------------------------------------------------------------------------- /R/archive/group_by_ic_old.R: -------------------------------------------------------------------------------- 1 | group_by.ee.imagecollection.ImageCollection <- function(x,...){ 2 | 3 | new_groups <- rlang::enquos(..., .ignore_empty = "all") 4 | 5 | class(x) <- c("grouped_imageCol", class(x)) 6 | new_groups_list <- new_groups |> purrr::map(~rlang::quo_get_expr(.x)) 7 | new_groups_chr <- as.character(unlist(new_groups_list)) 8 | 9 | assertthat::assert_that(new_groups_chr %in% c("year","month") , 10 | msg = "so far can only group by year, month, or both") 11 | cat(glue::glue("returning imageCol grouped by {new_groups_chr}\n")) 12 | attr(x,"grouped_vars") <- new_groups_chr 13 | return(x) 14 | 15 | } 16 | 17 | -------------------------------------------------------------------------------- /man/ee_year_month_filter.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ee_temporal_filters.R 3 | \name{ee_year_month_filter} 4 | \alias{ee_year_month_filter} 5 | \title{ee_year_month_filter} 6 | \usage{ 7 | ee_year_month_filter(imageCol, year, month, ...) 8 | } 9 | \arguments{ 10 | \item{imageCol}{ee$ImageCollection} 11 | 12 | \item{year}{\code{numeric} vector contain years to filter} 13 | 14 | \item{month}{\code{numeric} vector contain months to filter} 15 | 16 | \item{...}{other arguments} 17 | } 18 | \value{ 19 | ee$ImageCollection or ee$Image filtered by year & month 20 | } 21 | \description{ 22 | ee_year_month_filter 23 | } 24 | -------------------------------------------------------------------------------- /tidyrgee.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | ProjectId: 3f836b0f-9f8b-449d-b53a-c79d80d95257 3 | 4 | RestoreWorkspace: No 5 | SaveWorkspace: No 6 | AlwaysSaveHistory: Default 7 | 8 | EnableCodeIndexing: Yes 9 | UseSpacesForTab: Yes 10 | NumSpacesForTab: 2 11 | Encoding: UTF-8 12 | 13 | RnwWeave: Sweave 14 | LaTeX: pdfLaTeX 15 | 16 | AutoAppendNewline: Yes 17 | StripTrailingWhitespace: Yes 18 | LineEndingConversion: Posix 19 | 20 | BuildType: Package 21 | PackageUseDevtools: Yes 22 | PackageInstallArgs: --no-multiarch --with-keep.source 23 | PackageBuildArgs: --no-build-vignettes 24 | PackageBuildBinaryArgs: --no-build-vignettes 25 | PackageCheckArgs: --no-build-vignettes 26 | PackageRoxygenize: rd,collate,namespace 27 | -------------------------------------------------------------------------------- /man/as_ee.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/as_ee.R 3 | \name{as_ee} 4 | \alias{as_ee} 5 | \title{as_ee tidyee to ee$ImageCollection or ee$Image} 6 | \usage{ 7 | as_ee(x) 8 | } 9 | \arguments{ 10 | \item{x}{tidyee} 11 | } 12 | \value{ 13 | ee$ImageCollection or ee$Image 14 | } 15 | \description{ 16 | as_ee tidyee to ee$ImageCollection or ee$Image 17 | } 18 | \examples{ 19 | \dontrun{ 20 | library(rgee) 21 | library(tidyrgee) 22 | 23 | modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 24 | 25 | # create tidyee class 26 | modis_ic_tidy <- as_tidyee(modis_ic) 27 | # convert back to origina ee$ImageCollection class 28 | modis_ic_tidy |> 29 | as_ee() 30 | } 31 | } 32 | -------------------------------------------------------------------------------- /man/bind_ics.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bind.R 3 | \name{bind_ics} 4 | \alias{bind_ics} 5 | \title{bind ImageCollections} 6 | \usage{ 7 | bind_ics(x) 8 | } 9 | \arguments{ 10 | \item{x}{list of tidyee objects} 11 | } 12 | \value{ 13 | tidyee object containing single image collection and vrt 14 | } 15 | \description{ 16 | bind ImageCollections 17 | } 18 | \examples{ 19 | \dontrun{ 20 | library(tidyrgee) 21 | library(rgee) 22 | ee_Initialize() 23 | modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 24 | modis_ic_tidy <- as_tidyee(modis_ic) 25 | modis_tidy_list <- modis_tidy |> 26 | group_split(month) 27 | modis_tidy_list |> 28 | bind_ics() 29 | } 30 | 31 | } 32 | -------------------------------------------------------------------------------- /inst/WORDLIST: -------------------------------------------------------------------------------- 1 | CMD 2 | DayOfYear 3 | DetailedQA 4 | EVI 5 | FeatureCollection 6 | FeatureCollections 7 | HH 8 | ImageCollection 9 | ImageCollections 10 | Javascript 11 | Lifecycle 12 | MODIS 13 | MSNA 14 | NDVI 15 | NSE 16 | RelativeAzimuth 17 | SolarZenith 18 | SummaryQA 19 | ViewZenith 20 | anonymized 21 | args 22 | calendarRange 23 | codecov 24 | dat 25 | doy 26 | dplyr 27 | dplyr's 28 | dplyresque 29 | ee 30 | filterBounds 31 | fromImages 32 | fromYMD 33 | gcs 34 | getInfo 35 | interpretable 36 | millis 37 | modis 38 | ndvi 39 | purrring 40 | pyfunc 41 | rgee 42 | rlang's 43 | sd 44 | stdDev 45 | str 46 | summarise 47 | summarised 48 | summarising 49 | tidyee 50 | tidyverbs 51 | tidyverse 52 | ungroup 53 | ungrouped 54 | vrt 55 | -------------------------------------------------------------------------------- /R/print.R: -------------------------------------------------------------------------------- 1 | 2 | #' print tidyee 3 | #' 4 | #' @param x tidyee object 5 | #' @param ... additional arguments 6 | #' @return printed tidyee object 7 | #' @export 8 | 9 | # print <- function(x){ 10 | # UseMethod("print") 11 | # } 12 | 13 | 14 | print.tidyee <- function(x,...){ 15 | band_names <- vrt_band_names(x) 16 | cat(crayon::green("band names: [",glue::glue_collapse(band_names,sep = ", "),"]","\n\n")) 17 | NextMethod() 18 | } 19 | 20 | 21 | # print.tidyee <- function(x){ 22 | # cat(crayon::green("band names: [",glue::glue_collapse(attributes(x$vrt)$band_names,sep = ", "),"]","\n\n")) 23 | # if(inherits(x$vrt,"tbl_df")){ 24 | # NextMethod() 25 | # }else{ 26 | # printme <- x$vrt[1:10,] 27 | # print.data.frame(printme) 28 | # } 29 | # invisible(x$vrt) 30 | # } 31 | 32 | 33 | -------------------------------------------------------------------------------- /man/ee_composite.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ee_temporal_composites.R 3 | \name{ee_composite} 4 | \alias{ee_composite} 5 | \alias{ee_composite.tidyee} 6 | \title{ee_composite} 7 | \usage{ 8 | ee_composite(x, ...) 9 | 10 | \method{ee_composite}{tidyee}(x, stat, ...) 11 | } 12 | \arguments{ 13 | \item{x}{tidyee object containing \code{ee$ImageCollection}} 14 | 15 | \item{...}{other arguments} 16 | 17 | \item{stat}{A \code{character} indicating what to reduce the ImageCollection by, 18 | e.g. 'median' (default), 'mean', 'max', 'min', 'sum', 'sd', 'first'.} 19 | } 20 | \value{ 21 | tidyee class containing \code{ee$Image} where all images within \code{ee$ImageCollection} have been aggregated based on pixel-level stats 22 | } 23 | \description{ 24 | ee_composite 25 | } 26 | -------------------------------------------------------------------------------- /man/set_idx.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/set_idx.R 3 | \name{set_idx} 4 | \alias{set_idx} 5 | \title{set_idx} 6 | \usage{ 7 | set_idx(x, idx_name = "tidyee_index") 8 | } 9 | \arguments{ 10 | \item{x}{tidyee or \code{ee$ImageCollection} class object} 11 | 12 | \item{idx_name}{name for index to create (default = "tidyee_index")} 13 | } 14 | \value{ 15 | tidyee or \code{ee$ImageCollection} class object with new index containing sequential 0-based indexing 16 | } 17 | \description{ 18 | set_idx 19 | } 20 | \examples{ 21 | \dontrun{ 22 | library(rgee) 23 | library(tidyrgee) 24 | ee_Initialize() 25 | modis_link <- "MODIS/006/MOD13Q1" 26 | modisIC <- ee$ImageCollection(modis_link) 27 | modis_ndvi_tidy <- as_tidyee(modisIC) |> 28 | select("NDVI") 29 | modis_ndvi_tidy |> 30 | 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/master/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: test-coverage 10 | 11 | jobs: 12 | test-coverage: 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | 17 | steps: 18 | - uses: actions/checkout@v4 19 | 20 | - uses: r-lib/actions/setup-r@v2 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v2 25 | with: 26 | extra-packages: covr 27 | 28 | - name: Test coverage 29 | run: covr::codecov() 30 | shell: Rscript {0} 31 | -------------------------------------------------------------------------------- /man/mutate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mutate.R 3 | \name{mutate} 4 | \alias{mutate} 5 | \title{mutate columns into tidyee vrt which can later be used to modify tidyee ImageCollection} 6 | \arguments{ 7 | \item{.data}{tidyee class object (list of ee_ob, vrt)} 8 | 9 | \item{...}{mutate arguments} 10 | } 11 | \value{ 12 | return tidyee class object with vrt data.frame mutated. 13 | } 14 | \description{ 15 | mutate columns into tidyee vrt which can later be used to modify tidyee ImageCollection 16 | } 17 | \examples{ 18 | \dontrun{ 19 | library(tidyrgee) 20 | library(rgee) 21 | ee_Initialize() 22 | modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 23 | modis_ic_tidy <- as_tidyee(modis_ic) 24 | } 25 | } 26 | \seealso{ 27 | \code{\link[dplyr]{mutate}} for information about mutate on normal data tables. 28 | } 29 | -------------------------------------------------------------------------------- /man/inner_join.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/inner_join.R 3 | \name{inner_join} 4 | \alias{inner_join} 5 | \title{inner_join bands from different image/ImageCollections based on shared property} 6 | \arguments{ 7 | \item{x, y}{A pair of tidyee objects containing ee$ImageCollections} 8 | 9 | \item{by}{A character vector of variables to join by.} 10 | } 11 | \value{ 12 | An object of the same type as \code{x}. The output has the following properties: 13 | Same number of images as \code{x} 14 | Total number of bands equal the number of bands in \code{x} plus the number of bands in \code{y} 15 | } 16 | \description{ 17 | inner_join bands from different image/ImageCollections based on shared property 18 | } 19 | \seealso{ 20 | \code{\link[dplyr]{inner_join}} for information about inner_join on normal data tables. 21 | } 22 | -------------------------------------------------------------------------------- /R/bind.R: -------------------------------------------------------------------------------- 1 | 2 | #' bind ImageCollections 3 | #' 4 | #' @param x list of tidyee objects 5 | #' @return tidyee object containing single image collection and vrt 6 | #' @export 7 | #' 8 | #' @examples \dontrun{ 9 | #' library(tidyrgee) 10 | #' library(rgee) 11 | #' ee_Initialize() 12 | #' modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 13 | #' modis_ic_tidy <- as_tidyee(modis_ic) 14 | #' modis_tidy_list <- modis_tidy |> 15 | #' group_split(month) 16 | #' modis_tidy_list |> 17 | #' bind_ics() 18 | #' } 19 | #' 20 | 21 | bind_ics <- function(x){ 22 | ic_only <- x |> 23 | purrr::map(~.x$ee_ob) 24 | vrt_only <- x |> 25 | purrr::map(~.x$vrt) 26 | 27 | vrt_together<- dplyr::bind_rows(vrt_only) 28 | ic_container = ee$ImageCollection(list()) 29 | 30 | for(i in 1:length(ic_only)){ 31 | ic_container=ic_container$merge(ic_only[[i]]) 32 | 33 | } 34 | 35 | 36 | create_tidyee(x = ic_container$sort(prop = "system:time_start"),vrt = vrt_together ) 37 | 38 | 39 | } 40 | 41 | 42 | 43 | -------------------------------------------------------------------------------- /man/as_tidyee.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/as_tidyee.R 3 | \name{as_tidyee} 4 | \alias{as_tidyee} 5 | \title{as_tidy_ee} 6 | \usage{ 7 | as_tidyee(x, time_end = FALSE) 8 | } 9 | \arguments{ 10 | \item{x}{ee$Image or ee$ImageCollection} 11 | 12 | \item{time_end}{\code{logical} include time_end ("system:time_end") in vrt (default=F)} 13 | } 14 | \value{ 15 | tidyee class object which contains a list with two components ("x","vrt") 16 | } 17 | \description{ 18 | The function returns a list containing the original object (Image/ImageCollection)as well 19 | as a "virtual data.frame (vrt)" which is a data.frame holding key properties of the 20 | ee$Image/ee$ImageCollection. The returned list has been assigned a new class "tidyee". 21 | } 22 | \examples{ 23 | \dontrun{ 24 | library(tidyrgee) 25 | library(rgee) 26 | ee_Initialize() 27 | modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 28 | modis_ic_tidy <- as_tidyee(modis_ic) 29 | 30 | 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /man/select.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/select.R 3 | \name{select} 4 | \alias{select} 5 | \title{Select bands from ee$Image or ee$ImageCollection} 6 | \arguments{ 7 | \item{.data}{tidyee class object containing ee$ImageCollection or ee$Image} 8 | 9 | \item{...}{one or more quoted or unquoted expressions separated by commas.} 10 | } 11 | \value{ 12 | tidyee class object with specified (...) bands selected 13 | } 14 | \description{ 15 | Select bands from ee$Image or ee$ImageCollection 16 | } 17 | \examples{ 18 | \dontrun{ 19 | library(tidyrgee) 20 | ee_Initialize() 21 | modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 22 | modis_ic_tidy <- as_tidyee(modis_ic) 23 | 24 | # select NDVI band 25 | modis_ndvi <- modis_ic_tidy |> 26 | select("NDVI") 27 | 28 | # select NDVI band, but change band to new name 29 | modis_ndvi_renamed <- modis_ic_tidy |> 30 | select(ndvi_new= "NDVI") 31 | 32 | 33 | } 34 | } 35 | \seealso{ 36 | \code{\link[dplyr]{select}} for information about select on normal data tables. 37 | } 38 | -------------------------------------------------------------------------------- /man/ee_month_composite.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ee_temporal_composites.R 3 | \name{ee_month_composite} 4 | \alias{ee_month_composite} 5 | \alias{ee_month_composite.ee.imagecollection.ImageCollection} 6 | \alias{ee_month_composite.tidyee} 7 | \title{Pixel-level composite by month} 8 | \usage{ 9 | ee_month_composite(x, ...) 10 | 11 | \method{ee_month_composite}{ee.imagecollection.ImageCollection}(x, stat, months, ...) 12 | 13 | \method{ee_month_composite}{tidyee}(x, stat, ...) 14 | } 15 | \arguments{ 16 | \item{x}{An earth engine ImageCollection or tidyee class.} 17 | 18 | \item{...}{extra args to pass on} 19 | 20 | \item{stat}{A \code{character} indicating what to reduce the ImageCollection by, 21 | e.g. 'median' (default), 'mean', 'max', 'min', 'sum', 'sd', 'first'.} 22 | 23 | \item{months}{A vector of months, e.g. c(1, 12).} 24 | } 25 | \value{ 26 | tidyee class containing \code{ee$Image} or \code{ee$ImageCollection} with pixels aggregated by month 27 | } 28 | \description{ 29 | Pixel-level composite by month 30 | } 31 | -------------------------------------------------------------------------------- /man/ee_year_composite.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ee_temporal_composites.R 3 | \name{ee_year_composite} 4 | \alias{ee_year_composite} 5 | \alias{ee_year_composite.ee.imagecollection.ImageCollection} 6 | \alias{ee_year_composite.tidyee} 7 | \title{Pixel level composite by year} 8 | \usage{ 9 | ee_year_composite(x, ...) 10 | 11 | \method{ee_year_composite}{ee.imagecollection.ImageCollection}(x, stat, year, ...) 12 | 13 | \method{ee_year_composite}{tidyee}(x, stat, ...) 14 | } 15 | \arguments{ 16 | \item{x}{An earth engine ImageCollection or tidyee class.} 17 | 18 | \item{...}{other arguments} 19 | 20 | \item{stat}{A \code{character} indicating what to reduce the ImageCollection by, 21 | e.g. 'median' (default), 'mean', 'max', 'min', 'sum', 'sd', 'first'.} 22 | 23 | \item{year}{\code{numeric} vector containing years (i.e c(2001,2002,2003))} 24 | } 25 | \value{ 26 | tidyee class containing \code{ee$Image} or \code{ee$ImageCollection} with pixels aggregated by year 27 | } 28 | \description{ 29 | Pixel level composite by year 30 | } 31 | -------------------------------------------------------------------------------- /man/slice.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/slice.R 3 | \name{slice} 4 | \alias{slice} 5 | \title{slice ee$ImageCollections or tidyee objects that contain imageCollections} 6 | \arguments{ 7 | \item{.data}{ImageCollection or tidyee class object} 8 | 9 | \item{...}{other arguments} 10 | } 11 | \value{ 12 | sliced/filtered image or imageCollection form filtered imageCollection 13 | } 14 | \description{ 15 | slice ee$ImageCollections or tidyee objects that contain imageCollections 16 | } 17 | \examples{ 18 | \dontrun{ 19 | 20 | library(rgee) 21 | library(tidyrgee) 22 | ee_Initialize() 23 | l8 = ee$ImageCollection('LANDSAT/LC08/C01/T1_SR') 24 | l8 |> 25 | filter(date>"2016-01-01",date<"2016-03-04") 26 | 27 | 28 | # example with tidyee ckass 29 | modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 30 | modis_ic_tidy <- as_tidyee(modis_ic) 31 | 32 | # filter by month 33 | modis_march_april <- modis_ic_tidy |> 34 | filter(month \%in\% c(3,4)) 35 | } 36 | } 37 | \seealso{ 38 | \code{\link[dplyr]{slice}} for information about slice on normal data tables. 39 | } 40 | -------------------------------------------------------------------------------- /man/filter.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/filter.R 3 | \name{filter} 4 | \alias{filter} 5 | \title{filter ee$ImageCollections or tidyee objects that contain imageCollections} 6 | \arguments{ 7 | \item{.data}{ImageCollection or tidyee class object} 8 | 9 | \item{...}{other arguments} 10 | } 11 | \value{ 12 | filtered image or imageCollection form filtered imageCollection 13 | } 14 | \description{ 15 | filter ee$ImageCollections or tidyee objects that contain imageCollections 16 | } 17 | \examples{ 18 | \dontrun{ 19 | 20 | library(rgee) 21 | library(tidyrgee) 22 | ee_Initialize() 23 | l8 = ee$ImageCollection('LANDSAT/LC08/C01/T1_SR') 24 | l8 |> 25 | filter(date>"2016-01-01",date<"2016-03-04") 26 | 27 | 28 | # example with tidyee ckass 29 | modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 30 | modis_ic_tidy <- as_tidyee(modis_ic) 31 | 32 | # filter by month 33 | modis_march_april <- modis_ic_tidy |> 34 | filter(month \%in\% c(3,4)) 35 | } 36 | } 37 | \seealso{ 38 | \code{\link[dplyr]{filter}} for information about filter on normal data tables. 39 | } 40 | -------------------------------------------------------------------------------- /tests/testthat/test-year_month_composite.R: -------------------------------------------------------------------------------- 1 | skip_if_no_pypkg() 2 | test_that("year_month_composite; issue #28", { 3 | 4 | geom <- ee$Geometry$Polygon(list( 5 | c(44.2354847930793, 34.83077069846819), 6 | c(44.261577322376176, 34.692001577255105), 7 | c(44.40851946104805, 34.511140220037795), 8 | c(44.607646658313676, 34.47152432533435), 9 | c(44.687297537219926, 34.58918498051208), 10 | c(44.5211293243293, 34.75069665768057), 11 | c(44.393413259876176, 34.810477595189816), 12 | c(44.28217668761055, 34.88598770009403), 13 | c(44.223125173938676, 34.84316957807562) 14 | )) 15 | 16 | l8_ic <- ee$ImageCollection('LANDSAT/LC08/C02/T1_L2')$ 17 | filterDate("2013-01-01","2022-12-31")$ 18 | filterBounds(geom)$ 19 | filter(ee$Filter$lt('CLOUD_COVER', 25)) 20 | 21 | l8_ic_tidy <- as_tidyee(l8_ic) 22 | 23 | 24 | l8_median_compsites <- l8_ic_tidy |> 25 | group_by(year, month) |> 26 | summarise( 27 | stat="median" 28 | ) 29 | 30 | # this is not good they should be the same 31 | expect_equal(l8_median_compsites$ee_ob$size()$getInfo(),l8_median_compsites$vrt|> nrow()) 32 | 33 | }) 34 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2022 tidyrgee authors 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /R/mutate.R: -------------------------------------------------------------------------------- 1 | #' @export 2 | mutate.tidyee <- function(.data, 3 | ... 4 | ){ 5 | vrt <- .data$vrt |> 6 | dplyr::mutate(...) 7 | create_tidyee(.data$ee_ob,vrt) 8 | } 9 | 10 | 11 | #' @export 12 | mutate.ee.imagecollection.ImageCollection <- function(.data,...){ 13 | stopifnot(!is.null(.data), inherits(.data, "ee.imagecollection.ImageCollection")) 14 | convert_to_tidyee_warning() 15 | x_tidy <- as_tidyee(.data) 16 | x_tidy |> 17 | mutate(...) 18 | } 19 | 20 | #' mutate columns into tidyee vrt which can later be used to modify tidyee ImageCollection 21 | #' @name mutate 22 | #' @rdname mutate 23 | #' @param .data tidyee class object (list of ee_ob, vrt) 24 | #' @param ... mutate arguments 25 | #' @return return tidyee class object with vrt data.frame mutated. 26 | #' @examples \dontrun{ 27 | #'library(tidyrgee) 28 | #' library(rgee) 29 | #' ee_Initialize() 30 | #' modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 31 | #' modis_ic_tidy <- as_tidyee(modis_ic) 32 | #'} 33 | 34 | #' @seealso \code{\link[dplyr]{mutate}} for information about mutate on normal data tables. 35 | #' @export 36 | #' @importFrom dplyr mutate 37 | NULL 38 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: tidyrgee 2 | Title: 'tidyverse' Methods for 'Earth Engine' 3 | Version: 0.1.1 4 | Authors@R: c( 5 | person("Zack", "Arno", , "zackarno@gmail.com", role = c("aut", "cre", "cph")), 6 | person("Josh", "Erickson", , "joshualerickson@gmail.com", role = c("aut", "cph")) 7 | ) 8 | Description: Provides 'tidyverse' methods for wrangling 9 | and analyzing 'Earth Engine' data. These methods help the user with filtering, 10 | joining and summarising 'Earth Engine' image collections. 11 | License: MIT + file LICENSE 12 | URL: https://github.com/r-tidy-remote-sensing/tidyrgee 13 | BugReports: https://github.com/r-tidy-remote-sensing/tidyrgee/issues/ 14 | Depends: 15 | R (>= 4.1) 16 | Imports: 17 | assertthat, 18 | crayon, 19 | dplyr, 20 | glue, 21 | lubridate, 22 | purrr, 23 | readr, 24 | rgee, 25 | rlang, 26 | sf, 27 | stringr, 28 | tidyr 29 | Suggests: 30 | knitr, 31 | reticulate, 32 | rmarkdown, 33 | tibble, 34 | testthat (>= 3.0.0) 35 | Config/testthat/edition: 3 36 | Encoding: UTF-8 37 | LazyData: true 38 | Roxygen: list(markdown = TRUE) 39 | RoxygenNote: 7.3.1 40 | -------------------------------------------------------------------------------- /dev_history.R: -------------------------------------------------------------------------------- 1 | 2 | # Document functions and dependencies 3 | attachment::att_to_description() 4 | attachment::att_amend_desc() 5 | 6 | # Check the package 7 | devtools::check() 8 | 9 | # Run Tests 10 | library(testthat) 11 | library(tidyrgee) 12 | library(rgee) 13 | ee_Initialize() 14 | 15 | test_local() 16 | 17 | # Add this file 'dev_history.R' to ignore 18 | usethis::use_build_ignore("dev_history.R") 19 | 20 | # data set is a 2019 host community Multi-Sectoral Needs Assessment from Bangladesh. 21 | # All coordinate have been pre-processed with `st_jitter` 22 | # df <- read_csv("xxxxx") 23 | 24 | bgd_msna <- df |> 25 | select(`_uuid`,lon = `_gps_reading_longitude`,lat= `_gps_reading_latitude`,informed_consent,survey_date, end_survey,electricity_grid, 26 | solar_light,illness_HH_count,`cooking_fuel/collected_firewood`, 27 | `income_source/agricultural_production_sale` , 28 | agricultural_land , 29 | `employment_source/agricultural_casual`, 30 | `employment_source/non_agricultural_casual`, 31 | `employment_source/fishing` ) |> 32 | filter(informed_consent=="yes") 33 | usethis::use_data(bgd_msna,overwrite=T) 34 | # usethis::use_git_ignore("data/dat.rda") 35 | # usethis::use_mit_license() 36 | -------------------------------------------------------------------------------- /man/group_split.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/group_split.R 3 | \name{group_split} 4 | \alias{group_split} 5 | \title{filter ee$ImageCollections or tidyee objects that contain imageCollections} 6 | \arguments{ 7 | \item{.tbl}{ImageCollection or tidyee class object} 8 | 9 | \item{...}{other arguments} 10 | 11 | \item{return_tidyee}{\code{logical} return tidyee object(default =T), if FALSE - only return ee$ImageCollection} 12 | } 13 | \value{ 14 | filtered image or imageCollection form filtered imageCollection 15 | } 16 | \description{ 17 | filter ee$ImageCollections or tidyee objects that contain imageCollections 18 | } 19 | \examples{ 20 | \dontrun{ 21 | 22 | library(rgee) 23 | library(tidyrgee) 24 | ee_Initialize() 25 | l8 = ee$ImageCollection('LANDSAT/LC08/C01/T1_SR') 26 | l8 |> 27 | filter(date>"2016-01-01",date<"2016-03-04") 28 | 29 | 30 | # example with tidyee ckass 31 | modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 32 | modis_ic_tidy <- as_tidyee(modis_ic) 33 | 34 | # filter by month 35 | modis_march_april <- modis_ic_tidy |> 36 | filter(month \%in\% c(3,4)) 37 | } 38 | } 39 | \seealso{ 40 | \code{\link[dplyr]{group_split}} for information about filter on normal data tables. 41 | } 42 | -------------------------------------------------------------------------------- /man/ee_year_month_composite.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ee_temporal_composites.R 3 | \name{ee_year_month_composite} 4 | \alias{ee_year_month_composite} 5 | \alias{ee_year_month_composite.ee.imagecollection.ImageCollection} 6 | \alias{ee_year_month_composite.tidyee} 7 | \title{Pixel-level composite by year and month} 8 | \usage{ 9 | ee_year_month_composite(x, ...) 10 | 11 | \method{ee_year_month_composite}{ee.imagecollection.ImageCollection}(x, stat, startDate, endDate, months, ...) 12 | 13 | \method{ee_year_month_composite}{tidyee}(x, stat, ...) 14 | } 15 | \arguments{ 16 | \item{x}{An earth engine ImageCollection or tidyee class.} 17 | 18 | \item{...}{args to pass on.} 19 | 20 | \item{stat}{A \code{character} indicating what to reduce the ImageCollection by, 21 | e.g. 'median' (default), 'mean', 'max', 'min', 'sum', 'sd', 'first'.} 22 | 23 | \item{startDate}{\code{character} format date, e.g. "2018-10-23".} 24 | 25 | \item{endDate}{\code{character} format date, e.g. "2018-10-23".} 26 | 27 | \item{months}{\code{numeric} vector, e.g. c(1,12).} 28 | } 29 | \value{ 30 | tidyee class containing \code{ee$Image} or \code{ee$ImageCollection} with pixels aggregated by year and month 31 | } 32 | \description{ 33 | Pixel-level composite by year and month 34 | } 35 | -------------------------------------------------------------------------------- /R/bgd_msna.R: -------------------------------------------------------------------------------- 1 | 2 | #' A subset of question responses from the 2019 Host Community MSNA in Bangladesh 3 | #' 4 | #' Data frame of responses with anonymized coordinates 5 | #' 6 | #' @format A data frame with 1374 rows and 15 variables: 7 | #' \describe{ 8 | #' \item{_uuid}{unique identifier} 9 | #' \item{informed_consent}{informed consent} 10 | #' \item{survey_date}{date of survey} 11 | #' \item{end_survey}{date of end of survey} 12 | #' \item{electricity_grid}{question about electricity grid} 13 | #' \item{solar_light}{question about solar light} 14 | #' \item{illness_HH_count}{repeat group calculation on # hh members with illness in past x days} 15 | #' \item{cooking_fuel/collected_firewood}{select multiple response - did HH collect firewood for cooking fuel} 16 | #' \item{income_source/agricultural_production_sale}{income source question - ariculture} 17 | #' \item{agricultural_land}{question on agricultural land} 18 | #' \item{employment_source/agricultural_casual}{employment source - ag} 19 | #' \item{employment_source/non_agricultural_casual}{employment source - non-ag} 20 | #' \item{employment_source/fishing}{employment source - fishing} 21 | #' \item{_gps_reading_longitude}{longitude - jittered/anonymized} 22 | #' \item{_gps_reading_latitude}{latitude - jittered/anonymized} 23 | #' ... 24 | #' } 25 | #' @return data frame 26 | "bgd_msna" 27 | 28 | 29 | -------------------------------------------------------------------------------- /man/bgd_msna.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bgd_msna.R 3 | \docType{data} 4 | \name{bgd_msna} 5 | \alias{bgd_msna} 6 | \title{A subset of question responses from the 2019 Host Community MSNA in Bangladesh} 7 | \format{ 8 | A data frame with 1374 rows and 15 variables: 9 | \describe{ 10 | \item{_uuid}{unique identifier} 11 | \item{informed_consent}{informed consent} 12 | \item{survey_date}{date of survey} 13 | \item{end_survey}{date of end of survey} 14 | \item{electricity_grid}{question about electricity grid} 15 | \item{solar_light}{question about solar light} 16 | \item{illness_HH_count}{repeat group calculation on # hh members with illness in past x days} 17 | \item{cooking_fuel/collected_firewood}{select multiple response - did HH collect firewood for cooking fuel} 18 | \item{income_source/agricultural_production_sale}{income source question - ariculture} 19 | \item{agricultural_land}{question on agricultural land} 20 | \item{employment_source/agricultural_casual}{employment source - ag} 21 | \item{employment_source/non_agricultural_casual}{employment source - non-ag} 22 | \item{employment_source/fishing}{employment source - fishing} 23 | \item{_gps_reading_longitude}{longitude - jittered/anonymized} 24 | \item{_gps_reading_latitude}{latitude - jittered/anonymized} 25 | ... 26 | } 27 | } 28 | \usage{ 29 | bgd_msna 30 | } 31 | \value{ 32 | data frame 33 | } 34 | \description{ 35 | Data frame of responses with anonymized coordinates 36 | } 37 | \keyword{datasets} 38 | -------------------------------------------------------------------------------- /man/group_by.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/group_by.R 3 | \name{group_by} 4 | \alias{group_by} 5 | \title{Group an imageCollection or tidyee object with Imagecollections by a parameter} 6 | \arguments{ 7 | \item{.data}{ee$ImageCollection or tidyee object} 8 | 9 | \item{...}{group_by variables} 10 | 11 | \item{.add}{When \code{FALSE}, the default, \code{group_by()} will 12 | override existing groups. To add to the existing groups, use 13 | \code{.add = TRUE}. 14 | 15 | This argument was previously called \code{add}, but that prevented 16 | creating a new grouping variable called \code{add}, and conflicts with 17 | our naming conventions.} 18 | 19 | \item{.drop}{Drop groups formed by factor levels that don't appear in the 20 | data? The default is \code{TRUE} except when \code{.data} has been previously 21 | grouped with \code{.drop = FALSE}. See \code{\link[dplyr:group_by_drop_default]{dplyr::group_by_drop_default()}} for details.} 22 | } 23 | \value{ 24 | ee$ImageCollection with grouped_vars attribute 25 | } 26 | \description{ 27 | Group an imageCollection or tidyee object with Imagecollections by a parameter 28 | } 29 | \examples{ 30 | \dontrun{ 31 | library(tidyrgee) 32 | ee_Initialize() 33 | modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 34 | modis_ic |> 35 | filter(date>="2016-01-01",date<="2019-12-31") |> 36 | group_by(year) 37 | } 38 | } 39 | \seealso{ 40 | \code{\link[dplyr]{group_by}} for information about group_by on normal data tables. 41 | } 42 | -------------------------------------------------------------------------------- /R/add_date_to_bandname.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | #' add_date_to_band_name 4 | #' @description append date to band name 5 | #' @param x ee$ImageCollection or ee$Image 6 | #' @return a date to band name in x. 7 | #' @export 8 | 9 | add_date_to_bandname <- function(x) { 10 | UseMethod('add_date_to_bandname') 11 | } 12 | 13 | 14 | #' @export 15 | add_date_to_bandname.ee.imagecollection.ImageCollection <- function(x){ 16 | x |> 17 | ee$ImageCollection$map( 18 | function(img){ 19 | # can't use getInfo() in sever-side function 20 | bnames<- img$bandNames() 21 | date <- ee$Date(img$get("system:time_start"))$format('YYYY_MM_dd') 22 | 23 | # since bnames is technically a list rather than a simple string I need to map over it 24 | # this should make it flexible fore when there are more bands I want to rename anyways 25 | bnames_date <- bnames$map( 26 | rgee::ee_utils_pyfunc(function(x){ 27 | ee$String(x)$cat(ee$String("_"))$cat(date) 28 | 29 | }) 30 | ) 31 | img$select(bnames)$rename(bnames_date) 32 | } 33 | 34 | ) 35 | 36 | } 37 | 38 | #' @export 39 | add_date_to_bandname.ee.image.Image <- function(x){ 40 | bnames<- x$bandNames() 41 | date <- ee$Date(x$get("system:time_start"))$format('YYYY_MM_dd') 42 | bnames_date <- bnames$map( 43 | rgee::ee_utils_pyfunc(function(x){ 44 | ee$String(x)$cat(ee$String("_"))$cat(date) 45 | 46 | }) 47 | ) 48 | x$ 49 | select(bnames)$ 50 | rename(bnames_date) 51 | 52 | } 53 | 54 | -------------------------------------------------------------------------------- /R/archive/filter_imageCollection_old.R: -------------------------------------------------------------------------------- 1 | 2 | #' @export 3 | filter.ee.imagecollection.ImageCollection <- function(x,...){ 4 | stopifnot(!is.null(x), inherits(x, "ee.imagecollection.ImageCollection")) 5 | quo_list <- rlang::quos(...) 6 | quo_chr <- as.character(quo_list) |> purrr::map_chr(~trimws(.x)) 7 | 8 | ftype <- filter_type(quo_chr) 9 | if(ftype=="ymd"){ 10 | date_gt <- stringr::str_subset(stringr::str_remove(quo_chr,"~"),"^date+.>") 11 | date_lt <- stringr::str_subset(stringr::str_remove(quo_chr,"~"),"^date+.<") 12 | #split at condition ">",">=", etc 13 | gt_cond_split <- unlist(strsplit(date_gt, "(?=[><=)])", perl = TRUE)) 14 | lt_cond_split <- unlist(strsplit(date_lt, "(?=[><=)])", perl = TRUE)) 15 | # extract specific conditon 16 | lt_cond <- extract_condition(lt_cond_split) 17 | gt_cond <- extract_condition(gt_cond_split) 18 | 19 | # etract date and modify if necessary (i.e if ">" need to +1 to start date) 20 | lt_date <- extract_date(lt_cond_split) 21 | gt_date <- extract_date(gt_cond_split) 22 | 23 | date_range <- c(gt_date,lt_date) 24 | # cat(crayon::green(glue::glue("filtering imageCollection from {gt_date} to {lt_date}")),"\m") 25 | 26 | 27 | 28 | # x$filterDate(ee$Date$fromYMD(gt_date),ee$Date$fromYMD(lt_date)) 29 | x$filterDate(as.character(gt_date),as.character(lt_date)) 30 | } 31 | 32 | # gotta figure these out 33 | # 34 | # if(ftype=="month"){ 35 | # ee_month_filter 36 | # } 37 | # if(ftype=="year"){ 38 | # ee_year_filter 39 | # } 40 | 41 | 42 | } 43 | -------------------------------------------------------------------------------- /man/summarise.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/summarise.R 3 | \name{summarise} 4 | \alias{summarise} 5 | \alias{summarise.ee.imagecollection.ImageCollection} 6 | \alias{summarise.tidyee} 7 | \title{Summary pixel-level stats for ee$ImageCollection or tidyrgee objects with ImageCollections} 8 | \usage{ 9 | \method{summarise}{ee.imagecollection.ImageCollection}(.data, stat, ...) 10 | 11 | \method{summarise}{tidyee}(.data, stat, ..., join_bands = TRUE) 12 | } 13 | \arguments{ 14 | \item{.data}{ee$Image or ee$ImageCollection} 15 | 16 | \item{stat}{\code{character} stat/function to apply} 17 | 18 | \item{...}{other arguments} 19 | 20 | \item{join_bands}{\code{logical} (default= TRUE) if multiple stats selected should bands be joined?} 21 | } 22 | \value{ 23 | ee$Image or ee$ImageCollection where pixels are summarised by group_by and stat 24 | 25 | ee$Image or ee$ImageCollection where pixels are summarised by group_by and stat 26 | 27 | ee$Image or ee$ImageCollection where pixels are summarised by group_by and stat 28 | } 29 | \description{ 30 | Summary pixel-level stats for ee$ImageCollection or tidyrgee objects with ImageCollections 31 | } 32 | \examples{ 33 | \dontrun{ 34 | library(tidyrgee) 35 | library(rgee) 36 | ee_Initialize() 37 | modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 38 | modis_ic |> 39 | filter(date>="2016-01-01",date<="2019-12-31") |> 40 | group_by(year) |> 41 | summarise(stat="max") 42 | } 43 | } 44 | \seealso{ 45 | \code{\link[dplyr]{summarise}} for information about summarise on normal data tables. 46 | } 47 | -------------------------------------------------------------------------------- /R/slice.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | #' @export 4 | slice.tidyee <- function(.data,...){ 5 | .data <- .data |> set_idx() 6 | vrt <- .data$vrt |> 7 | slice(...) 8 | 9 | 10 | if(length(vrt$tidyee_index)>1){ 11 | ee_index_list <- ee$List(vrt$tidyee_index |> as.character()) 12 | ic_sliced = .data$ee_ob$filter(ee$Filter$inList("tidyee_index", ee_index_list)) 13 | } 14 | if(length(vrt$tidyee_index)==1){ 15 | ee_index <- rgee::ee$String(vrt$tidyee_index |> as.character()) 16 | ic_sliced <- .data$ee_ob$filter(ee$Filter$eq('tidyee_index', ee_index)) 17 | ic_sliced <- rgee::ee$Image(ic_sliced$first()) 18 | } 19 | 20 | return(create_tidyee(x=ic_sliced,vrt=vrt)) 21 | 22 | } 23 | 24 | 25 | 26 | #' slice ee$ImageCollections or tidyee objects that contain imageCollections 27 | #' @name slice 28 | #' @rdname slice 29 | #' @param .data ImageCollection or tidyee class object 30 | #' @param ... other arguments 31 | #' @return sliced/filtered image or imageCollection form filtered imageCollection 32 | #' @examples \dontrun{ 33 | #' 34 | #' library(rgee) 35 | #' library(tidyrgee) 36 | #' ee_Initialize() 37 | #' l8 = ee$ImageCollection('LANDSAT/LC08/C01/T1_SR') 38 | #' l8 |> 39 | #' filter(date>"2016-01-01",date<"2016-03-04") 40 | #' 41 | #' 42 | #' # example with tidyee ckass 43 | # 44 | #' modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 45 | #' modis_ic_tidy <- as_tidyee(modis_ic) 46 | #' 47 | #' # filter by month 48 | #' modis_march_april <- modis_ic_tidy |> 49 | #' filter(month %in% c(3,4)) 50 | #' } 51 | #' @seealso \code{\link[dplyr]{slice}} for information about slice on normal data tables. 52 | #' @importFrom dplyr slice 53 | #' @export 54 | 55 | NULL 56 | 57 | 58 | 59 | 60 | 61 | 62 | -------------------------------------------------------------------------------- /tests/testthat/test-tidyee.R: -------------------------------------------------------------------------------- 1 | 2 | skip_if_no_pypkg() 3 | test_that("initial tidyee objects are", { 4 | modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 5 | modis_ic_tidy <- tidyrgee::as_tidyee(modis_ic) 6 | 7 | vrt_rows <- modis_ic_tidy$vrt |> nrow() 8 | ic_length <- modis_ic_tidy$ee_ob$size()$getInfo() 9 | expect_equal(vrt_rows, ic_length) 10 | }) 11 | 12 | 13 | test_that("tidyee objects aligned after month summary", { 14 | modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 15 | modis_ic_tidy <- tidyrgee::as_tidyee(modis_ic) 16 | modis_summarised <- modis_ic_tidy |> 17 | group_by(month) |> 18 | summarise( 19 | stat= "mean" 20 | ) 21 | vrt_rows <- modis_summarised$vrt |> nrow() 22 | ic_length <- modis_summarised$ee_ob$size()$getInfo() 23 | expect_equal(vrt_rows, ic_length) 24 | }) 25 | 26 | test_that("tidyee objects aligned after year summary", { 27 | modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 28 | modis_ic_tidy <- tidyrgee::as_tidyee(modis_ic) 29 | modis_summarised <- modis_ic_tidy |> 30 | group_by(year) |> 31 | summarise( 32 | stat= "mean" 33 | ) 34 | vrt_rows <- modis_summarised$vrt |> nrow() 35 | ic_length <- modis_summarised$ee_ob$size()$getInfo() 36 | expect_equal(vrt_rows, ic_length) 37 | }) 38 | 39 | test_that("tidyee objects aligned after year-month summary", { 40 | modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 41 | modis_ic_tidy <- tidyrgee::as_tidyee(modis_ic) 42 | modis_summarised <- modis_ic_tidy |> 43 | group_by(year,month) |> 44 | summarise( 45 | stat= "mean" 46 | ) 47 | vrt_rows <- modis_summarised$vrt |> nrow() 48 | ic_length <- modis_summarised$ee_ob$size()$getInfo() 49 | expect_equal(vrt_rows, ic_length) 50 | }) 51 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/master/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ${{ matrix.config.os }} 14 | 15 | name: OS=${{ matrix.config.os }} R=${{ matrix.config.r }} py=${{ matrix.config.python }} 16 | 17 | timeout-minutes: 30 18 | 19 | strategy: 20 | fail-fast: false 21 | matrix: 22 | config: 23 | - {os: macOS-latest, r: 'release', python: '3.8'} 24 | - {os: windows-latest, r: 'release', python: '3.8'} 25 | - {os: ubuntu-latest, r: 'oldrel-1', python: '3.8'} 26 | - {os: ubuntu-latest, r: 'release', python: '3.8'} 27 | - {os: ubuntu-latest, r: 'release', python: '3.9'} 28 | - {os: ubuntu-latest, r: 'release', python: '3.10'} 29 | 30 | env: 31 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 32 | R_KEEP_PKG_SOURCE: yes 33 | 34 | steps: 35 | - uses: actions/checkout@v2 36 | 37 | - uses: r-lib/actions/setup-pandoc@v2 38 | 39 | - uses: r-lib/actions/setup-r@v2 40 | with: 41 | r-version: ${{ matrix.config.r }} 42 | http-user-agent: ${{ matrix.config.http-user-agent }} 43 | use-public-rspm: true 44 | 45 | - uses: actions/setup-python@v3 46 | with: 47 | python-version: ${{ matrix.config.python }} 48 | 49 | - uses: r-lib/actions/setup-r-dependencies@v2 50 | with: 51 | extra-packages: rcmdcheck 52 | 53 | - uses: r-lib/actions/check-r-package@v2 54 | -------------------------------------------------------------------------------- /R/set_idx.R: -------------------------------------------------------------------------------- 1 | 2 | #' @export 3 | set_idx.tidyee <- function(x,idx_name="tidyee_index"){ 4 | group_vars_chr <- dplyr::group_vars(x$vrt) 5 | ic_indexed <- set_idx(x$ee_ob, idx_name = idx_name) 6 | vrt_sorted <- x$vrt |> 7 | ungroup() |> 8 | dplyr::arrange( 9 | dplyr::across( 10 | dplyr::any_of(c("time_start","year","month")) 11 | ) 12 | ) |> 13 | dplyr::mutate( 14 | !!idx_name:=sprintf((dplyr::row_number()-1),fmt = "%03d") 15 | ) 16 | if(length(group_vars_chr)>0){ 17 | vrt_sorted <- vrt_sorted |> 18 | group_by(!!!rlang::syms(group_vars_chr)) 19 | } 20 | 21 | 22 | create_tidyee(x = ic_indexed,vrt = vrt_sorted) 23 | 24 | } 25 | 26 | #' @export 27 | set_idx.ee.imagecollection.ImageCollection <- function(x,idx_name="tidyee_index"){ 28 | x <- x$sort("sytem:time_start") 29 | idx_list = ee$List$sequence(0,x$size()$subtract(1)) 30 | ic_list = x$toList(x$size()) 31 | ic_with_idx = ee$ImageCollection( 32 | idx_list$map(rgee::ee_utils_pyfunc( 33 | function(idx){ 34 | img = ee$Image(ic_list$get(idx)) 35 | #create as string 36 | idx_string = ee$Number(idx)$format('%03d') 37 | img$set(idx_name, idx_string) 38 | })) 39 | ) 40 | return(ic_with_idx) 41 | } 42 | 43 | 44 | #' set_idx 45 | #' 46 | #' @param x tidyee or `ee$ImageCollection` class object 47 | #' @param idx_name name for index to create (default = "tidyee_index") 48 | #' 49 | #' @return tidyee or `ee$ImageCollection` class object with new index containing sequential 0-based indexing 50 | #' @export 51 | #' @importFrom rlang := 52 | #' @examples \dontrun{ 53 | #' library(rgee) 54 | #' library(tidyrgee) 55 | #' ee_Initialize() 56 | # 57 | #' modis_link <- "MODIS/006/MOD13Q1" 58 | #' modisIC <- ee$ImageCollection(modis_link) 59 | #' modis_ndvi_tidy <- as_tidyee(modisIC) |> 60 | #' select("NDVI") 61 | #' modis_ndvi_tidy |> 62 | # set_idx() 63 | #' 64 | #' } 65 | 66 | set_idx <- function(x, idx_name= "tidyee_index"){ 67 | UseMethod("set_idx") 68 | } 69 | -------------------------------------------------------------------------------- /R/group_by.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | #' @export 4 | group_by.ee.imagecollection.ImageCollection <- function(.data, 5 | ..., 6 | .add=FALSE, 7 | .drop=dplyr::group_by_drop_default(.data)){ 8 | stopifnot(!is.null(.data), inherits(.data, "ee.imagecollection.ImageCollection")) 9 | convert_to_tidyee_warning() 10 | x_tidy <- as_tidyee(.data) 11 | x_tidy |> 12 | group_by(...) 13 | } 14 | 15 | 16 | #' @export 17 | group_by.tidyee <- function(.data,...,.add=FALSE,.drop=dplyr::group_by_drop_default(.data)){ 18 | vrt <- .data$vrt |> 19 | dplyr::group_by(...) 20 | create_tidyee(.data$ee_ob,vrt) 21 | } 22 | 23 | 24 | 25 | #' Group an imageCollection or tidyee object with Imagecollections by a parameter 26 | #' @name group_by 27 | #' @rdname group_by 28 | #' @param .data ee$ImageCollection or tidyee object 29 | #' @param ... group_by variables 30 | #' @param .add When `FALSE`, the default, `group_by()` will 31 | #' override existing groups. To add to the existing groups, use 32 | #' `.add = TRUE`. 33 | #' 34 | #' This argument was previously called `add`, but that prevented 35 | #' creating a new grouping variable called `add`, and conflicts with 36 | #' our naming conventions. 37 | #' @param .drop Drop groups formed by factor levels that don't appear in the 38 | #' data? The default is `TRUE` except when `.data` has been previously 39 | #' grouped with `.drop = FALSE`. See [dplyr::group_by_drop_default()] for details. 40 | #' @return ee$ImageCollection with grouped_vars attribute 41 | #' @examples \dontrun{ 42 | #' library(tidyrgee) 43 | #' ee_Initialize() 44 | #' modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 45 | #' modis_ic |> 46 | #' filter(date>="2016-01-01",date<="2019-12-31") |> 47 | #' group_by(year) 48 | #' } 49 | #' @seealso \code{\link[dplyr]{group_by}} for information about group_by on normal data tables. 50 | #' @importFrom dplyr group_by 51 | #' @export 52 | NULL 53 | -------------------------------------------------------------------------------- /man/filter_bounds.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/filter_bounds.R 3 | \name{filter_bounds} 4 | \alias{filter_bounds} 5 | \title{filter_bounds a wrapper for rgee::ee$ImageCollection$filterBounds} 6 | \usage{ 7 | filter_bounds(x, y, use_tidyee_index = FALSE, return_tidyee = TRUE) 8 | } 9 | \arguments{ 10 | \item{x}{tidyee object containing ee$ImageCollection or ee$ImageCollection} 11 | 12 | \item{y}{feature to filter bounds by (sf, ee$FeatureCollection, ee$Feature, ee$Geometry)} 13 | 14 | \item{use_tidyee_index}{filter on tidyee_index (default = F) or system_index (by default)} 15 | 16 | \item{return_tidyee}{\code{logical} return tidyee class (default = TRUE) object or ee$ImageCollection. Faster performance if set to FALSE} 17 | } 18 | \value{ 19 | tidyee class or ee$ImageCollection class object with scenes filtered to bounding box of y geometry 20 | } 21 | \description{ 22 | filter_bounds a wrapper for rgee::ee$ImageCollection$filterBounds 23 | } 24 | \examples{ 25 | \dontrun{ 26 | 27 | library(tidyrgee) 28 | library(tidyverse) 29 | library(rgee) 30 | rgee::ee_Initialize() 31 | 32 | # create geometry and convert to sf 33 | coord_tibble <- tibble::tribble( 34 | ~X, ~Y, 35 | 92.2303683692011, 20.9126490153521, 36 | 92.2311567217866, 20.9127410439304, 37 | 92.2287527311594, 20.9124072954926, 38 | 92.2289221219251, 20.9197352745068, 39 | 92.238724724534, 20.9081803233546 40 | ) 41 | sf_ob <- sf::st_as_sf(coord_tibble, coords=c("X","Y"),crs=4326) 42 | 43 | # load landsat 44 | ls = ee$ImageCollection("LANDSAT/LC08/C01/T1_SR") 45 | 46 | #create tidyee class 47 | ls_tidy <- as_tidyee(ls) 48 | 49 | # filter_bounds on sf object 50 | # return tidyee object 51 | ls_tidy |> 52 | filter_bounds(sf_ob) 53 | # return ee$ImageCollection 54 | ls_tidy |> 55 | filter_bounds(sf_ob,return_tidyee = FALSE) 56 | 57 | # filter_bounds on ee$Geometry object 58 | # return tidyee object 59 | ee_geom_ob <- sf_ob |> rgee::ee_as_sf() 60 | ls_tidy |> 61 | filter_bounds(ee_geom_ob) 62 | 63 | 64 | } 65 | } 66 | -------------------------------------------------------------------------------- /R/filter.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | #' @export 4 | filter.tidyee <- function(.data,...){ 5 | .data <- .data |> set_idx() 6 | vrt <- .data$vrt |> 7 | dplyr::filter(...) 8 | 9 | assertthat::assert_that(nrow(vrt)>0,msg="filter out of range") 10 | 11 | if(length(vrt$tidyee_index)>1){ 12 | ee_index_list <- ee$List(vrt$tidyee_index |> as.character()) 13 | ic_filt = .data$ee_ob$filter(ee$Filter$inList("tidyee_index", ee_index_list)) 14 | } 15 | if(length(vrt$tidyee_index)==1){ 16 | ee_index <- rgee::ee$String(vrt$tidyee_index |> as.character()) 17 | ic_filt = .data$ee_ob$filter(ee$Filter$eq('tidyee_index', ee_index)) 18 | ic_filt <- rgee::ee$Image(ic_filt$first()) 19 | } 20 | 21 | return(create_tidyee(x=ic_filt,vrt=vrt)) 22 | } 23 | 24 | #' @export 25 | filter.ee.imagecollection.ImageCollection <- function(.data,...){ 26 | stopifnot(!is.null(.data), inherits(.data, "ee.imagecollection.ImageCollection")) 27 | 28 | convert_to_tidyee_warning() 29 | 30 | x_tidy <- as_tidyee(.data) 31 | x_tidy |> 32 | filter(...) |> 33 | as_ee() 34 | 35 | } 36 | 37 | 38 | #' filter ee$ImageCollections or tidyee objects that contain imageCollections 39 | #' @name filter 40 | #' @rdname filter 41 | #' @param .data ImageCollection or tidyee class object 42 | #' @param ... other arguments 43 | #' @return filtered image or imageCollection form filtered imageCollection 44 | #' @examples \dontrun{ 45 | #' 46 | #' library(rgee) 47 | #' library(tidyrgee) 48 | #' ee_Initialize() 49 | #' l8 = ee$ImageCollection('LANDSAT/LC08/C01/T1_SR') 50 | #' l8 |> 51 | #' filter(date>"2016-01-01",date<"2016-03-04") 52 | #' 53 | #' 54 | #' # example with tidyee ckass 55 | # 56 | #' modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 57 | #' modis_ic_tidy <- as_tidyee(modis_ic) 58 | #' 59 | #' # filter by month 60 | #' modis_march_april <- modis_ic_tidy |> 61 | #' filter(month %in% c(3,4)) 62 | #' } 63 | #' @seealso \code{\link[dplyr]{filter}} for information about filter on normal data tables. 64 | #' @importFrom dplyr filter 65 | #' @export 66 | 67 | NULL 68 | 69 | 70 | 71 | 72 | 73 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(tidyrgee) 3 | library(sf) 4 | library(rgee) 5 | 6 | 7 | Sys.setenv(EARTHENGINE_PYTHON="/usr/bin/python3") 8 | Sys.setenv(RETICULATE_PYTHON="/usr/bin/python3") 9 | 10 | # Pre-checking ------------------------------------------------------ 11 | # Google credentials were loaded in the system? 12 | skip_if_no_credentials <- function() { 13 | ee_path <- ee_get_earthengine_path() 14 | credentials <- list.files( 15 | path = ee_path, 16 | pattern = "@gmail.com|credentials|GCS_AUTH_FILE.json" 17 | ) 18 | if (length(credentials) != 3) { 19 | skip("All google credentials were not found") 20 | } 21 | } 22 | 23 | # Necessary Python packages were loaded? 24 | skip_if_no_pypkg <- function() { 25 | have_ee <- reticulate::py_module_available("ee") 26 | have_numpy <- reticulate::py_module_available("numpy2") 27 | if (isFALSE(have_ee)) { 28 | skip("ee not available for testing") 29 | } 30 | if (isFALSE(have_numpy)) { 31 | skip("numpy not available for testing") 32 | } 33 | } 34 | 35 | # Define your Drive folder to save intermediate files 36 | # ALERT!!: After tests finished all the files inside the folder 37 | # will be deleted. 38 | drive_folder_f <- function(){ 39 | "rgee_backup" 40 | } 41 | 42 | # Define your own GCS bucket with fine-grained access to save 43 | # intermediate files. ALERT!!: After test finished all the files 44 | # inside the bucket will be deleted. 45 | gcs_bucket_f <- function(){ 46 | "rgee_dev" 47 | } 48 | 49 | # Define your own GCS bucket with uniform access to save 50 | # intermediate files. ALERT!!: After test finished all the files 51 | # inside the bucket will be deleted. 52 | gcs_bucket_uniform_f <- function(){ 53 | "rgee_dev_uniform" 54 | } 55 | 56 | # Initialize credentials 57 | # If you do not count with GCS credentials the test will be skipped 58 | have_ee <- reticulate::py_module_available("ee") 59 | have_numpy <- reticulate::py_module_available("numpy2") 60 | if (have_ee & have_numpy) { 61 | ee_Initialize(drive = TRUE, gcs = TRUE) 62 | } 63 | 64 | test_check("tidyrgee") 65 | -------------------------------------------------------------------------------- /vignettes/aa-tidyverbs.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "aa-tidyverbs" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{aa-tidyverbs} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>" 14 | ) 15 | ``` 16 | 17 | ```{r setup} 18 | library(rgee) 19 | library(tidyrgee) 20 | 21 | ee_Initialize() 22 | ``` 23 | 24 | 25 | # Filter 26 | 27 | Have adopted have made an s3 method for `filter` so it now works in a dplyresque fashion 28 | 29 | ```{r} 30 | 31 | l8 = ee$ImageCollection('LANDSAT/LC08/C01/T1_SR') 32 | 33 | l8 |> 34 | filter(date>"2016-01-01",date<"2016-03-04") 35 | 36 | 37 | ``` 38 | 39 | 40 | # group_by and summarise 41 | 42 | ### group_by 43 | ```{r} 44 | 45 | modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 46 | 47 | modis_ic$select("NDVI") %>% 48 | filter(date>="2016-01-01",date<="2019-12-31") %>% 49 | group_by(year) 50 | 51 | ``` 52 | 53 | 54 | ### group_by + summarise 55 | 56 | ```{r} 57 | 58 | # debugonce(summarise) 59 | modis_ndvi_yearly <- modis_ic$select("NDVI") %>% 60 | filter(date>="2016-01-01",date<="2019-12-31") %>% 61 | group_by(year) %>% 62 | summarise(stat=list("sum","sd")) 63 | 64 | 65 | # showing difference in year_filter vs year_composite here... 66 | # modis_ic |> tidyrgee::ee_year_filter("2002-01-01","2004-01-01") |> ee_print() 67 | # modis_ic |> tidyrgee::ee_year_composite(start_date = "2002-01-01",end_date = "2004-01-01",stat="max") |> ee_print() 68 | 69 | 70 | # cool dplyr::group_by still working 71 | # library(tidyverse) 72 | 73 | # dat |> group_by(survey_date) 74 | ``` 75 | 76 | 77 | low level filters `ee_year`,`ee_month`, `ee_year_month` - this will be wrapped conditionally into `filter` methods 78 | 79 | ```{r} 80 | 81 | 82 | modis_ic |> 83 | ee_month_filter(month=c(3,6,9)) |> 84 | ee_get_date_ic() 85 | 86 | 87 | 88 | modis_ic |> 89 | ee_year_month_filter( 90 | year = c(2005,2007), 91 | month=c(3,4) 92 | ) |> 93 | ee_get_date_ic() 94 | 95 | 96 | ``` 97 | 98 | -------------------------------------------------------------------------------- /R/select.R: -------------------------------------------------------------------------------- 1 | #' @export 2 | select.tidyee <- function(.data,...){ 3 | dots <- list(...) 4 | if(is.null(names(dots))){ 5 | ic_selected=.data$ee_ob$select(unname(dots)) 6 | # attributes(x$vrt)$band_names <- unname(dots) 7 | .data$vrt <- .data$vrt |> 8 | mutate(band_names = list( unname(dots) |> unlist())) 9 | } 10 | if(!is.null(names(dots))){ 11 | name_lookup <- data.frame( 12 | new_name= names(dots), 13 | old_name=dots |> 14 | unname() |> 15 | unlist() 16 | ) 17 | name_lookup <- name_lookup |> 18 | dplyr::mutate(new_name=dplyr::if_else(.data$new_name=="",.data$old_name,.data$new_name)) 19 | 20 | if(inherits(.data$ee_ob ,"ee.imagecollection.ImageCollection")){ 21 | ic_selected <- .data$ee_ob$map( 22 | function(img){ 23 | img$select(unname(dots))$rename(name_lookup$new_name) 24 | } 25 | ) 26 | } 27 | if(inherits(.data$ee_ob,"ee.image.Image")){ 28 | ic_selected <- .data$ee_ob$select(unname(dots))$rename(name_lookup$new_name) 29 | } 30 | 31 | .data$vrt <- .data$vrt |> 32 | mutate(band_names = list( name_lookup$new_name)) 33 | } 34 | create_tidyee(ic_selected, .data$vrt) 35 | } 36 | 37 | #' Select bands from ee$Image or ee$ImageCollection 38 | #' @name select 39 | #' @rdname select 40 | #' @param .data tidyee class object containing ee$ImageCollection or ee$Image 41 | #' @param ... one or more quoted or unquoted expressions separated by commas. 42 | #' @return tidyee class object with specified (...) bands selected 43 | #' @examples \dontrun{ 44 | #' library(tidyrgee) 45 | #' ee_Initialize() 46 | #' modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 47 | #' modis_ic_tidy <- as_tidyee(modis_ic) 48 | #' 49 | #' # select NDVI band 50 | #' modis_ndvi <- modis_ic_tidy |> 51 | #' select("NDVI") 52 | #' 53 | #' # select NDVI band, but change band to new name 54 | #' modis_ndvi_renamed <- modis_ic_tidy |> 55 | #' select(ndvi_new= "NDVI") 56 | #' 57 | #' 58 | #' } 59 | #' @seealso \code{\link[dplyr]{select}} for information about select on normal data tables. 60 | #' @export 61 | #' @importFrom dplyr select 62 | #' @importFrom rlang .data 63 | NULL 64 | 65 | 66 | 67 | -------------------------------------------------------------------------------- /vignettes/ac-summarise-purrring.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "ac-summarise-purrring" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{ac-summarise-purrring} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>" 14 | ) 15 | ``` 16 | 17 | 18 | # Setup 19 | ```{r setup} 20 | 21 | library(rgee) 22 | library(tidyrgee) 23 | ee_Initialize() 24 | 25 | modis_link <- "MODIS/006/MOD13Q1" 26 | modisIC <- ee$ImageCollection(modis_link) 27 | modis_ndvi_tidy <- as_tidyee(modisIC) |> 28 | select("NDVI") 29 | ``` 30 | 31 | # Run summarise 32 | 33 | Currently it's now working with multiples statistics. I did a few changes: 34 | 35 | - I made an `inner_join` method for both `tidyee` and `ImageCollection`. The one being utilized here inside of summarise is the `tidyee` method 36 | - I made the last step of the `inner_join` function `create_tidyee(..., tidyee_index=F)`. The **tidyee_index=F** seems to be the crucial to make this run without getting hung up giving the weird python "time has elapsed" error 37 | 38 | ```{r} 39 | summarised_mean_sd <- modis_ndvi_tidy |> 40 | filter(year %in% 2000:2015) |> 41 | group_by(month) |> 42 | summarise(stat=list("mean","sd","min")) 43 | ``` 44 | 45 | - it is very odd why creating the index (with setting `tidyee=T`) causes this issue because **as you can see in the following chunk** I can easily use the `set_idx` function and have it run with no delay 46 | 47 | ```{r} 48 | ic_with_tidyee_idx <- summarised_mean_sd$ee_ob |> 49 | tidyrgee:::set_idx() 50 | ic_with_tidyee_idx$aggregate_array("tidyee_index")$getInfo() 51 | ``` 52 | 53 | - Furthermore, after creating the summarised merged/joined tidyee imageCollection/vrt, I can run `create_tidyee` with `tidyee_index=T` and have it run instantly. Unforutunately no matter how i put this at the end of the `summarise` function it hangs.... WHY!? 54 | 55 | ```{r} 56 | create_tidyee(x = summarised_mean_sd$ee_ob ,vrt = summarised_mean_sd$vrt,tidyee_index = T) 57 | 58 | ``` 59 | 60 | Although I don't understand this issue fully, perhaps a good/safe way forward would just be to set_idx whenever filter is called!!! as long as it doesnt hang 61 | -------------------------------------------------------------------------------- /R/filter-helpers.R: -------------------------------------------------------------------------------- 1 | 2 | #' extract_condition 3 | #' 4 | #' @param expr_split an expr_split object 5 | #' @noRd 6 | #' @return a condition 7 | extract_condition <- function(expr_split){ 8 | assertthat::assert_that(length(expr_split) %in% c(3,4),msg = "something wrong with conditional logic") 9 | if(length(expr_split)==3){ 10 | cond <- expr_split[2] 11 | } 12 | if(length(expr_split)==4){ 13 | cond <- paste0(expr_split[2],expr_split[3]) 14 | } 15 | return(cond) 16 | 17 | 18 | } 19 | #' extract_date 20 | #' 21 | #' @param expr_split an expr_split object 22 | #' @noRd 23 | #' @return a condition 24 | extract_date <- function(expr_split){ 25 | assertthat::assert_that(length(expr_split) %in% c(3,4),msg = "something wrong with conditional logic") 26 | if(length(expr_split)==3){ 27 | date_component <- expr_split[3] 28 | } 29 | if(length(expr_split)==4){ 30 | date_component <- expr_split[4] 31 | } 32 | date_component_fmt <- stringr::str_remove_all(date_component,"\\\"") |> readr::parse_date() 33 | cond <- extract_condition(expr_split) 34 | if(cond==">"){ 35 | date_component_adjusted <- lubridate::ymd(date_component_fmt)+1 36 | } 37 | if(cond=="<"){ 38 | date_component_adjusted <- lubridate::ymd(date_component_fmt)-1 39 | } 40 | else{ 41 | date_component_adjusted <- lubridate::ymd(date_component_fmt) 42 | } 43 | return(date_component_adjusted) 44 | } 45 | 46 | #' extract_condition 47 | #' 48 | #' @param x a character string 49 | #' @noRd 50 | #' @return a conditiont to filter on 51 | filter_type<- function(x){ 52 | ymd_boolean<- stringr::str_detect(string = x, pattern = "date") 53 | month_boolean <- stringr::str_detect(string = x, pattern = "month") 54 | year_boolean <- stringr::str_detect(string = x, pattern = "year") 55 | if(any(ymd_boolean)){ 56 | assertthat::assert_that(length(ymd_boolean)==2 & all(ymd_boolean==T), 57 | msg = "if date (YMD) is being used there should be 2 dates supplied") 58 | } 59 | if(any(month_boolean)){ 60 | assertthat::assert_that(all(month_boolean==T), 61 | msg = "if filtering by month...") 62 | } 63 | 64 | filter_index <- c(all(ymd_boolean),all(month_boolean),all(year_boolean)) 65 | filter_type <- c("ymd","month","year") 66 | filter_type[filter_index] 67 | } 68 | 69 | 70 | -------------------------------------------------------------------------------- /man/ee_extract_tidy.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ee_extract_tidy.R 3 | \name{ee_extract_tidy} 4 | \alias{ee_extract_tidy} 5 | \title{ee_extract_tidy} 6 | \usage{ 7 | ee_extract_tidy( 8 | x, 9 | y, 10 | stat = "mean", 11 | scale, 12 | via = "getInfo", 13 | container = "rgee_backup", 14 | sf = TRUE, 15 | lazy = FALSE, 16 | quiet = FALSE, 17 | ... 18 | ) 19 | } 20 | \arguments{ 21 | \item{x}{tidyee, ee$Image, or ee$ImageCollection} 22 | 23 | \item{y}{sf or ee$feature or ee$FeatureCollection} 24 | 25 | \item{stat}{zonal stat ("mean", "median" , "min","max" etc)} 26 | 27 | \item{scale}{A nominal scale in meters of the Image projection to work in. By default 1000.} 28 | 29 | \item{via}{Character. Method to export the image. Three method are implemented: "getInfo", "drive", "gcs".} 30 | 31 | \item{container}{Character. Name of the folder ('drive') or bucket ('gcs') to be exported into (ignore if via is not defined as "drive" or "gcs").} 32 | 33 | \item{sf}{Logical. Should return an sf object?} 34 | 35 | \item{lazy}{Logical. If TRUE, a future::sequential object is created to evaluate the task in the future. Ignore if via is set as "getInfo". See details.} 36 | 37 | \item{quiet}{Logical. Suppress info message.} 38 | 39 | \item{...}{additional parameters} 40 | } 41 | \value{ 42 | data.frame in long format with point estimates for each time-step and y feature based on statistic provided 43 | } 44 | \description{ 45 | ee_extract_tidy 46 | } 47 | \examples{ 48 | \dontrun{ 49 | library(rgee) 50 | library(tidyrgee) 51 | ee_Initizialize() 52 | modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 53 | point_sample_buffered <- tidyrgee::bgd_msna |> 54 | sample_n(3) |> 55 | sf::st_as_sf(coords=c("_gps_reading_longitude", 56 | "_gps_reading_latitude"), crs=4326) |> 57 | sf::st_transform(crs=32646) |> 58 | sf::st_buffer(dist = 500) |> 59 | dplyr::select(`_uuid`) 60 | modis_ic_tidy <- as_tidyee(modis_ic) 61 | modis_monthly_baseline_mean <- modis_ic_tidy |> 62 | select("NDVI") |> 63 | filter(year \%in\% 2000:2015) |> 64 | group_by(month) |> 65 | summarise(stat="mean") 66 | 67 | ndvi_monthly_mean_at_pt<- modis_monthly_baseline_mean |> 68 | ee_extract(y = point_sample_buffered, 69 | fun="mean", 70 | scale = 500) 71 | } 72 | } 73 | \seealso{ 74 | \code{\link[rgee]{ee_extract}} for information about ee_extract on ee$ImageCollections and ee$Images 75 | } 76 | -------------------------------------------------------------------------------- /man/clip.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/clip.R 3 | \name{clip} 4 | \alias{clip} 5 | \title{clip flexible wrapper for rgee::ee$Image$clip()} 6 | \usage{ 7 | clip(x, y, return_tidyee = TRUE) 8 | } 9 | \arguments{ 10 | \item{x}{object to be clipped (tidyee, ee$ImageCollection, ee$Image)} 11 | 12 | \item{y}{geometry object to clip to (sf, ee$Feature,ee$FeatureCollections)} 13 | 14 | \item{return_tidyee}{\code{logical} return tidyee class (default = TRUE) object or ee$ImageCollection. Faster performance if F} 15 | } 16 | \value{ 17 | x as tidyee or ee$Image/ee$ImageCollection depending on \code{return_tidyee} argument. 18 | } 19 | \description{ 20 | allows clipping of tidyee,ee$Imagecollection, or ee$Image classes. Also allows objects to be clipped to sf object in addition to ee$FeatureCollections/ee$Feature 21 | } 22 | \examples{ 23 | \dontrun{ 24 | library(tidyrgee) 25 | library(tidyverse) 26 | library(rgee) 27 | rgee::ee_Initialize() 28 | 29 | # create geometry and convert to sf 30 | coord_tibble <- tibble::tribble( 31 | ~X, ~Y, 32 | 92.2303683692011, 20.9126490153521, 33 | 92.2311567217866, 20.9127410439304, 34 | 92.2287527311594, 20.9124072954926, 35 | 92.2289221219251, 20.9197352745068, 36 | 92.238724724534, 20.9081803233546 37 | ) 38 | sf_ob <- sf::st_as_sf(coord_tibble, coords=c("X","Y"),crs=4326) 39 | 40 | roi <- ee$Geometry$Polygon(list( 41 | c(-114.275, 45.891), 42 | c(-108.275, 45.868), 43 | c(-108.240, 48.868), 44 | c(-114.240, 48.891) 45 | )) 46 | 47 | # load landsat 48 | ls = ee$ImageCollection("LANDSAT/LC08/C01/T1_SR") 49 | 50 | # create tidyee class 51 | ls_tidy <- as_tidyee(ls) 52 | 53 | # filter_bounds on sf object 54 | # return tidyee object 55 | ls_tidy |> 56 | filter_bounds(y = roi,return_tidyee = FALSE) |> 57 | clip(roi,return_tidyee = FALSE) 58 | 59 | # pretty instant with return_tidyee=FALSE 60 | ls_clipped_roi_ic <- ls_tidy |> 61 | filter_bounds(y = roi,return_tidyee = FALSE) |> 62 | clip(roi,return_tidyee = FALSE) 63 | 64 | # takes more time with return_tidyee=T, but you get the vrt 65 | ls_clipped__roi_tidyee <- ls_tidy |> 66 | filter_bounds(y = roi,return_tidyee = FALSE) |> 67 | clip(roi,return_tidyee = TRUE) 68 | 69 | # demonstrating on sf object 70 | ls_clipped_sf_ob_ic <- ls_tidy |> 71 | filter_bounds(y = sf_ob,return_tidyee = FALSE) |> 72 | clip(roi,return_tidyee = FALSE) 73 | 74 | ls_clipped_sf_ob_tidyee <- ls_tidy |> 75 | filter_bounds(y = roi,return_tidyee = FALSE) |> 76 | clip(roi,return_tidyee = TRUE) 77 | } 78 | } 79 | -------------------------------------------------------------------------------- /R/as_tidyee.R: -------------------------------------------------------------------------------- 1 | #' as_tidy_ee 2 | #' 3 | #' @param x ee$Image or ee$ImageCollection 4 | #' @param time_end \code{logical} include time_end ("system:time_end") in vrt (default=F) 5 | #' @description The function returns a list containing the original object (Image/ImageCollection)as well 6 | #' as a "virtual data.frame (vrt)" which is a data.frame holding key properties of the 7 | #' ee$Image/ee$ImageCollection. The returned list has been assigned a new class "tidyee". 8 | #' @return tidyee class object which contains a list with two components ("x","vrt") 9 | #' @importFrom rlang .data 10 | #' @export 11 | #' 12 | #' @examples \dontrun{ 13 | #' library(tidyrgee) 14 | #' library(rgee) 15 | #' ee_Initialize() 16 | #' modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 17 | #' modis_ic_tidy <- as_tidyee(modis_ic) 18 | #' 19 | #' 20 | #' } 21 | 22 | as_tidyee <- function(x,time_end=FALSE){ 23 | 24 | if(inherits(x, "ee.image.Image")){ 25 | band_names <- x$bandNames()$getInfo() 26 | vrt_base <- rgee::ee_get_date_img(x,time_end = time_end) |> 27 | data.frame() |> 28 | dplyr::tibble() 29 | } 30 | if(inherits(x, "ee.imagecollection.ImageCollection")){ 31 | band_names <- x$first()$bandNames()$getInfo() 32 | system_index_vec <- x$aggregate_array("system:index")$getInfo() 33 | vrt_base<- rgee::ee_get_date_ic(x,time_end = time_end) |> 34 | dplyr::arrange(.data$time_start) |> 35 | mutate( 36 | system_index = system_index_vec 37 | ) 38 | } 39 | 40 | vrt<- vrt_base |> 41 | dplyr::mutate( 42 | date = lubridate::as_date(.data$time_start), 43 | month=lubridate::month(date), 44 | year= lubridate::year(date), 45 | doy=lubridate::yday(date), 46 | band_names = list(band_names) 47 | ) |> 48 | dplyr::as_tibble() 49 | 50 | create_tidyee(x = x,vrt = vrt) 51 | } 52 | 53 | 54 | 55 | #' create_tidyee 56 | #' 57 | #' @param x ee$ImageCollection 58 | #' @param vrt virtual table 59 | #' @description helper function to assign new tidyee when running `as_tidyee` 60 | #' 61 | #' @return tidyee class list object 62 | #' @export 63 | 64 | create_tidyee <- function(x,vrt){ 65 | # time_start_vec <- x$aggregate_array("system:time_start")$getInfo 66 | # vrt <- vrt |> 67 | # # dplyr::arrange(time_start) |> 68 | # dplyr::mutate( 69 | # tidyee_index= sprintf(dplyr::row_number()-1,fmt = "%03d") 70 | # # time_start= time_start_vec 71 | # ) 72 | 73 | ee_tidy_ob <- list(ee_ob=x,vrt=vrt) 74 | class(ee_tidy_ob)<-c("tidyee") 75 | return(ee_tidy_ob) 76 | 77 | } 78 | 79 | 80 | 81 | -------------------------------------------------------------------------------- /tests/testthat/test-summarise.R: -------------------------------------------------------------------------------- 1 | skip_if_no_pypkg() 2 | test_that("working with summarise by filter and grouping", { 3 | 4 | ## Landsat 8 5 | roi <- ee$Geometry$Point(-114.275, 45.891) 6 | 7 | ld_ic = ee$ImageCollection("LANDSAT/LC08/C01/T1_SR")$filterBounds(roi) 8 | 9 | # with == and year 10 | filter_year_month <- ld_ic %>% 11 | as_tidyee() %>% 12 | filter(year == 2018) %>% 13 | group_by(year, month) %>% 14 | summarise(stat = c('mean', 'median')) 15 | 16 | meta <- filter_year_month$ee_ob$getInfo() 17 | 18 | expect_equal(length(meta[["features"]][[1]][["bands"]]), 24) 19 | 20 | expect_equal(filter_year_month$vrt$band_names[[1]], c("B1_mean", "B2_mean", 21 | "B3_mean", "B4_mean", 22 | "B5_mean", "B6_mean", 23 | "B7_mean", "B10_mean", 24 | "B11_mean","sr_aerosol_mean", 25 | "pixel_qa_mean", "radsat_qa_mean", 26 | "B1_median", "B2_median", 27 | "B3_median", "B4_median", 28 | "B5_median", "B6_median", 29 | "B7_median", "B10_median", 30 | "B11_median","sr_aerosol_median", 31 | "pixel_qa_median","radsat_qa_median" )) 32 | 33 | # related to issue #24 34 | # just comment out and watch for bugs/etc... 35 | 36 | # filter_year_month <- ld_ic %>% 37 | # as_tidyee() %>% 38 | # filter(year %in% c(2016:2019)) %>% 39 | # group_by(year, month) %>% 40 | # summarise(stat = c('mean', 'median')) 41 | # 42 | # meta <- filter_year_month$ee_ob$getInfo() 43 | # 44 | # expect_equal(length(meta[["features"]][[1]][["bands"]]), 24) 45 | 46 | # with MODIS 47 | modis_ic <- rgee::ee$ImageCollection("MODIS/006/MOD13Q1") 48 | 49 | # with %in% and year 50 | filter_year_month <- modis_ic %>% 51 | as_tidyee() %>% 52 | filter(year %in% c(2008:2015)) %>% 53 | group_by(year, month) %>% 54 | summarise(stat = c('mean', 'median')) 55 | 56 | 57 | meta <- filter_year_month$ee_ob$getInfo() 58 | 59 | expect_equal(length(meta[["features"]][[1]][["bands"]]), 24) 60 | 61 | }) 62 | 63 | -------------------------------------------------------------------------------- /R/group_split.R: -------------------------------------------------------------------------------- 1 | 2 | #' @export 3 | group_split.ee.imagecollection.ImageCollection <- function(.tbl,...){ 4 | stopifnot(!is.null(.tbl), inherits(.tbl, "ee.imagecollection.ImageCollection")) 5 | convert_to_tidyee_warning() 6 | 7 | x_tidy <- as_tidyee(.tbl) 8 | x_tidy |> 9 | group_split(...) 10 | } 11 | 12 | 13 | 14 | #' @export 15 | group_split.tidyee <- function(.tbl,...,return_tidyee=T){ 16 | tidyee_ob <- .tbl |> 17 | set_idx() 18 | vrt_list <- tidyee_ob$vrt |> 19 | dplyr::group_split(...,.keep=TRUE)# unfortunately drop attributes 20 | # is there a way to figure this out with `vctrs` package? 21 | # fixed by moving band_naems to list-col instead of relying on attributes 22 | # for print method 23 | 24 | # date_list <- vrt_list |> 25 | # purrr::map( 26 | # ~.x$date |> 27 | # lubridate::as_date() |> 28 | # as.character() 29 | # ) 30 | index_list <- vrt_list |> 31 | purrr::map( 32 | ~.x$tidyee_index 33 | ) 34 | 35 | 36 | ee_index_list=purrr::map(index_list, 37 | function(x){ if(length(x)==1){ 38 | out_list_component <- ee$String(as.character(x)) 39 | }else{ 40 | out_list_component <- rgee::ee$List(as.character(x)) 41 | } 42 | return(out_list_component) 43 | } 44 | ) 45 | 46 | 47 | ic_filt_list<-purrr::map(ee_index_list,~ tidyee_ob$ee_ob$filter(rgee::ee$Filter$inList("tidyee_index", .x))) 48 | 49 | if(return_tidyee){ 50 | return(purrr::map2(.x = ic_filt_list,.y = vrt_list,.f = ~create_tidyee(.x,.y))) 51 | } 52 | if(!return_tidyee){ 53 | return(ic_filt_list) 54 | } 55 | 56 | 57 | } 58 | 59 | 60 | 61 | #' filter ee$ImageCollections or tidyee objects that contain imageCollections 62 | #' @name group_split 63 | #' @rdname group_split 64 | #' @param .tbl ImageCollection or tidyee class object 65 | #' @param ... other arguments 66 | #' @param return_tidyee \code{logical} return tidyee object(default =T), if FALSE - only return ee$ImageCollection 67 | #' @return filtered image or imageCollection form filtered imageCollection 68 | #' @examples \dontrun{ 69 | #' 70 | #' library(rgee) 71 | #' library(tidyrgee) 72 | #' ee_Initialize() 73 | #' l8 = ee$ImageCollection('LANDSAT/LC08/C01/T1_SR') 74 | #' l8 |> 75 | #' filter(date>"2016-01-01",date<"2016-03-04") 76 | #' 77 | #' 78 | #' # example with tidyee ckass 79 | # 80 | #' modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 81 | #' modis_ic_tidy <- as_tidyee(modis_ic) 82 | #' 83 | #' # filter by month 84 | #' modis_march_april <- modis_ic_tidy |> 85 | #' filter(month %in% c(3,4)) 86 | #' } 87 | #' @seealso \code{\link[dplyr]{group_split}} for information about filter on normal data tables. 88 | #' @importFrom dplyr group_split 89 | #' @export 90 | 91 | NULL 92 | 93 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(add_date_to_bandname,ee.image.Image) 4 | S3method(add_date_to_bandname,ee.imagecollection.ImageCollection) 5 | S3method(as_ee,tidyee) 6 | S3method(clip,ee.image.Image) 7 | S3method(clip,ee.imagecollection.ImageCollection) 8 | S3method(clip,tidyee) 9 | S3method(ee_composite,tidyee) 10 | S3method(ee_extract_tidy,ee.image.Image) 11 | S3method(ee_extract_tidy,ee.imagecollection.ImageCollection) 12 | S3method(ee_extract_tidy,tidyee) 13 | S3method(ee_month_composite,ee.imagecollection.ImageCollection) 14 | S3method(ee_month_composite,tidyee) 15 | S3method(ee_month_filter,ee.imagecollection.ImageCollection) 16 | S3method(ee_year_composite,ee.imagecollection.ImageCollection) 17 | S3method(ee_year_composite,tidyee) 18 | S3method(ee_year_filter,ee.imagecollection.ImageCollection) 19 | S3method(ee_year_month_composite,ee.imagecollection.ImageCollection) 20 | S3method(ee_year_month_composite,tidyee) 21 | S3method(ee_year_month_filter,ee.imagecollection.ImageCollection) 22 | S3method(filter,ee.imagecollection.ImageCollection) 23 | S3method(filter,tidyee) 24 | S3method(filter_bounds,ee.imagecollection.ImageCollection) 25 | S3method(filter_bounds,tidyee) 26 | S3method(group_by,ee.imagecollection.ImageCollection) 27 | S3method(group_by,tidyee) 28 | S3method(group_split,ee.imagecollection.ImageCollection) 29 | S3method(group_split,tidyee) 30 | S3method(inner_join,ee.imagecollection.ImageCollection) 31 | S3method(inner_join,tidyee) 32 | S3method(mutate,ee.imagecollection.ImageCollection) 33 | S3method(mutate,tidyee) 34 | S3method(print,tidyee) 35 | S3method(rename_stdDev_bands,ee.image.Image) 36 | S3method(rename_stdDev_bands,ee.imagecollection.ImageCollection) 37 | S3method(select,tidyee) 38 | S3method(set_idx,ee.imagecollection.ImageCollection) 39 | S3method(set_idx,tidyee) 40 | S3method(slice,tidyee) 41 | S3method(str,ee.image.Image) 42 | S3method(str,ee.imagecollection.ImageCollection) 43 | S3method(summarise,ee.imagecollection.ImageCollection) 44 | S3method(summarise,tidyee) 45 | S3method(ungroup,tidyee) 46 | export(add_date_to_bandname) 47 | export(as_ee) 48 | export(as_tidyee) 49 | export(bind_ics) 50 | export(clip) 51 | export(create_tidyee) 52 | export(ee_composite) 53 | export(ee_extract_tidy) 54 | export(ee_month_composite) 55 | export(ee_month_filter) 56 | export(ee_year_composite) 57 | export(ee_year_filter) 58 | export(ee_year_month_composite) 59 | export(ee_year_month_filter) 60 | export(filter) 61 | export(filter_bounds) 62 | export(group_by) 63 | export(group_split) 64 | export(inner_join) 65 | export(mutate) 66 | export(select) 67 | export(set_idx) 68 | export(slice) 69 | export(summarise) 70 | export(ungroup) 71 | importFrom(dplyr,filter) 72 | importFrom(dplyr,group_by) 73 | importFrom(dplyr,group_split) 74 | importFrom(dplyr,inner_join) 75 | importFrom(dplyr,mutate) 76 | importFrom(dplyr,select) 77 | importFrom(dplyr,slice) 78 | importFrom(dplyr,summarise) 79 | importFrom(dplyr,ungroup) 80 | importFrom(rgee,ee) 81 | importFrom(rgee,ee_extract) 82 | importFrom(rlang,":=") 83 | importFrom(rlang,.data) 84 | importFrom(utils,str) 85 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## R CMD check results 2 | 3 | Run on 2022-09-13 4 | 5 | -- R CMD check results ------------------------------------------- tidyrgee 0.1.0 ---- 6 | Duration: 58.1s 7 | 8 | 0 errors √ | 0 warnings √ | 0 notes √ 9 | 10 | 11 | There were no ERRORs , NOTEs or WARNINGs. 12 | 13 | ## Downstream dependencies 14 | 15 | There are currently no downstream dependencies for this package. 16 | 17 | ## Notes 18 | Below I have quoted and numbered CRAN feedback from the first submission. Below each number point I have provided a response. 19 | 20 | **1. (problem)** "Please omit the redundant "in R" in your description." 21 | 22 | **1. (response)** The description has been modified as requested. 23 | 24 | **2. (problem)** "Please provide a link to the used webservices (Earth Engine) to the 25 | description field 26 | of your DESCRIPTION file in the form 27 | or 28 | with angle brackets for auto-linking and no space after 'http:' and 29 | 'https:'." 30 | 31 | **2. (response)** The link has been added as requested. 32 | 33 | **3. (problem)** "Please write TRUE and FALSE instead of T and F." 34 | 35 | **3. (response)** TRUE and FALSE have been added to functions where necessary. 36 | 37 | **4. (problem)** "Please don't use "T" or "F" as vector names. 38 | 'T' and 'F' instead of TRUE and FALSE: 39 | man/clip.Rd: 40 | clip(x, y, return_tidyee = T) 41 | man/filter_bounds.Rd: 42 | filter_bounds(x, y, use_tidyee_index = F, return_tidyee = T) 43 | man/summarise.Rd: 44 | {summarise}{ee.imagecollection.ImageCollection}(.data, stat, ...) 45 | {summarise}{tidyee}(.data, stat, ..., join_bands = T)" 46 | 47 | **4. (response)** T and F have been replaced by TRUE and FALSE as requested. 48 | 49 | **5. (problem)** "We see: Unexecutable code in man/set_idx.Rd 50 | Please look into this. 51 | 52 | \dontrun{} should only be used if the example really cannot be executed 53 | (e.g. because of missing additional software, missing API keys, ...) by 54 | the user. That's why wrapping examples in \dontrun{} adds the comment 55 | ("# Not run:") as a warning for the user. 56 | Does not seem necessary. 57 | Please replace \dontrun with \donttest. 58 | 59 | Please unwrap the examples if they are executable in < 5 sec, or replace 60 | \dontrun{} with \donttest{}." 61 | 62 | **5. (response)** Our package relies on API credentials so the functions cannot be run without. 63 | For this reason we think `\dontrun{}` is the best option for `@examples`. 64 | 65 | **6. (problem)** "You write information messages to the console that cannot be easily 66 | suppressed. 67 | It is more R like to generate objects that can be used to extract the 68 | information a user is interested in, and then print() that object. 69 | Instead of print()/cat() rather use message()/warning() or 70 | if(verbose)cat(..) (or maybe stop()) if you really have to write text to 71 | the console. 72 | (except for print, summary, interactive functions)" 73 | 74 | **6. (response)** We changed all `cat()` and `print()` calls to message as requested. 75 | 76 | **7. (problem)** "Please do not modify the global environment (e.g. by using <<-) in your 77 | functions. This is not allowed by the CRAN policies. -> R/zzz.R" 78 | 79 | **7. (response)** This file has been removed after being deemed unnecessary. 80 | 81 | -------------------------------------------------------------------------------- /R/inner_join.R: -------------------------------------------------------------------------------- 1 | #' @export 2 | inner_join.tidyee<- function(x, y, by,...){ 3 | x_ic <- x$ee_ob 4 | y_ic <- y$ee_ob 5 | 6 | if(inherits(x_ic,"ee.image.Image")) {x_ic <- ee$ImageCollection(x_ic)} 7 | if(inherits(y_ic,"ee.image.Image")) {y_ic <- ee$ImageCollection(y_ic)} 8 | # Define an inner join 9 | innerJoin = rgee::ee$Join$inner() 10 | 11 | # Specify an equals filter for image timestamps. 12 | filterEq <- rgee::ee$Filter$equals(leftField = by, rightField = by) 13 | 14 | # Apply the join. 15 | inner_join_output = innerJoin$apply(x_ic, y_ic, filterEq) 16 | 17 | # Map a function to merge the results in the output FeatureCollection. 18 | # in the JavaScript code-editor this seems to auto-convert/get coerced to ImageCollection 19 | joined_fc = inner_join_output$map(function(feature) { 20 | ee$Image$cat(feature$get('primary'), feature$get('secondary')) 21 | }) 22 | 23 | # with rgee is seems necessary to explicitly convert 24 | ic_inner_joined <- rgee::ee$ImageCollection(joined_fc) 25 | joined_band_names <- unique(c(vrt_band_names(x),vrt_band_names(y))) 26 | # joined_band_names <- unique(c(attributes(x$vrt)$band_names,attributes(y$vrt)$band_names)) 27 | # attributes(x$vrt)$band_names <- joined_band_names 28 | vrt_joined <- x$vrt |> 29 | dplyr::mutate(band_names= list(joined_band_names)) 30 | # return(ic_inner_joined) 31 | # return(ic_inner_joined) 32 | create_tidyee(ic_inner_joined,vrt_joined) 33 | } 34 | 35 | #' @export 36 | inner_join.ee.imagecollection.ImageCollection<- function(x, y, by,...){ 37 | x_ic <- x 38 | y_ic <- y 39 | 40 | # Define an inner join 41 | innerJoin = rgee::ee$Join$inner() 42 | 43 | # Specify an equals filter for image timestamps. 44 | filterEq <- rgee::ee$Filter$equals(leftField = by, rightField = by) 45 | 46 | # Apply the join. 47 | inner_join_output = innerJoin$apply(x_ic, y_ic, filterEq) 48 | 49 | # Map a function to merge the results in the output FeatureCollection. 50 | # in the JavaScript code-editor this seems to auto-convert/get coerced to ImageCollection 51 | joined_fc = inner_join_output$map(function(feature) { 52 | ee$Image$cat(feature$get('primary'), feature$get('secondary')) 53 | }) 54 | 55 | # with rgee is seems necessary to explicitly convert 56 | ic_inner_joined <- rgee::ee$ImageCollection(joined_fc) 57 | # joined_band_names <- unique(c(vrt_band_names(x),vrt_band_names(y))) 58 | # joined_band_names <- unique(c(attributes(x$vrt)$band_names,attributes(y$vrt)$band_names)) 59 | # attributes(x$vrt)$band_names <- joined_band_names 60 | # vrt_joined <- x$vrt |> 61 | # dplyr::mutate(band_names= list(joined_band_names)) 62 | # # return(ic_inner_joined) 63 | return(ic_inner_joined) 64 | # create_tidyee(ic_inner_joined,vrt_joined,tidyee_index = F) 65 | } 66 | 67 | #' inner_join bands from different image/ImageCollections based on shared property 68 | #' @name inner_join 69 | #' @param x,y A pair of tidyee objects containing ee$ImageCollections 70 | #' @param by A character vector of variables to join by. 71 | #' @return An object of the same type as `x`. The output has the following properties: 72 | #' Same number of images as `x` 73 | #' Total number of bands equal the number of bands in `x` plus the number of bands in `y` 74 | #' @seealso \code{\link[dplyr]{inner_join}} for information about inner_join on normal data tables. 75 | #' @export 76 | #' @importFrom rgee ee 77 | #' @importFrom dplyr inner_join 78 | NULL 79 | -------------------------------------------------------------------------------- /R/mutate_extra.R: -------------------------------------------------------------------------------- 1 | 2 | # #' Title 3 | # #' 4 | # #' @param .data 5 | # #' @param ... 6 | # #' 7 | # #' @return 8 | # #' @export 9 | # #' 10 | # #' @examples \dontrun{ 11 | 12 | # #' 13 | # #' library(rgee) 14 | # library(lubridate) 15 | # library(tidyrgee) 16 | # library(tidyverse) 17 | # ee_Initialize() 18 | # baseline <- 2000:2021 19 | # satellite <- "terra" 20 | # yoi <- 2021 21 | # # date_range <- c() 22 | # modis_link <- get_modis_link(satellite) 23 | # modisIC <- ee$ImageCollection("MODIS/061/MOD13Q1") 24 | # # modis_ndvi <- cloud_scale_modis_ndvi(x = modisIC,mask="cloud&quality") 25 | # modis_ndvi_tidy <- as_tidyee(modisIC) 26 | # 27 | # recent <- modis_ndvi_tidy |> 28 | # filter(year %in% yoi) |> 29 | # mutate( 30 | # ag_season = if_else(doy %in% lubridate::yday(x = as.Date("2022-06-20")): 31 | # lubridate::yday(x = as.Date("2022-09-26")), 32 | # "growing_season","not_growing") 33 | # ) |> 34 | # 35 | # group_by(ag_season) |> 36 | # summarise(stat= list("mean")) 37 | # recent$vrt |> arrange(time_start) 38 | # # recent$ee_ob$sort(prop = "system:time_start")$aggregate_array("system:time_start")$getInfo() 39 | # # recent$ee_ob$sort(prop = "system:time_start",opt_ascending = FALSE) |> ee_get_date_ic() 40 | # recent$ee_ob$sort(prop = "system:time_start",opt_ascending = T) |> ee_get_date_ic() 41 | # debugonce(mutate_extra) 42 | # bla <- modis_ndvi_tidy |> 43 | # filter(year %in% yoi) |> 44 | # mutate_extra( 45 | # ag_season = if_else(doy %in% lubridate::yday(x = as.Date("2022-06-20")): 46 | # lubridate::yday(x = as.Date("2022-09-26")), 47 | # "growing_season","not_growing"), 48 | # rando= if_else(doy %in% 1:100,"asdf","bbb") 49 | # ) 50 | # 51 | # bla$ee_ob$aggregate_array("ag_season")$getInfo() 52 | # debugonce(summarise_pixels) 53 | # 54 | # debugonce(mutate) 55 | # mutate.prop <- function() 56 | # 57 | # } 58 | #' mutate_extra <- function(.data, 59 | #' ...){ 60 | #' new_col_names <- .data$vrt |> 61 | #' dplyr::transmute(...) |> colnames() 62 | #' vrt <- .data$vrt |> 63 | #' dplyr::mutate(...) |> 64 | #' arrange(.data$time_start) 65 | #' 66 | #' ee_ob <- .data$ee_ob$sort(prop = "system:time_start",opt_ascending = T) 67 | #' 68 | #' tidyrgee:::inner_join.ee.imagecollection.ImageCollection 69 | #' ics<-new_col_names |> 70 | #' purrr::map(~{ 71 | #' ee_new_prop <- ee$List(vrt[[.x]]) 72 | #' idx_list = ee$List$sequence(0,ee_new_prop$size()$subtract(1)) 73 | #' ic_list = ee_ob$toList(ee_ob$size()) 74 | #' ic_temp <- ee$ImageCollection( 75 | #' idx_list$map(rgee::ee_utils_pyfunc( 76 | #' function(idx){ 77 | #' img = ee$Image(ic_list$get(idx)) 78 | #' #create as string 79 | #' idx_string = ee$String(ee_new_prop$get(idx)) 80 | #' img$set(.x, idx_string) 81 | #' })) 82 | #' ) 83 | #' return(ic_temp) 84 | #' } 85 | #' ) 86 | #' filter <- ee$Filter$equals( 87 | #' leftField= "system:index", 88 | #' rightField= "system:index" 89 | #' ) 90 | #' 91 | #' simpleJoin = ee$Join$saveAll() 92 | #' ic<-ee$ImageCollection(purrr::reduce(ics,simpleJoin$apply,filter)) 93 | #' ic$aggregate_array("ag_season")$getInfo() 94 | #' ic$aggregate_array("rando")$getInfo() 95 | #' var simpleJoined = simpleJoin.apply(primary, secondary, filter); 96 | #' # ic <- purrr::reduce(ics, inner_join,"system:time_start") 97 | #' 98 | #' create_tidyee(ics,vrt) 99 | #' 100 | #' } 101 | -------------------------------------------------------------------------------- /tests/testthat/test-group_by.R: -------------------------------------------------------------------------------- 1 | skip_if_no_pypkg() 2 | test_that("grouping by year", { 3 | 4 | #### group_by method doesn't do anything with ee.ImageCollection so 5 | ## just testing vrt essentially. 6 | 7 | # with MODIS 8 | modis_ic <- rgee::ee$ImageCollection("MODIS/006/MOD13Q1") 9 | 10 | # with %in% and year 11 | group_year <- modis_ic %>% 12 | as_tidyee() %>% 13 | filter(year %in% c(2008:2015)) %>% 14 | group_by(year) 15 | 16 | expect_equal(inherits(group_year$vrt, "grouped_df"), TRUE) 17 | 18 | # with == and year 19 | 20 | group_year <- modis_ic %>% 21 | as_tidyee() %>% 22 | filter(year == 2008) %>% 23 | group_by(year) 24 | 25 | expect_equal(inherits(group_year$vrt, "grouped_df"), TRUE) 26 | 27 | #with landsat T1/SR 28 | 29 | roi <- ee$Geometry$Point(-114.275, 45.891) 30 | 31 | ld_ic = ee$ImageCollection("LANDSAT/LC08/C01/T1_SR")$filterBounds(roi) 32 | 33 | # with == and year 34 | filter_year <- ld_ic %>% 35 | as_tidyee() %>% 36 | filter(year == 2018) %>% 37 | group_by(year) 38 | 39 | expect_equal(inherits(group_year$vrt, "grouped_df"), TRUE) 40 | 41 | 42 | }) 43 | 44 | 45 | test_that("grouping by year", { 46 | 47 | #### group_by method doesn't do anything with ee.ImageCollection so 48 | ## just testing vrt essentially. 49 | 50 | # with MODIS 51 | modis_ic <- rgee::ee$ImageCollection("MODIS/006/MOD13Q1") 52 | 53 | # with %in% and month 54 | group_month <- modis_ic %>% 55 | as_tidyee() %>% 56 | filter(year %in% c(2008:2015)) %>% 57 | group_by(month) 58 | 59 | expect_equal(inherits(group_month$vrt, "grouped_df"), TRUE) 60 | 61 | # with == and year 62 | 63 | group_month <- modis_ic %>% 64 | as_tidyee() %>% 65 | filter(year == 2008) %>% 66 | group_by(month) 67 | 68 | expect_equal(inherits(group_month$vrt, "grouped_df"), TRUE) 69 | 70 | #with landsat T1/SR 71 | 72 | roi <- ee$Geometry$Point(-114.275, 45.891) 73 | 74 | ld_ic = ee$ImageCollection("LANDSAT/LC08/C01/T1_SR")$filterBounds(roi) 75 | 76 | # with == and year 77 | filter_month <- ld_ic %>% 78 | as_tidyee() %>% 79 | filter(year == 2018) %>% 80 | group_by(month) 81 | 82 | expect_equal(inherits(group_month$vrt, "grouped_df"), TRUE) 83 | 84 | 85 | }) 86 | 87 | test_that("grouping by year and month", { 88 | 89 | #### group_by method doesn't do anything with ee.ImageCollection so 90 | ## just testing vrt essentially. 91 | 92 | # with MODIS 93 | modis_ic <- rgee::ee$ImageCollection("MODIS/006/MOD13Q1") 94 | 95 | # with %in% and year 96 | group_year_month <- modis_ic %>% 97 | as_tidyee() %>% 98 | filter(year %in% c(2008:2015)) %>% 99 | group_by(year, month) 100 | 101 | expect_equal(inherits(group_year_month$vrt, "grouped_df"), TRUE) 102 | 103 | # with == and year 104 | 105 | group_year_month <- modis_ic %>% 106 | as_tidyee() %>% 107 | filter(year == 2008) %>% 108 | group_by(year, month) 109 | 110 | expect_equal(inherits(group_year_month$vrt, "grouped_df"), TRUE) 111 | 112 | #with landsat T1/SR 113 | 114 | roi <- ee$Geometry$Point(-114.275, 45.891) 115 | 116 | ld_ic = ee$ImageCollection("LANDSAT/LC08/C01/T1_SR")$filterBounds(roi) 117 | 118 | # with == and year 119 | filter_year_month <- ld_ic %>% 120 | as_tidyee() %>% 121 | filter(year == 2018) %>% 122 | group_by(year, month) 123 | 124 | expect_equal(inherits(group_year_month$vrt, "grouped_df"), TRUE) 125 | 126 | # with == and year 127 | filter_year_month <- ld_ic %>% 128 | as_tidyee() %>% 129 | filter(year == 2018) %>% 130 | group_by(month, year) 131 | 132 | expect_equal(inherits(group_year_month$vrt, "grouped_df"), TRUE) 133 | 134 | 135 | }) 136 | 137 | -------------------------------------------------------------------------------- /R/ee_temporal_filters.R: -------------------------------------------------------------------------------- 1 | 2 | #' ee_year_filter 3 | #' 4 | #' @param imageCol ee$ImageCollection 5 | #' @param year \code{numeric} vector containing years (i.e c(2001,2002,2003)) 6 | #' @param ... other arguments 7 | #' 8 | #' @return ee$ImageCollection or ee$Image filtered by year 9 | #' @export 10 | 11 | ee_year_filter <- function(imageCol,year,...){ 12 | 13 | UseMethod('ee_year_filter') 14 | 15 | } 16 | 17 | 18 | #' @export 19 | 20 | 21 | ee_year_filter.ee.imagecollection.ImageCollection <- function(imageCol, 22 | year, 23 | ...){ 24 | 25 | 26 | stopifnot(!is.null(imageCol), inherits(imageCol, "ee.imagecollection.ImageCollection")) 27 | 28 | # should make assertion for no duplicates 29 | 30 | ee_year_list <- rgee::ee$List(year) # switched from ee$List$sequence - let the user make sequence in R or suppply raw 31 | 32 | ic_list <- 33 | ee_year_list$map(rgee::ee_utils_pyfunc(function (y) { 34 | imageCol$filter(rgee::ee$Filter$calendarRange(y, y, 'year')) 35 | } 36 | 37 | )) 38 | 39 | fc_from_ic_list <- rgee::ee$FeatureCollection(ic_list) 40 | 41 | message("returning ImageCollection of x\n") 42 | return(rgee::ee$ImageCollection(fc_from_ic_list$flatten())) 43 | 44 | } 45 | 46 | 47 | #' ee_month_filter 48 | #' 49 | #' @param imageCol ee$ImageCollection 50 | #' @param month \code{numeric} vector containing month values (1-12) 51 | #' @param ... other arguments 52 | #' 53 | #' @return ee$ImageCollection or ee$Image filtered by month 54 | #' @export 55 | 56 | ee_month_filter <- function(imageCol,month,...){ 57 | UseMethod('ee_month_filter') 58 | } 59 | 60 | 61 | #' @export 62 | ee_month_filter.ee.imagecollection.ImageCollection <- function(imageCol, 63 | month, 64 | ...){ 65 | 66 | stopifnot(!is.null(imageCol), inherits(imageCol, "ee.imagecollection.ImageCollection")) 67 | assertthat::assert_that(is.numeric(month)&length(month)>1, 68 | msg = "month must be a numeric vector of lenght greater than 0") 69 | assertthat::assert_that(all(month %in% c(1:12)), 70 | msg = "month values must be integeer inside 1-12 range") 71 | 72 | # should make assertion for no duplicates 73 | 74 | ee_month_list <- rgee::ee$List(month) # switched from ee$List$sequence - let the user make sequence in R or suppply raw 75 | 76 | ic_list <- 77 | ee_month_list$map(rgee::ee_utils_pyfunc(function (m) { 78 | imageCol$filter(rgee::ee$Filter$calendarRange(m, m, 'month')) 79 | } 80 | 81 | )) 82 | 83 | fc_from_ic_list <- rgee::ee$FeatureCollection(ic_list) 84 | 85 | message("returning ImageCollection of x\n") 86 | return(rgee::ee$ImageCollection(fc_from_ic_list$flatten())) 87 | 88 | } 89 | 90 | #' ee_year_month_filter 91 | #' 92 | #' @param imageCol ee$ImageCollection 93 | #' @param year \code{numeric} vector contain years to filter 94 | #' @param month \code{numeric} vector contain months to filter 95 | #' @param ... other arguments 96 | #' 97 | #' @return ee$ImageCollection or ee$Image filtered by year & month 98 | #' @export 99 | 100 | ee_year_month_filter <- function(imageCol,year, month,...){ 101 | 102 | UseMethod('ee_year_month_filter') 103 | 104 | } 105 | 106 | 107 | #' @export 108 | 109 | ee_year_month_filter.ee.imagecollection.ImageCollection <- function(imageCol, 110 | year, 111 | month, 112 | ...){ 113 | # assertions 114 | stopifnot(!is.null(imageCol), inherits(imageCol, "ee.imagecollection.ImageCollection")) 115 | assertthat::assert_that(is.numeric(year)&length(year)>0, 116 | msg = "year must be a numeric vector of lenght greater than 0") 117 | assertthat::assert_that(is.numeric(month)&length(month)>0, 118 | msg = "month must be a numeric vector of lenght greater than 0") 119 | 120 | yr_ic <- ee_year_filter(imageCol = imageCol,year=year) 121 | yr_mo_ic <- ee_month_filter(imageCol=yr_ic,month=month) 122 | return(yr_mo_ic) 123 | 124 | 125 | 126 | 127 | 128 | } 129 | -------------------------------------------------------------------------------- /R/filter_bounds.R: -------------------------------------------------------------------------------- 1 | 2 | #' filter_bounds a wrapper for rgee::ee$ImageCollection$filterBounds 3 | #' 4 | #' @param x tidyee object containing ee$ImageCollection or ee$ImageCollection 5 | #' @param y feature to filter bounds by (sf, ee$FeatureCollection, ee$Feature, ee$Geometry) 6 | #' @param use_tidyee_index filter on tidyee_index (default = F) or system_index (by default) 7 | #' @param return_tidyee \code{logical} return tidyee class (default = TRUE) object or ee$ImageCollection. Faster performance if set to FALSE 8 | #' 9 | #' @return tidyee class or ee$ImageCollection class object with scenes filtered to bounding box of y geometry 10 | #' @importFrom rlang .data 11 | #' @export 12 | #' 13 | #' @examples \dontrun{ 14 | #' 15 | #' library(tidyrgee) 16 | #' library(tidyverse) 17 | #' library(rgee) 18 | #' rgee::ee_Initialize() 19 | #' 20 | #' # create geometry and convert to sf 21 | #' coord_tibble <- tibble::tribble( 22 | #' ~X, ~Y, 23 | #' 92.2303683692011, 20.9126490153521, 24 | #' 92.2311567217866, 20.9127410439304, 25 | #' 92.2287527311594, 20.9124072954926, 26 | #' 92.2289221219251, 20.9197352745068, 27 | #' 92.238724724534, 20.9081803233546 28 | #' ) 29 | #' sf_ob <- sf::st_as_sf(coord_tibble, coords=c("X","Y"),crs=4326) 30 | #' 31 | #' # load landsat 32 | #' ls = ee$ImageCollection("LANDSAT/LC08/C01/T1_SR") 33 | #' 34 | #' #create tidyee class 35 | #' ls_tidy <- as_tidyee(ls) 36 | #' 37 | #' # filter_bounds on sf object 38 | #' # return tidyee object 39 | #' ls_tidy |> 40 | #' filter_bounds(sf_ob) 41 | #' # return ee$ImageCollection 42 | #' ls_tidy |> 43 | #' filter_bounds(sf_ob,return_tidyee = FALSE) 44 | #' 45 | #' # filter_bounds on ee$Geometry object 46 | #' # return tidyee object 47 | #' ee_geom_ob <- sf_ob |> rgee::ee_as_sf() 48 | #' ls_tidy |> 49 | #' filter_bounds(ee_geom_ob) 50 | #' 51 | #' 52 | #' } 53 | 54 | filter_bounds <- function(x,y,use_tidyee_index=FALSE,return_tidyee=TRUE){ 55 | UseMethod('filter_bounds') 56 | } 57 | 58 | 59 | 60 | 61 | #' @export 62 | filter_bounds.tidyee <- function(x,y,use_tidyee_index=FALSE,return_tidyee=TRUE){ 63 | assertthat::assert_that(rlang::inherits_any(y, c("sf","ee.geometry.Geometry", 64 | "ee.featurecollection.FeatureCollection", 65 | "ee.feature.Feature"))) 66 | assertthat::assert_that(inherits(x, c("tidyee"))) 67 | 68 | if(inherits(y,"sf")){ 69 | y <- sf::st_bbox(y) |> 70 | sf::st_as_sfc() 71 | y_ee <- rgee::sf_as_ee(y) 72 | class(y_ee) 73 | } 74 | if(rlang::inherits_any(y,c("ee.geometry.Geometry", 75 | "ee.featurecollection.FeatureCollection", 76 | "ee.feature.Feature"))){ 77 | y_ee <- y 78 | } 79 | 80 | if(!return_tidyee){ 81 | x_ic <- x$ee_ob 82 | return(x_ic$filterBounds(y_ee)) 83 | } 84 | 85 | # not sure this is necessary - would like to remove soon. 86 | if(use_tidyee_index){ 87 | x <- x |> set_idx() 88 | x_ee_spatial_filtered<- x$ee_ob$filterBounds(y_ee) 89 | x_ee_spatial_filtered_idx<- x_ee_spatial_filtered$aggregate_array("tidyee_index")$getInfo() 90 | vrt_spatial_filtered <- x$vrt |> 91 | filter(.data$tidyee_index %in%x_ee_spatial_filtered_idx ) 92 | create_tidyee(x = x_ee_spatial_filtered,vrt = vrt_spatial_filtered) 93 | } 94 | if(!use_tidyee_index) 95 | x_ee_spatial_filtered<- x$ee_ob$filterBounds(y_ee) 96 | x_ee_spatial_filtered_idx <- x_ee_spatial_filtered$aggregate_array("system:index")$getInfo() 97 | vrt_spatial_filtered <- x$vrt |> 98 | filter(.data$system_index %in% x_ee_spatial_filtered_idx ) 99 | create_tidyee(x = x_ee_spatial_filtered,vrt = vrt_spatial_filtered) 100 | } 101 | 102 | 103 | #' @export 104 | filter_bounds.ee.imagecollection.ImageCollection <- function(x,y,use_tidyee_index=FALSE,return_tidyee=TRUE){ 105 | 106 | assertthat::assert_that(rlang::inherits_any(y, c("sf","ee.geometry.Geometry", 107 | "ee.featurecollection.FeatureCollection", 108 | "ee.feature.Feature"))) 109 | 110 | assertthat::assert_that(inherits(x, c("ee.imagecollection.ImageCollection"))) 111 | 112 | if(inherits(y,"sf")){ 113 | y <- sf::st_bbox(y) |> 114 | sf::st_as_sfc() 115 | y_ee <- rgee::sf_as_ee(y) 116 | } 117 | if(rlang::inherits_any(y,c("ee.geometry.Geometry", 118 | "ee.featurecollection.FeatureCollection", 119 | "ee.feature.Feature"))){ 120 | y_ee <- y 121 | } 122 | x_ee <- x$ee_ob 123 | x_ee_spatial_filtered <- x_ee$filterBounds(y_ee) 124 | if(!return_tidyee){ 125 | res <- x_ee_spatial_filtered 126 | } 127 | if(return_tidyee){ 128 | res <- as_tidyee(x_ee_spatial_filtered) 129 | } 130 | return(res) 131 | } 132 | -------------------------------------------------------------------------------- /R/archive/ee_extract.R: -------------------------------------------------------------------------------- 1 | 2 | #' @export 3 | ee_extract.tidyee <- function(x, 4 | y, 5 | stat="mean", 6 | scale, 7 | via="getInfo", 8 | container="rgee_backup", 9 | sf=TRUE, 10 | lazy=FALSE, 11 | quiet=FALSE,...){ 12 | 13 | 14 | if( any(c("sfc","sf") %in% class(y))){ 15 | assertthat::assert_that( 16 | geometry_type_is_unique(y), 17 | msg = "Currently we can only handle a single geometry types" 18 | ) 19 | message("uploading sf to ee object\n") 20 | y_ee <- rgee::sf_as_ee(y) 21 | 22 | } 23 | if("ee.featurecollection.FeatureCollection" %in% class(y)){ 24 | y_ee <- y 25 | } 26 | 27 | message("renaming bands with dates\n") 28 | ic_renamed<- x$ee_ob |> 29 | add_date_to_bandname() 30 | 31 | ee_reducer <- stat_to_reducer(fun = stat) 32 | 33 | 34 | 35 | message("starting ee_extract\n") 36 | ic_extracted_wide_sf <- rgee::ee_extract(x = ic_renamed, 37 | y=y_ee, 38 | scale=scale, 39 | fun= ee_reducer, 40 | via = via, 41 | container= container, 42 | sf=sf, 43 | lazy=lazy, 44 | quiet=quiet) 45 | 46 | if("ee.image.Image" %in% class(x$ee_ob)){ 47 | band_names_cli<- x$ee_ob$bandNames()$getInfo() 48 | } 49 | 50 | if("ee.imagecollection.ImageCollection" %in% class(x$ee_ob)){ 51 | band_names_cli<- x$ee_ob$first()$bandNames()$getInfo() 52 | } 53 | 54 | # regex to be removed from name to create date col 55 | rm_rgx <- paste0(".*",band_names_cli) 56 | rm_rgx <- glue::glue_collapse(rm_rgx,sep = "|") 57 | 58 | # regex to extract parameter identifier 59 | # reorder so shorter names with common prefix to another band names wont replace string before longer version 60 | extract_rgx <- band_names_cli[stringr::str_order(band_names_cli,decreasing=T)] 61 | extract_rgx <- glue::glue_collapse(extract_rgx,sep = "|") 62 | 63 | ic_extracted_wide_sf |> 64 | sf::st_drop_geometry() |> 65 | tidyr::pivot_longer(-1,names_to = "name") |> 66 | mutate( 67 | parameter=stringr::str_extract(.data$name, pattern=extract_rgx), 68 | date= stringr::str_remove(string = .data$name, pattern = rm_rgx) |> 69 | stringr::str_replace_all("_","-") |> lubridate::ymd() 70 | 71 | ) |> 72 | dplyr::select(-.data$name) 73 | 74 | 75 | } 76 | 77 | #' @export 78 | ee_extract.default <- rgee::ee_extract 79 | 80 | #' ee_extract_tidy 81 | #' @name ee_extract 82 | #' @rdname ee_extract 83 | #' @param x tidyee, ee$Image, or ee$ImageCollection 84 | #' @param y sf or ee$feature or ee$FeatureCollection 85 | #' @param stat zonal stat ("mean", "median" , "min","max" etc) 86 | #' @param scale A nominal scale in meters of the Image projection to work in. By default 1000. 87 | #' @param via Character. Method to export the image. Three method are implemented: "getInfo", "drive", "gcs". 88 | #' @param container Character. Name of the folder ('drive') or bucket ('gcs') to be exported into (ignore if via is not defined as "drive" or "gcs"). 89 | #' @param sf Logical. Should return an sf object? 90 | #' @param lazy Logical. If TRUE, a future::sequential object is created to evaluate the task in the future. Ignore if via is set as "getInfo". See details. 91 | #' @param quiet Logical. Suppress info message. 92 | #' @param ... additional parameters 93 | #' 94 | #' @return 95 | #' 96 | #' @examples \dontrun{ 97 | #' library(rgee) 98 | #' library(tidyrgee) 99 | #' ee_Initizialize() 100 | #' modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 101 | #' point_sample_buffered <- tidyrgee::bgd_msna |> 102 | #' sample_n(3) |> 103 | #' sf::st_as_sf(coords=c("_gps_reading_longitude", 104 | #' "_gps_reading_latitude"), crs=4326) |> 105 | #' sf::st_transform(crs=32646) |> 106 | #' sf::st_buffer(dist = 500) |> 107 | #' dplyr::select(`_uuid`) 108 | #' modis_ic_tidy <- as_tidyee(modis_ic) 109 | #' modis_monthly_baseline_mean <- modis_ic_tidy |> 110 | #' select("NDVI") |> 111 | #' filter(year %in% 2000:2015) |> 112 | #' group_by(month) |> 113 | #' summarise(stat="mean") 114 | #' 115 | #' ndvi_monthly_mean_at_pt<- modis_monthly_baseline_mean |> 116 | #' ee_extract(y = point_sample_buffered, 117 | #' stat="mean", 118 | #' scale = 500) 119 | #'} 120 | #' @seealso \code{\link[rgee]{ee_extract}} for information about ee_extract on ee$ImageCollections and ee$Images 121 | #' @export 122 | #' @importFrom rgee ee_extract 123 | #' @importFrom rlang .data 124 | #' 125 | #' 126 | ee_extract <- function(x, 127 | y, 128 | stat="mean", 129 | scale, 130 | via="getInfo", 131 | container="rgee_backup", 132 | sf=TRUE, 133 | lazy=FALSE, 134 | quiet=FALSE,...){ 135 | UseMethod("ee_extract") 136 | } 137 | -------------------------------------------------------------------------------- /R/summarise.R: -------------------------------------------------------------------------------- 1 | #' @rdname summarise 2 | #' @name summarise 3 | #' @export 4 | #' @return ee$Image or ee$ImageCollection where pixels are summarised by group_by and stat 5 | summarise.ee.imagecollection.ImageCollection <- function(.data,stat,...){ 6 | stopifnot(!is.null(.data), inherits(.data, "ee.imagecollection.ImageCollection")) 7 | convert_to_tidyee_warning() 8 | x_tidy <- as_tidyee(.data) 9 | x_tidy |> 10 | summarise( 11 | stat=stat 12 | ) 13 | } 14 | 15 | #' @rdname summarise 16 | #' @name summarise 17 | #' @export 18 | #' @return ee$Image or ee$ImageCollection where pixels are summarised by group_by and stat 19 | summarise.tidyee <- function(.data,stat,...,join_bands=TRUE){ 20 | summary_list <- stat |> 21 | purrr::map( 22 | ~.data |> 23 | summarise_pixels(stat=.x) 24 | ) 25 | 26 | if(length(summary_list)==1){ 27 | return(summary_list[[1]]) 28 | } 29 | if(length(summary_list)>1 & isTRUE(join_bands)){ 30 | return(purrr::reduce(.x = summary_list,.f = inner_join,"system:time_start")) 31 | } 32 | if(length(summary_list)>1 & join_bands==F){ 33 | return(summary_list) 34 | } 35 | } 36 | 37 | 38 | #' Summary pixel-level stats for ee$ImageCollection or tidyrgee objects with ImageCollections 39 | #' @rdname summarise 40 | #' @name summarise 41 | #' @param .data ee$Image or ee$ImageCollection 42 | #' @param stat \code{character} stat/function to apply 43 | #' @param ... other arguments 44 | #' @param join_bands \code{logical} (default= TRUE) if multiple stats selected should bands be joined? 45 | #' @return ee$Image or ee$ImageCollection where pixels are summarised by group_by and stat 46 | #' @examples \dontrun{ 47 | #' library(tidyrgee) 48 | #' library(rgee) 49 | #' ee_Initialize() 50 | #' modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 51 | #' modis_ic |> 52 | #' filter(date>="2016-01-01",date<="2019-12-31") |> 53 | #' group_by(year) |> 54 | #' summarise(stat="max") 55 | #' } 56 | #' @seealso \code{\link[dplyr]{summarise}} for information about summarise on normal data tables. 57 | #' @export 58 | #' @importFrom dplyr summarise 59 | NULL 60 | 61 | 62 | 63 | 64 | 65 | #' Summary pixel-level stats for ee$ImageCollection or tidyrgee objects with ImageCollections 66 | #' @rdname summarise_pixels 67 | #' @name summarise_pixels 68 | #' @param .data ee$Image or ee$ImageCollection 69 | #' @param stat stat/function to apply 70 | #' @param ... other arguments 71 | #' @noRd 72 | 73 | summarise_pixels <- function(.data,stat,...){ 74 | group_vars_chr <- dplyr::group_vars(.data$vrt) 75 | 76 | assertthat::assert_that(all(group_vars_chr %in% names(.data$vrt))) 77 | if(all(group_vars_chr %in% c("year","month"))){ 78 | if(length(group_vars_chr)==0){ 79 | tidyee_output <- ee_composite(x = .data,stat = stat) 80 | } 81 | if(length(group_vars_chr)>0){ 82 | 83 | years_unique_chr <- unique(.data$vrt$year) |> sort() 84 | months_unique_chr <- unique(.data$vrt$month) |> sort() 85 | 86 | if(length(group_vars_chr)==1){ 87 | if(group_vars_chr=="year"){ 88 | tidyee_output <- ee_year_composite(.data,stat = stat) 89 | } 90 | if(group_vars_chr=="month"){ 91 | tidyee_output <- ee_month_composite(.data,stat = stat) 92 | } 93 | } 94 | if(length(group_vars_chr)==2 & all(c("month","year")%in%group_vars_chr)){ 95 | # dont want to run year_month composite if there is only 96 | # 1 month or 1 year in vrt... mapping over ee$List of 1 value throws error. 97 | if(length(months_unique_chr)==1){ 98 | tidyee_output <- ee_year_composite(.data,stat = stat) 99 | } 100 | if(length(years_unique_chr)==1){ 101 | tidyee_output <- ee_month_composite(.data,stat = stat) 102 | }else{ 103 | tidyee_output <- ee_year_month_composite(.data,stat = stat) 104 | } 105 | 106 | 107 | } 108 | } 109 | } 110 | 111 | if( 112 | !all (group_vars_chr %in% c("month","year"))& 113 | length(group_vars_chr)>0 114 | ){ 115 | # x_split_list <- .data |> 116 | # group_split() 117 | # x_split_summaries <- x_split_list |> 118 | # purrr::map( ~ee_composite(x = .x |> 119 | # group_by(!!!rlang::syms(group_vars_chr)), 120 | # stat = stat)) 121 | 122 | tidyee_output <- .data |> 123 | group_split() |> 124 | purrr::map( 125 | ~ee_composite( 126 | .x |> 127 | group_by(!!!rlang::syms(group_vars_chr)), 128 | stat=stat) 129 | ) |> 130 | bind_ics() 131 | #previously would just call this: 132 | # tidyee_output <- bind_ics(x=x_split_summaries) 133 | #however lets see if taking it out of function gets rid of error 134 | # ic_only <- x_split_summaries |> 135 | # purrr::map("ee_ob") 136 | # vrt_only <- x_split_summaries |> 137 | # purrr::map("vrt") 138 | # 139 | # vrt_together<- dplyr::bind_rows(vrt_only) 140 | # 141 | # ic_container = ee$ImageCollection(list()) 142 | # for(i in 1:length(ic_only)){ 143 | # ic_container=ic_container$merge(ic_only[[i]]) 144 | # 145 | # } 146 | # tidyee_output <- create_tidyee(x = ic_container$sort(prop = "system:time_start"),vrt = vrt_together ) 147 | 148 | 149 | 150 | } 151 | 152 | return(tidyee_output) 153 | } 154 | -------------------------------------------------------------------------------- /R/clip.R: -------------------------------------------------------------------------------- 1 | #' clip flexible wrapper for rgee::ee$Image$clip() 2 | #' @description allows clipping of tidyee,ee$Imagecollection, or ee$Image classes. Also allows objects to be clipped to sf object in addition to ee$FeatureCollections/ee$Feature 3 | #' @param x object to be clipped (tidyee, ee$ImageCollection, ee$Image) 4 | #' @param y geometry object to clip to (sf, ee$Feature,ee$FeatureCollections) 5 | #' @param return_tidyee \code{logical} return tidyee class (default = TRUE) object or ee$ImageCollection. Faster performance if F 6 | #' 7 | #' @return x as tidyee or ee$Image/ee$ImageCollection depending on `return_tidyee` argument. 8 | #' @export 9 | #' 10 | #' @examples \dontrun{ 11 | 12 | #' library(tidyrgee) 13 | #' library(tidyverse) 14 | #' library(rgee) 15 | #' rgee::ee_Initialize() 16 | #' 17 | #' # create geometry and convert to sf 18 | #' coord_tibble <- tibble::tribble( 19 | #' ~X, ~Y, 20 | #' 92.2303683692011, 20.9126490153521, 21 | #' 92.2311567217866, 20.9127410439304, 22 | #' 92.2287527311594, 20.9124072954926, 23 | #' 92.2289221219251, 20.9197352745068, 24 | #' 92.238724724534, 20.9081803233546 25 | #' ) 26 | #' sf_ob <- sf::st_as_sf(coord_tibble, coords=c("X","Y"),crs=4326) 27 | #' 28 | #' roi <- ee$Geometry$Polygon(list( 29 | #' c(-114.275, 45.891), 30 | #' c(-108.275, 45.868), 31 | #' c(-108.240, 48.868), 32 | #' c(-114.240, 48.891) 33 | #' )) 34 | #' 35 | #' # load landsat 36 | #' ls = ee$ImageCollection("LANDSAT/LC08/C01/T1_SR") 37 | #' 38 | #' # create tidyee class 39 | #' ls_tidy <- as_tidyee(ls) 40 | #' 41 | #' # filter_bounds on sf object 42 | #' # return tidyee object 43 | #' ls_tidy |> 44 | #' filter_bounds(y = roi,return_tidyee = FALSE) |> 45 | #' clip(roi,return_tidyee = FALSE) 46 | #' 47 | #' # pretty instant with return_tidyee=FALSE 48 | #' ls_clipped_roi_ic <- ls_tidy |> 49 | #' filter_bounds(y = roi,return_tidyee = FALSE) |> 50 | #' clip(roi,return_tidyee = FALSE) 51 | #' 52 | #' # takes more time with return_tidyee=T, but you get the vrt 53 | #' ls_clipped__roi_tidyee <- ls_tidy |> 54 | #' filter_bounds(y = roi,return_tidyee = FALSE) |> 55 | #' clip(roi,return_tidyee = TRUE) 56 | #' 57 | #' # demonstrating on sf object 58 | #' ls_clipped_sf_ob_ic <- ls_tidy |> 59 | #' filter_bounds(y = sf_ob,return_tidyee = FALSE) |> 60 | #' clip(roi,return_tidyee = FALSE) 61 | #' 62 | #' ls_clipped_sf_ob_tidyee <- ls_tidy |> 63 | #' filter_bounds(y = roi,return_tidyee = FALSE) |> 64 | #' clip(roi,return_tidyee = TRUE) 65 | #' } 66 | 67 | clip<- function(x,y, return_tidyee=TRUE){ 68 | UseMethod("clip") 69 | } 70 | 71 | 72 | 73 | 74 | 75 | #' @export 76 | clip.tidyee <- function(x,y,return_tidyee=TRUE){ 77 | assertthat::assert_that(rlang::inherits_any(y, c("sf","ee.geometry.Geometry", 78 | "ee.featurecollection.FeatureCollection", 79 | "ee.feature.Feature"))) 80 | assertthat::assert_that(inherits(x, c("tidyee"))) 81 | 82 | if(inherits(y,"sf")){ 83 | y_ee <- rgee::sf_as_ee(y) 84 | } 85 | if(rlang::inherits_any(y,c("ee.geometry.Geometry", 86 | "ee.featurecollection.FeatureCollection", 87 | "ee.feature.Feature"))){ 88 | y_ee <- y 89 | } 90 | if(inherits(x$ee_ob,"ee.imagecollection.ImageCollection")){ 91 | x_clipped <- x$ee_ob$map( 92 | function(img){ 93 | img$clip(y_ee) 94 | } 95 | ) 96 | } 97 | if(inherits(x$ee_ob,"ee.image.Image")){ 98 | x_clipped <- x$ee_ob$clip(y_ee) 99 | } 100 | 101 | 102 | if(!return_tidyee){ 103 | res <- x_clipped 104 | } 105 | if(return_tidyee){ 106 | res <- as_tidyee(x_clipped) 107 | } 108 | return(res) 109 | } 110 | 111 | #' @export 112 | clip.ee.image.Image <- function(x,y,return_tidyee=TRUE){ 113 | assertthat::assert_that(rlang::inherits_any(y, c("sf","ee.geometry.Geometry", 114 | "ee.featurecollection.FeatureCollection", 115 | "ee.feature.Feature"))) 116 | assertthat::assert_that(inherits(x, c("ee.image.Image"))) 117 | 118 | if(inherits(y,"sf")){ 119 | y_ee <- rgee::sf_as_ee(y) 120 | } 121 | if(rlang::inherits_any(y,c("ee.geometry.Geometry", 122 | "ee.featurecollection.FeatureCollection", 123 | "ee.feature.Feature"))){ 124 | y_ee <- y 125 | } 126 | x_clipped <- x$clip(y_ee) 127 | if(!return_tidyee){ 128 | res <- x_clipped 129 | } 130 | if(return_tidyee){ 131 | res <- as_tidyee(x_clipped) 132 | } 133 | return(res) 134 | } 135 | 136 | #' @export 137 | clip.ee.imagecollection.ImageCollection <- function(x,y,return_tidyee=TRUE){ 138 | assertthat::assert_that(rlang::inherits_any(y, c("sf","ee.geometry.Geometry", 139 | "ee.featurecollection.FeatureCollection", 140 | "ee.feature.Feature"))) 141 | assertthat::assert_that(inherits(x, c("ee.imagecollection.ImageCollection"))) 142 | 143 | if(inherits(y,"sf")){ 144 | y_ee <- rgee::sf_as_ee(y) 145 | } 146 | if(rlang::inherits_any(y,c("ee.geometry.Geometry", 147 | "ee.featurecollection.FeatureCollection", 148 | "ee.feature.Feature"))){ 149 | y_ee <- y 150 | } 151 | x_clipped <- x$map( 152 | function(img){ 153 | img$clip(y_ee) 154 | } 155 | ) 156 | if(!return_tidyee){ 157 | res <- x_clipped 158 | } 159 | if(return_tidyee){ 160 | res <- as_tidyee(x_clipped) 161 | } 162 | return(res) 163 | } 164 | 165 | -------------------------------------------------------------------------------- /tests/testthat/test-filter.R: -------------------------------------------------------------------------------- 1 | skip_if_no_pypkg() 2 | test_that("testing filter() using year", { 3 | 4 | # with MODIS 5 | modis_ic <- rgee::ee$ImageCollection("MODIS/006/MOD13Q1") 6 | 7 | # with == and year 8 | filter_year <- modis_ic %>% 9 | as_tidyee() %>% 10 | filter(year == 2008) 11 | 12 | ee_filter <- modis_ic$filterDate('2008-01-01', '2009-01-01') 13 | 14 | expect_equal(filter_year$ee_ob$size()$getInfo(), 23) 15 | expect_equal(filter_year$ee_ob$size()$getInfo(), ee_filter$size()$getInfo()) 16 | expect_equal(nrow(filter_year$vrt),filter_year$ee_ob$size()$getInfo()) 17 | 18 | # with %in% and : and year 19 | filter_year <- modis_ic %>% 20 | as_tidyee() %>% 21 | filter(year %in% c(2008:2010)) 22 | 23 | ee_filter <- modis_ic$filterDate('2008-01-01', '2011-01-01') 24 | 25 | expect_equal(filter_year$ee_ob$size()$getInfo(), 69) 26 | expect_equal(filter_year$ee_ob$size()$getInfo(), ee_filter$size()$getInfo()) 27 | expect_equal(nrow(filter_year$vrt),filter_year$ee_ob$size()$getInfo()) 28 | 29 | # with non-sequential years 30 | filter_year <- modis_ic %>% 31 | as_tidyee() %>% 32 | filter(year %in% c(2007,2012)) 33 | 34 | ee_filter1 <- modis_ic$filterDate('2007-01-01', '2008-01-01') 35 | ee_filter2 <- modis_ic$filterDate('2012-01-01', '2013-01-01') 36 | ee_filter <- ee_filter1$merge(ee_filter2) 37 | 38 | expect_equal(filter_year$ee_ob$size()$getInfo(), 46) 39 | expect_equal(filter_year$ee_ob$size()$getInfo(), ee_filter$size()$getInfo()) 40 | expect_equal(nrow(filter_year$vrt),filter_year$ee_ob$size()$getInfo()) 41 | 42 | #with landsat T1/SR 43 | 44 | roi <- ee$Geometry$Point(-114.275, 45.891) 45 | 46 | ld_ic = ee$ImageCollection("LANDSAT/LC08/C01/T1_SR")$filterBounds(roi) 47 | 48 | # with == and year 49 | filter_year <- ld_ic %>% 50 | as_tidyee() %>% 51 | filter(year == 2018) 52 | 53 | ee_filter <- ld_ic$filterDate('2018-01-01', '2019-01-01') 54 | 55 | expect_equal(filter_year$ee_ob$size()$getInfo(), ee_filter$size()$getInfo()) 56 | expect_equal(nrow(filter_year$vrt),filter_year$ee_ob$size()$getInfo()) 57 | 58 | # with %in% and : and year 59 | filter_year <- ld_ic %>% 60 | as_tidyee() %>% 61 | filter(year %in% c(2018:2020)) 62 | 63 | ee_filter <- ld_ic$filterDate('2018-01-01', '2021-01-01') 64 | 65 | expect_equal(filter_year$ee_ob$size()$getInfo(), ee_filter$size()$getInfo()) 66 | expect_equal(nrow(filter_year$vrt),filter_year$ee_ob$size()$getInfo()) 67 | 68 | # with non-sequential years 69 | filter_year <- ld_ic %>% 70 | as_tidyee() %>% 71 | filter(year %in% c(2017,2021)) 72 | 73 | ee_filter1 <- ld_ic$filterDate('2017-01-01', '2018-01-01') 74 | ee_filter2 <- ld_ic$filterDate('2021-01-01', '2022-01-01') 75 | ee_filter <- ee_filter1$merge(ee_filter2) 76 | 77 | expect_equal(filter_year$ee_ob$size()$getInfo(), ee_filter$size()$getInfo()) 78 | expect_equal(nrow(filter_year$vrt),filter_year$ee_ob$size()$getInfo()) 79 | 80 | #with sentinel 81 | s_ic = ee$ImageCollection("COPERNICUS/S2")$filterBounds(roi) 82 | 83 | # with == and year 84 | filter_year <- s_ic %>% 85 | as_tidyee() %>% 86 | filter(year == 2018) 87 | 88 | ee_filter <- s_ic$filterDate('2018-01-01', '2019-01-01') 89 | 90 | expect_equal(filter_year$ee_ob$size()$getInfo(), ee_filter$size()$getInfo()) 91 | expect_equal(nrow(filter_year$vrt),filter_year$ee_ob$size()$getInfo()) 92 | 93 | # with %in% and : and year 94 | filter_year <- s_ic %>% 95 | as_tidyee() %>% 96 | filter(year %in% c(2018:2020)) 97 | 98 | ee_filter <- s_ic$filterDate('2018-01-01', '2021-01-01') 99 | 100 | expect_equal(filter_year$ee_ob$size()$getInfo(), ee_filter$size()$getInfo()) 101 | 102 | expect_equal(nrow(filter_year$vrt),filter_year$ee_ob$size()$getInfo()) 103 | 104 | # with non-sequential years 105 | filter_year <- s_ic %>% 106 | as_tidyee() %>% 107 | filter(year %in% c(2017,2021)) 108 | 109 | ee_filter1 <- s_ic$filterDate('2017-01-01', '2018-01-01') 110 | ee_filter2 <- s_ic$filterDate('2021-01-01', '2022-01-01') 111 | ee_filter <- ee_filter1$merge(ee_filter2) 112 | 113 | expect_equal(filter_year$ee_ob$size()$getInfo(), ee_filter$size()$getInfo()) 114 | 115 | expect_equal(nrow(filter_year$vrt),filter_year$ee_ob$size()$getInfo()) 116 | 117 | }) 118 | 119 | test_that("testing filter() using month", { 120 | 121 | # with MODIS 122 | modis_ic <- rgee::ee$ImageCollection("MODIS/006/MOD13Q1") 123 | 124 | month = c(8,10) 125 | expect_equal({ 126 | 127 | ee_month_list <- rgee::ee$List(month) # switched from ee$List$sequence - let the user make sequence in R or suppply raw 128 | 129 | ic_list <- 130 | ee_month_list$map(rgee::ee_utils_pyfunc(function (m) { 131 | modis_ic$filter(rgee::ee$Filter$calendarRange(m, m, 'month')) 132 | } 133 | 134 | )) 135 | 136 | fc_from_ic_list <- rgee::ee$FeatureCollection(ic_list) 137 | first_month_filter <- rgee::ee$ImageCollection(fc_from_ic_list$flatten()) 138 | first_month_filter$size()$getInfo()}, 139 | { 140 | month_filter <- modis_ic %>% 141 | as_tidyee() %>% 142 | filter(month %in% c(8,10)) 143 | 144 | month_filter$ee_ob$size()$getInfo() 145 | }) 146 | 147 | month = c(8,12) 148 | expect_equal({ 149 | 150 | ee_month_list <- rgee::ee$List(month) # switched from ee$List$sequence - let the user make sequence in R or suppply raw 151 | 152 | ic_list <- 153 | ee_month_list$map(rgee::ee_utils_pyfunc(function (m) { 154 | modis_ic$filter(rgee::ee$Filter$calendarRange(m, m, 'month')) 155 | } 156 | 157 | )) 158 | 159 | fc_from_ic_list <- rgee::ee$FeatureCollection(ic_list) 160 | first_month_filter <- rgee::ee$ImageCollection(fc_from_ic_list$flatten()) 161 | first_month_filter$size()$getInfo()}, 162 | { 163 | month_filter <- modis_ic %>% 164 | as_tidyee() %>% 165 | filter(month %in% c(8,12)) 166 | 167 | month_filter$ee_ob$size()$getInfo() 168 | }) 169 | 170 | 171 | }) 172 | 173 | 174 | test_that('year, month within filter',{ 175 | 176 | # with MODIS 177 | modis_ic <- rgee::ee$ImageCollection("MODIS/006/MOD13Q1") 178 | 179 | month = c(8,10) 180 | year = c(2010,2011) 181 | 182 | yr_ic <- ee_year_filter(modis_ic,year = year) 183 | yr_mo_ic <- ee_month_filter(yr_ic,month=month) 184 | 185 | filter_year <- modis_ic %>% 186 | as_tidyee() %>% 187 | filter(year %in% c(2010,2011), 188 | month %in% c(8,10)) 189 | 190 | expect_equal(filter_year$ee_ob$size()$getInfo(), yr_mo_ic$size()$getInfo()) 191 | 192 | # with landsat 8 T1/SR 193 | 194 | roi <- ee$Geometry$Point(-114.275, 45.891) 195 | 196 | ld_ic = ee$ImageCollection("LANDSAT/LC08/C01/T1_SR")$filterBounds(roi) 197 | 198 | month = c(8,10) 199 | year = c(2018,2020) 200 | 201 | yr_ic <- ee_year_filter(ld_ic,year = year) 202 | yr_mo_ic <- ee_month_filter(yr_ic,month=month) 203 | 204 | filter_year <- ld_ic %>% 205 | as_tidyee() %>% 206 | filter(year %in% c(2018,2020), 207 | month %in% c(8,10)) 208 | 209 | expect_equal(filter_year$ee_ob$size()$getInfo(), yr_mo_ic$size()$getInfo()) 210 | 211 | }) 212 | -------------------------------------------------------------------------------- /tests/testthat/test-filters.R: -------------------------------------------------------------------------------- 1 | skip_if_no_pypkg() 2 | test_that("ee_year_filter works", { 3 | 4 | # with MODIS 5 | modis_ic <- rgee::ee$ImageCollection("MODIS/006/MOD13Q1") 6 | 7 | num_img_2003 <- modis_ic$filterDate("2003-01-01","2003-12-31")$size()$getInfo() 8 | num_img_2007 <- modis_ic$filterDate("2007-01-01","2007-12-31")$size()$getInfo() 9 | num_images_2003_and_2007 <- num_img_2003+num_img_2007 10 | 11 | modis_ic_year_filtered <- modis_ic |> 12 | ee_year_filter(year= c(2003,2007)) 13 | 14 | 15 | expect_equal(modis_ic_year_filtered$ 16 | size()$ 17 | getInfo() , 18 | num_images_2003_and_2007) 19 | 20 | #with landsat T1/SR 21 | 22 | roi <- ee$Geometry$Polygon(list( 23 | c(-114.275, 45.891), 24 | c(-108.275, 45.868), 25 | c(-108.240, 48.868), 26 | c(-114.240, 48.891) 27 | )) 28 | 29 | imageCol = ee$ImageCollection("LANDSAT/LC08/C01/T1_SR")$filterBounds(roi) 30 | 31 | num_img_2014 <- imageCol$filterDate("2014-01-01","2014-12-31")$size()$getInfo() 32 | num_img_2017 <- imageCol$filterDate("2017-01-01","2017-12-31")$size()$getInfo() 33 | num_images_2014_and_2017 <- num_img_2014+num_img_2017 34 | 35 | filter_by_year = imageCol %>% 36 | ee_year_filter(year = c(2014,2017)) 37 | 38 | expect_equal(filter_by_year$size()$getInfo(), num_images_2014_and_2017) 39 | 40 | #with COPERNICUS/S2 41 | 42 | roi = ee$Geometry$Point(-115.11353, 48.1380) 43 | imageCol = ee$ImageCollection("COPERNICUS/S2")$filterBounds(roi) 44 | 45 | num_img_2018 <- imageCol$filterDate("2018-01-01","2018-12-31")$size()$getInfo() 46 | num_img_2020 <- imageCol$filterDate("2020-01-01","2020-12-31")$size()$getInfo() 47 | num_images_2018_and_2020 <- num_img_2018+num_img_2020 48 | 49 | filter_by_year = imageCol %>% 50 | ee_year_filter(year = c(2018,2020)) 51 | 52 | expect_equal(filter_by_year$size()$getInfo(), num_images_2018_and_2020) 53 | 54 | #with three years 55 | num_img_2018 <- imageCol$filterDate("2018-01-01","2018-12-31")$size()$getInfo() 56 | num_img_2020 <- imageCol$filterDate("2020-01-01","2020-12-31")$size()$getInfo() 57 | num_img_2021 <- imageCol$filterDate("2021-01-01","2021-12-31")$size()$getInfo() 58 | 59 | num_images_2018_and_2020_and_2021 <- num_img_2018+num_img_2020+num_img_2021 60 | 61 | filter_by_year = imageCol %>% 62 | ee_year_filter(year = c(2018,2020, 2021)) 63 | 64 | expect_equal(filter_by_year$size()$getInfo(), num_images_2018_and_2020_and_2021) 65 | 66 | 67 | # there are differences though depending on size; see below 68 | 69 | imageCol = ee$ImageCollection("LANDSAT/LC08/C01/T1_SR") 70 | 71 | num_img_2014 <- imageCol$filterDate("2014-01-01","2014-12-31")$size()$getInfo() 72 | num_img_2017 <- imageCol$filterDate("2017-01-01","2017-12-31")$size()$getInfo() 73 | num_images_2014_and_2017 <- num_img_2014+num_img_2017 74 | 75 | filter_by_year = imageCol %>% 76 | ee_year_filter(year = c(2014,2017)) 77 | 78 | expect_error(expect_equal(filter_by_year$size()$getInfo(), num_images_2014_and_2017)) 79 | 80 | # for IDAHO_EPSCOR/GRIDMET 81 | 82 | roi = ee$Geometry$Point(-115.11353, 48.1380) 83 | imageCol = ee$ImageCollection("IDAHO_EPSCOR/GRIDMET")$filterBounds(roi) 84 | 85 | num_img_2018 <- imageCol$filterDate("2018-01-01","2018-12-31")$size()$getInfo() 86 | num_img_2020 <- imageCol$filterDate("2020-01-01","2020-12-31")$size()$getInfo() 87 | num_images_2018_and_2020 <- num_img_2018+num_img_2020 88 | 89 | filter_by_year = imageCol %>% 90 | ee_year_filter(year = c(2018,2020)) 91 | 92 | expect_error(expect_equal(filter_by_year$size()$getInfo(), num_images_2018_and_2020)) 93 | 94 | #reason for errors is that filterDate only goes to 12-30 and not 12-31; see below 95 | iterate_over_final_ic <- function(image, newlist){ 96 | date = ee$Number$parse(image$date()$format("YYYYMMdd")) 97 | newlist = ee$List(newlist) 98 | return(ee$List(newlist$add(date)$sort())) 99 | } 100 | 101 | year_list = filter_by_year$iterate(iterate_over_final_ic, ee$List(list())) 102 | 103 | year_list <- year_list$getInfo() 104 | 105 | num_img_2018 <- imageCol$filterDate("2018-01-01","2018-12-31") 106 | num_img_2020 <- imageCol$filterDate("2020-01-01","2020-12-31") 107 | 108 | merged <- num_img_2018$merge(num_img_2020) 109 | 110 | merge_list = merged$iterate(iterate_over_final_ic, ee$List(list())) 111 | 112 | merge_list <- merge_list$getInfo() 113 | 114 | dates_not_in <- year_list[!(year_list %in% merge_list)] 115 | 116 | expect_equal(dates_not_in, c(20181231,20201231)) 117 | 118 | # now fix with 01-01 as last date for IDAHO_EPSCOR/GRIDMET 119 | 120 | roi = ee$Geometry$Point(-115.11353, 48.1380) 121 | imageCol = ee$ImageCollection("IDAHO_EPSCOR/GRIDMET")$filterBounds(roi) 122 | 123 | num_img_2018 <- imageCol$filterDate("2018-01-01","2019-01-01")$size()$getInfo() 124 | num_img_2020 <- imageCol$filterDate("2020-01-01","2021-01-01")$size()$getInfo() 125 | num_images_2018_and_2020 <- num_img_2018+num_img_2020 126 | 127 | filter_by_year = imageCol %>% 128 | ee_year_filter(year = c(2018,2020)) 129 | 130 | expect_equal(filter_by_year$size()$getInfo(), num_images_2018_and_2020) 131 | 132 | }) 133 | 134 | 135 | test_that("ee_month_filter works", { 136 | 137 | # with MODIS 138 | modis_ic <- rgee::ee$ImageCollection("MODIS/006/MOD13Q1") 139 | 140 | month = c(3,7) 141 | expect_equal({ 142 | 143 | ee_month_list <- rgee::ee$List(month) # switched from ee$List$sequence - let the user make sequence in R or suppply raw 144 | 145 | ic_list <- 146 | ee_month_list$map(rgee::ee_utils_pyfunc(function (m) { 147 | modis_ic$filter(rgee::ee$Filter$calendarRange(m, m, 'month')) 148 | } 149 | 150 | )) 151 | 152 | fc_from_ic_list <- rgee::ee$FeatureCollection(ic_list) 153 | first_month_filter <- rgee::ee$ImageCollection(fc_from_ic_list$flatten()) 154 | first_month_filter$size()$getInfo()}, 155 | { 156 | month_filter <- modis_ic |> 157 | ee_month_filter(month= c(3,7)) 158 | 159 | month_filter$size()$getInfo() 160 | }) 161 | 162 | #with four months 163 | month = c(3,7,9,11) 164 | expect_equal({ 165 | 166 | ee_month_list <- rgee::ee$List(month) # switched from ee$List$sequence - let the user make sequence in R or suppply raw 167 | 168 | ic_list <- 169 | ee_month_list$map(rgee::ee_utils_pyfunc(function (m) { 170 | modis_ic$filter(rgee::ee$Filter$calendarRange(m, m, 'month')) 171 | } 172 | 173 | )) 174 | 175 | fc_from_ic_list <- rgee::ee$FeatureCollection(ic_list) 176 | first_month_filter <- rgee::ee$ImageCollection(fc_from_ic_list$flatten()) 177 | first_month_filter$size()$getInfo()}, 178 | { 179 | month_filter <- modis_ic |> 180 | ee_month_filter(month= c(3,7,9,11)) 181 | 182 | month_filter$size()$getInfo() 183 | }) 184 | 185 | # with landsat T1/SR 186 | 187 | roi = ee$Geometry$Point(-115.11353, 48.1380) 188 | ld_ic <- rgee::ee$ImageCollection("LANDSAT/LC08/C01/T1_SR")$filterBounds(roi) 189 | 190 | month = c(3,7) 191 | expect_equal({ 192 | 193 | ee_month_list <- rgee::ee$List(month) # switched from ee$List$sequence - let the user make sequence in R or suppply raw 194 | 195 | ic_list <- 196 | ee_month_list$map(rgee::ee_utils_pyfunc(function (m) { 197 | ld_ic$filter(rgee::ee$Filter$calendarRange(m, m, 'month')) 198 | } 199 | 200 | )) 201 | 202 | fc_from_ic_list <- rgee::ee$FeatureCollection(ic_list) 203 | first_month_filter <- rgee::ee$ImageCollection(fc_from_ic_list$flatten()) 204 | first_month_filter$size()$getInfo()}, 205 | { 206 | month_filter <- ld_ic |> 207 | ee_month_filter(month= c(3,7)) 208 | 209 | month_filter$size()$getInfo() 210 | }) 211 | 212 | }) 213 | 214 | 215 | 216 | 217 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | 2 | #' @name rename_stdDev_bands 3 | #' @title rename_stdDev_bands 4 | #' @param x ee$ImageCollection 5 | #' @return x ee$Image/ImageCollection with `.*_stdDev$` bands renamed to `.*_sd$` 6 | 7 | rename_stdDev_bands <- function(x){ 8 | UseMethod("rename_stdDev_bands") 9 | } 10 | 11 | 12 | #' @export 13 | rename_stdDev_bands.ee.imagecollection.ImageCollection<-function(x){ 14 | x$map( 15 | function(img){ 16 | bnames_server <- img$bandNames() 17 | bnames_renamed_server <- bnames_server$ 18 | map( 19 | rgee::ee_utils_pyfunc( 20 | function(bname){ee$String(bname)$replace("_stdDev$","_sd")} 21 | ) 22 | ) 23 | img$select(bnames_server,bnames_renamed_server) 24 | } 25 | ) 26 | } 27 | 28 | #' @export 29 | rename_stdDev_bands.ee.image.Image<-function(x){ 30 | bnames_server <- x$bandNames() 31 | bnames_renamed_server <- bnames_server$ 32 | map( 33 | rgee::ee_utils_pyfunc( 34 | function(bname){ee$String(bname)$replace("_stdDev$","_sd")} 35 | ) 36 | ) 37 | x$select(bnames_server,bnames_renamed_server) 38 | } 39 | 40 | 41 | 42 | #' @noRd 43 | #' @title rename_summary_stat_bands 44 | #' @name rename_summary_stat_bands 45 | #' @param x ee$ImageCollection/ee$Image 46 | #' @param stat statistic 47 | #' @description helper function to rename bands that have been auto-renamed during composite. `rgee` appends on reducer name to band (i.e `band_reducer`). The r-syntax and GEE syntax are the same accept for standard deviation. When images are reduced by standard deviation - this function switches the suffix to r-syntax. 48 | #' 49 | #' @return x ee$Image/ImageCollection with renamed band if `.*_stdDev` bandnames 50 | 51 | rename_summary_stat_bands <- function(x, stat){ 52 | if(stat=="sd"){ 53 | res <- rename_stdDev_bands(x) 54 | } 55 | else{ 56 | res <- x 57 | } 58 | return(res) 59 | } 60 | 61 | 62 | 63 | #' stat_to_reducer 64 | #' @noRd 65 | #' 66 | #' @param fun \code{character} rstats fun (i.e "mean" , "median") 67 | #' 68 | #' @return `ee$Reducer` class function that can be supplied as reducer type arguments 69 | 70 | 71 | 72 | stat_to_reducer <- function(fun){ switch( 73 | fun, 74 | "mean" = rgee::ee$Reducer$mean(), 75 | "max" = rgee::ee$Reducer$max(), 76 | "min" = rgee::ee$Reducer$min(), 77 | "median"= rgee::ee$Reducer$median(), 78 | "sum"= rgee::ee$Reducer$sum(), 79 | "sd" = rgee::ee$Reducer$stdDev(), 80 | "first" = rgee::ee$Reducer$first(), 81 | NULL 82 | ) 83 | } 84 | 85 | #' @noRd 86 | #' @title stat_to_reducer_full - helper function - useful in ee_*_composite funcs 87 | #' @param fun reducer/statistic using typical r-syntax (character) 88 | #' @return `ee$Reducer` function that can be piped or wrapped around `ee$ImageCollections` 89 | 90 | stat_to_reducer_full <- function(fun){switch(fun, 91 | 92 | "mean" = function(x)x$reduce(rgee::ee$Reducer$mean()), 93 | "max" = function(x)x$reduce(rgee::ee$Reducer$max()), 94 | "min" = function(x)x$reduce(rgee::ee$Reducer$min()), 95 | "median"= function(x)x$reduce(rgee::ee$Reducer$median()), 96 | "sum"= function(x)x$reduce(rgee::ee$Reducer$sum()), 97 | "sd" = function(x)x$reduce(rgee::ee$Reducer$stdDev()), 98 | NULL 99 | 100 | ) 101 | } 102 | 103 | #' @noRd 104 | #' @name rstat_to_eestat 105 | #' @title rstat_to_eestat - helper function - useful in ee_*_composite functions to get bandNames from vrt 106 | #' @param fun reducer/statistic using typical r-syntax (character) 107 | #' @return rgee/GEE equivalent typical character statistic syntax 108 | 109 | rstat_to_eestat <- function(fun){switch(fun, 110 | 111 | "mean" = "mean", 112 | "max" = "max", 113 | "min" = "min", 114 | "median"= "median", 115 | "sum"= "sum", 116 | "sd" = "stdDev", 117 | NULL 118 | 119 | ) 120 | } 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | #' date_range_imageCol 131 | #' 132 | #' @param x imageCollection or image 133 | #' @description a fast-working helper function to extract min and max date ranges for image collections 134 | #' @noRd 135 | #' @return sorted date vector (length 2) 136 | #' 137 | #' @examples \dontrun{ 138 | #' library(tidyrgee) 139 | #' ee_Initialize() 140 | #' modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 141 | #' date_range_imageCol(modis_ic) 142 | #' } 143 | #' 144 | 145 | date_range_imageCol <- function(x){ 146 | time_start_list <- x$aggregate_array("system:time_start") 147 | time_start_list_fmt <- time_start_list$map( 148 | rgee::ee_utils_pyfunc( function(x){ 149 | rgee::ee$Date(x)$format("YYYY-MM-dd") 150 | 151 | }) 152 | ) 153 | time_start_list_fmt$sort()$getInfo() |> 154 | lubridate::ymd() |> 155 | range() 156 | 157 | 158 | 159 | } 160 | 161 | 162 | 163 | #' vrt_band_names 164 | #' @name vrt_band_names 165 | #' @noRd 166 | #' @param x tidyee class object 167 | #' @return a character vector of band_names 168 | #' @importFrom rlang .data 169 | 170 | 171 | vrt_band_names <- function(x){ 172 | x$vrt |> 173 | dplyr::pull(.data$band_names) |> 174 | unique() |> 175 | unlist() 176 | } 177 | 178 | 179 | 180 | #' last_day_of_month 181 | #' @param year \code{numeric} year 182 | #' @param month_numeric \code{numeric} vector containing months of interest 183 | #' @noRd 184 | #' @return \code{numeric} vector which the last day of each month 185 | #' 186 | 187 | last_day_of_month <- function(year,month_numeric){ 188 | lubridate::day( 189 | lubridate::ceiling_date( 190 | lubridate::ymd( 191 | glue::glue("{year}-{c(month_numeric)}-01") 192 | ),"month" 193 | )-lubridate::days(1) 194 | ) 195 | } 196 | 197 | # logicals --------------------------------------------------------------- 198 | #' @noRd 199 | #' @name geometry_type_is_unique 200 | #' @title geometry_type_is_unique 201 | #' @param x sf object 202 | #' @return \code{logical} indicating whether geometry type is unique in sf object 203 | 204 | geometry_type_is_unique <- function(x){ 205 | length(unique(sf::st_geometry_type(x)))==1 206 | } 207 | 208 | #' @noRd 209 | #' @return return warning message when filter/summarise is implicitly casting from `Image/ImageCollection` to tidyee class 210 | convert_to_tidyee_warning <- function(){ 211 | message( 212 | crayon::yellow("We recommend you always start your `tidyee` flow by first converting and storing your object to class `tidyee` with the function:"), 213 | crayon::green("`as_tidyee()`."), 214 | crayon::yellow("Using `tidyverse/dplyr`-style functions on `ee$ImageCollections` directly can be slow on large ImageCollections.\n")) 215 | } 216 | 217 | 218 | # theses `str` methods provide a work around for the "Error in .Call(_reticulate_py_str_impl, x) : reached elapsed time limit" which was 219 | # occurring due to the object not being able to render in the environment pane 220 | # https://github.com/rstudio/reticulate/issues/1227#issue-1272278478 221 | 222 | #' @export 223 | str.ee.imagecollection.ImageCollection <- function(object,...) { 224 | "A short description of x" 225 | } 226 | 227 | 228 | #' @export 229 | str.ee.image.Image <- function(object,...) { 230 | "A short description of x" 231 | } 232 | 233 | #' Compactly Display the Structure of an Arbitrary R Object 234 | #' @noRd 235 | #' @param object imageCollection or tidyee class object 236 | #' @param ... potential further arguments (required for Method/Generic reasons). 237 | #' @return return str 238 | #' @seealso \code{\link[utils]{str}} for information about str on other R objects. 239 | #' @importFrom utils str 240 | #' @export 241 | NULL 242 | 243 | 244 | 245 | 246 | 247 | #' ic_list_to_ic 248 | #' 249 | #' @param x ee list made up of imageCollections 250 | #' 251 | #' @return imageCollection 252 | 253 | ic_list_to_ic <- function(x){ 254 | rgee::ee$ImageCollection(rgee::ee$FeatureCollection(x)$flatten()) 255 | } 256 | 257 | 258 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, include = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | out.width = "100%" 13 | ) 14 | ``` 15 | # tidyrgee 16 | 17 | 18 | [![R-CMD-check](https://github.com/r-tidy-remote-sensing/tidyrgee/workflows/R-CMD-check/badge.svg)](https://github.com/r-tidy-remote-sensing/tidyrgee/actions) 19 | [![CRAN status](https://www.r-pkg.org/badges/version/tidyrgee)](https://CRAN.R-project.org/package=tidyrgee) 20 | [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) 21 | [![codecov](https://codecov.io/gh/r-tidy-remote-sensing/tidyrgee/branch/main/graph/badge.svg)](https://app.codecov.io/gh/r-tidy-remote-sensing/tidyrgee) 22 | [![contributions welcome](https://img.shields.io/badge/contributions-welcome-brightgreen.svg?style=flat)](https://github.com/dwyl/esta/issues) 23 | 24 | 25 | 26 | 27 | tidyrgee brings components of [dplyr's](https://github.com/tidyverse/dplyr/) syntax to remote sensing analysis, using the [rgee](https://github.com/r-spatial/rgee) package. 28 | 29 | rgee is an R-API for the [Google Earth Engine (GEE)](https://earthengine.google.com/) which provides R support to the methods/functions available in the JavaScript code editor and python API. The `rgee` syntax was written to be very similar to the GEE Javascript/python. However, this syntax can feel unnatural and difficult at times especially to users with less experience in GEE. Simple concepts that are easy express verbally can be cumbersome even to advanced users (see *Syntax Comparison*). The `tidyverse` has provided [principals and concepts](https://tidyr.tidyverse.org/articles/tidy-data.html) that help data scientists/R-users efficiently write and communicate there code in a clear and concise manner. `tidyrgee` aims to bring these principals to GEE-remote sensing analyses. 30 | 31 | tidyrgee provides the convenience of pipe-able dplyr style methods such as `filter`, `group_by`, `summarise`, `select`,`mutate`,etc. using [rlang's](https://github.com/r-lib/rlang) style of non-standard evaluation (NSE) 32 | 33 | try it out! 34 | 35 | ## Installation 36 | 37 | Install from CRAN with: 38 | 39 | ``` r 40 | install.packages("tidyrgee") 41 | ``` 42 | 43 | You can install the development version of tidyrgee from [GitHub](https://github.com/) with: 44 | 45 | ``` r 46 | # install.packages("devtools") 47 | devtools::install_github("r-tidy-remote-sensing/tidyrgee") 48 | ``` 49 | It is important to note that to use tidyrgee you must be signed up for a GEE developer account. Additionally you must install the rgee package following there [installation and setup instructions here](https://github.com/r-spatial/rgee) 50 | 51 | ## Syntax Comparison 52 | 53 | Below is a quick example demonstrating the simplified syntax. Note that the `rgee` syntax is very similar to the syntax in the Javascript code editor. In this example I want to simply calculate mean monthly NDVI (per pixel) for every year from 2000-2015. This is clearly a fairly simple analysis to verbalize/conceptualize. Yet, using using standard GEE conventions, the process is not so simple. Aside, from many peculiarities such as `flattening` a list and then calling and then rebuilding the `imageCollection` at the end, I also have to write and **think about** a double mapping statement using months and years (sort of like a double for-loop). By comparison the tidyrgee syntax removes the complexity and allows me to write the code in a more human readable/interpretable format. 54 | 55 | 56 | 57 | 58 | 59 | 60 | 90 | 102 | 103 |
rgee (similar to Javascript)tidyrgee
61 | ```{r, eval=F} 62 | 63 | modis <- ee$ImageCollection( "MODIS/006/MOD13Q1") 64 | modis_ndvi <- modis$select("NDVI") 65 | month_list <- ee$List$sequence(1,12) 66 | year_list <- ee$List$sequence(2000,2015) 67 | 68 | 69 | mean_ndvi <- ee$ImageCollection$fromImages( 70 | year_list$map( 71 | ee_utils_pyfunc(function (y) { 72 | month_list$map( 73 | ee_utils_pyfunc(function (m) { 74 | # dat_pre_filt <- 75 | modis_ndvi$ 76 | filter(ee$Filter$calendarRange(y, y, 'year'))$ 77 | filter(ee$Filter$calendarRange(m, m, 'month'))$ 78 | mean()$ 79 | set('year',y)$ 80 | set('month',m)$ 81 | set('date',ee$Date$fromYMD(y,m,1))$ 82 | set('system:time_start',ee$Date$millis(ee$Date$fromYMD(y,m,1))) 83 | 84 | 85 | }) 86 | ) 87 | }))$flatten()) 88 | ``` 89 | 91 | ```{r,eval =F} 92 | modis <- ee$ImageCollection( "MODIS/006/MOD13Q1") 93 | modis_tidy <- as_tidyee(modis) 94 | 95 | mean_ndvi <- modis_tidy |> 96 | select("NDVI") |> 97 | filter(year %in% 2000:2015) |> 98 | group_by(year, month) |> 99 | summarise(stat= "mean") 100 | ``` 101 |
104 | 105 | ## Example usage 106 | 107 | Below are a couple examples showing some of the available functions. 108 | 109 | To load images/imageCollections you follow the standard approach using `rgee`: 110 | 111 | - load libraries 112 | - initialize the GEE session 113 | - load `ee$ImageCollection`/ `ee$Image` 114 | 115 | ```{r example,warning= F,message=FALSE,eval=T} 116 | library(tidyrgee) 117 | library(rgee) 118 | ee_Initialize(quiet = T) 119 | 120 | modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 121 | ``` 122 | 123 | Once the above steps are performed you can convert the `ee$ImageCollection` to a `tidyee` object with the function `as_tidyee`. The tidyee object stores the original `ee$ImageCollection` as `ee_ob` (for earth engine object) and produces as virtual table/data.frame stored as `vrt`. This vrt not only facilitates the use of dplyr/tidyverse methods, but also allows the user to better view the data stored in the accompanying imageCollection. The `ee_ob` and `vrt` inside the tidyee object are linked, any function applied to the tidyee object will apply to them both so that they remain in sync. 124 | 125 | ```{r, eval=T} 126 | modis_tidy <- as_tidyee(modis_ic) 127 | ``` 128 | 129 | the `vrt` comes with a few built in columns which you can use off the bat for filtering and grouping, but you can also `mutate` additional info for filtering and grouping (i.e using `lubridate` to create new temporal groupings) 130 | 131 | ```{r} 132 | knitr::kable(modis_tidy$vrt |> head()) 133 | ``` 134 | 135 | Next we demonstrate filtering by date, month, and year. The `vrt` and `ee_ob` are always filtered together 136 | 137 | - **by date** 138 | ```{r} 139 | modis_tidy |> 140 | filter(date>="2021-06-01") 141 | ``` 142 | 143 | - **by year** 144 | ```{r} 145 | modis_tidy |> 146 | filter(year%in% 2010:2011) 147 | ``` 148 | - **by month** 149 | ```{r} 150 | modis_tidy |> 151 | filter(month%in% c(7,8)) 152 | ``` 153 | 154 | ### Putting a dplyr-like chain together: 155 | 156 | In this next example we pipe together multiple functions (`select`, `filter`, `group_by`, `summarise`) to 157 | 158 | 1. select the `NDVI` band from the ImageCollection 159 | 2. filter the imageCollection to a desired date range 160 | 2. group the filtered ImageCollection by month 161 | 3. summarizing each pixel by year and month. 162 | 163 | The result will be an `ImageCollection` with the one `Image` per month (12 images) where each pixel in each image represents the average NDVI value for that month calculated using monthly data from 2000 2015. 164 | 165 | ```{r} 166 | 167 | modis_tidy |> 168 | select("NDVI") |> 169 | filter(year %in% 2000:2015) |> 170 | group_by(month) |> 171 | summarise(stat= "mean") 172 | ``` 173 | 174 | You can easily `group_by` more than 1 property to calculate different summary stats. Below we 175 | 176 | 1. filter to only data from 2021-2022 177 | 2. group by year, month and calculate the median NDVI pixel value 178 | 179 | As we are using the MODIS 16-day composite we summarising approximately 2 images per month to create median composite image fo reach month in the specified years. The `vrt` holds a `list-col` containing all the dates summarised per new composite image. 180 | 181 | ```{r} 182 | modis_tidy |> 183 | select("NDVI") |> 184 | filter(year %in% 2021:2022) |> 185 | group_by(year,month) |> 186 | summarise(stat= "median") 187 | 188 | 189 | ``` 190 | 191 | To improve interoperability with `rgee` we have included the `as_ee` function to return the `tidyee` object back to `rgee` classes when necessary 192 | 193 | ```{r,eval=T} 194 | modis_ic <- modis_tidy |> as_ee() 195 | ``` 196 | -------------------------------------------------------------------------------- /vignettes/ab-tidyee-class-framework.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "ab-tidyee-class-framework" 3 | output: rmarkdown::html_vignette 4 | vignette: > 5 | %\VignetteIndexEntry{ab-tidyee-class-framework} 6 | %\VignetteEngine{knitr::rmarkdown} 7 | %\VignetteEncoding{UTF-8} 8 | --- 9 | 10 | ```{r, include = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>" 14 | ) 15 | ``` 16 | 17 | ```{r setup} 18 | library(tidyrgee) 19 | library(rgee) 20 | library(dplyr) 21 | ee_Initialize() 22 | 23 | ``` 24 | 25 | ## Intro 26 | 27 | In addition to building nice dplyresque/tidy syntax wrappers around `rgee/GEE` functions. We have decided to explore the possibility of introducing a new framework which includes a new class object: "tidyee". 28 | 29 | To use this framework your `ImageCollection` or `Image` has to be converted to `tidyee` class using the new `as_tidy_ee` function as shown below: 30 | 31 | ```{r} 32 | modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 33 | modis_ic_tidy <- as_tidyee(modis_ic) 34 | ``` 35 | 36 | As you can see below the new object (`modis_ic_tidy`) is a named list (of class "tidyee") containing : 37 | 38 | 1. `ee_ob`: the original ee_object (in this case `ImageCollection`) 39 | 2. `vrt`: virtual table holding key properties of the original ee_object 40 | 41 | ```{r} 42 | modis_ic_tidy$ee_ob 43 | modis_ic_tidy$vrt 44 | ``` 45 | 46 | The virtual table (`vrt`) data.frame allows us to leverage all the power and functionality of dplyr to filter, mutate,group, etc. An S3 class method `filter.tidyee` has been written which, essentially, first filters the `vrt` based on conditions supplied to the `filter` argument and then uses the filtered data.frame (vrt) to filter/subset the `ImageCollection`. The vrt comes with several pre-defined columns useful for filtering(date, year, month), but `mutate` can be used to add any new columns/categories for filtering. 47 | 48 | Below is an example using months to filter 49 | 50 | ```{r} 51 | # library(tidyverse) 52 | # library(tidyrgee) 53 | # filter |> debugonce() 54 | 55 | modis_march_april <- modis_ic_tidy |> 56 | filter(month %in% c(3,4)) 57 | 58 | 59 | 60 | 61 | ``` 62 | 63 | **DEMO of Slice** 64 | slice respects R's 1-based indexing rather than GEE 0-based indexing 65 | ```{r} 66 | modis_sliced <- modis_ic_tidy |> 67 | slice(1:2) 68 | # modis_sliced$ee_ob$size()$getInfo() 69 | ``` 70 | 71 | Now we show an example of mutating a new category and then filtering the `tidyee` by that column 72 | ```{r} 73 | 74 | modis_filt_growing_season <- modis_ic_tidy |> 75 | mutate(crop_cycle= case_when( 76 | month %in% c(4,5)~ "land prep", 77 | month %in% c(6,7)~ "planting", 78 | month %in% c(8,9,10)~"growing", 79 | month ==11~ "harvesting", 80 | TRUE ~ "other" 81 | ) 82 | ) |> 83 | filter(crop_cycle=="planting") 84 | 85 | 86 | modis_split_crop_cycle <- modis_ic_tidy |> 87 | mutate(crop_cycle= case_when( 88 | month %in% c(4,5)~ "land prep", 89 | month %in% c(6,7)~ "planting", 90 | month %in% c(8,9,10)~"growing", 91 | month ==11~ "harvesting", 92 | TRUE ~ "other" 93 | ) 94 | ) |> 95 | group_by(crop_cycle) |> 96 | group_split() 97 | 98 | modis_split_crop_cycle[[2]]$ee_ob$aggregate_array("tidyee_index")$getInfo() 99 | modis_split_crop_cycle[[2]]$ee_ob$aggregate_array("system:time_start")$getInfo() 100 | modis_split_crop_cycle[[2]]$ee_ob$size()$getInfo() 101 | 102 | 103 | external_group_output <- modis_ic_tidy |> 104 | mutate(crop_cycle= case_when( 105 | month %in% c(4,5)~ "land prep", 106 | month %in% c(6,7)~ "planting", 107 | month %in% c(8,9,10)~"growing", 108 | month ==11~ "harvesting", 109 | TRUE ~ "other" 110 | ) 111 | ) |> 112 | group_by(crop_cycle) |> 113 | summarise( 114 | stat="mean",join_bands=F 115 | ) 116 | 117 | 118 | external_group_output$ee_ob$size()$getInfo() 119 | 120 | external_group_output_multi <- modis_ic_tidy |> 121 | mutate(crop_cycle= case_when( 122 | month %in% c(4,5)~ "land prep", 123 | month %in% c(6,7)~ "planting", 124 | month %in% c(8,9,10)~"growing", 125 | month ==11~ "harvesting", 126 | TRUE ~ "other" 127 | ) 128 | ) |> 129 | group_by(crop_cycle) |> 130 | summarise( 131 | stat=list("mean","sd","min"),join_bands=F 132 | ) 133 | 134 | 135 | external_group_output_multi_joined <- modis_ic_tidy |> 136 | mutate(crop_cycle= case_when( 137 | month %in% c(4,5)~ "land prep", 138 | month %in% c(6,7)~ "planting", 139 | month %in% c(8,9,10)~"growing", 140 | month ==11~ "harvesting", 141 | TRUE ~ "other" 142 | ) 143 | ) |> 144 | group_by(crop_cycle) |> 145 | summarise( 146 | stat=list("mean","sd") 147 | ) 148 | 149 | modis_ic_tidy |> 150 | mutate(crop_cycle= case_when( 151 | month %in% c(4,5)~ "land prep", 152 | month %in% c(6,7)~ "planting", 153 | month %in% c(8,9,10)~"growing", 154 | month ==11~ "harvesting", 155 | TRUE ~ "other" 156 | ) 157 | ) |> 158 | group_by(year,crop_cycle) |> 159 | summarise( 160 | stat=list("mean","sd") 161 | ) 162 | 163 | ``` 164 | 165 | Here we show how you can perform pixel-level summary statistics with `summarise` function. This is typically referred to as `compositing` in GEE documentation as well as other remote sensing literature. 166 | 167 | ```{r} 168 | 169 | modis_mean_by_yrmo <- modis_ic_tidy |> 170 | group_by(year,month) |> 171 | summarise(stat = list("median","sd")) 172 | 173 | 174 | modis_mean_by_yrmo <- modis_ic_tidy |> 175 | select("NDVI","EVI") |> 176 | group_by(year,month) |> 177 | summarise(stat = "mean") 178 | 179 | 180 | modis_mean_by_yrmo$ee_ob$map( 181 | function(img){ 182 | ex_bnames <- img$bandNames() 183 | ex_bnames_renamed <- ex_bnames$map( 184 | rgee::ee_utils_pyfunc(function(bname){ 185 | ee$String(bname)$replace("_mean$","_m") 186 | 187 | }) 188 | ) 189 | img$select(ex_bnames,ex_bnames_renamed) 190 | } 191 | )$first()$bandNames()$getInfo() 192 | 193 | 194 | modis_mean_by_yrmo$ee_ob$first() 195 | ``` 196 | 197 | It's nice that you can summarise by multiple different statistics at once if you want. 198 | ```{r} 199 | modis_mean_and_sd_by_yrmo <- modis_ic_tidy |> 200 | select("NDVI") |> 201 | group_by(year,month) |> 202 | summarise(stat = list("mean","sd")) 203 | 204 | modis_mean_and_sd_by_yrmo 205 | ``` 206 | 207 | Next we will show how you can mutate a new category and then group by and summarise to that category. This is nice and seems to be working well. However, we still need to work out to deal with disappearing attributes after running dplyr verbs like `group_split`. This does not seem to affect the results, but just the print methods. Could be a potential solution in `vctrs` package. However, it might make more sense to just store `band_names` as col/list-col instead of attribute. 208 | 209 | ```{r} 210 | modis_ic_tidy |> 211 | # select("NDVI") |> 212 | mutate(crop_cycle= case_when( 213 | month %in% c(4,5)~ "land prep", 214 | month %in% c(6,7)~ "planting", 215 | month %in% c(8,9,10)~"growing", 216 | month ==11~ "harvesting", 217 | TRUE ~ "other" 218 | ) 219 | ) |> 220 | group_by(crop_cycle) |> 221 | summarise( 222 | stat="mean" 223 | ) 224 | 225 | ``` 226 | 227 | select & inner_join example 228 | ```{r} 229 | 230 | modis_monthly_baseline_mean <- modis_ic_tidy |> 231 | select("NDVI") |> 232 | filter(year %in% 2000:2015) |> 233 | group_by(month) |> 234 | summarise(stat="mean") 235 | 236 | modis_monthly_baseline_sd <- modis_ic_tidy |> 237 | select("NDVI") |> 238 | filter(year %in% 2000:2015) |> 239 | group_by(month) |> 240 | summarise(stat="sd") 241 | 242 | modis_monthly_baseline <- modis_monthly_baseline_mean |> 243 | inner_join(modis_monthly_baseline_sd, by="month") 244 | 245 | modis_monthly_baseline 246 | 247 | ``` 248 | 249 | ```{r,eval =F} 250 | 251 | point_sample_buffered <- tidyrgee::bgd_msna |> 252 | dplyr::sample_n(3) |> 253 | sf::st_as_sf(coords=c("_gps_reading_longitude", 254 | "_gps_reading_latitude"), crs=4326) |> 255 | sf::st_transform(crs=32646) |> 256 | sf::st_buffer(dist = 500) |> 257 | dplyr::select(`_uuid`) 258 | 259 | 260 | ndvi_monthly_mean_at_pt<- modis_monthly_baseline_mean |> 261 | ee_extract_tidy(y = point_sample_buffered, 262 | fun="mean", 263 | scale = 500) 264 | 265 | # just to show that it also works on imageCollection 266 | modis_monthly_baseline_ic<- modis_monthly_baseline_mean |> 267 | as_ee() 268 | 269 | modis_monthly_baseline_ic |> 270 | ee_extract_tidy(y = point_sample_buffered, 271 | fun="mean", 272 | scale = 500) 273 | 274 | # and image 275 | modis_monthly_baseline_img_first <- modis_monthly_baseline_ic$first() 276 | 277 | modis_monthly_baseline_img_first |> 278 | ee_extract_tidy(y = point_sample_buffered, 279 | fun="mean", 280 | scale = 500) 281 | 282 | 283 | ``` 284 | 285 | 286 | ## Limitations/Next Steps 287 | 288 | Below I list properties of this approach that could be considered potential downsides and list potential ways to circumvent or minimize these downsides. 289 | 290 | **1. The new `tidyee` object reduces interoperability with `rgee`** 291 | 292 | Some potential ideas to improve: 293 | 294 | a. maybe very simple functions to switch resulting `tidyee` object back to `ee$ImageCollection` or `ee$Image` (maybe `as_ic`, `as_img`,`as_ee`) 295 | b.add option to make `tidyee` on fly from `ee$Image`/`ee$ImageCollection` and then also include something like `return_ic`as a logical switch which will just return `ee$Image` or `ee$ImageCollection` instead of `tidyee` class. 296 | 297 | So far I lean towards **a** and just create a `as_ee` function to implement it. 298 | 299 | 300 | ```{r} 301 | modis_ic_tidy |> 302 | as_ee() 303 | 304 | ``` 305 | 306 | **2. as_tidyee makes the process take slightly longer** 307 | 308 | a. Since `as_tidyee` relies on client-side operation (primarily `rgee::ee_get_date_ic`) this function requires some start-up time investment. However, I am thinking that this one-time investment will actually save time since when using the `tidyee` object we will have constantly updating data.frame which is basically updated instantaneously as we filter and process the `ImageCollection`. This could allow nice print methods and querying without having to perform the `rgee`/client side functions like `rgee::ee_print` and `getInfo` repeatedly in work-flows which take just as much time as `as_tidyee` every time they are run. 309 | b. To make sure these percieved benefits are actual benefits we should: 1) include checks/assertions at the end of each process to ensure the `ee_ob` and `vrt` are in perfect agreement, 2) think about including more information (bands, properties) in the the print methods for tidyee 310 | 311 | 312 | Might be worth prefixing `dplyr` functions with `ee_` to avoid conflicts? 313 | 314 | ```{r} 315 | 316 | modis_ndvi_baseline <- modis_ic_tidy |> 317 | select("NDVI") |> 318 | filter(year %in% c(2000:2015)) |> 319 | group_by(month) |> 320 | summarise(stat = list("mean","sd")) 321 | 322 | modis_ndvi_current <- modis_ic_tidy |> 323 | select("NDVI") |> 324 | filter(year %in% c(2022)) |> 325 | group_by(month) |> 326 | summarise(stat = "mean") 327 | 328 | modis_mean_and_sd_by_yrmo 329 | 330 | 331 | modis_monthly_baseline_current <- modis_ndvi_baseline |> 332 | inner_join(modis_ndvi_current |> select(NDVI_mean_current="NDVI"), by="month") 333 | 334 | modis_current_with_baseline <- modis_ndvi_current |> 335 | select(NDVI_mean_current="NDVI") |> 336 | inner_join(modis_ndvi_baseline, by="month") 337 | 338 | ``` 339 | 340 | 341 | 342 | -------------------------------------------------------------------------------- /R/ee_extract_tidy.R: -------------------------------------------------------------------------------- 1 | 2 | #' @export 3 | ee_extract_tidy.tidyee <- function(x, 4 | y, 5 | stat="mean", 6 | scale, 7 | via="getInfo", 8 | container="rgee_backup", 9 | sf=TRUE, 10 | lazy=FALSE, 11 | quiet=FALSE, 12 | rgee_issue_fixed=FALSE, 13 | ...){ 14 | 15 | if(rgee_issue_fixed){ 16 | if( any(c("sfc","sf") %in% class(y))){ 17 | assertthat::assert_that( 18 | geometry_type_is_unique(y), 19 | msg = "Currently we can only handle a single geometry types" 20 | ) 21 | message("uploading sf to ee object\n") 22 | y_ee <- rgee::sf_as_ee(y) 23 | 24 | } 25 | if("ee.featurecollection.FeatureCollection" %in% class(y)){ 26 | y_ee <- y 27 | } 28 | } 29 | if(!rgee_issue_fixed){ 30 | y_ee <- y 31 | } 32 | 33 | message("renaming bands with dates\n") 34 | ic_renamed<- x$ee_ob |> 35 | add_date_to_bandname() 36 | 37 | ee_reducer <- stat_to_reducer(fun = stat) 38 | 39 | 40 | 41 | message("starting ee_extract\n") 42 | ic_extracted_wide <- rgee::ee_extract(x = ic_renamed, 43 | y=y_ee, 44 | scale=scale, 45 | fun= ee_reducer, 46 | via = via, 47 | container= container, 48 | sf=sf, 49 | lazy=lazy, 50 | quiet=quiet) 51 | 52 | if("ee.image.Image" %in% class(x$ee_ob)){ 53 | band_names_cli<- x$ee_ob$bandNames()$getInfo() 54 | } 55 | 56 | if("ee.imagecollection.ImageCollection" %in% class(x$ee_ob)){ 57 | band_names_cli<- x$ee_ob$first()$bandNames()$getInfo() 58 | } 59 | 60 | # regex to be removed from name to create date col 61 | rm_rgx <- paste0(".*",band_names_cli) 62 | rm_rgx <- glue::glue_collapse(rm_rgx,sep = "|") 63 | 64 | # regex to extract parameter identifier 65 | # reorder so shorter names with common prefix to another band names wont replace string before longer version 66 | extract_rgx <- band_names_cli[stringr::str_order(band_names_cli,decreasing=T)] 67 | extract_rgx <- glue::glue_collapse(extract_rgx,sep = "|") 68 | 69 | names_pivot <- stringr::str_subset(colnames(ic_extracted_wide),pattern = extract_rgx) 70 | 71 | if(isTRUE(sf)){ 72 | ic_extracted_wide <- ic_extracted_wide |> 73 | sf::st_drop_geometry() 74 | } 75 | ic_extracted_wide |> 76 | tidyr::pivot_longer(cols = dplyr::all_of(names_pivot),names_to = "name") |> 77 | mutate( 78 | parameter=stringr::str_extract(.data$name, pattern=extract_rgx), 79 | date= stringr::str_remove(string = .data$name, pattern = rm_rgx) |> 80 | stringr::str_replace_all("_","-") |> lubridate::ymd() 81 | 82 | ) |> 83 | dplyr::select(-.data$name) 84 | 85 | 86 | } 87 | 88 | # image collection version 89 | #' @export 90 | ee_extract_tidy.ee.imagecollection.ImageCollection <- function(x, 91 | y, 92 | stat="mean", 93 | scale, 94 | via="getInfo", 95 | container="rgee_backup", 96 | sf=TRUE, 97 | lazy=FALSE, 98 | quiet=FALSE, 99 | rgee_issue_fixed=FALSE, 100 | ...){ 101 | stopifnot(!is.null(x), inherits(x, "ee.imagecollection.ImageCollection")) 102 | 103 | if(rgee_issue_fixed){ 104 | if( any(c("sfc","sf") %in% class(y))){ 105 | assertthat::assert_that( 106 | geometry_type_is_unique(y), 107 | msg = "Currently we can only handle a single geometry types" 108 | ) 109 | message("uploading sf to ee object\n") 110 | y_ee <- rgee::sf_as_ee(y) 111 | 112 | } 113 | if("ee.featurecollection.FeatureCollection" %in% class(y)){ 114 | y_ee <- y 115 | } 116 | } 117 | if(!rgee_issue_fixed){ 118 | y_ee <- y 119 | } 120 | 121 | message("renaming bands with dates\n") 122 | ic_renamed<- x |> 123 | add_date_to_bandname() 124 | 125 | ee_reducer <- stat_to_reducer(fun = stat) 126 | 127 | 128 | 129 | message("starting ee_extract\n") 130 | ic_extracted_wide <- rgee::ee_extract(x = ic_renamed, 131 | y=y_ee, 132 | scale=scale, 133 | fun= ee_reducer, 134 | via = via, 135 | container= container, 136 | sf=sf, 137 | lazy=lazy, 138 | quiet=quiet) 139 | 140 | if("ee.imagecollection.ImageCollection" %in% class(x)){ 141 | band_names_cli<- x$first()$bandNames()$getInfo() 142 | } 143 | 144 | # regex to be removed from name to create date col 145 | rm_rgx <- paste0(".*",band_names_cli) 146 | rm_rgx <- glue::glue_collapse(rm_rgx,sep = "|") 147 | 148 | # regex to extract parameter identifier 149 | # reorder so shorter names with common prefix to another band names wont replace string before longer version 150 | extract_rgx <- band_names_cli[stringr::str_order(band_names_cli,decreasing=T)] 151 | extract_rgx <- glue::glue_collapse(extract_rgx,sep = "|") 152 | 153 | names_pivot <- stringr::str_subset(colnames(ic_extracted_wide),pattern = extract_rgx) 154 | 155 | if(isTRUE(sf)){ 156 | ic_extracted_wide <- ic_extracted_wide |> 157 | sf::st_drop_geometry() 158 | } 159 | ic_extracted_wide |> 160 | tidyr::pivot_longer(cols = dplyr::all_of(names_pivot),names_to = "name") |> 161 | mutate( 162 | parameter=stringr::str_extract(.data$name, pattern=extract_rgx), 163 | date= stringr::str_remove(string = .data$name, pattern = rm_rgx) |> 164 | stringr::str_replace_all("_","-") |> lubridate::ymd() 165 | 166 | ) |> 167 | dplyr::select(-.data$name) 168 | 169 | 170 | } 171 | # image version 172 | #' @export 173 | ee_extract_tidy.ee.image.Image <- function(x, 174 | y, 175 | stat="mean", 176 | scale, 177 | via="getInfo", 178 | container="rgee_backup", 179 | sf=TRUE, 180 | lazy=FALSE, 181 | quiet=FALSE, 182 | rgee_issue_fixed=FALSE, 183 | ...){ 184 | stopifnot(!is.null(x), inherits(x, "ee.image.Image")) 185 | 186 | if(rgee_issue_fixed){ 187 | if( any(c("sfc","sf") %in% class(y))){ 188 | assertthat::assert_that( 189 | geometry_type_is_unique(y), 190 | msg = "Currently we can only handle a single geometry types" 191 | ) 192 | message("uploading sf to ee object\n") 193 | y_ee <- rgee::sf_as_ee(y) 194 | 195 | } 196 | if("ee.featurecollection.FeatureCollection" %in% class(y)){ 197 | y_ee <- y 198 | } 199 | } 200 | if(!rgee_issue_fixed){ 201 | y_ee <- y 202 | } 203 | 204 | message("renaming bands with dates\n") 205 | ic_renamed<- x |> 206 | add_date_to_bandname() 207 | 208 | ee_reducer <- stat_to_reducer(fun = stat) 209 | 210 | 211 | 212 | message("starting ee_extract\n") 213 | ic_extracted_wide <- rgee::ee_extract(x = ic_renamed, 214 | y=y_ee, 215 | scale=scale, 216 | fun= ee_reducer, 217 | via = via, 218 | container= container, 219 | sf=sf, 220 | lazy=lazy, 221 | quiet=quiet) 222 | 223 | if("ee.image.Image" %in% class(x)){ 224 | band_names_cli<- x$bandNames()$getInfo() 225 | } 226 | 227 | # regex to be removed from name to create date col 228 | rm_rgx <- paste0(".*",band_names_cli) 229 | rm_rgx <- glue::glue_collapse(rm_rgx,sep = "|") 230 | 231 | # regex to extract parameter identifier 232 | # reorder so shorter names with common prefix to another band names wont replace string before longer version 233 | extract_rgx <- band_names_cli[stringr::str_order(band_names_cli,decreasing=T)] 234 | extract_rgx <- glue::glue_collapse(extract_rgx,sep = "|") 235 | 236 | names_pivot <- stringr::str_subset(colnames(ic_extracted_wide),pattern = extract_rgx) 237 | 238 | if(isTRUE(sf)){ 239 | ic_extracted_wide <- ic_extracted_wide |> 240 | sf::st_drop_geometry() 241 | } 242 | ic_extracted_wide |> 243 | tidyr::pivot_longer(cols = dplyr::all_of(names_pivot),names_to = "name") |> 244 | mutate( 245 | parameter=stringr::str_extract(.data$name, pattern=extract_rgx), 246 | date= stringr::str_remove(string = .data$name, pattern = rm_rgx) |> 247 | stringr::str_replace_all("_","-") |> lubridate::ymd() 248 | 249 | ) |> 250 | dplyr::select(-.data$name) 251 | 252 | 253 | } 254 | 255 | 256 | 257 | #' ee_extract_tidy 258 | #' @name ee_extract_tidy 259 | #' @rdname ee_extract_tidy 260 | #' @param x tidyee, ee$Image, or ee$ImageCollection 261 | #' @param y sf or ee$feature or ee$FeatureCollection 262 | #' @param stat zonal stat ("mean", "median" , "min","max" etc) 263 | #' @param scale A nominal scale in meters of the Image projection to work in. By default 1000. 264 | #' @param via Character. Method to export the image. Three method are implemented: "getInfo", "drive", "gcs". 265 | #' @param container Character. Name of the folder ('drive') or bucket ('gcs') to be exported into (ignore if via is not defined as "drive" or "gcs"). 266 | #' @param sf Logical. Should return an sf object? 267 | #' @param lazy Logical. If TRUE, a future::sequential object is created to evaluate the task in the future. Ignore if via is set as "getInfo". See details. 268 | #' @param quiet Logical. Suppress info message. 269 | #' @param ... additional parameters 270 | #' 271 | #' @return data.frame in long format with point estimates for each time-step and y feature based on statistic provided 272 | #' 273 | #' @examples \dontrun{ 274 | #' library(rgee) 275 | #' library(tidyrgee) 276 | #' ee_Initizialize() 277 | #' modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 278 | #' point_sample_buffered <- tidyrgee::bgd_msna |> 279 | #' sample_n(3) |> 280 | #' sf::st_as_sf(coords=c("_gps_reading_longitude", 281 | #' "_gps_reading_latitude"), crs=4326) |> 282 | #' sf::st_transform(crs=32646) |> 283 | #' sf::st_buffer(dist = 500) |> 284 | #' dplyr::select(`_uuid`) 285 | #' modis_ic_tidy <- as_tidyee(modis_ic) 286 | #' modis_monthly_baseline_mean <- modis_ic_tidy |> 287 | #' select("NDVI") |> 288 | #' filter(year %in% 2000:2015) |> 289 | #' group_by(month) |> 290 | #' summarise(stat="mean") 291 | #' 292 | #' ndvi_monthly_mean_at_pt<- modis_monthly_baseline_mean |> 293 | #' ee_extract(y = point_sample_buffered, 294 | #' fun="mean", 295 | #' scale = 500) 296 | #'} 297 | #' @seealso \code{\link[rgee]{ee_extract}} for information about ee_extract on ee$ImageCollections and ee$Images 298 | #' @export 299 | #' @importFrom rgee ee_extract 300 | #' @importFrom rlang .data 301 | #' 302 | #' 303 | ee_extract_tidy <- function(x, 304 | y, 305 | stat="mean", 306 | scale, 307 | via="getInfo", 308 | container="rgee_backup", 309 | sf=TRUE, 310 | lazy=FALSE, 311 | quiet=FALSE,...){ 312 | UseMethod("ee_extract_tidy") 313 | } 314 | -------------------------------------------------------------------------------- /R/ee_temporal_composites.R: -------------------------------------------------------------------------------- 1 | #' @title Pixel level composite by year 2 | #' @rdname ee_year_composite 3 | #' @param x An earth engine ImageCollection or tidyee class. 4 | #' @param stat A \code{character} indicating what to reduce the ImageCollection by, 5 | #' e.g. 'median' (default), 'mean', 'max', 'min', 'sum', 'sd', 'first'. 6 | #' @param year \code{numeric} vector containing years (i.e c(2001,2002,2003)) 7 | 8 | #' @param ... other arguments 9 | #' @return tidyee class containing `ee$Image` or `ee$ImageCollection` with pixels aggregated by year 10 | #' @importFrom rlang .data 11 | #' @export 12 | #' 13 | 14 | ee_year_composite <- function(x,...){ 15 | UseMethod('ee_year_composite') 16 | } 17 | 18 | 19 | #' @name ee_year_composite 20 | #' @export 21 | ee_year_composite.ee.imagecollection.ImageCollection<- function(x, 22 | stat, 23 | year, 24 | ...){ 25 | 26 | stopifnot(!is.null(x), inherits(x, "ee.imagecollection.ImageCollection")) 27 | 28 | # start_year = lubridate::year(start_date) 29 | # end_year = lubridate::year(end_date) 30 | years = rgee::ee$List(year) 31 | ee_reducer <- stat_to_reducer_full(stat) 32 | 33 | # dont really think this pre-filter simplifies code or saves any time...leaving for now 34 | 35 | ic_temp_pre_filt <- x |> 36 | ee_year_filter(year = year) 37 | 38 | ic_summarised <- rgee::ee$ImageCollection$fromImages( 39 | years$map(rgee::ee_utils_pyfunc(function (y) { 40 | ic_temp_filtered <- ic_temp_pre_filt$filter(rgee::ee$Filter$calendarRange(y, y, 'year')) 41 | indexString = rgee::ee$Number(y)$format('%03d') 42 | ee_reducer(ic_temp_filtered)$ 43 | set('system:index', indexString)$ 44 | set('year',y)$ 45 | set('month',1)$ 46 | set('date',rgee::ee$Date$fromYMD(y,1,1))$ 47 | # set('system:time_start',ee$Date$fromYMD(y,m,1))$ 48 | set('system:time_start',rgee::ee$Date$millis(rgee::ee$Date$fromYMD(y,1,1)))$ 49 | set('system:time_end',rgee::ee$Date$millis(rgee::ee$Date$fromYMD(y,12,31))) 50 | } 51 | 52 | )) 53 | ) 54 | ic_summarised <- rename_summary_stat_bands(ic_summarised,stat=stat) 55 | return(ic_summarised) 56 | } 57 | 58 | #' @name ee_year_composite 59 | #' @export 60 | ee_year_composite.tidyee<- function(x, 61 | stat, 62 | ...){ 63 | 64 | stopifnot(!is.null(x), inherits(x, "tidyee")) 65 | years_unique_chr <- unique(x$vrt$year) |> sort() 66 | # start_year = lubridate::year(start_date) 67 | # end_year = lubridate::year(end_date) 68 | ee_years_list = rgee::ee$List(years_unique_chr) 69 | ee_reducer <- stat_to_reducer_full(stat) 70 | 71 | 72 | ic_summarised <- rgee::ee$ImageCollection$fromImages( 73 | ee_years_list$map(rgee::ee_utils_pyfunc(function (y) { 74 | ic_temp_filtered <- x$ee_ob$filter(rgee::ee$Filter$calendarRange(y, y, 'year')) 75 | indexString <- rgee::ee$Number(y)$format('%03d') 76 | idString <- ee$String("composited_yyyy_")$cat(indexString) 77 | ee_reducer(ic_temp_filtered)$ 78 | set('system:id',idString)$ 79 | set('system:index', indexString)$ 80 | set('year',y)$ 81 | set('month',1)$ 82 | set('date',rgee::ee$Date$fromYMD(y,1,1))$ 83 | # set('system:time_start',ee$Date$fromYMD(y,m,1))$ 84 | set('system:time_start',rgee::ee$Date$millis(rgee::ee$Date$fromYMD(y,1,1)))$ 85 | set('system:time_end',rgee::ee$Date$millis(rgee::ee$Date$fromYMD(y,12,31))) 86 | } 87 | )) 88 | ) 89 | 90 | ic_summarised <- rename_summary_stat_bands(ic_summarised,stat=stat) 91 | client_bandnames<- paste0(vrt_band_names(x),"_",stat) 92 | vrt_summarised <- x$vrt |> 93 | dplyr::summarise( 94 | dates_summarised= list(.data$time_start), 95 | number_images= dplyr::n(), 96 | time_start= min(.data$time_start), 97 | time_end= max(.data$time_start), 98 | date= lubridate::as_date(.data$time_start), 99 | .groups = "drop" 100 | ) |> 101 | mutate( 102 | band_names= list(client_bandnames), 103 | tidyee_index= dplyr::row_number()-1 104 | ) 105 | create_tidyee(ic_summarised,vrt_summarised) 106 | } 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | #' @title Pixel-level composite by month 116 | #' @rdname ee_month_composite 117 | #' @param x An earth engine ImageCollection or tidyee class. 118 | #' @param stat A \code{character} indicating what to reduce the ImageCollection by, 119 | #' e.g. 'median' (default), 'mean', 'max', 'min', 'sum', 'sd', 'first'. 120 | #' @param months A vector of months, e.g. c(1, 12). 121 | #' @param ... extra args to pass on 122 | #' @return tidyee class containing `ee$Image` or `ee$ImageCollection` with pixels aggregated by month 123 | #' @importFrom rlang .data 124 | #' @export 125 | #' 126 | 127 | ee_month_composite <- function(x, ...){ 128 | 129 | UseMethod('ee_month_composite') 130 | 131 | } 132 | 133 | 134 | 135 | 136 | #' @name ee_month_composite 137 | #' @export 138 | ee_month_composite.ee.imagecollection.ImageCollection <- function(x, stat, months, ...){ 139 | 140 | ee_month_list = rgee::ee$List(months) 141 | 142 | stopifnot(!is.null(x), inherits(x, "ee.imagecollection.ImageCollection")) 143 | 144 | ee_reducer <- stat_to_reducer_full(stat) 145 | 146 | ic_summarised <- rgee::ee$ImageCollection$fromImages( 147 | ee_month_list$map(rgee::ee_utils_pyfunc(function (m) { 148 | indexString = rgee::ee$Number(m)$format('%03d') 149 | ic_temp_filtered <- x$filter(rgee::ee$Filter$calendarRange(m, m, 'month')) 150 | ee_reducer(ic_temp_filtered)$ 151 | set('system:index', indexString)$ 152 | set('year',0000)$ 153 | set('month',m)$ 154 | set('date',rgee::ee$Date$fromYMD(1,m,1))$ 155 | # set('system:time_start',ee$Date$fromYMD(y,m,1))$ 156 | set('system:time_start',rgee::ee$Date$millis(rgee::ee$Date$fromYMD(1,m,1))) 157 | } 158 | ))) 159 | ic_summarised <- rename_summary_stat_bands(ic_summarised,stat=stat) 160 | return(ic_summarised) 161 | 162 | } 163 | 164 | #' @name ee_month_composite 165 | #' @export 166 | ee_month_composite.tidyee <- function(x, stat, ...){ 167 | 168 | stopifnot(!is.null(x), inherits(x, "tidyee")) 169 | months_unique_chr <- unique(x$vrt$month) |> sort() 170 | yrs_unique<- unique(lubridate::year(x$vrt$time_start)) 171 | start_year <- min(yrs_unique) 172 | end_year <- max(yrs_unique) 173 | 174 | ee_months_list <- rgee::ee$List(months_unique_chr) 175 | 176 | 177 | ee_reducer <- stat_to_reducer_full(stat) 178 | 179 | ic_summarised <- rgee::ee$ImageCollection$fromImages( 180 | ee_months_list$map(rgee::ee_utils_pyfunc(function (m) { 181 | indexString <- rgee::ee$Number(m)$format('%03d') 182 | last_month <- rgee::ee$Date$fromYMD(end_year,m,1) 183 | last_date <- last_month$advance(1,"month")$advance(-1,"day") 184 | ic_temp_filtered <- x$ee_ob$filter(rgee::ee$Filter$calendarRange(m, m, 'month')) 185 | ee_reducer(ic_temp_filtered)$ 186 | set('system:id',indexString)$ 187 | set('system:index', indexString)$ 188 | set('year',start_year)$ 189 | set('month',m)$ 190 | set('date',rgee::ee$Date$fromYMD(1,m,1))$ 191 | # set('system:time_start',ee$Date$fromYMD(y,m,1))$ 192 | set('system:time_start',rgee::ee$Date$millis(rgee::ee$Date$fromYMD(start_year,m,1)))$ 193 | set('system:time_end',rgee::ee$Date$millis(last_date)) 194 | } 195 | ))) 196 | 197 | eestat <- stat |> purrr::map(~rstat_to_eestat(fun = .x)) |> unlist() 198 | client_bandnames<- paste0(vrt_band_names(x),"_",eestat) 199 | ic_summarised <- rename_summary_stat_bands(ic_summarised,stat=stat) 200 | 201 | vrt_summarised <- x$vrt |> 202 | dplyr::summarise( 203 | dates_summarised= list(.data$time_start),.groups = "drop", 204 | number_images= dplyr::n(), 205 | time_start= min(.data$time_start), 206 | time_end= max(.data$time_start), 207 | date= lubridate::as_date(.data$time_start) 208 | ) |> 209 | mutate( 210 | band_names = list(client_bandnames) 211 | ) 212 | 213 | 214 | 215 | create_tidyee(ic_summarised,vrt_summarised) 216 | 217 | } 218 | 219 | 220 | #' @title Pixel-level composite by year and month 221 | #' @rdname ee_year_month_composite 222 | #' @param x An earth engine ImageCollection or tidyee class. 223 | #' @param stat A \code{character} indicating what to reduce the ImageCollection by, 224 | #' e.g. 'median' (default), 'mean', 'max', 'min', 'sum', 'sd', 'first'. 225 | #' @param startDate \code{character} format date, e.g. "2018-10-23". 226 | #' @param endDate \code{character} format date, e.g. "2018-10-23". 227 | #' @param months \code{numeric} vector, e.g. c(1,12). 228 | #' @param ... args to pass on. 229 | #' @return tidyee class containing `ee$Image` or `ee$ImageCollection` with pixels aggregated by year and month 230 | #' @export 231 | #' 232 | #' 233 | ee_year_month_composite <- function(x, 234 | ...){ 235 | 236 | UseMethod('ee_year_month_composite') 237 | 238 | } 239 | 240 | #' @name ee_year_month_composite 241 | #' @export 242 | ee_year_month_composite.ee.imagecollection.ImageCollection <- function(x, 243 | stat, 244 | startDate, 245 | endDate, 246 | months, 247 | ... 248 | ){ 249 | 250 | stopifnot(!is.null(x), inherits(x, "ee.imagecollection.ImageCollection")) 251 | 252 | 253 | startYear = lubridate::year(startDate) 254 | endYear = lubridate::year(endDate) 255 | 256 | years = rgee::ee$List$sequence(startYear, endYear) 257 | 258 | months = rgee::ee$List$sequence(months[1], months[2]) 259 | 260 | ee_reducer <- stat_to_reducer_full(stat) 261 | 262 | ic_summarised <- rgee::ee$ImageCollection( 263 | rgee::ee$FeatureCollection(years$map(rgee::ee_utils_pyfunc(function (y) { 264 | 265 | yearCollection = x$filter(rgee::ee$Filter$calendarRange(y, y, 'year')) 266 | 267 | rgee::ee$ImageCollection$fromImages( 268 | 269 | months$map(rgee::ee_utils_pyfunc(function (m) { 270 | 271 | indexString = rgee::ee$Number(m)$format('%03d') 272 | ic_temp_filtered <- yearCollection$filter(rgee::ee$Filter$calendarRange(m, m, 'month')) 273 | ee_reducer(ic_temp_filtered)$ 274 | set('system:index', indexString)$ 275 | set('year',y)$ 276 | set('month',m)$ 277 | set('date',rgee::ee$Date$fromYMD(y,m,1))$ 278 | # set('system:time_start',ee$Date$fromYMD(y,m,1))$ 279 | set('system:time_start',rgee::ee$Date$millis(rgee::ee$Date$fromYMD(y,m,1))) 280 | 281 | })) 282 | ) 283 | 284 | })))$flatten()) 285 | ic_summarised <- rename_summary_stat_bands(ic_summarised,stat=stat) 286 | return(ic_summarised) 287 | } 288 | 289 | #' @name ee_year_month_composite 290 | #' @export 291 | ee_year_month_composite.tidyee <- function(x, stat, ... 292 | ){ 293 | 294 | stopifnot(!is.null(x), inherits(x, "tidyee")) 295 | 296 | 297 | # after running the calendarRange maps there is a strange behavior which 298 | # warrants the need to post-filter. 299 | start_post_filter <- lubridate::floor_date(min(x$vrt$time_start),"month") |> as.character() 300 | end_post_filter <- (lubridate::as_date(max(x$vrt$time_start))+1) |> as.character() 301 | 302 | 303 | years_unique_chr <- unique(x$vrt$year) |> sort() 304 | months_unique_chr <- unique(x$vrt$month) |> sort() 305 | 306 | # if(length(years_unique_chr)==1){ 307 | # ee_years_list = rgee::ee$List(ee$Number(years_unique_chr)) 308 | # } 309 | # if(length(years_unique_chr)>1){ 310 | # ee_years_list = rgee::ee$List(years_unique_chr) 311 | # } 312 | # if(length(months_unique_chr)==1){ 313 | # ee_months_list = rgee::ee$List(ee$Number(months_unique_chr)) 314 | # } 315 | # if(length(months_unique_chr)>1){ 316 | # ee_months_list = rgee::ee$List(months_unique_chr) 317 | # } 318 | ee_months_list = rgee::ee$List(months_unique_chr) 319 | ee_years_list = rgee::ee$List(years_unique_chr) 320 | 321 | ee_reducer <- stat_to_reducer_full(stat) 322 | 323 | ic_summarised <- rgee::ee$ImageCollection( 324 | rgee::ee$FeatureCollection(ee_years_list$map(rgee::ee_utils_pyfunc(function (y) { 325 | 326 | yearCollection = x$ee_ob$filter(rgee::ee$Filter$calendarRange(y, y, 'year')) 327 | 328 | rgee::ee$ImageCollection$fromImages( 329 | 330 | ee_months_list$map(rgee::ee_utils_pyfunc(function (m) { 331 | yearString <- rgee::ee$Number(y)$format('%04d') 332 | monthString <- rgee::ee$Number(m)$format('%03d') 333 | start_date <- rgee::ee$Date$fromYMD(y,m,1) 334 | end_date <- start_date$advance(1,"month")$advance(-1, "day") 335 | # indexString <- rgee::ee$Number(m)$format('%03d') 336 | indexString <- yearString$cat(monthString) 337 | idString <- ee$String("composited_yyyymmm_")$cat(indexString) 338 | ic_temp_filtered <- yearCollection$filter(rgee::ee$Filter$calendarRange(m, m, 'month')) 339 | rgee::ee$Algorithms$If( 340 | ic_temp_filtered$size(), 341 | ee_reducer(ic_temp_filtered)$ 342 | # set('system:id',idString)$ 343 | set('system:index', indexString)$ 344 | set('year',y)$ 345 | set('month',m)$ 346 | set('date',rgee::ee$Date$fromYMD(y,m,1))$ 347 | #set('system:time_start',ee$Date$fromYMD(y,m,1))$ 348 | set('system:time_start',rgee::ee$Date$millis(start_date))$ 349 | set('system:time_end',rgee::ee$Date$millis(end_date)), 350 | NULL 351 | 352 | ) 353 | 354 | 355 | })) 356 | ) 357 | 358 | })))$flatten()) 359 | 360 | 361 | # think we could recreate the new index client side for filter with `system:index` eventually 362 | # yrmo_combinations <- x$vrt |> 363 | # distinct(year,month) |> 364 | # dplyr::mutate(yrmo=paste0(year,month)) |> 365 | # pull(yrmo) 366 | # 367 | # index_vec <- years_unique_chr |> 368 | # expand.grid(months_unique_chr) |> 369 | # dplyr::mutate( 370 | # yrmo=paste0(Var1,Var2), 371 | # index_vec=paste0(Var1,sprintf("%03d",Var2)) 372 | # ) |> 373 | # filter(yrmo %in% yrmo_combinations) |> 374 | # pull(index_vec) 375 | # 376 | 377 | # Need to filter yrmo composite to original date range or you can end up with empty slots 378 | # for months that didn't occur yet 379 | 380 | ic_summarised <- ic_summarised$filterDate(start_post_filter,end_post_filter) 381 | ic_summarised <- rename_summary_stat_bands(ic_summarised,stat=stat) 382 | 383 | 384 | client_bandnames<- paste0(vrt_band_names(x),"_",stat) 385 | vrt_summarised <- x$vrt |> 386 | # nest(data=date) 387 | dplyr::summarise( 388 | dates_summarised= list(.data$time_start),.groups = "drop", 389 | number_images= dplyr::n(), 390 | time_start= min(.data$time_start), 391 | time_end= max(.data$time_start), 392 | date= lubridate::as_date(.data$time_start) 393 | ) |> 394 | mutate( 395 | band_names= list(client_bandnames) 396 | ) 397 | 398 | create_tidyee(ic_summarised,vrt_summarised) 399 | 400 | } 401 | 402 | 403 | 404 | 405 | #' @title ee_composite 406 | #' 407 | #' @param x tidyee object containing `ee$ImageCollection` 408 | #' @param stat A \code{character} indicating what to reduce the ImageCollection by, 409 | #' e.g. 'median' (default), 'mean', 'max', 'min', 'sum', 'sd', 'first'. 410 | #' @param ... other arguments 411 | #' @return tidyee class containing `ee$Image` where all images within `ee$ImageCollection` have been aggregated based on pixel-level stats 412 | #' @importFrom rlang .data 413 | #' @export 414 | #' 415 | 416 | 417 | ee_composite <- function(x, 418 | ...){ 419 | UseMethod("ee_composite") 420 | } 421 | 422 | #' @name ee_composite 423 | #' @export 424 | ee_composite.tidyee <- function(x, 425 | stat, 426 | ...){ 427 | 428 | ee_reducer <- stat_to_reducer_full(stat) 429 | ic_summarised <- ee_reducer(x$ee_ob) 430 | min_year <- lubridate::year(min(x$vrt$time_start)) 431 | min_month <- lubridate::month(min(x$vrt$month)) 432 | min_day <- lubridate::day(min(x$vrt$time_start)) 433 | max_year <- lubridate::year(max(x$vrt$time_start)) 434 | max_month <- lubridate::month(max(x$vrt$month)) 435 | max_day <- lubridate::day(max(x$vrt$time_start)) 436 | 437 | ic_summarised <- ic_summarised$ 438 | set('year',min_year)$ 439 | set('month',min_month)$ 440 | set('date',rgee::ee$Date$fromYMD(min_year,min_month,min_day))$ 441 | set('system:time_start',rgee::ee$Date$millis(rgee::ee$Date$fromYMD(min_year,min_month,min_day)))$ 442 | set('system:time_end',rgee::ee$Date$millis(rgee::ee$Date$fromYMD(max_year,max_month,max_day))) 443 | 444 | ic_summarised <- rename_summary_stat_bands(ic_summarised,stat=stat) 445 | client_bandnames<- paste0(vrt_band_names(x),"_",stat) 446 | 447 | 448 | if("dates_summarised"%in% colnames(x$vrt)){ 449 | vrt_summarised <-x$vrt |> 450 | tidyr::unnest(.data$dates_summarised) |> 451 | dplyr::summarise( 452 | dates_summarised= list(.data$dates_summarised), 453 | time_start= lubridate::ymd(glue::glue("{min_year}-{min_month}-{min_day}")), 454 | date= lubridate::as_date(.data$time_start), 455 | .groups = "drop" 456 | ) 457 | } 458 | if(!"dates_summarised" %in% colnames(x$vrt)){ 459 | vrt_summarised <-x$vrt |> 460 | # dplyr::tibble() |> 461 | dplyr::summarise( 462 | dates_summarised= list(.data$time_start), 463 | time_start= lubridate::ymd(glue::glue("{min_year}-{min_month}-{min_day}")), 464 | date= lubridate::as_date(.data$time_start), 465 | .groups = "drop" 466 | ) 467 | } 468 | vrt_summarised <- vrt_summarised |> 469 | mutate( 470 | band_names= list(client_bandnames) 471 | ) 472 | 473 | 474 | 475 | create_tidyee(ic_summarised,vrt_summarised) 476 | 477 | 478 | } 479 | 480 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # tidyrgee 5 | 6 | 7 | 8 | [![R-CMD-check](https://github.com/r-tidy-remote-sensing/tidyrgee/workflows/R-CMD-check/badge.svg)](https://github.com/r-tidy-remote-sensing/tidyrgee/actions) 9 | [![CRAN 10 | status](https://www.r-pkg.org/badges/version/tidyrgee)](https://CRAN.R-project.org/package=tidyrgee) 11 | [![Lifecycle: 12 | experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental) 13 | [![codecov](https://codecov.io/gh/r-tidy-remote-sensing/tidyrgee/branch/main/graph/badge.svg)](https://app.codecov.io/gh/r-tidy-remote-sensing/tidyrgee) 14 | [![contributions 15 | welcome](https://img.shields.io/badge/contributions-welcome-brightgreen.svg?style=flat)](https://github.com/dwyl/esta/issues) 16 | 17 | 18 | 19 | tidyrgee brings components of 20 | [dplyr’s](https://github.com/tidyverse/dplyr/) syntax to remote sensing 21 | analysis, using the [rgee](https://github.com/r-spatial/rgee) package. 22 | 23 | rgee is an R-API for the [Google Earth Engine 24 | (GEE)](https://earthengine.google.com/) which provides R support to the 25 | methods/functions available in the JavaScript code editor and python 26 | API. The `rgee` syntax was written to be very similar to the GEE 27 | Javascript/python. However, this syntax can feel unnatural and difficult 28 | at times especially to users with less experience in GEE. Simple 29 | concepts that are easy express verbally can be cumbersome even to 30 | advanced users (see *Syntax Comparison*). The `tidyverse` has provided 31 | [principals and 32 | concepts](https://tidyr.tidyverse.org/articles/tidy-data.html) that help 33 | data scientists/R-users efficiently write and communicate there code in 34 | a clear and concise manner. `tidyrgee` aims to bring these principals to 35 | GEE-remote sensing analyses. 36 | 37 | tidyrgee provides the convenience of pipe-able dplyr style methods such 38 | as `filter`, `group_by`, `summarise`, `select`,`mutate`,etc. using 39 | [rlang’s](https://github.com/r-lib/rlang) style of non-standard 40 | evaluation (NSE) 41 | 42 | try it out! 43 | 44 | ## Installation 45 | 46 | Install from CRAN with: 47 | 48 | ``` r 49 | install.packages("tidyrgee") 50 | ``` 51 | 52 | You can install the development version of tidyrgee from 53 | [GitHub](https://github.com/) with: 54 | 55 | ``` r 56 | # install.packages("devtools") 57 | devtools::install_github("r-tidy-remote-sensing/tidyrgee") 58 | ``` 59 | 60 | It is important to note that to use tidyrgee you must be signed up for a 61 | GEE developer account. Additionally you must install the rgee package 62 | following there [installation and setup instructions 63 | here](https://github.com/r-spatial/rgee) 64 | 65 | ## Syntax Comparison 66 | 67 | Below is a quick example demonstrating the simplified syntax. Note that 68 | the `rgee` syntax is very similar to the syntax in the Javascript code 69 | editor. In this example I want to simply calculate mean monthly NDVI 70 | (per pixel) for every year from 2000-2015. This is clearly a fairly 71 | simple analysis to verbalize/conceptualize. Yet, using using standard 72 | GEE conventions, the process is not so simple. Aside, from many 73 | peculiarities such as `flattening` a list and then calling and then 74 | rebuilding the `imageCollection` at the end, I also have to write and 75 | **think about** a double mapping statement using months and years (sort 76 | of like a double for-loop). By comparison the tidyrgee syntax removes 77 | the complexity and allows me to write the code in a more human 78 | readable/interpretable format. 79 | 80 | 81 | 82 | 85 | 88 | 89 | 90 | 121 | 135 | 136 |
83 | rgee (similar to Javascript) 84 | 86 | tidyrgee 87 |
91 | 92 | ``` r 93 | modis <- ee$ImageCollection( "MODIS/006/MOD13Q1") 94 | modis_ndvi <- modis$select("NDVI") 95 | month_list <- ee$List$sequence(1,12) 96 | year_list <- ee$List$sequence(2000,2015) 97 | 98 | 99 | mean_ndvi <- ee$ImageCollection$fromImages( 100 | year_list$map( 101 | ee_utils_pyfunc(function (y) { 102 | month_list$map( 103 | ee_utils_pyfunc(function (m) { 104 | # dat_pre_filt <- 105 | modis_ndvi$ 106 | filter(ee$Filter$calendarRange(y, y, 'year'))$ 107 | filter(ee$Filter$calendarRange(m, m, 'month'))$ 108 | mean()$ 109 | set('year',y)$ 110 | set('month',m)$ 111 | set('date',ee$Date$fromYMD(y,m,1))$ 112 | set('system:time_start',ee$Date$millis(ee$Date$fromYMD(y,m,1))) 113 | 114 | 115 | }) 116 | ) 117 | }))$flatten()) 118 | ``` 119 | 120 | 122 | 123 | ``` r 124 | modis <- ee$ImageCollection( "MODIS/006/MOD13Q1") 125 | modis_tidy <- as_tidyee(modis) 126 | 127 | mean_ndvi <- modis_tidy |> 128 | select("NDVI") |> 129 | filter(year %in% 2000:2015) |> 130 | group_by(year, month) |> 131 | summarise(stat= "mean") 132 | ``` 133 | 134 |
137 | 138 | ## Example usage 139 | 140 | Below are a couple examples showing some of the available functions. 141 | 142 | To load images/imageCollections you follow the standard approach using 143 | `rgee`: 144 | 145 | - load libraries 146 | - initialize the GEE session 147 | - load `ee$ImageCollection`/ `ee$Image` 148 | 149 | ``` r 150 | library(tidyrgee) 151 | library(rgee) 152 | ee_Initialize(quiet = T) 153 | 154 | modis_ic <- ee$ImageCollection("MODIS/006/MOD13Q1") 155 | ``` 156 | 157 | Once the above steps are performed you can convert the 158 | `ee$ImageCollection` to a `tidyee` object with the function `as_tidyee`. 159 | The tidyee object stores the original `ee$ImageCollection` as `ee_ob` 160 | (for earth engine object) and produces as virtual table/data.frame 161 | stored as `vrt`. This vrt not only facilitates the use of 162 | dplyr/tidyverse methods, but also allows the user to better view the 163 | data stored in the accompanying imageCollection. The `ee_ob` and `vrt` 164 | inside the tidyee object are linked, any function applied to the tidyee 165 | object will apply to them both so that they remain in sync. 166 | 167 | ``` r 168 | modis_tidy <- as_tidyee(modis_ic) 169 | ``` 170 | 171 | the `vrt` comes with a few built in columns which you can use off the 172 | bat for filtering and grouping, but you can also `mutate` additional 173 | info for filtering and grouping (i.e using `lubridate` to create new 174 | temporal groupings) 175 | 176 | ``` r 177 | knitr::kable(modis_tidy$vrt |> head()) 178 | ``` 179 | 180 | | id | time_start | system_index | date | month | year | doy | band_names | 181 | |:-----------------------------|:-----------|:-------------|:-----------|------:|-----:|----:|:--------------------------------------------------------------------------------------------------------------------------------------------------------| 182 | | MODIS/006/MOD13Q1/2000_02_18 | 2000-02-18 | 2000_02_18 | 2000-02-18 | 2 | 2000 | 49 | NDVI , EVI , DetailedQA , sur_refl_b01 , sur_refl_b02 , sur_refl_b03 , sur_refl_b07 , ViewZenith , SolarZenith , RelativeAzimuth, DayOfYear , SummaryQA | 183 | | MODIS/006/MOD13Q1/2000_03_05 | 2000-03-05 | 2000_03_05 | 2000-03-05 | 3 | 2000 | 65 | NDVI , EVI , DetailedQA , sur_refl_b01 , sur_refl_b02 , sur_refl_b03 , sur_refl_b07 , ViewZenith , SolarZenith , RelativeAzimuth, DayOfYear , SummaryQA | 184 | | MODIS/006/MOD13Q1/2000_03_21 | 2000-03-21 | 2000_03_21 | 2000-03-21 | 3 | 2000 | 81 | NDVI , EVI , DetailedQA , sur_refl_b01 , sur_refl_b02 , sur_refl_b03 , sur_refl_b07 , ViewZenith , SolarZenith , RelativeAzimuth, DayOfYear , SummaryQA | 185 | | MODIS/006/MOD13Q1/2000_04_06 | 2000-04-06 | 2000_04_06 | 2000-04-06 | 4 | 2000 | 97 | NDVI , EVI , DetailedQA , sur_refl_b01 , sur_refl_b02 , sur_refl_b03 , sur_refl_b07 , ViewZenith , SolarZenith , RelativeAzimuth, DayOfYear , SummaryQA | 186 | | MODIS/006/MOD13Q1/2000_04_22 | 2000-04-22 | 2000_04_22 | 2000-04-22 | 4 | 2000 | 113 | NDVI , EVI , DetailedQA , sur_refl_b01 , sur_refl_b02 , sur_refl_b03 , sur_refl_b07 , ViewZenith , SolarZenith , RelativeAzimuth, DayOfYear , SummaryQA | 187 | | MODIS/006/MOD13Q1/2000_05_08 | 2000-05-08 | 2000_05_08 | 2000-05-08 | 5 | 2000 | 129 | NDVI , EVI , DetailedQA , sur_refl_b01 , sur_refl_b02 , sur_refl_b03 , sur_refl_b07 , ViewZenith , SolarZenith , RelativeAzimuth, DayOfYear , SummaryQA | 188 | 189 | Next we demonstrate filtering by date, month, and year. The `vrt` and 190 | `ee_ob` are always filtered together 191 | 192 | - **by date** 193 | 194 | ``` r 195 | modis_tidy |> 196 | filter(date>="2021-06-01") 197 | #> band names: [ NDVI, EVI, DetailedQA, sur_refl_b01, sur_refl_b02, sur_refl_b03, sur_refl_b07, ViewZenith, SolarZenith, RelativeAzimuth, DayOfYear, SummaryQA ] 198 | #> 199 | #> $ee_ob 200 | #> EarthEngine Object: ImageCollection 201 | #> $vrt 202 | #> # A tibble: 28 x 9 203 | #> id time_start system_index date month year doy 204 | #> 205 | #> 1 MODIS/006/MOD1~ 2021-06-10 00:00:00 2021_06_10 2021-06-10 6 2021 161 206 | #> 2 MODIS/006/MOD1~ 2021-06-26 00:00:00 2021_06_26 2021-06-26 6 2021 177 207 | #> 3 MODIS/006/MOD1~ 2021-07-12 00:00:00 2021_07_12 2021-07-12 7 2021 193 208 | #> 4 MODIS/006/MOD1~ 2021-07-28 00:00:00 2021_07_28 2021-07-28 7 2021 209 209 | #> 5 MODIS/006/MOD1~ 2021-08-13 00:00:00 2021_08_13 2021-08-13 8 2021 225 210 | #> 6 MODIS/006/MOD1~ 2021-08-29 00:00:00 2021_08_29 2021-08-29 8 2021 241 211 | #> 7 MODIS/006/MOD1~ 2021-09-14 00:00:00 2021_09_14 2021-09-14 9 2021 257 212 | #> 8 MODIS/006/MOD1~ 2021-09-30 00:00:00 2021_09_30 2021-09-30 9 2021 273 213 | #> 9 MODIS/006/MOD1~ 2021-10-16 00:00:00 2021_10_16 2021-10-16 10 2021 289 214 | #> 10 MODIS/006/MOD1~ 2021-11-01 00:00:00 2021_11_01 2021-11-01 11 2021 305 215 | #> # ... with 18 more rows, and 2 more variables: band_names , 216 | #> # tidyee_index 217 | #> 218 | #> attr(,"class") 219 | #> [1] "tidyee" 220 | ``` 221 | 222 | - **by year** 223 | 224 | ``` r 225 | modis_tidy |> 226 | filter(year%in% 2010:2011) 227 | #> band names: [ NDVI, EVI, DetailedQA, sur_refl_b01, sur_refl_b02, sur_refl_b03, sur_refl_b07, ViewZenith, SolarZenith, RelativeAzimuth, DayOfYear, SummaryQA ] 228 | #> 229 | #> $ee_ob 230 | #> EarthEngine Object: ImageCollection 231 | #> $vrt 232 | #> # A tibble: 46 x 9 233 | #> id time_start system_index date month year doy 234 | #> 235 | #> 1 MODIS/006/MOD1~ 2010-01-01 00:00:00 2010_01_01 2010-01-01 1 2010 1 236 | #> 2 MODIS/006/MOD1~ 2010-01-17 00:00:00 2010_01_17 2010-01-17 1 2010 17 237 | #> 3 MODIS/006/MOD1~ 2010-02-02 00:00:00 2010_02_02 2010-02-02 2 2010 33 238 | #> 4 MODIS/006/MOD1~ 2010-02-18 00:00:00 2010_02_18 2010-02-18 2 2010 49 239 | #> 5 MODIS/006/MOD1~ 2010-03-06 00:00:00 2010_03_06 2010-03-06 3 2010 65 240 | #> 6 MODIS/006/MOD1~ 2010-03-22 00:00:00 2010_03_22 2010-03-22 3 2010 81 241 | #> 7 MODIS/006/MOD1~ 2010-04-07 00:00:00 2010_04_07 2010-04-07 4 2010 97 242 | #> 8 MODIS/006/MOD1~ 2010-04-23 00:00:00 2010_04_23 2010-04-23 4 2010 113 243 | #> 9 MODIS/006/MOD1~ 2010-05-09 00:00:00 2010_05_09 2010-05-09 5 2010 129 244 | #> 10 MODIS/006/MOD1~ 2010-05-25 00:00:00 2010_05_25 2010-05-25 5 2010 145 245 | #> # ... with 36 more rows, and 2 more variables: band_names , 246 | #> # tidyee_index 247 | #> 248 | #> attr(,"class") 249 | #> [1] "tidyee" 250 | ``` 251 | 252 | - **by month** 253 | 254 | ``` r 255 | modis_tidy |> 256 | filter(month%in% c(7,8)) 257 | #> band names: [ NDVI, EVI, DetailedQA, sur_refl_b01, sur_refl_b02, sur_refl_b03, sur_refl_b07, ViewZenith, SolarZenith, RelativeAzimuth, DayOfYear, SummaryQA ] 258 | #> 259 | #> $ee_ob 260 | #> EarthEngine Object: ImageCollection 261 | #> $vrt 262 | #> # A tibble: 91 x 9 263 | #> id time_start system_index date month year doy 264 | #> 265 | #> 1 MODIS/006/MOD1~ 2000-07-11 00:00:00 2000_07_11 2000-07-11 7 2000 193 266 | #> 2 MODIS/006/MOD1~ 2000-07-27 00:00:00 2000_07_27 2000-07-27 7 2000 209 267 | #> 3 MODIS/006/MOD1~ 2000-08-12 00:00:00 2000_08_12 2000-08-12 8 2000 225 268 | #> 4 MODIS/006/MOD1~ 2000-08-28 00:00:00 2000_08_28 2000-08-28 8 2000 241 269 | #> 5 MODIS/006/MOD1~ 2001-07-12 00:00:00 2001_07_12 2001-07-12 7 2001 193 270 | #> 6 MODIS/006/MOD1~ 2001-07-28 00:00:00 2001_07_28 2001-07-28 7 2001 209 271 | #> 7 MODIS/006/MOD1~ 2001-08-13 00:00:00 2001_08_13 2001-08-13 8 2001 225 272 | #> 8 MODIS/006/MOD1~ 2001-08-29 00:00:00 2001_08_29 2001-08-29 8 2001 241 273 | #> 9 MODIS/006/MOD1~ 2002-07-12 00:00:00 2002_07_12 2002-07-12 7 2002 193 274 | #> 10 MODIS/006/MOD1~ 2002-07-28 00:00:00 2002_07_28 2002-07-28 7 2002 209 275 | #> # ... with 81 more rows, and 2 more variables: band_names , 276 | #> # tidyee_index 277 | #> 278 | #> attr(,"class") 279 | #> [1] "tidyee" 280 | ``` 281 | 282 | ### Putting a dplyr-like chain together: 283 | 284 | In this next example we pipe together multiple functions (`select`, 285 | `filter`, `group_by`, `summarise`) to 286 | 287 | 1. select the `NDVI` band from the ImageCollection 288 | 2. filter the imageCollection to a desired date range 289 | 3. group the filtered ImageCollection by month 290 | 4. summarizing each pixel by year and month. 291 | 292 | The result will be an `ImageCollection` with the one `Image` per month 293 | (12 images) where each pixel in each image represents the average NDVI 294 | value for that month calculated using monthly data from 2000 2015. 295 | 296 | ``` r 297 | modis_tidy |> 298 | select("NDVI") |> 299 | filter(year %in% 2000:2015) |> 300 | group_by(month) |> 301 | summarise(stat= "mean") 302 | #> band names: [ NDVI_mean ] 303 | #> 304 | #> $ee_ob 305 | #> EarthEngine Object: ImageCollection 306 | #> $vrt 307 | #> # A tibble: 12 x 6 308 | #> month dates_summarised number_images time_start time_end 309 | #> 310 | #> 1 1 30 2001-01-01 00:00:00 2001-01-01 00:00:00 311 | #> 2 2 31 2000-02-18 00:00:00 2000-02-18 00:00:00 312 | #> 3 3 32 2000-03-05 00:00:00 2000-03-05 00:00:00 313 | #> 4 4 32 2000-04-06 00:00:00 2000-04-06 00:00:00 314 | #> 5 5 32 2000-05-08 00:00:00 2000-05-08 00:00:00 315 | #> 6 6 32 2000-06-09 00:00:00 2000-06-09 00:00:00 316 | #> 7 7 32 2000-07-11 00:00:00 2000-07-11 00:00:00 317 | #> 8 8 32 2000-08-12 00:00:00 2000-08-12 00:00:00 318 | #> 9 9 32 2000-09-13 00:00:00 2000-09-13 00:00:00 319 | #> 10 10 20 2000-10-15 00:00:00 2000-10-15 00:00:00 320 | #> 11 11 28 2000-11-16 00:00:00 2000-11-16 00:00:00 321 | #> 12 12 32 2000-12-02 00:00:00 2000-12-02 00:00:00 322 | #> # ... with 1 more variable: band_names 323 | #> 324 | #> attr(,"class") 325 | #> [1] "tidyee" 326 | ``` 327 | 328 | You can easily `group_by` more than 1 property to calculate different 329 | summary stats. Below we 330 | 331 | 1. filter to only data from 2021-2022 332 | 2. group by year, month and calculate the median NDVI pixel value 333 | 334 | As we are using the MODIS 16-day composite we summarising approximately 335 | 2 images per month to create median composite image fo reach month in 336 | the specified years. The `vrt` holds a `list-col` containing all the 337 | dates summarised per new composite image. 338 | 339 | ``` r 340 | modis_tidy |> 341 | select("NDVI") |> 342 | filter(year %in% 2021:2022) |> 343 | group_by(year,month) |> 344 | summarise(stat= "median") 345 | #> band names: [ NDVI_median ] 346 | #> 347 | #> $ee_ob 348 | #> EarthEngine Object: ImageCollection 349 | #> $vrt 350 | #> # A tibble: 20 x 7 351 | #> year month dates_summarised number_images time_start time_end band_names 352 | #> 353 | #> 1 2021 1 2 2021-01-01 2021-01-17 354 | #> 2 2021 2 2 2021-02-02 2021-02-18 355 | #> 3 2021 3 2 2021-03-06 2021-03-22 356 | #> 4 2021 4 2 2021-04-07 2021-04-23 357 | #> 5 2021 5 2 2021-05-09 2021-05-25 358 | #> 6 2021 6 2 2021-06-10 2021-06-26 359 | #> 7 2021 7 2 2021-07-12 2021-07-28 360 | #> 8 2021 8 2 2021-08-13 2021-08-29 361 | #> 9 2021 9 2 2021-09-14 2021-09-30 362 | #> 10 2021 10 1 2021-10-16 2021-10-16 363 | #> 11 2021 11 2 2021-11-01 2021-11-17 364 | #> 12 2021 12 2 2021-12-03 2021-12-19 365 | #> 13 2022 1 2 2022-01-01 2022-01-17 366 | #> 14 2022 2 2 2022-02-02 2022-02-18 367 | #> 15 2022 3 2 2022-03-06 2022-03-22 368 | #> 16 2022 4 2 2022-04-07 2022-04-23 369 | #> 17 2022 5 2 2022-05-09 2022-05-25 370 | #> 18 2022 6 2 2022-06-10 2022-06-26 371 | #> 19 2022 7 2 2022-07-12 2022-07-28 372 | #> 20 2022 8 1 2022-08-13 2022-08-13 373 | #> 374 | #> attr(,"class") 375 | #> [1] "tidyee" 376 | ``` 377 | 378 | To improve interoperability with `rgee` we have included the `as_ee` 379 | function to return the `tidyee` object back to `rgee` classes when 380 | necessary 381 | 382 | ``` r 383 | modis_ic <- modis_tidy |> as_ee() 384 | ``` 385 | --------------------------------------------------------------------------------