move wrapper function to PEPRMT

Author: abbylewis

CHANGELOG.md

@@ -34,6 +34,7 @@ For more information about this file see also [Keep a Changelog](http://keepacha
 - Added `PEcAn.data.land::to_co2e()` for converting SOC change, CH4, and N2O to CO2-equivalent emissions using IPCC Global Warming Potential values.
 - Added `PEcAn.data.land::event_parquet_to_json` for generating PEcAn `event.json` files from well-formatted event parquet files, with support for ensembles of events.
 - Added statewide synthetic fertilization and compost amendment event workflows for CA ag parcels. Outputs share an ensemble naming so a downstream cleaner unions them into one fertilization event type for SIPNET.
+- Added `PEcAn.remote::get_EVI_HLS()` for loading harmonized landsat-sentinel data and calculating EVI
 
 ### Fixed
 - The median run's manifest row went in with the literal strings `"NA"` for pft and trait, which `read.csv` turns into real `NA`, so `read.sa.output` never matched the median quantile and `splinefun` silently dropped that knot. Sensitivity analysis output changes as a result: partial variances shift slightly, though rankings are unaffected in the cases checked.

models/peprmt/R/hls2model.PEPRMT.R

@@ -55,3 +55,52 @@ hls2model.PEPRMT <- function(in.path, in.prefix, outfolder, start_date, end_date
   utils::write.table(out, out.file.full, quote = FALSE, sep = " ", row.names = FALSE, col.names = TRUE)
 
   } # hls2model.PEPRMT
+
+
+#' Wrapper function for double log calculation
+#'
+#' @param df data frame
+#'
+#' @returns modeled evi on each date
+#' @export
+calc_curve_beck <- function(df) {
+  year_to_run <- unique(lubridate::year(df$Date))
+  if(length(year_to_run) >1){
+    stop("EVI has to be calculated one year at a time")
+  }
+  # Add explicit NAs
+  x <- df |>
+    dplyr::mutate(Date = as.Date(Date),
+                  img_doy = lubridate::yday(Date)) |>
+    dplyr::group_by(img_doy) |>
+    dplyr::summarise(
+      Date = min(Date),
+      evi = mean(evi, na.rm = TRUE),
+      .groups = "drop"
+    ) |>
+    tidyr::complete(img_doy = 1:365)
+  
+  # Run double log function
+  fit <- FitDoubleLogBeck(x$evi, t = x$img_doy, hessian = T, ninit = 100)
+  
+  # Format output
+  out <- data.frame(
+    param_name = names(fit$params),
+    param_value = fit$params,
+    stdError = fit$stdError
+  )
+  rownames(out) <- NULL
+  
+  pred_df_beck <- data.frame(doy = rep(1:365)) |>
+    dplyr::cross_join(out |>
+                        tidyr::pivot_wider(names_from = param_name,
+                                           values_from = c(param_value, stdError))) |>
+    dplyr::mutate(pred = param_value_mn + (param_value_mx - param_value_mn) *
+                    (1/(1 + exp(-param_value_rsp * (doy - param_value_sos))) +
+                       1/(1 + exp(param_value_rau * (doy - param_value_eos))))) |>
+    dplyr::left_join(df |> dplyr::rename(doy = img_doy)) |>
+    dplyr::mutate(method = "Beck",
+                  Date = as.Date(paste0(year_to_run,"-01-01"))+ lubridate::days(doy-1))
+  
+  return(pred_df_beck)
+}

modules/data.remote/R/get_EVI_HLS.R

@@ -223,53 +223,4 @@ build_mask <- function(fmask, selected_bit_nums){
     mask <- mask | mask_temp
   }
   return(mask)
-}
-
-
-#' Wrapper function for double log calculation
-#'
-#' @param df data frame
-#'
-#' @returns modeled evi on each date
-
-calc_curve_beck <- function(df) {
-  year_to_run <- unique(lubridate::year(df$Date))
-  if(length(year_to_run) >1){
-    stop("EVI has to be calculated one year at a time")
-  }
-  # Add explicit NAs
-  x <- df |>
-    dplyr::mutate(Date = as.Date(Date),
-                  img_doy = lubridate::yday(Date)) |>
-    dplyr::group_by(img_doy) |>
-    dplyr::summarise(
-      Date = min(Date),
-      evi = mean(evi, na.rm = TRUE),
-      .groups = "drop"
-    ) |>
-    tidyr::complete(img_doy = 1:365)
-  
-  # Run double log function
-  fit <- FitDoubleLogBeck(x$evi, t = x$img_doy, hessian = T, ninit = 100)
-  
-  # Format output
-  out <- data.frame(
-    param_name = names(fit$params),
-    param_value = fit$params,
-    stdError = fit$stdError
-  )
-  rownames(out) <- NULL
-  
-  pred_df_beck <- data.frame(doy = rep(1:365)) |>
-    dplyr::cross_join(out |>
-                        tidyr::pivot_wider(names_from = param_name,
-                                           values_from = c(param_value, stdError))) |>
-    dplyr::mutate(pred = param_value_mn + (param_value_mx - param_value_mn) *
-                    (1/(1 + exp(-param_value_rsp * (doy - param_value_sos))) +
-                       1/(1 + exp(param_value_rau * (doy - param_value_eos))))) |>
-    dplyr::left_join(df |> dplyr::rename(doy = img_doy)) |>
-    dplyr::mutate(method = "Beck",
-                  Date = as.Date(paste0(year_to_run,"-01-01"))+ lubridate::days(doy-1))
-  
-  return(pred_df_beck)
-}
+}