Merge pull request #4088 from sarahkanee/yp-planting-events

Add planting events for young woody (YP) parcels

Author: mdietze

modules/data.remote/inst/ccmmf/events/R/matched_input.R

@@ -145,6 +145,11 @@ load_landiq_season2_identity <- function(year, landiq_crops, cropcode_csv) {
   } else {
     landiq[, SPECOND := NA_character_]
   }
+  if ("COUNTY" %in% names(landiq)) {
+    landiq[, COUNTY := trimws(as.character(COUNTY))]
+  } else {
+    landiq[, COUNTY := NA_character_]
+  }
 
   landiq <- merge(landiq, ag_pairs, by = c("CLASS", "SUBCLASS"))
   data.table::setorder(landiq, parcel_id)
@@ -154,6 +159,28 @@ load_landiq_season2_identity <- function(year, landiq_crops, cropcode_csv) {
     CLASS,
     SUBCLASS,
     PFT,
-    SPECOND
+    SPECOND,
+    COUNTY
   )]
 }
+
+# Season-2 identity year -> year+1 (shared by harvest clearing and YP planting).
+load_landiq_season2_lookahead <- function(year, paths) {
+  yr <- as.integer(year)
+  prior <- load_landiq_season2_identity(yr, paths$landiq_crops, paths$cropcode_csv)
+  curr <- load_landiq_season2_identity(yr + 1L, paths$landiq_crops, paths$cropcode_csv)
+  if (is.null(prior) || is.null(curr)) {
+    return(NULL)
+  }
+  data.table::setnames(
+    prior,
+    c("CLASS", "SUBCLASS", "PFT", "SPECOND", "COUNTY"),
+    c("prior_CLASS", "prior_SUBCLASS", "prior_PFT", "prior_SPECOND", "prior_COUNTY")
+  )
+  data.table::setnames(
+    curr,
+    c("CLASS", "SUBCLASS", "PFT", "SPECOND", "COUNTY"),
+    c("curr_CLASS", "curr_SUBCLASS", "curr_PFT", "curr_SPECOND", "curr_COUNTY")
+  )
+  merge(prior, curr, by = "parcel_id", all.x = TRUE)
+}

modules/data.remote/inst/ccmmf/events/R/planting_events.R

@@ -57,7 +57,7 @@ build_planting_events <- function(year, out_dir, matched_dir) {
       dt[, coarse_root_n_kg_m2 := as.numeric(N_COARSEROOT)]
       if ("PFT" %in% names(dt)) {
         pft_l <- tolower(trimws(as.character(dt$PFT)))
-        dt <- dt[!pft_l %in% c("hay", "woody", "other")]
+        dt <- dt[!pft_l %in% c("hay", "other")]
       }
       dt <- keep_event_columns(dt, .planting_event_cols)
       if (nrow(dt)) {

modules/data.remote/inst/ccmmf/traits/apply_harvest.R

@@ -167,28 +167,15 @@ build_woody_destructive_from_transition <- function(year, matched, pool_env, lk,
     yr, " -> ", next_yr, " (CLASS-level)"
   )
 
-  prior <- load_landiq_season2_identity(yr, paths$landiq_crops, paths$cropcode_csv)
-  curr <- load_landiq_season2_identity(next_yr, paths$landiq_crops, paths$cropcode_csv)
-  if (is.null(prior) || is.null(curr)) {
+  trans <- load_landiq_season2_lookahead(yr, paths)
+  if (is.null(trans)) {
     message(
       "  Skip woody destructive: need season-2 LandIQ for both ",
       yr, " and ", next_yr, " (re-run prior year after new LandIQ year exists)."
     )
     return(NULL)
   }
 
-  data.table::setnames(
-    prior,
-    c("CLASS", "SUBCLASS", "PFT", "SPECOND"),
-    c("prior_CLASS", "prior_SUBCLASS", "prior_PFT", "prior_SPECOND")
-  )
-  data.table::setnames(
-    curr,
-    c("CLASS", "SUBCLASS", "PFT", "SPECOND"),
-    c("curr_CLASS", "curr_SUBCLASS", "curr_PFT", "curr_SPECOND")
-  )
-
-  trans <- merge(prior, curr, by = "parcel_id", all.x = TRUE)
   prior_mature <- tolower(trimws(as.character(trans$prior_PFT))) == "woody" &
     !(toupper(trimws(as.character(trans$prior_CLASS))) == "YP" |
       toupper(trimws(as.character(trans$prior_SPECOND))) == "Y")

modules/data.remote/inst/ccmmf/traits/apply_planting.R

@@ -48,7 +48,7 @@ matched <- load_matched_for_events(
   year_arg, paths$matched_dir, run_planting = TRUE
 )
 
-lai_dt <- build_planting_lai_table(matched, pool$pool_env)
+lai_dt <- build_planting_lai_table(matched, pool$pool_env, year_arg, paths)
 message("[lai] ", nrow(lai_dt), " rows in memory (not written)")
 if (nrow(lai_dt)) {
   print(lai_dt[, .N, by = .(PFT, lai_source)])

modules/data.remote/inst/ccmmf/traits/planting_apply.R

@@ -1,7 +1,65 @@
 # Shared EVI -> LAI and LAI -> C/N tables for planting.
 # CLI: apply_planting.R
 # make_events_statewide planting reads assigned_year=Y_planting.parquet
-# (does not recompute). Hay and woody are not planted here.
+# (does not recompute). Hay and mature woody are not planted here; YP is.
+
+# Young perennial (CLASS=YP) has no crop subclass, so planting traits must come
+# from an orchard/vineyard code (D, C, or V).
+resolve_yp_planting_codes <- function(matched, year, paths) {
+  idx <- which(toupper(trimws(as.character(matched$landiq_CLASS))) == "YP")
+  if (!length(idx)) return(matched)
+
+  # Load existing transition CSVs (does not rebuild them).
+  gf <- trimws(Sys.getenv(
+    "LANDIQ_GAPFILL_ROOT", file.path(Sys.getenv("CCMMF_CODE"), "landiq-gapfill")
+  ))
+  source(file.path(gf, "scripts", "R", "county_transition.R"), local = TRUE)
+  state_csv <- file.path(dirname(paths$cropcode_csv), "state_transition_matrix.csv")
+  ag <- rownames(read.csv(state_csv, row.names = 1, check.names = FALSE))
+  mats <- load_county_transition_matrices(path_county_transition_dir(), ag)
+  fb <- load_transition_matrix_csv(state_csv, ag)
+
+  ov <- c("D", "C", "V")
+  # Argmax of YP -> D/C/V from the county matrix (or statewide fallback).
+  prior_one <- function(county) {
+    st <- county_matrix_stem(county)
+    A <- if (!is.na(st) && nzchar(st) && st %in% names(mats)) mats[[st]] else fb
+    p <- as.numeric(A["YP", ov])
+    names(p) <- ov
+    p[!is.finite(p)] <- 0
+    if (!any(p > 0)) "D" else names(p)[which.max(p)]
+  }
+
+  cls <- character(length(idx))
+  sub <- rep("**", length(idx))
+  county <- rep(NA_character_, length(idx))
+
+  # 1) Look-ahead: season-2 identity year -> year+1 (same helper as harvest clearing).
+  tr <- load_landiq_season2_lookahead(year, paths)
+  if (!is.null(tr)) {
+    j <- match(as.character(matched$parcel_id[idx]), as.character(tr$parcel_id))
+    hit <- !is.na(j)
+    county[hit] <- as.character(tr$prior_COUNTY[j[hit]])
+    cc <- toupper(trimws(as.character(tr$curr_CLASS[j])))
+    # Only accept a mature orchard/vineyard destination.
+    ok <- hit & cc %in% ov
+    cls[ok] <- cc[ok]
+    s <- as.character(tr$curr_SUBCLASS[j[ok]])
+    s[is.na(s) | trimws(s) %in% c("", "**")] <- "**"
+    sub[ok] <- s
+  }
+
+  # 2) Still YP / no usable next class -> county (or state) transition prior.
+  need <- !nzchar(cls)
+  cls[need] <- vapply(county[need], prior_one, character(1))
+  message(
+    "[planting] YP trait codes: ", length(idx),
+    " (look-ahead=", sum(!need), ", county prior=", sum(need), ")"
+  )
+  # Overwrite YP with the resolved D/C/V code used by the planting lookup.
+  matched[idx, `:=`(landiq_CLASS = cls, landiq_SUBCLASS = sub)]
+  matched
+}
 
 planting_keep_dated_crop_rows <- function(matched) {
   if (!"planting_date_str" %in% names(matched)) {
@@ -11,9 +69,19 @@ planting_keep_dated_crop_rows <- function(matched) {
   keep <- !is.na(d) & nzchar(d) & d != "NA"
   matched <- matched[keep]
   pft_l <- tolower(trimws(as.character(matched$landiq_PFT)))
-  # Annual planting only (row, rice). Hay and woody are not planted each year;
-  # they get phenology + harvest instead. YP OGI stays on the overlay.
-  matched <- matched[!pft_l %in% c("other", "woody", "hay")]
+  specond <- if ("landiq_SPECOND" %in% names(matched)) {
+    as.character(matched$landiq_SPECOND)
+  } else {
+    rep(NA_character_, nrow(matched))
+  }
+  # Plant annuals plus young woody. CLASS=YP needs trait resolve below;
+  # SPECOND=Y already carries a D/C/V class and uses those traits as-is.
+  # Mature woody and hay stay phenology + harvest only.
+  young <- pft_l == "woody" & (
+    toupper(trimws(as.character(matched$landiq_CLASS))) == "YP" |
+      toupper(trimws(specond)) == "Y"
+  )
+  matched <- matched[pft_l %in% c("row", "rice") | young]
   matched
 }
 
@@ -92,8 +160,12 @@ lookup_planting_lai_fallback <- function(class, pft, fb) {
 }
 
 # Overlay rows -> LAI via compute_lai_from_mslsp (or CLASS/PFT fallback).
-build_planting_lai_table <- function(matched, pool_env) {
+# Keep filter first (while CLASS is still YP), then rewrite YP to D/C/V.
+build_planting_lai_table <- function(matched, pool_env, year = NULL, paths = NULL) {
   matched <- planting_keep_dated_crop_rows(matched)
+  if (!is.null(year) && !is.null(paths)) {
+    matched <- resolve_yp_planting_codes(matched, year, paths)
+  }
   message("[lai] Crop rows with planting date: ", nrow(matched))
   lai_fb <- planting_lai_fallbacks(matched, pool_env)
   message(