potential new `mutate` argument

[zackarno]

we have a mutate.tidyee method. Currently it only really effects the vrt. I've been running across the situation where it would be nice if the mutate could also set the property for each image in the imageCollection.... think it could be something simple like mutate(...,set_img_prop=T)

i've gotten the concept pretty close with the below. The result mutates the vrt and then returns the imageCollection with image properties set. It's set so that however many columns are mutated to the vrt these will be added to the imageCollection via purrr::map - problem is that if there are more than 1 columns mutated, each mapping iteration is returning an individual imageCollection with the property set and I am drawing a blank on the best way to join them. They should be joinable by "system:index" or "system:time_start", but i'd like to join them so that the properties merge, not the bands

mutate_new_idea <- function(.data,
                         ...){
  new_col_names <- .data$vrt |>
    dplyr::transmute(...) |> colnames()
  vrt <- .data$vrt |>
    dplyr::mutate(...) |>
    arrange(.data$time_start)

  ee_ob <- .data$ee_ob$sort(prop = "system:time_start",opt_ascending = T)

  ics<-new_col_names |>
    purrr::map(~{
      ee_new_prop <- ee$List(vrt[[.x]])
      idx_list = ee$List$sequence(0,ee_new_prop$size()$subtract(1))
      ic_list = ee_ob$toList(ee_ob$size())
      ic_temp <- ee$ImageCollection(
        idx_list$map(rgee::ee_utils_pyfunc(
          function(idx){
            img = ee$Image(ic_list$get(idx))
            #create as string
            idx_string = ee$String(ee_new_prop$get(idx))
            img$set(.x, idx_string)
          }))
      )
      return(ic_temp)
    }
    )

[joshualerickson]

This sounds really good @zackarno. I'm running into this problem with ee_extract_tidy(). It would be nice to add the properties of the group_by() to the IC/image and then you could get that from ee$Feature$set(f, "imageId", ee$Image$get(img, "system:index")) in rgee, which would mean would most likely have to augment the ee_extract() function... For me I'd really like to do this;

prism <- ee$ImageCollection("IDAHO_EPSCOR/GRIDMET")$select('pr')

ee_prism <- prism %>% 
            as_tidyee() %>% 
            mutate(wy = whitewater:::waterYear(date)) %>% 
            group_by(wy) %>% 
            summarise('sum')


ee_basin_extract <- ee_extract_tidy(ee_prism, 
                                    basins_nhd,
                                    stat = 'sum',
                                    scale = 4638.3,
                                    via = 'gcs',
                                    container = 'jle_rasters')

Here I group by water year but when I get the data.frame back it has date because ee_extract() uses date as the properties. It would be nice to have wy as the property.

[joshualerickson]

Alright, I think I'm getting close thanks to your code above! We can't merge by properties or inner_join because of the unique indexes that ee creates (just inherent). I'd be down if you found otherwise. But, we can keep adding to the properties with a IC. So, we have to loop through the IC based on the new columns added.

library(rgee)
ee_Initialize()

roi <- ee$Geometry$Polygon(list(
  c(-114.275, 45.891),
  c(-108.275, 45.868),
  c(-108.240, 48.868),
  c(-114.240, 48.891)
))

gridmet <- ee$ImageCollection("IDAHO_EPSCOR/GRIDMET")$select('pr')$filterBounds(roi)

ee_prism <- gridmet %>% 
  as_tidyee() %>% 
  filter(date > '2022-08-01') %>% 
  mutate_new_idea(wy = as.numeric(whitewater:::waterYear(date)),
                  wy_doy = lubridate::yday(date))

meta <- ee_prism$getInfo()

mutate_new_idea <- function(.data,
                            ...){
  
  new_col_names <- .data$vrt |>
    dplyr::transmute(...) |> colnames()
  
  vrt <- .data$vrt |>
    dplyr::mutate(...) |>
    dplyr::arrange(.data$time_start)
  
  ee_ob <- .data$ee_ob$sort(prop = "system:time_start",opt_ascending = T)

  ic_temp <- list()
    
  for(i in new_col_names){
    
    if(i == new_col_names[[1]]){
        
      ee_new_prop <- ee$List(vrt[[i]])
      idx_list = ee$List$sequence(0,ee_new_prop$size()$subtract(1))
      ic_list = ee_ob$toList(ee_ob$size())
      ic_temp1 <- ee$ImageCollection(
            idx_list$map(rgee::ee_utils_pyfunc(
              function(idx){
                img = ee$Image(ic_list$get(idx))
                #create as string
                idx_string = ee$String(ee_new_prop$get(idx))
                img$set(i, idx_string)
              }))
          )
      ic_temp <- append(ic_temp, ic_temp1)
        
      } else {
        
        ee_new_prop <- ee$List(vrt[[i]])
        idx_list = ee$List$sequence(0,ee_new_prop$size()$subtract(1))
        ic_list = ic_temp[[which(new_col_names == i)-1]]$toList(ic_temp[[which(new_col_names == i)-1]]$size())
        ic_temp2 <- ee$ImageCollection(
          idx_list$map(rgee::ee_utils_pyfunc(
            function(idx){
              img = ee$Image(ic_list$get(idx))
              #create as string
              idx_string = ee$String(ee_new_prop$get(idx))
              img$set(i, idx_string)
            }))
        )
        
        ic_temp <- append(ic_temp, ic_temp2)
      }
    
    
  }
  
  ic_temp[[length(new_col_names)]]
 }

So any mutate() that happens will get added to the properties and then we can use that for what we pull in ee_extract_tidy(). Let me know if you can do this on your end? Thanks.

[zackarno]

Hey - this looks sweet! I ran the code and it works! So now we can mutate properties onto IC's - I like it. My initial thinking would be to add this to the pre-existing mutate.tidyee method and include an optional argument.... maybe a conditional like: mutate_prop=T/F. I can imagine some cases where people might want to mutate many columns to the vrt, but it might not be necessary for the ic . With huge ImageCollections with thousands of images we might just introduce unnecessary complications if setting tons of properties for every image? If we start this way and see that there are no issues then maybe we make it default behaviour and remove the conditional argument?

I need to unpack my understanding of ee_extract() and ee_extract_tidy() a bit to see how we could modify that step to extract the different properties. If you have a good idea on this let me know or feel free to go for it!

[joshualerickson]

Hey thanks and sounds good Zack (making arg conditional for now). I'll tinker with summarise() as well because we'll need to do a similar thing. I think.... Yeah me too (ee_extract()) :) Talk soon!

[joshualerickson]

This is seems to be working with summarise() when grouping before summarising. This will help with ee_extract() i think...

#' @name ee_composite
#' @export
ee_composite.tidyee <-  function(x,
                                 stat,
                                 ...){

  ee_reducer <-  stat_to_reducer_full(stat)
  ic_summarised <- ee_reducer(x$ee_ob)
  min_year <- lubridate::year(min(x$vrt$time_start))
  min_month <- lubridate::month(min(x$vrt$month))
  min_day <- lubridate::day(min(x$vrt$time_start))
  max_year <- lubridate::year(max(x$vrt$time_start))
  max_month <- lubridate::month(max(x$vrt$month))
  max_day <- lubridate::day(max(x$vrt$time_start))

  try(group_vars_chr <- dplyr::group_vars(x$vrt), silent = TRUE)

  if(length(group_vars_chr) > 0){

  ic_temp <- list()

  for(i in group_vars_chr){

    if(i == group_vars_chr[[1]]){


      ic_temp1 <- ic_summarised$set(i, x$vrt[1,i][[1]])

      ic_temp <- append(ic_temp, ic_temp1)

    } else {

      ic_temp2  <-  ic_temp1$set(i, x$vrt[1,i][[1]])

      ic_temp <- append(ic_temp, ic_temp2)
    }

  }
  
  ic_summarised <- ic_temp[[length(group_vars_chr)]]
  
  }

  ic_summarised <- ic_summarised$
    set('year',min_year)$
    set('month',min_month)$
    set('date',rgee::ee$Date$fromYMD(min_year,min_month,min_day))$
    set('system:time_start',rgee::ee$Date$millis(rgee::ee$Date$fromYMD(min_year,min_month,min_day)))$
    set('system:time_end',rgee::ee$Date$millis(rgee::ee$Date$fromYMD(max_year,max_month,max_day)))

  ic_summarised <- rename_summary_stat_bands(ic_summarised,stat=stat)
  client_bandnames<- paste0(vrt_band_names(x),"_",stat)


  if("dates_summarised"%in% colnames(x$vrt)){
    vrt_summarised <-x$vrt |>
      tidyr::unnest(.data$dates_summarised) |>
      dplyr::summarise(
        dates_summarised= list(.data$dates_summarised),
        time_start= lubridate::ymd(glue::glue("{min_year}-{min_month}-{min_day}")),
        date= lubridate::as_date(.data$time_start),
        .groups = "drop"
      )
  }
  if(!"dates_summarised" %in% colnames(x$vrt)){
    vrt_summarised <-x$vrt |>
      # dplyr::tibble() |>
      dplyr::summarise(
        dates_summarised= list(.data$time_start),
        time_start= lubridate::ymd(glue::glue("{min_year}-{min_month}-{min_day}")),
        date= lubridate::as_date(.data$time_start),
        .groups = "drop"
      )
  }
  vrt_summarised <-  vrt_summarised |>
    mutate(
      band_names= list(client_bandnames)
    )



  create_tidyee(ic_summarised,vrt_summarised)


}

[joshualerickson]

So scratch the ee_extract() augment and all we need to do is play with the slick function you made add_date_to_bandname()! This will rename the band name with the grouping or whatever the user wants to use a property! Just need to code it out...

[zackarno]

Cool i think I see what your saying - Potentially we would want ee_extract_tidy to have argument that tells it which are the id column(s) to keep ( maybe id_cols?). Then we could make a modified add_date_to_bandname function to concatenate it correctly?

Perhaps if the specified id_col is in the vrt, but not in the image properties it could be mutated/set right in ee_extract_tidy as well?