diff --git a/R/fct_arithmetic_mean.R b/R/fct_arithmetic_mean.R index 522f9e0..cd88640 100644 --- a/R/fct_arithmetic_mean.R +++ b/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) } diff --git a/R/fct_combine_mcs_E.R b/R/fct_combine_mcs_E.R index c817412..0f0bfc5 100644 --- a/R/fct_combine_mcs_E.R +++ b/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() ) } diff --git a/R/fct_combine_mcs_ER.R b/R/fct_combine_mcs_ER.R index c2b4b61..8116b02 100644 --- a/R/fct_combine_mcs_ER.R +++ b/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() diff --git a/R/fct_combine_mcs_cpools.R b/R/fct_combine_mcs_cpools.R index c9dd193..f232bc0 100644 --- a/R/fct_combine_mcs_cpools.R +++ b/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()) } diff --git a/R/fct_combine_mcs_cstock.R b/R/fct_combine_mcs_cstock.R index 4cd2319..784758e 100644 --- a/R/fct_combine_mcs_cstock.R +++ b/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 diff --git a/man/fct_combine_mcs_ER.Rd b/man/fct_combine_mcs_ER.Rd index 93b46cf..4682b4b 100644 --- a/man/fct_combine_mcs_ER.Rd +++ b/man/fct_combine_mcs_ER.Rd @@ -49,15 +49,22 @@ time <- read_xlsx( time_clean <- time |> dplyr::mutate(nb_years = year_end - year_start + 1) -sim_trans <- fct_combine_mcs_E(.ad = ad_clean, .cs = cs_clean, .usr = usr) +sim_trans <- fct_combine_mcs_E(.ad = ad, .cs = cs, .usr = usr) -sim_FREL <- fct_combine_mcs_P( +sim_REF <- fct_combine_mcs_P( .data = sim_trans, .time = time_clean, .period_type = "REF", .ad_annual = usr$ad_annual ) +sim_MON <- fct_combine_mcs_P( + .data = sim_trans, + .time = time_clean, + .period_type = "MON", + .ad_annual = usr$ad_annual +) + ## !!! SIM MON and ER to be done } diff --git a/man/fct_combine_mcs_cstock.Rd b/man/fct_combine_mcs_cstock.Rd index fe927c2..81d382f 100644 --- a/man/fct_combine_mcs_cstock.Rd +++ b/man/fct_combine_mcs_cstock.Rd @@ -43,7 +43,7 @@ usr <- read_xlsx( 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) } diff --git a/tests/test-functions.R b/tests/test-functions.R index a896e4c..3f6bcdb 100644 --- a/tests/test-functions.R +++ b/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") diff --git a/tests/testthat/test-fct_combine_mcs_C.R b/tests/testthat/test-fct_combine_mcs_C.R deleted file mode 100644 index ece7970..0000000 --- a/tests/testthat/test-fct_combine_mcs_C.R +++ /dev/null @@ -1,25 +0,0 @@ - - -usr <- readxl::read_xlsx( - path = system.file("extdata/example1.xlsx", package = "mocaredd"), - sheet = "user_inputs", - na = "NA" - ) - -cs <- readxl::read_xlsx( - path = system.file("extdata/example1.xlsx", package = "mocaredd"), - sheet = "c_stocks", - na = "NA" - ) - -cs_clean <- cs |> dplyr::filter(!(is.na(c_value) & is.na(c_pdf_a))) - -c_sub <- cs_clean |> dplyr::filter(!(is.na(c_value) & is.na(c_pdf_a)), lu_id == "ev_wet_closed") - -set.seed(1) -res <- fct_combine_mcs_C(.c_sub = c_sub, .usr = usr) -test_res <- round(median(res$C_all)) - -testthat::test_that("fct_combine_mcs_C works on example1", { - testthat::expect_equal(test_res, 451) -}) diff --git a/tests/testthat/test-fct_combine_mcs_E.R b/tests/testthat/test-fct_combine_mcs_E.R index a32b381..38f7f9b 100644 --- a/tests/testthat/test-fct_combine_mcs_E.R +++ b/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) }) diff --git a/tests/testthat/test-fct_combine_mcs_P.R b/tests/testthat/test-fct_combine_mcs_P.R index 8fe13e4..b9b77b7 100644 --- a/tests/testthat/test-fct_combine_mcs_P.R +++ b/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) }) diff --git a/tests/testthat/test-fct_combine_mcs_cstock.R b/tests/testthat/test-fct_combine_mcs_cstock.R new file mode 100644 index 0000000..c411594 --- /dev/null +++ b/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) +}) diff --git a/vignettes/app-build.Rmd b/vignettes/app-build.Rmd index 24ce1c0..31ac629 100644 --- a/vignettes/app-build.Rmd +++ b/vignettes/app-build.Rmd @@ -65,7 +65,9 @@ usethis::use_package("dplyr") devtools::document() devtools::load_all() shiny_run_mocaredd() +``` +```{r} devtools::install() library(mocaredd) shiny_run_mocaredd()