From 2abb6ecf7ae1e952313be300a99d14d0fca7ee52 Mon Sep 17 00:00:00 2001 From: Vibhor Tyagi Date: Sun, 27 Sep 2026 14:36:46 +0530 Subject: [PATCH 1/7] sipnet: drop segments with unchanged PFT --- models/sipnet/R/write_segmented_configs.R | 31 ++++++++++++++++--- .../testthat/test-write_segmented_configs.R | 2 +- 2 files changed, 28 insertions(+), 5 deletions(-) diff --git a/models/sipnet/R/write_segmented_configs.R b/models/sipnet/R/write_segmented_configs.R index fb70afce42..a1e07ad732 100644 --- a/models/sipnet/R/write_segmented_configs.R +++ b/models/sipnet/R/write_segmented_configs.R @@ -182,7 +182,31 @@ 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 = cumsum( + dplyr::row_number() == 1 | + .data$pft != dplyr::lag(.data$pft) + ) + ) |> + dplyr::group_by(.data$pft_group) |> + dplyr::summarise( + site_id = dplyr::first(.data$site_id), + start_date = dplyr::first(.data$start_date), + end_date = dplyr::last(.data$end_date), + crop_code = dplyr::last(.data$crop_code), + pft = dplyr::first(.data$pft), + .groups = "drop" + ) |> + dplyr::mutate( + segment_id = sprintf("%03d", dplyr::row_number()) + ) +} write_segment_configs <- function( settings, run_row, @@ -216,10 +240,9 @@ 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)) + ) + segments <- drop_same_pft_segments(segments) utils::write.csv( segments, file = file.path(run_dir, "segments.csv"), diff --git a/models/sipnet/tests/testthat/test-write_segmented_configs.R b/models/sipnet/tests/testthat/test-write_segmented_configs.R index 6acd918c40..2021353e5e 100644 --- a/models/sipnet/tests/testthat/test-write_segmented_configs.R +++ b/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")) From e8f088faac8a12dd46e1ead7027cac4ec9fe410e Mon Sep 17 00:00:00 2001 From: tyagivibhor111-hub Date: Sun, 18 Oct 2026 16:28:21 +0000 Subject: [PATCH 2/7] fix(sipnet): merge adjacent segments with same PFT --- models/sipnet/R/write_segmented_configs.R | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/models/sipnet/R/write_segmented_configs.R b/models/sipnet/R/write_segmented_configs.R index a1e07ad732..c8c2f2f49f 100644 --- a/models/sipnet/R/write_segmented_configs.R +++ b/models/sipnet/R/write_segmented_configs.R @@ -191,7 +191,12 @@ drop_same_pft_segments <- function(segments) { dplyr::mutate( pft_group = cumsum( dplyr::row_number() == 1 | - .data$pft != dplyr::lag(.data$pft) + is.na(.data$pft) | + is.na(dplyr::lag(.data$pft)) | + dplyr::coalesce( + .data$pft != dplyr::lag(.data$pft), + FALSE + ) ) ) |> dplyr::group_by(.data$pft_group) |> @@ -235,14 +240,20 @@ write_segment_configs <- function( # No restarts needed. Return path to unaltered full-run script. return(file.path(run_dir, "job.sh")) } - segments <- segments |> # 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)) - ) - segments <- drop_same_pft_segments(segments) + ) + + segments <- drop_same_pft_segments(segments) |> + dplyr::mutate( + segment_dir = file.path( + segment_rootdir, + paste0("segment_", .data$segment_id) + ) + ) utils::write.csv( segments, file = file.path(run_dir, "segments.csv"), From 9bf04d4c619b9b60f02b6b3485a8ac39747d43ee Mon Sep 17 00:00:00 2001 From: Vibhor Tyagi Date: Thu, 22 Oct 2026 12:48:27 +0530 Subject: [PATCH 3/7] fix(sipnet): merge consecutive segments with same PFT --- models/sipnet/R/write_segmented_configs.R | 41 +++++++++-------- .../testthat/test-write_segmented_configs.R | 44 ++++++++++++++++++- 2 files changed, 62 insertions(+), 23 deletions(-) diff --git a/models/sipnet/R/write_segmented_configs.R b/models/sipnet/R/write_segmented_configs.R index 23fb2bb363..5b71c07cc5 100644 --- a/models/sipnet/R/write_segmented_configs.R +++ b/models/sipnet/R/write_segmented_configs.R @@ -182,25 +182,13 @@ drop_same_pft_segments <- function(segments) { } segments |> - dplyr::mutate( - pft_group = cumsum( - dplyr::row_number() == 1 | - is.na(.data$pft) | - is.na(dplyr::lag(.data$pft)) | - dplyr::coalesce( - .data$pft != dplyr::lag(.data$pft), - FALSE - ) - ) - ) |> - dplyr::group_by(.data$pft_group) |> + dplyr::mutate(pft_group = dplyr::consecutive_id(.data$pft)) |> dplyr::summarise( - site_id = dplyr::first(.data$site_id), - start_date = dplyr::first(.data$start_date), - end_date = dplyr::last(.data$end_date), - crop_code = dplyr::last(.data$crop_code), + start_date = min(.data$start_date), + end_date = max(.data$end_date), + crop_code = paste(.data$crop_code, collapse = " "), pft = dplyr::first(.data$pft), - .groups = "drop" + .by = "pft_group" ) |> dplyr::mutate( segment_id = sprintf("%03d", dplyr::row_number()) @@ -239,9 +227,8 @@ write_segment_configs <- function( dplyr::bind_rows(tibble::tibble(pft = character())) |> dplyr::mutate( pft = dplyr::coalesce(.data$pft, crop2pft(.data$crop_code)) - ) - - segments <- drop_same_pft_segments(segments) |> + ) |> + drop_same_pft_segments() |> dplyr::mutate( segment_dir = file.path( segment_rootdir, @@ -393,7 +380,19 @@ write_segment_configs <- function( if (replace_and_link) { run_jobsh_backup <- file.path(run_dir, "job_original.sh") file.rename(run_jobsh, run_jobsh_backup) - file.symlink(segmented_jobsh_file, run_jobsh) + link_created <- suppressWarnings( + file.symlink(segmented_jobsh_file, run_jobsh) + ) + if (!link_created) { + copy_created <- file.copy( + segmented_jobsh_file, + run_jobsh, + overwrite = TRUE + ) + if (!copy_created) { + stop("Failed to create job.sh from job_segmented.sh") + } + } Sys.chmod(run_jobsh, mode = "0755") } invisible(segmented_jobsh_file) diff --git a/models/sipnet/tests/testthat/test-write_segmented_configs.R b/models/sipnet/tests/testthat/test-write_segmented_configs.R index bdf7223fca..140b92aa39 100644 --- a/models/sipnet/tests/testthat/test-write_segmented_configs.R +++ b/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-04,D13","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")) @@ -115,7 +115,6 @@ test_that("write_segmented_configs", { ) } } - # job.sh includes calls to segment scripts jobsh <- readLines(file.path(run_path, "job.sh")) expect_match(jobsh, "segment_001/run/1/job.sh", all = FALSE) @@ -269,3 +268,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") + ) +}) From cb9d3687b4930b181cf963a83589cd297578c15b Mon Sep 17 00:00:00 2001 From: Chris Black Date: Thu, 22 Oct 2026 09:42:30 -0700 Subject: [PATCH 4/7] Apply batched suggestions from code review Co-authored-by: Chris Black --- models/sipnet/R/write_segmented_configs.R | 15 ++------------- 1 file changed, 2 insertions(+), 13 deletions(-) diff --git a/models/sipnet/R/write_segmented_configs.R b/models/sipnet/R/write_segmented_configs.R index 5b71c07cc5..023488d96b 100644 --- a/models/sipnet/R/write_segmented_configs.R +++ b/models/sipnet/R/write_segmented_configs.R @@ -222,6 +222,7 @@ write_segment_configs <- function( # No restarts needed. Return path to unaltered full-run script. return(file.path(run_dir, "job.sh")) } + segments <- segments |> # Adds an all-NA pft column if needed w/o clobbering one that exists already dplyr::bind_rows(tibble::tibble(pft = character())) |> @@ -380,19 +381,7 @@ write_segment_configs <- function( if (replace_and_link) { run_jobsh_backup <- file.path(run_dir, "job_original.sh") file.rename(run_jobsh, run_jobsh_backup) - link_created <- suppressWarnings( - file.symlink(segmented_jobsh_file, run_jobsh) - ) - if (!link_created) { - copy_created <- file.copy( - segmented_jobsh_file, - run_jobsh, - overwrite = TRUE - ) - if (!copy_created) { - stop("Failed to create job.sh from job_segmented.sh") - } - } + file.symlink(segmented_jobsh_file, run_jobsh) Sys.chmod(run_jobsh, mode = "0755") } invisible(segmented_jobsh_file) From ee9a1d4da80a434082df70b1d661bb897a128b35 Mon Sep 17 00:00:00 2001 From: Chris Black Date: Thu, 22 Oct 2026 09:43:22 -0700 Subject: [PATCH 5/7] space --- models/sipnet/R/write_segmented_configs.R | 1 - 1 file changed, 1 deletion(-) diff --git a/models/sipnet/R/write_segmented_configs.R b/models/sipnet/R/write_segmented_configs.R index 023488d96b..cdd92aa599 100644 --- a/models/sipnet/R/write_segmented_configs.R +++ b/models/sipnet/R/write_segmented_configs.R @@ -222,7 +222,6 @@ write_segment_configs <- function( # No restarts needed. Return path to unaltered full-run script. return(file.path(run_dir, "job.sh")) } - segments <- segments |> # Adds an all-NA pft column if needed w/o clobbering one that exists already dplyr::bind_rows(tibble::tibble(pft = character())) |> From c32f51e613e51eddb37b3b735e97f1d75103b5ef Mon Sep 17 00:00:00 2001 From: Chris Black Date: Thu, 22 Oct 2026 09:45:27 -0700 Subject: [PATCH 6/7] space Co-authored-by: Chris Black --- models/sipnet/R/write_segmented_configs.R | 3 ++- models/sipnet/tests/testthat/test-write_segmented_configs.R | 1 + 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/models/sipnet/R/write_segmented_configs.R b/models/sipnet/R/write_segmented_configs.R index cdd92aa599..3939dd4b5a 100644 --- a/models/sipnet/R/write_segmented_configs.R +++ b/models/sipnet/R/write_segmented_configs.R @@ -222,6 +222,7 @@ write_segment_configs <- function( # No restarts needed. Return path to unaltered full-run script. return(file.path(run_dir, "job.sh")) } + segments <- segments |> # Adds an all-NA pft column if needed w/o clobbering one that exists already dplyr::bind_rows(tibble::tibble(pft = character())) |> @@ -380,7 +381,7 @@ write_segment_configs <- function( if (replace_and_link) { run_jobsh_backup <- file.path(run_dir, "job_original.sh") file.rename(run_jobsh, run_jobsh_backup) - file.symlink(segmented_jobsh_file, run_jobsh) + file.symlink(segmented_jobsh_file, run_jobsh) Sys.chmod(run_jobsh, mode = "0755") } invisible(segmented_jobsh_file) diff --git a/models/sipnet/tests/testthat/test-write_segmented_configs.R b/models/sipnet/tests/testthat/test-write_segmented_configs.R index 140b92aa39..14cab9c37f 100644 --- a/models/sipnet/tests/testthat/test-write_segmented_configs.R +++ b/models/sipnet/tests/testthat/test-write_segmented_configs.R @@ -115,6 +115,7 @@ test_that("write_segmented_configs", { ) } } + # job.sh includes calls to segment scripts jobsh <- readLines(file.path(run_path, "job.sh")) expect_match(jobsh, "segment_001/run/1/job.sh", all = FALSE) From 774a7140365e690829c872d03454a7d358c6f52b Mon Sep 17 00:00:00 2001 From: Vibhor Tyagi Date: Thu, 22 Oct 2026 22:51:55 +0530 Subject: [PATCH 7/7] docs: add NEWS entry for SIPNET segment merging --- models/sipnet/NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/models/sipnet/NEWS.md b/models/sipnet/NEWS.md index 4bb7b1ef38..6c51f6008d 100644 --- a/models/sipnet/NEWS.md +++ b/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). * `model2netcdf.SIPNET` now also writes `soil_organic_carbon_content`, the soil carbon pool alone. `TotSoilCarb` is unchanged and still includes the litter pool, so it is not comparable to a measured soil organic carbon