dones step 3, working on step 4

Author: gaelso

R/fct_combine_mcs_cstock.R

@@ -25,11 +25,11 @@
 #' ad <- read_xlsx(path = path, sheet = "AD_lu_transitions", na = "NA")
 #' usr <- read_xlsx(path = path, sheet = "user_inputs", na = "NA")
 #'
-#' res <- fct_combine_mcs_cstock(.ad = ad, .cs = cs, .usr = usr)
+#' res <- fct_combine_sims_C_allstock(.ad = ad, .cs = cs, .usr = usr)
 #' res |> filter(sim_no == 1)
 #'
 #' @export
-fct_combine_mcs_cstock <- function(.ad, .cs, .usr){
+fct_combine_sims_C_allstock <- function(.ad, .cs, .usr){
 
   ## !!! FOR TESTING ONLY - run example then assign ad, cs and usr to the input vars.
   # .ad <- ad
@@ -47,14 +47,17 @@ fct_combine_mcs_cstock <- function(.ad, .cs, .usr){
   ## 1. simulate CF ####
 
   if (is.numeric(.usr$c_fraction)) {
-    sims_CF <- fct_make_mcs(
-      .n_iter = .usr$n_iter,
-      .pdf    = .usr$c_fraction_pdf,
-      .mean   = round(.usr$c_fraction, 3),
-      .se     = round(.usr$c_fraction_se, 3),
-      #.params = c(params$c_pdf_a, params$c_pdf_b, params$c_pdf_c),
-      .trunc  = .usr$trunc_pdf
-    ) |> round(3)
+    sims_CF <- tibble(
+      sim_no = 1:.usr$n_iter,
+      CF = round(fct_make_mcs(
+        .n_iter = .usr$n_iter,
+        .pdf    = .usr$c_fraction_pdf,
+        .mean   = round(.usr$c_fraction, 3),
+        .se     = round(.usr$c_fraction_se, 3),
+        #.params = c(params$c_pdf_a, params$c_pdf_b, params$c_pdf_c),
+        .trunc  = .usr$trunc_pdf
+      ), 3)
+    )
   }
 
   ## 2. simulate C elements ####
@@ -114,69 +117,91 @@ fct_combine_mcs_cstock <- function(.ad, .cs, .usr){
     dplyr::distinct()
 
   ## + Run loop
-  combi_formulas <- pmap(combi, function(period, lu){
+  combi_form <- purrr::pmap(combi, function(period, lu){
 
     c_sub <- .cs |> filter(.data$c_period == period, .data$c_lu_id == lu)
 
     c_check <- fct_check_pool(.c_sub = c_sub, .c_unit = .usr$c_unit, .c_fraction = .usr$c_fraction)
+    c_form  <- fct_make_formula(.c_check = c_check, .c_unit = .usr$c_unit)
 
-  })
+    tibble(
+      period = period,
+      lu_id = lu,
+      c_form = c_form
+    )
 
+  }) |> purrr::list_rbind()
 
+  ## CHECK
+  # combi_form
 
+  ## + Add to sims
+  if (is.numeric(.usr$c_fraction)) {
+    sims_C_form <- sims_C |>
+      left_join(sims_CF, by = "sim_no") |>
+      left_join(combi_form, by = c("period", "lu_id"))
+  } else {
+    sims_C_form <- sims_C |>
+      left_join(combi_form, by = c("period", "lu_id"))
+  }
 
-  #|>
-    #dplyr::select("sim_no", "c_period", "lu_id", "C_all", "C_form", dplyr::everything())
+  sims_C_all <- sims_C_form |>
+    rowwise() |>
+    mutate(
+      C_all = if_else(c_form == "DG_ratio", NA_real_, round(eval(parse(text=c_form)), 3))
+      ) |>
+    ungroup()
 
   ## CHECK
-  # tt <- mcs_c |> dplyr::filter(.data$sim_no == 1)
+  # tt <- sims_C_all |> dplyr::filter(.data$sim_no == 1)
+
+  ## 4. Calculate C for degraded land uses
 
-  if ("DG_ratio" %in% unique(mcs_c$C_form)) {
+  if ("DG_ratio" %in% unique(sims_C_all$c_form)) {
 
-    ## Get pools used for DG
+    ## + Get pools used for DG
     if (.usr$dg_pool == "ALL") {
       dg_pool <- "C_all"
     } else {
       dg_pool <- stringr::str_split(.usr$dg_pool, pattern = ",") |> purrr::map(stringr::str_trim) |> unlist()
     }
     dg_pool_intact <- paste0(dg_pool, "_intact")
 
-    ## Filter DG to modify formula and recalculate
-    mcs_dg <- mcs_c |>
-      dplyr::filter(.data$C_form == "DG_ratio") |>
+    ## + Filter DG to modify formula and recalculate
+    sims_DG <- sims_C_all |>
+      dplyr::filter(.data$c_form == "DG_ratio") |>
       dplyr::mutate(
         lu_intact = stringr::str_remove(.data$lu_id, pattern = .usr$dg_ext)
       )
 
-    mcs_join <- mcs_c |>
-      dplyr::filter(.data$lu_id %in% unique(mcs_dg$lu_intact)) |>
+    sims_C_intact <- sims_C_all |>
+      dplyr::filter(.data$lu_id %in% unique(sims_DG$lu_intact)) |>
       dplyr::select("sim_no", lu_intact = "lu_id", !!!rlang::syms(dg_pool))
 
-    names(mcs_join)[!(names(mcs_join) %in% c("sim_no", "lu_intact"))] <- dg_pool_intact
+    names(sims_C_intact)[!(names(sims_C_intact) %in% c("sim_no", "lu_intact"))] <- dg_pool_intact
 
-    mcs_dg2 <- mcs_dg |>
-      dplyr::left_join(mcs_join, by = c("sim_no", "lu_intact")) |>
+    sims_DG2 <- sims_DG |>
+      dplyr::left_join(sims_C_intact, by = c("sim_no", "lu_intact")) |>
       dplyr::rowwise() |>
       dplyr::mutate(
-        C_form = paste0(.data$C_form, " * (", paste0(dg_pool_intact, collapse = " + "), ")"),
-        C_all  = round(.data$C_all * sum(!!!rlang::syms(dg_pool_intact)), 3)
+        c_form = paste0(.data$c_form, " * (", paste0(dg_pool_intact, collapse = " + "), ")"),
+        C_all  = round(.data$DG_ratio * sum(!!!rlang::syms(dg_pool_intact)), 3)
       ) |>
       dplyr::ungroup() |>
       dplyr::select(-"lu_intact", -dplyr::all_of(dg_pool_intact))
 
-    mcs_c2 <- mcs_c |>
-      dplyr::filter(.data$C_form != "DG_ratio") |>
-      dplyr::bind_rows(mcs_dg2) |>
-      dplyr::distinct()
+    sims_C_all2 <- sims_C_all |>
+      dplyr::filter(.data$c_form != "DG_ratio") |>
+      dplyr::bind_rows(sims_DG2)
 
   } else {
-    mcs_c2 <- mcs_c
+    sims_C_all2 <- sims_C_all
   }
 
-  mcs_c2
+  sims_C_all2
 
   ## Check
-  # tt <- mcs_c2 |> dplyr::filter(.data$sim_no == 1)
+  # tt <- sims_C_all2 |> dplyr::filter(.data$sim_no == 1)
 
 }