ee_closest_distance_to_val

.gitignore

@@ -3,3 +3,4 @@
 .RData
 .Ruserdata
 docs
+inst/doc

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

R/ee_closest_distance_to_val.R

@@ -0,0 +1,121 @@
+#' 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')
+
+
+}
+
+
+
+
+ee_closest_distance_to_val.ee.imagecollection.ImageCollection <-  function(x,
+                                                                           y,
+                                                                           boolean_cond="=",
+                                                                           val=2,
+                                                                           scale=30
+){
+
+  # 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=y,temporal="all",scale=scale)
+  return(res)
+}
+
+
+ee_closest_distance_to_val.ee.image.Image<-  function(x,
+                                                      y,
+                                                      boolean_cond="=",
+                                                      val=2,
+                                                      scale=30
+){
+
+  # 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_cond=boolean_cond,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=y,temporal="all",scale=scale)
+  return(res)
+}

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
@@ -236,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)
@@ -259,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){
@@ -287,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

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
+
+)
+}
+
+
+

vignettes/.gitignore

@@ -0,0 +1,2 @@
+*.html
+*.R