Updated functions to provide app outputs

R/fct_arithmetic_mean.R

@@ -58,6 +58,7 @@ fct_arithmetic_mean <- function(.ad, .cs, .usr, .time){
   # .ad = ad
   # .cs = cs
   # .usr = usr
+  # .time = time_clean
   ## !!!
 
   usr_ari <- .usr |> dplyr::mutate(n_iter = 1)
@@ -82,6 +83,19 @@ fct_arithmetic_mean <- function(.ad, .cs, .usr, .time){
     .ad_annual = usr_ari$ad_annual
   )
 
+  ari_ER <- fct_combine_mcs_ER(.sim_ref = ari_REF, .sim_mon = ari_MON, .ad_annual = .usr$ad_annual) |>
+    dplyr::mutate(period_type = paste0("ER-", .data$period_type)) |>
+    dplyr::select("period_type", E = "ER_sim")
+
+  ari_REF2 <- ari_REF |> dplyr::select("period_type", E = "E_sim")
+  ari_MON2 <- ari_MON |>
+    dplyr::mutate(period_type = paste0("E-", .data$period_type)) |>
+    dplyr::select("period_type", E = "E_sim")
+
+  ari_combi <- ari_REF2 |>
+    dplyr::bind_rows(ari_MON2) |>
+    dplyr::bind_rows(ari_ER)
+
   out_combi <- .time |>
     dplyr::group_by(.data$period_type) |>
     dplyr::summarize(
@@ -126,7 +140,7 @@ fct_arithmetic_mean <- function(.ad, .cs, .usr, .time){
       y = "Emissions (MtCO2e/y)"
     )
 
-  list(emissions = out_combi, gg_emissions = out_gg)
+  list(ER = ari_combi, emissions = out_combi, gg_emissions = out_gg)
 
 }
 

R/fct_combine_mcs_E.R

@@ -167,9 +167,9 @@ fct_combine_mcs_E <- function(.ad, .cs, .usr){
       E_sim  = .data$AD * .data$EF
     ) %>%
     dplyr::select(
-      .data$sim_no, .data$redd_activity, time_period = .data$trans_period, .data$trans_id,
-      .data$AD, .data$EF, .data$E_sim, .data$C_form_i, .data$C_all_i, .data$C_form_f,
-      .data$C_all_f, dplyr::everything()
+      "sim_no", "redd_activity", time_period = "trans_period", "trans_id",
+      "AD", "EF", "E_sim", "C_form_i", "C_all_i", "C_form_f",
+      "C_all_f", dplyr::everything()
     )
 
 }

R/fct_combine_mcs_ER.R

@@ -67,9 +67,9 @@ fct_combine_mcs_ER <- function(
 ){
 
   ## !!! FOR TESTING ONLY - run example then assign to function inputs
-  .sim_ref = sim_REF
-  .sim_mon = sim_MON
-  .ad_annual = usr$ad_annual
+  # .sim_ref = sim_REF
+  # .sim_mon = sim_MON
+  # .ad_annual = usr$ad_annual
   ## !!!
 
   moni_combi <- unique(.sim_mon$period_type)
@@ -78,7 +78,7 @@ fct_combine_mcs_ER <- function(
 
     out <- .sim_mon |>
       dplyr::filter(.data$period_type == x) |>
-      dplyr::inner_join(sim_FREL, by = "sim_no", suffix = c("", "_R")) |>
+      dplyr::inner_join(.sim_ref, by = "sim_no", suffix = c("", "_R")) |>
       dplyr::mutate(ER_sim = .data$E_sim_R - .data$E_sim)
 
   }) |> purrr::list_rbind()

R/fct_combine_mcs_cpools.R

@@ -97,7 +97,7 @@ fct_combine_mcs_cpools <- function(.c_sub, .usr){
       C_all = eval(parse(text=c_form), SIMS),
       sim_no = 1:.usr$n_iter
     ) |>
-    dplyr::select(.data$sim_no, dplyr::everything())
+    dplyr::select("sim_no", dplyr::everything())
 
 }
 

R/fct_combine_mcs_cstock.R

@@ -36,7 +36,7 @@
 #'   na = "NA"
 #'   )
 #'
-#' res <- fct_combine_mcs_cstock(.ad = ad, .cs = cs_clean, .usr = usr)
+#' res <- fct_combine_mcs_cstock(.ad = ad, .cs = cs, .usr = usr)
 #' res |> filter(sim_no == 1)
 #'
 #' @export

tests/test-functions.R

@@ -13,52 +13,79 @@
 # usr <- readxl::read_xlsx(system.file("extdata/example1.xlsx", package = "mocaredd"), sheet = "user_inputs", na = "NA")
 # time <- readxl::read_xlsx(system.file("extdata/example1.xlsx", package = "mocaredd"), sheet = "time_periods", na = "NA")
 #
-# time_clean <- time |> dplyr::mutate(nb_years = year_end - year_start + 1)
+# time <- time |> dplyr::mutate(nb_years = year_end - year_start + 1)
+#
+# usr$ci_alpha <- 1 - usr$conf_level
+# usr$conf_level_txt = paste0(usr$conf_level * 100, "%")
 #
-# ci_alpha <- 1 - usr$conf_level
 #
 # ##
 # ## test whole calculation chain ######
 # ##
 #
+# ari <- fct_arithmetic_mean(.ad = ad, .cs = cs, .usr = usr ,.time = time)
+#
 # sim_trans <- fct_combine_mcs_E(.ad = ad, .cs = cs, .usr = usr)
 #
 # ## Check
-# tt <- sim_FREL |> filter(sim_no == 1)
+# tt <- sim_trans |> filter(sim_no == 1)
+# tt
+#
+#
+# res_trans <- sim_trans |> fct_calc_res(.id = trans_id, .sim = E_sim, .ci_alpha = usr$ci_alpha)
+#
+# gt_trans <- fct_forestplot(
+#   .data = res_trans,
+#   .id = trans_id,
+#   .value = E,
+#   .uperc = E_U,
+#   .cilower = E_cilower,
+#   .ciupper = E_ciupper,
+#   .id_colname = "REDD+ Activity",
+#   .conflevel = usr$conf_level_txt,
+#   .filename = NA
+#   )
+#
+# sim_redd <- sim_trans |>
+#  dplyr::group_by(.data$sim_no, .data$time_period, .data$redd_activity) |>
+#   dplyr::summarise(E_sim = sum(.data$E_sim), .groups = "drop")
+#
+# ## Check
+# tt <- sim_redd |> filter(sim_no == 1)
 # tt
+# res_redd <- fct_calc_res(.data = sim_redd, .id = redd_activity, .sim = E_sim, .ci_alpha = usr$ci_alpha)
 #
 # ## FREL
 # sim_REF <- fct_combine_mcs_P(
 #   .data = sim_trans,
-#   .time = time_clean,
+#   .time = time,
 #   .period_type = "REF",
 #   .ad_annual = usr$ad_annual
 # )
 #
-#
 # res_REF <- sim_REF |>
-#   fct_calc_res(.id = period_type, .sim = E_sim, .ci_alpha = ci_alpha)
+#   fct_calc_res(.id = period_type, .sim = E_sim, .ci_alpha = usr$ci_alpha)
 #
 # message("FREL is: ", res_REF$E, " ± ", res_REF$E_U, "%")
 #
 # ## Monitoring
 # sim_MON <- fct_combine_mcs_P(
 #     .data = sim_trans,
-#     .time = time_clean,
+#     .time = time,
 #     .period_type = "MON",
 #     .ad_annual = usr$ad_annual
 #   )
 #
 # res_MON <- sim_MON |>
-#   fct_calc_res(.id = period_type, .sim = E_sim, .ci_alpha = ci_alpha) |>
+#   fct_calc_res(.id = period_type, .sim = E_sim, .ci_alpha = usr$ci_alpha) |>
 #   mutate(period_type = paste0("E-", period_type))
 #
 # sim_ER <- fct_combine_mcs_ER(.sim_ref = sim_REF, .sim_mon = sim_MON, .ad_annual = usr$ad_annual)
 #
 # res_ER <- sim_ER |>
-#   fct_calc_res(.id = period_type, .sim = ER_sim, .ci_alpha = ci_alpha) |>
+#   fct_calc_res(.id = period_type, .sim = ER_sim, .ci_alpha = usr$ci_alpha) |>
 #   mutate(period_type = paste0("ER-", period_type))
-#
+
 # ## Combine results
 # gt_all <- res_REF |>
 #   bind_rows(res_MON) |>
@@ -80,50 +107,50 @@
 # sim_ER <- sim_FREL |>
 #   bind_rows(sim_moni)
 
-
-
-
-res_ER <- sim_ER |>
-  fct_calc_res(.id = period_type, .sim = ER_sim, .ci_alpha = ci_alpha)
-
-
-
-tmp_ER <- time_clean |>
-  group_by(period_type) |>
-  summarise(
-    year_start = min(year_start),
-    year_end = max(year_end),
-    nb_years = sum(nb_years)
-  )
-
-
-
-
-
-
-res_ER2 <- tmp_ER |> inner_join(res_ER, by = join_by(period_type))
-
-
-
-
-gt_ER <- res_ER |> fct_forestplot(
-  .id = period_type,
-  .value = E,
-  .uperc = E_U,
-  .cilower = E_cilower,
-  .ciupper = E_ciupper,
-  .id_colname = "Monitoring period",
-  .conflevel = "90%",
-  .filename = NA
-  )
-
-gg_ER <- fct_histogram(
-  .dat = sim_ER,
-  .res = res_ER,
-  .id = period_type,
-  .value = ER_sim,
-  .value_type = "ER"
-  )
+#
+#
+#
+# res_ER <- sim_ER |>
+#   fct_calc_res(.id = period_type, .sim = ER_sim, .ci_alpha = ci_alpha)
+#
+#
+#
+# tmp_ER <- time_clean |>
+#   group_by(period_type) |>
+#   summarise(
+#     year_start = min(year_start),
+#     year_end = max(year_end),
+#     nb_years = sum(nb_years)
+#   )
+#
+#
+#
+#
+#
+#
+# res_ER2 <- tmp_ER |> inner_join(res_ER, by = join_by(period_type))
+#
+#
+#
+#
+# gt_ER <- res_ER |> fct_forestplot(
+#   .id = period_type,
+#   .value = E,
+#   .uperc = E_U,
+#   .cilower = E_cilower,
+#   .ciupper = E_ciupper,
+#   .id_colname = "Monitoring period",
+#   .conflevel = "90%",
+#   .filename = NA
+#   )
+#
+# gg_ER <- fct_histogram(
+#   .dat = sim_ER,
+#   .res = res_ER,
+#   .id = period_type,
+#   .value = ER_sim,
+#   .value_type = "ER"
+#   )
 
 #gt::gtsave(gt_ER, filename = "test.png")
 

tests/testthat/test-fct_combine_mcs_E.R

@@ -7,11 +7,12 @@ usr <- readxl::read_xlsx(system.file("extdata/example1.xlsx", package = "mocared
 ad_clean <- ad |> dplyr::filter(!is.na(trans_area) | !is.na(trans_pdf_a))
 cs_clean <- cs |> dplyr::filter(!is.na(c_value) | !is.na(c_pdf_a))
 
+set.seed(1)
 res <- fct_combine_mcs_E(.ad = ad_clean, .cs = cs_clean, .usr = usr)
 test_res <- round(median(res$E_sim))
 
 
 testthat::test_that("Works", {
-  testthat::expect_equal(test_res, 75830)
+  testthat::expect_equal(test_res, 75398)
 
 })

tests/testthat/test-fct_combine_mcs_P.R

@@ -8,6 +8,7 @@ ad_clean <- ad |> dplyr::filter(!is.na(trans_area) | !is.na(trans_pdf_a))
 cs_clean <- cs |> dplyr::filter(!is.na(c_value) | !is.na(c_pdf_a))
 time_clean <- time |> dplyr::mutate(nb_years = year_end - year_start + 1)
 
+set.seed(1)
 sim_trans <- fct_combine_mcs_E(.ad = ad_clean, .cs = cs_clean, .usr = usr)
 
 sim_FREL <- fct_combine_mcs_P(
@@ -20,5 +21,5 @@ sim_FREL <- fct_combine_mcs_P(
 test_res <- round(median(sim_FREL$E_sim))
 
 testthat::test_that("function doesn't work :P", {
-  testthat::expect_equal(test_res, 4591614)
+  testthat::expect_equal(test_res, 4594283)
 })

tests/testthat/test-fct_combine_mcs_cstock.R

@@ -0,0 +1,30 @@
+
+
+cs <- readxl::read_xlsx(
+  system.file("extdata/example1.xlsx", package = "mocaredd"),
+  sheet = "c_stocks",
+  na = "NA"
+  )
+ad <- readxl::read_xlsx(
+  system.file("extdata/example1.xlsx", package = "mocaredd"),
+  sheet = "AD_lu_transitions",
+  na = "NA"
+  )
+usr <- readxl::read_xlsx(
+  system.file("extdata/example1.xlsx", package = "mocaredd"),
+  sheet = "user_inputs",
+  na = "NA"
+  )
+
+set.seed(1)
+res <- fct_combine_mcs_cstock(.ad = ad, .cs = cs, .usr = usr)
+
+test_res <- res |>
+  dplyr::filter(.data$sim_no == 1, .data$lu_id == "open") |>
+  dplyr::pull("C_all") |>
+  round()
+
+
+testthat::test_that("fct_combine_mcs_C works on example1", {
+  testthat::expect_equal(test_res, 210)
+})