sipnet: drop segments with unchanged PFT

models/sipnet/NEWS.md

@@ -1,5 +1,6 @@
 # PEcAn.SIPNET 1.10.0.9000
 
+* `write_segmented_configs.SIPNET` now merges consecutive segments with the same PFT to avoid unnecessary SIPNET restarts (#4129).
 * `write.config.SIPNET` converted `stem_respiration_rate` and
     `root_respiration_rate` to per day rates, but SIPNET reads `baseVegResp`
     and `baseFineRootResp` as per year and divides by 365 itself, so both were

models/sipnet/R/write_segmented_configs.R

@@ -176,7 +176,24 @@ segment_dataframe <- function(run_settings) {
     dplyr::arrange(.data$start_date) |>
     dplyr::mutate(segment_id = sprintf("%03d", dplyr::row_number()))
 }
+drop_same_pft_segments <- function(segments) {
+  if (nrow(segments) <= 1) {
+    return(segments)
+  }
 
+  segments |>
+    dplyr::mutate(pft_group = dplyr::consecutive_id(.data$pft)) |>
+    dplyr::summarise(
+      start_date = min(.data$start_date),
+      end_date = max(.data$end_date),
+      crop_code = paste(.data$crop_code, collapse = " "),
+      pft = dplyr::first(.data$pft),
+      .by = "pft_group"
+    ) |>
+    dplyr::mutate(
+      segment_id = sprintf("%03d", dplyr::row_number())
+    )
+}
 write_segment_configs <- function(
   settings,
   run_row,
@@ -210,9 +227,14 @@ write_segment_configs <- function(
     # Adds an all-NA pft column if needed w/o clobbering one that exists already
     dplyr::bind_rows(tibble::tibble(pft = character())) |>
     dplyr::mutate(
-      pft = dplyr::coalesce(.data$pft, crop2pft(.data$crop_code)),
-      segment_dir = file.path(segment_rootdir,
-                              sprintf("segment_%s", .data$segment_id))
+      pft = dplyr::coalesce(.data$pft, crop2pft(.data$crop_code))
+    ) |>
+    drop_same_pft_segments() |>
+    dplyr::mutate(
+      segment_dir = file.path(
+        segment_rootdir,
+        paste0("segment_", .data$segment_id)
+      )
     )
   utils::write.csv(
     segments,

models/sipnet/tests/testthat/test-write_segmented_configs.R

@@ -10,7 +10,7 @@ test_that("write_segmented_configs", {
 
   event_lines |>
     writeLines(con = event_src_path)
-  c("date,crop_code", "2025-01-02,D12", "2025-01-05,G6") |>
+  c("date,crop_code", "2025-01-02,D12", "2025-01-04,D13", "2025-01-05,G6") |>
     writeLines(crp_chg_path)
   c("run_id,site_id", "ENS-00001-a,a") |>
     writeLines(file.path(pth, "runs_manifest.csv"))
@@ -269,3 +269,44 @@ test_that("write_segment_configs returns unaltered job.sh when no segments remai
   expect_false(file.exists(file.path(run_path, "job_segmented.sh")))
   expect_false(dir.exists(file.path(run_path, "segments")))
 })
+
+test_that("drop_same_pft_segments merges consecutive segments with the same PFT", {
+  segments <- data.frame(
+    start_date = as.Date(c(
+      "2025-01-01", "2025-01-02", "2025-01-04", "2025-01-05"
+    )),
+    end_date = as.Date(c(
+      "2025-01-01", "2025-01-03", "2025-01-04", "2025-01-10"
+    )),
+    crop_code = c(NA_character_, "D12", "D13", "G6"),
+    pft = c("pft1", "pft2", "pft2", "pft3")
+  )
+
+  result <- PEcAn.SIPNET:::drop_same_pft_segments(segments)
+
+  expect_equal(nrow(result), 3)
+
+  expect_equal(
+    result$start_date,
+    as.Date(c("2025-01-01", "2025-01-02", "2025-01-05"))
+  )
+
+  expect_equal(
+    result$end_date,
+    as.Date(c("2025-01-01", "2025-01-04", "2025-01-10"))
+  )
+
+  expect_identical(
+    result$crop_code,
+    c("NA", "D12 D13", "G6")
+  )
+  expect_identical(
+    result$pft,
+    c("pft1", "pft2", "pft3")
+  )
+
+  expect_identical(
+    result$segment_id,
+    c("001", "002", "003")
+  )
+})