From d595517a4188b3409501957ec5cd4af138988b57 Mon Sep 17 00:00:00 2001 From: zackarno Date: Thu, 31 Mar 2022 08:58:29 +0300 Subject: [PATCH 1/7] add `switch_boolean` to utils and initiate `ee_closest_distance_to_val` with vignette --- .gitignore | 1 + DESCRIPTION | 3 +- R/ee_closest_distance_to_val.R | 86 ++++++++++++++++++++++++ R/utils.R | 28 ++++++++ vignettes/.gitignore | 2 + vignettes/ee_closest_distance_to_val.Rmd | 19 ++++++ 6 files changed, 138 insertions(+), 1 deletion(-) create mode 100644 R/ee_closest_distance_to_val.R create mode 100644 vignettes/.gitignore create mode 100644 vignettes/ee_closest_distance_to_val.Rmd diff --git a/.gitignore b/.gitignore index 234f028..0d7f03b 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,4 @@ .RData .Ruserdata docs +inst/doc diff --git a/DESCRIPTION b/DESCRIPTION index 7565d97..921e9aa 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -42,7 +42,8 @@ Depends: Suggests: knitr, AOI, - testthat (>= 3.0.0) + testthat (>= 3.0.0), + rmarkdown URL: https://github.com/joshualerickson/exploreRGEE BugReports: https://github.com/joshualerickson/exploreRGEE/issues VignetteBuilder: knitr diff --git a/R/ee_closest_distance_to_val.R b/R/ee_closest_distance_to_val.R new file mode 100644 index 0000000..fce7354 --- /dev/null +++ b/R/ee_closest_distance_to_val.R @@ -0,0 +1,86 @@ + +ee_closest_distance_to_val <- function(x,...){ + UseMethod('ee_closest_distance_to_val') + + +} + + +ee_closest_distance_to_val.ee.imagecollection.ImageCollection <- function(x, + y, + boolean_cond="=", + val=2, + scale +){ + + # stopifnot(!is.null(x), inherits(x, "ee.imagecollection.ImageCollection")) + assertthat:::assert_that(!is.null(x), inherits(x, "ee.imagecollection.ImageCollection")) + boolean_mask_cond<-switch_boolean(boolean_cond=boolean_cond,val=val) + + # if(is.numeric(val)){} + # cat(crayon::green("masking x image/imageCollection\n")) + x_masked <- x$map( + function(image){ + image_masked = boolean_mask_cond(image)$ + selfMask() + return(ee$Image(image_masked$copyProperties(image,image$propertyNames()))) + + } + ) + + cat(crayon::green("Generating distance raster(s)\n")) + euclidean_distance_to_x <- x_masked$ + map( + function(image){ + distances = image$mask()$ + fastDistanceTransform({ + neighborhood=1024 + })$multiply(ee$Image$pixelArea())$sqrt()$rename("distance_to")$ + reproject(crs="EPSG:4326",scale=scale) + return(ee$Image(distances$copyProperties(image,image$propertyNames()))) + + } + ) + cat(crayon::green("Extracting distance raster values to y\n")) + res <- exploreRGEE::ee_timeseries(imageCol = euclidean_distance_to_x$select("distance_to"),geom=sf,temporal="all",scale=30) + return(res) +} + +JRC_example$first() |> class() +ee_closest_distance_to_val.ee.image.Image<- function(x, + y, + boolean="=", + val=2, + scale +){ + + # stopifnot(!is.null(x), inherits(x, "ee.imagecollection.ImageCollection")) + assertthat:::assert_that(!is.null(x), inherits(x, "ee.image.Image")) + boolean_mask_cond<-switch_boolean(boolean=boolean,val=val) + + # if(is.numeric(val)){} + cat(crayon::green("masking x image/imageCollection\n")) + x_masked <-ee$Image( + boolean_mask_cond(x)$ + selfMask()$ + copyProperties(x,x$propertyNames()) + ) + cat(crayon::green("Generating distance raster(s)\n")) + + FDT = x_masked$mask()$ + fastDistanceTransform({ + neighborhood=1024 + }) + + distances= FDT$ + multiply(ee$Image$pixelArea())$ + sqrt()$ + rename("distance_to")$ + reproject(crs="EPSG:4326",scale=scale) + + euclidean_distance_to_x <-ee$Image(distances$copyProperties(x_masked,x_masked$propertyNames())) + + cat(crayon::green("Extracting distance raster values to y\n")) + res <- exploreRGEE::ee_timeseries(imageCol = euclidean_distance_to_x$select("distance_to"),geom=sf,temporal="all",scale=30) + return(res) +} diff --git a/R/utils.R b/R/utils.R index b20643f..0bf702d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -224,3 +224,31 @@ viz_A <- function() { } +# maybe we should add all switch functions dowm here. I think there are a couple floating around + + +#' switch boolean +#' @description switch R-syntax boolean conditions to GEE javaScript language. Useful allowing users to specify +#' masking values in custom functions - currently made fore use in ee_closest_distance_to_val +#' @param boolean_cond \code{character} representation of logical condition following typical R syntax (">",">=") +#' @param val \code{numeric} value for condition to operate on. +#' @return JavaScript-based function for boolean masking +#' @examples \dontrun{ +#' library(rgee) +#' ee_initialize() +#' switch_boolean(boolean_cond = ">",val=2) +#' } + +switch_boolean <- function(boolean_cond,val){switch(boolean_cond, + ">" = function(x)x$gt(val), + ">=" = function(x)x$gte(val), + "<" = function(x)x$lt(val), + "<=" = function(x)x$lte(val), + "=" = function(x)x$eq(val), + NULL + +) +} + + + diff --git a/vignettes/.gitignore b/vignettes/.gitignore new file mode 100644 index 0000000..097b241 --- /dev/null +++ b/vignettes/.gitignore @@ -0,0 +1,2 @@ +*.html +*.R diff --git a/vignettes/ee_closest_distance_to_val.Rmd b/vignettes/ee_closest_distance_to_val.Rmd new file mode 100644 index 0000000..979c296 --- /dev/null +++ b/vignettes/ee_closest_distance_to_val.Rmd @@ -0,0 +1,19 @@ +--- +title: "ee_closest_distance_to_val" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{ee_closest_distance_to_val} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r setup} +library(exploreRGEE) +``` From dfd633b14e4f286633d5c1b27d32f017fe934f23 Mon Sep 17 00:00:00 2001 From: zackarno Date: Thu, 31 Mar 2022 08:59:59 +0300 Subject: [PATCH 2/7] init hacky `ee.image.Image` method for `ee_timeseries` - will follow up w/ discussion on this --- R/timeseries.R | 86 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 86 insertions(+) diff --git a/R/timeseries.R b/R/timeseries.R index 3465480..a52507f 100644 --- a/R/timeseries.R +++ b/R/timeseries.R @@ -129,6 +129,92 @@ ee_timeseries.ee.imagecollection.ImageCollection <- function(imageCol, } +ee_timeseries.ee.image.Image<- function(imageCol, + geom, + geeFC = NULL, + scale, + temporal = 'yearly', + temporal_stat = 'mean', + reducer = 'mean', + lazy = FALSE, + startDate = NULL, + endDate = NULL, + months = NULL, + ...){ + + # error catching + if(missing(imageCol)){stop("Need a get_* object or ImageCollection to use this function")} + + # if(any(class(imageCol) == 'diff_list' | class(imageCol) == 'terrain_list' | class(imageCol) == 'ee.image.Image')){stop("Can't band with this type of list")} + + # if(!temporal %in% c('yearly', 'monthly', 'year_month', 'all')){stop("Need correct temporal argument")} + + stopifnot(!is.null(imageCol), inherits(imageCol, "ee.image.Image")) + + if( "ee.image.Image" %in% class(imageCol)){ + cat(crayon::green("As imageCol is actually an ee$Image rather than ee$ImageCollection exact values will be extracted without compositing")) + temporal <- "all" + } + + if(temporal == 'yearly'){ + + imageCol <- ee_year_filter(imageCol = imageCol,startDate = startDate, endDate = endDate, stat = temporal_stat) + + } else if (temporal == 'monthly'){ + + imageCol <- ee_month_filter(imageCol = imageCol, months = months, stat = temporal_stat) + + } else if (temporal == 'year_month') { + + imageCol <- ee_year_month_filter(imageCol = imageCol,startDate = startDate, endDate = endDate,months = months, stat = temporal_stat) + + } else if (temporal == 'all'){ + + } + + if(is.null(geeFC)) { + + reg <- sf_setup(geom) + + } else { + + if (isTRUE(lazy)){ + + reg <- geeFC_setup_aoi(geom, geeFC) + + } else { + + reg <- geeFC_setup(geom, geeFC) + + }} + + if(isTRUE(lazy)){ + prev_plan <- future::plan(future::sequential, .skip = TRUE) + on.exit(future::plan(prev_plan, .skip = TRUE), add = TRUE) + future::future({ + + extract_time(imageCol = imageCol, + reg = reg, + scale = scale, + reducer = reducer, + ... + ) + }, lazy = TRUE) + + } else { + + extract_time(imageCol = imageCol, + reg = reg, + scale = scale, + reducer = reducer, + ... + ) + + } + +} + + #' @name ee_timeseries #' @param ... extra args to pass on From 55b6e569a240b2663108d8e25be4f8eeb450448d Mon Sep 17 00:00:00 2001 From: zackarno Date: Thu, 31 Mar 2022 13:34:38 +0300 Subject: [PATCH 3/7] allow `map_date_to_bandname_ic` to run on images - should probably rename function --- R/timeseries.R | 33 ++++++++++++++++++++++++++++++++- 1 file changed, 32 insertions(+), 1 deletion(-) diff --git a/R/timeseries.R b/R/timeseries.R index a52507f..d5703a5 100644 --- a/R/timeseries.R +++ b/R/timeseries.R @@ -322,7 +322,15 @@ extract_time <- function(imageCol, reg, reducer, scale,...){ scale = scale, ...) # client side + # can't run `first()` on image so need the if statement + # @ josh- is it better to use `inherits` inside of ifs? instead of x %in% class(y) + if("ee.image.Image" %in% class(imageCol)){ + band_names_cli<- imageCol$bandNames()$getInfo() + } + + if("ee.imagecollection.ImageCollection" %in% class(imageCol)){ band_names_cli<- imageCol$first()$bandNames()$getInfo() + } # regex to be removed from name to create date col rm_rgx <- paste0(".*",band_names_cli) @@ -345,12 +353,22 @@ extract_time <- function(imageCol, reg, reducer, scale,...){ select(-.data$.names) } + + + + +map_date_to_bandname_ic <- function(ic, ...) { + + UseMethod('map_date_to_bandname_ic') +} + + #' @title map_date_to_bandname_ic #' @description Slick helper function by Zack that get's the names #' of the bands as well as the date. #' @param ic ee ImageCollection #' -map_date_to_bandname_ic <- function(ic){ +map_date_to_bandname_ic.ee.imagecollection.ImageCollection <- function(ic){ ic |> ee$ImageCollection$map( function(x){ @@ -373,6 +391,19 @@ map_date_to_bandname_ic <- function(ic){ } +map_date_to_bandname_ic.ee.image.Image <- function(ic){ + bnames<- ic$bandNames() + date <- ee$Date(ic$get("system:time_start"))$format('YYYY_MM_dd') + bnames_date <- bnames$map( + rgee::ee_utils_pyfunc(function(x){ + ee$String(x)$cat(ee$String("_"))$cat(date) + + }) + ) + ic$select(bnames)$rename(bnames_date) + +} + #' @title Filtering by Temporal Arguments #' @description A helper function to distinguish time reducer From 4bdaf9bb73d51d0529b99896e49bde260fcef4d0 Mon Sep 17 00:00:00 2001 From: zackarno Date: Thu, 31 Mar 2022 13:35:07 +0300 Subject: [PATCH 4/7] clean up --- R/ee_closest_distance_to_val.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/ee_closest_distance_to_val.R b/R/ee_closest_distance_to_val.R index fce7354..21601ed 100644 --- a/R/ee_closest_distance_to_val.R +++ b/R/ee_closest_distance_to_val.R @@ -42,21 +42,21 @@ ee_closest_distance_to_val.ee.imagecollection.ImageCollection <- function(x, } ) cat(crayon::green("Extracting distance raster values to y\n")) - res <- exploreRGEE::ee_timeseries(imageCol = euclidean_distance_to_x$select("distance_to"),geom=sf,temporal="all",scale=30) + res <- exploreRGEE::ee_timeseries(imageCol = euclidean_distance_to_x$select("distance_to"),geom=y,temporal="all",scale=30) return(res) } -JRC_example$first() |> class() + ee_closest_distance_to_val.ee.image.Image<- function(x, y, - boolean="=", + boolean_cond="=", val=2, scale ){ # stopifnot(!is.null(x), inherits(x, "ee.imagecollection.ImageCollection")) assertthat:::assert_that(!is.null(x), inherits(x, "ee.image.Image")) - boolean_mask_cond<-switch_boolean(boolean=boolean,val=val) + boolean_mask_cond<-switch_boolean(boolean_cond=boolean_cond,val=val) # if(is.numeric(val)){} cat(crayon::green("masking x image/imageCollection\n")) @@ -81,6 +81,6 @@ ee_closest_distance_to_val.ee.image.Image<- function(x, euclidean_distance_to_x <-ee$Image(distances$copyProperties(x_masked,x_masked$propertyNames())) cat(crayon::green("Extracting distance raster values to y\n")) - res <- exploreRGEE::ee_timeseries(imageCol = euclidean_distance_to_x$select("distance_to"),geom=sf,temporal="all",scale=30) + res <- exploreRGEE::ee_timeseries(imageCol = euclidean_distance_to_x$select("distance_to"),geom=y,temporal="all",scale=30) return(res) } From 6a688a0011ae008848a5eca65845cb77e840ffd1 Mon Sep 17 00:00:00 2001 From: zackarno Date: Thu, 31 Mar 2022 13:35:14 +0300 Subject: [PATCH 5/7] rmd demo --- vignettes/ee_closest_distance_to_val.Rmd | 103 +++++++++++++++++++++++ 1 file changed, 103 insertions(+) diff --git a/vignettes/ee_closest_distance_to_val.Rmd b/vignettes/ee_closest_distance_to_val.Rmd index 979c296..26fcc11 100644 --- a/vignettes/ee_closest_distance_to_val.Rmd +++ b/vignettes/ee_closest_distance_to_val.Rmd @@ -16,4 +16,107 @@ knitr::opts_chunk$set( ```{r setup} library(exploreRGEE) +library(mapedit) +library(rgee) +library(ggplot2) +library(leaflet) +library(sf) +library(tmap) +rgee::ee_Initialize() +``` + + +# Get data + +- make some fake point data +- load in and temporally filter JRC yearly water data + +```{r} +#DRAW SOME FAKE HH DATA +aoi <- drawFeatures() + + + +#GET YEARLY WATER OCCURENCE IMAGE COLLECTION FROM GEE - JRC +water_yearly <- rgee::ee$ImageCollection("JRC/GSW1_3/YearlyHistory") + +# FILTER DATES 2000-2019 +water_years_filtered <- water_yearly$ + filterDate("2000-01-01","2019-12-31") + +``` + +# Process +- Now use `ee_closest_distance_to_val` to calculate the distance from each point the closest water pixel +- since 2 is seasonal and 3 is permanent we can specify `boolean_cond` as `>=` 2 and to consider all water pixels +```{r} +# 2 is seasonal, 3 is permanent +# so if we specify >= 2 we get all water +distance_to_water <- ee_closest_distance_to_val(x = water_years_filtered, + y = aoi, + boolean_cond = ">=", + val = 2, + scale = 30) +``` + +# Plot results +```{r} +distance_to_water |> + ggplot(aes(x=value,y=factor(date)))+ + geom_boxplot() + +# plot is showing distribution of CLOSEST distance values for each year + + +``` + +# Potential wrapper + +- when making the above function I specifically had the JRC yearly water ImageCollection in mind. Therefore, +a potential convenience wrapper could be made something like below. +- now I am thining this could be useful for landcover as well (i.e closest cropland) + + +```{r} + + + + +ee_distance_to_JRC_yearly_water <- function(x, y,water_type="all",scale=30){ + res <- list() + boolean_input <- switch(water_type, + "all"=">=", + "seasonal"="=", + "permanent"="=" + ) + val_input <- switch(water_type, + "all"=2, + "seasonal"=2, + "permanent"=3 + ) + ee_closest_distance_to_val(x = x, + y = y, + boolean_cond = boolean_input, + val = val_input, + scale = scale) + + +} +``` + +- wrapper works +```{r} + + + +dist_to_water <- ee_distance_to_JRC_yearly_water(x = water_years_filtered, + y = aoi, + water_type = "all" + ) + + + + + + ``` From 0842912ece7fea051af7e43394feb9c36d7c8aa3 Mon Sep 17 00:00:00 2001 From: zackarno Date: Thu, 31 Mar 2022 13:48:12 +0300 Subject: [PATCH 6/7] add roxygen --- R/ee_closest_distance_to_val.R | 35 ++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/R/ee_closest_distance_to_val.R b/R/ee_closest_distance_to_val.R index 21601ed..f8cbb73 100644 --- a/R/ee_closest_distance_to_val.R +++ b/R/ee_closest_distance_to_val.R @@ -1,3 +1,36 @@ +#' ee_closest_distance_to_val +#' @param x ee$Image or ee$ImageCollection +#' @param y ee$Geometry$*, ee$Feature, ee$FeatureCollection, sfc or sf objects. +#' @param val \code{numeric} pixel value of interest +#' @param scale \code{numeric} scale in meters +#' @return data.frame containg y with closest distance column ("distance_to") containing +#' closest distance to pixel value specified for each record. +#' @export +#' @examples \dontrun{ +#' +#' # Load Libraries +#' +#' library(rgee) +#' library(tidyverse) +#' library(sf) +#' ee_Initialize() +#' library(exploreRGEE) +#' +#' # Bring in data +#' huc <- exploreRGEE::huc |> st_centroid() +#' #GET YEARLY WATER OCCURENCE IMAGE COLLECTION FROM GEE - JRC +#' water_yearly <- rgee::ee$ImageCollection("JRC/GSW1_3/YearlyHistory") +#' # FILTER DATES 2000-2019 +#' water_years_filtered <- water_yearly$ +#' filterDate("2000-01-01","2019-12-31") +#' +#' distance_to_water <- ee_closest_distance_to_val(x = water_years_filtered, +#' y = aoi, +#' boolean_cond = ">=", +#' val = 2, +#' scale = 30) +#' +#' } ee_closest_distance_to_val <- function(x,...){ UseMethod('ee_closest_distance_to_val') @@ -6,6 +39,8 @@ ee_closest_distance_to_val <- function(x,...){ } + + ee_closest_distance_to_val.ee.imagecollection.ImageCollection <- function(x, y, boolean_cond="=", From a4a7ecb4ec3805260d3b2f04d88c0ff9ab9e2259 Mon Sep 17 00:00:00 2001 From: zackarno Date: Thu, 31 Mar 2022 14:04:01 +0300 Subject: [PATCH 7/7] fix typo --- R/ee_closest_distance_to_val.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/ee_closest_distance_to_val.R b/R/ee_closest_distance_to_val.R index f8cbb73..181624e 100644 --- a/R/ee_closest_distance_to_val.R +++ b/R/ee_closest_distance_to_val.R @@ -45,7 +45,7 @@ ee_closest_distance_to_val.ee.imagecollection.ImageCollection <- function(x, y, boolean_cond="=", val=2, - scale + scale=30 ){ # stopifnot(!is.null(x), inherits(x, "ee.imagecollection.ImageCollection")) @@ -77,7 +77,7 @@ ee_closest_distance_to_val.ee.imagecollection.ImageCollection <- function(x, } ) cat(crayon::green("Extracting distance raster values to y\n")) - res <- exploreRGEE::ee_timeseries(imageCol = euclidean_distance_to_x$select("distance_to"),geom=y,temporal="all",scale=30) + res <- exploreRGEE::ee_timeseries(imageCol = euclidean_distance_to_x$select("distance_to"),geom=y,temporal="all",scale=scale) return(res) } @@ -86,7 +86,7 @@ ee_closest_distance_to_val.ee.image.Image<- function(x, y, boolean_cond="=", val=2, - scale + scale=30 ){ # stopifnot(!is.null(x), inherits(x, "ee.imagecollection.ImageCollection")) @@ -116,6 +116,6 @@ ee_closest_distance_to_val.ee.image.Image<- function(x, euclidean_distance_to_x <-ee$Image(distances$copyProperties(x_masked,x_masked$propertyNames())) cat(crayon::green("Extracting distance raster values to y\n")) - res <- exploreRGEE::ee_timeseries(imageCol = euclidean_distance_to_x$select("distance_to"),geom=y,temporal="all",scale=30) + res <- exploreRGEE::ee_timeseries(imageCol = euclidean_distance_to_x$select("distance_to"),geom=y,temporal="all",scale=scale) return(res) }