Function to parse restart dates out of event files

modules/data.land/NAMESPACE

@@ -18,6 +18,7 @@ export(download_package_rm)
 export(ens_veg_module)
 export(eto_to_etc)
 export(eto_to_etc_bism)
+export(events_to_crop_cycle_starts)
 export(extract.stringCode)
 export(extract_FIA)
 export(extract_NEON_veg)

modules/data.land/R/events_to_crop_cycle_starts.R

@@ -0,0 +1,52 @@
+#' Extract the first planting date of each crop cycle
+#'
+#' Reads a (JSON) management events file and finds the planting events at which
+#' the site changes from from one crop to another, ignoring repeat plantings of
+#' the same crop.
+#' These are the dates when single-PFT models will need to restart to update
+#' their crop parameterization.
+#'
+#' TODO: For now this function requires each planting event to specify a
+#' `crop` attribute, but note that this is not enforced by v0.1 of the PEcAn
+#' events schema. The schema instead allows each site object to specify a
+#' site-level `PFT` attribute that is implied constant over time.
+#' As I write this I think the schema may need to change to require a crop or
+#' PFT identifier be specified for every planting event.
+#'
+#' @param event_json path to an `events.json` file
+#'
+#' @return data frame with columns `site_id`, `date`, `crop`,
+#'  with one row per detected crop cycle.
+#' @export
+#' @author Chris Black
+#'
+#' @examples
+#' # Not currently runnable because file does not list crop in planting events.
+#' # Revisit after deciding if schema update is warranted.
+#' \dontrun{
+#' evts <- system.file(
+#'   "events_fixtures/events_site1_site2.json",
+#'   package = "PEcAn.data.land"
+#' )
+#' events_to_crop_cycle_starts(evts)
+#' }
+events_to_crop_cycle_starts <- function(event_json) {
+  jsonlite::read_json(event_json) |>
+    dplyr::bind_rows() |>
+    dplyr::mutate(events = purrr::map(.data$events, as.data.frame)) |>
+    tidyr::unnest(.data$events) |>
+    dplyr::mutate(date = as.Date(.data$date)) |>
+    find_crop_changes()
+}
+
+# helper for events_to_crop_cyle_starts,
+# mostly to ease unit testing
+find_crop_changes <- function(event_df) {
+  event_df |>
+    dplyr::filter(.data$event_type == "planting") |>
+    dplyr::arrange(.data$site_id, .data$date) |>
+    dplyr::mutate(crop_cycle_id = dplyr::consecutive_id(.data$site_id, .data$crop)) |>
+    dplyr::group_by(.data$site_id, .data$crop_cycle_id) |>
+    dplyr::slice_min(.data$date) |>
+    dplyr::select("site_id", "date", "crop")
+}

modules/data.land/tests/testthat/test-events_to_crop_cycle_starts.R

@@ -0,0 +1,49 @@
+test_that("non-planting events are ignored", {
+  dat <- dplyr::tribble(
+    ~site_id, ~date, ~event_type, ~crop,
+    "a", "2016-01-01", "planting", "almond",
+    "a", "2016-05-01", "irrigation", NA_character_,
+    "a", "2017-01-01", "planting", "almond",
+    "a", "2017-05-15", "fertilization", NA_character_,
+  )
+  res <- find_crop_changes(dat)
+  expect_equal(nrow(res), 1)
+  expect_equal(res$date, "2016-01-01")
+  expect_equal(res, find_crop_changes(dat[-c(2, 4), ]))
+})
+
+test_that("nonconsecutive runs of the same crop counted separately", {
+  dat <- dplyr::tribble(
+    ~site_id, ~date, ~event_type, ~crop,
+    "b", "2016-03-01", "planting", "tomato",
+    "b", "2017-03-05", "planting", "tomato",
+    "b", "2018-04-15", "planting", "potato",
+    "b", "2018-08-01", "planting", "tomato",
+  )
+  res <- find_crop_changes(dat)
+  expect_equal(nrow(res), 3)
+  expect_equal(res$date, dat$date[c(1, 3, 4)])
+})
+
+test_that("sites are counted separately", {
+  dat <- dplyr::tribble(
+    ~site_id, ~date, ~event_type, ~crop,
+    "a", "2016-03-01", "planting", "grape",
+    "b", "2016-03-01", "planting", "grape",
+    "c", "2023-03-01", "planting", "grape",
+  )
+  res <- find_crop_changes(dat)
+  expect_equal(nrow(res), 3)
+  expect_equal(res$date, dat$date)
+  expect_equal(res$site_id, dat$site_id)
+})
+
+test_that("reads from JSON", {
+  path <- system.file(
+    "events_fixtures/events_site1.json",
+    package = "PEcAn.data.land"
+  )
+  res <- events_to_crop_cycle_starts(path)
+  expect_equal(res$date, "2022-02-19")
+  expect_equal(res$crop, "EX1")
+})