diff --git a/tests/testthat/testOutputs/v_6.0/result_test6.1.RData b/tests/testthat/testOutputs/v_6.0/result_test6.1.RData index ce1a30d3..c4ddfbc5 100644 Binary files a/tests/testthat/testOutputs/v_6.0/result_test6.1.RData and b/tests/testthat/testOutputs/v_6.0/result_test6.1.RData differ diff --git a/tests/testthat/testOutputs/v_6.0/result_test6.RData b/tests/testthat/testOutputs/v_6.0/result_test6.RData new file mode 100644 index 00000000..0833c1fd Binary files /dev/null and b/tests/testthat/testOutputs/v_6.0/result_test6.RData differ diff --git a/tests/testthat/testReporter_v6.0.R b/tests/testthat/testReporter_v6.0.R index db197ffe..78c61656 100644 --- a/tests/testthat/testReporter_v6.0.R +++ b/tests/testthat/testReporter_v6.0.R @@ -1,776 +1,776 @@ -# library(gcamreport) -# library(testthat) -# library(magrittr) -# -# test_that("Test1_v6. download db, create project, and run", { -# # load a reference GCAM db form a Zenodo repository -# db_path <- file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0") -# rpackageutils::download_unpack_zip( -# data_directory = db_path, -# url = "https://zenodo.org/record/8162970/files/database_basexdb_ref.zip?download=1" -# ) -# testthat::expect_equal(1, 1) -# -# # create the prj -# db_name <- "database_basexdb_ref" -# prj_name <- "gcamv6.0_test.dat" -# scenarios <- "Reference" -# -# create_project(db_path, db_name, prj_name, scenarios, GCAM_version = 'v6.0') -# prj_tmp <- prj -# testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test6.dat"))) -# prj <- prj_tmp -# testthat::expect_equal(prj$Reference$`nonCO2 emissions by region`, testResult$Reference$`nonCO2 emissions by region`) -# testthat::expect_equal(prj$Reference$`nonCO2 emissions by sector`, testResult$Reference$`nonCO2 emissions by sector`) -# testthat::expect_equal(prj$Reference$`CO2 prices`, testResult$Reference$`CO2 prices`) -# -# # check nonCO2 emissions query -# dt_sec <- data_query("nonCO2 emissions by sector", db_path, db_name, prj_name, scenarios, GCAM_version = 'v6.0') -# testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test1.RData"))) -# testthat::expect_equal(dt_sec, testResult) -# }) -# -# test_that("Test2_v6. load project", { -# testResult <- as.numeric(length(load_project(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat")))) -# testthat::expect(!is.null(testResult), 'Null project. Check if the path exists or the "load_project" function works correctly.') -# }) -# -# test_that("Test3_v6. run - dataset created", { -# generate_report(prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), launch_ui = FALSE, GCAM_version = 'v6.0') -# testthat::expect(!is.null(report) & dplyr::n_distinct(report) > 0, 'Empty dataset. Check if the project path exists or the "run" function works correctly.') -# }) -# -# test_that("Test4_v6. run - dataset saved with output_file specified", { -# generate_report( -# prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), launch_ui = FALSE, -# output_file = file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test6_output"), GCAM_version = 'v6.0' -# ) -# -# testResult1 <- read.csv(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test6_output.csv")) -# testthat::expect(dplyr::n_distinct(testResult1) > 0, 'Dataset not saved. Check if the project path exists or the "run" function works correctly.') -# testResult2 <- read.csv(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test4.1.csv")) -# testthat::expect_equal( -# testResult1 %>% -# dplyr::select(-Unit), -# testResult2 %>% -# dplyr::select(-Unit) -# ) -# -# testResult1 <- readxl::read_excel(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test6_output.xlsx")) -# testthat::expect(dplyr::n_distinct(testResult1) > 0, 'Dataset not saved. Check if the project path exists or the "run" function works correctly.') -# testResult2 <- readxl::read_excel(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test4.2.xlsx")) -# testthat::expect_equal( -# testResult1 %>% -# dplyr::select(-Unit), -# testResult2 %>% -# dplyr::select(-Unit) -# ) -# }) -# -# test_that("Test5_v6. run - dataset saved with default output_file", { -# generate_report(prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), launch_ui = FALSE, GCAM_version = 'v6.0') -# -# testResult <- read.csv(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6_standardized.csv")) -# testthat::expect(dplyr::n_distinct(testResult) > 0, 'Dataset not saved. Check if the project path exists or the "run" function works correctly.') -# -# testResult <- readxl::read_excel(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6_standardized.xlsx")) -# testthat::expect(dplyr::n_distinct(testResult) > 0, 'Dataset not saved. Check if the project path exists or the "run" function works correctly.') -# }) -# -# test_that("Test6_v6. load variable and get function", { -# # load prj -# generate_report(prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), launch_ui = FALSE, GCAM_version = 'v6.0') -# -# # load variables -# vv <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/results_test6.RData"))) -# loaded_internal_variables.global <<- c() -# desired_regions <<- "All" -# desired_variables <<- "All" -# GCAM_version <- "v6.0" -# template_internal_variable <- get(paste('template',GCAM_version,sep='_'), envir = asNamespace("gcamreport"))[['Internal_variable']] -# variables_base <- data.frame( -# "name" = unique(template_internal_variable)[!is.na(unique(template_internal_variable)) & unique(template_internal_variable) != ""], -# "required" = TRUE, -# stringsAsFactors = FALSE -# ) -# variables.global <<- merge(variables_base, var_fun_map, by = "name", all = TRUE) %>% -# tidyr::replace_na(list(required = FALSE)) -# -# # test -# load_variable(vv, GCAM_version = GCAM_version) -# -# testthat::expect(exists("ag_prices_wld"), "Loading variables function is broken.") -# -# get_elec_capital() -# testthat::expect(exists("elec_capital_clean"), "get_elec_capital() function is broken.") -# testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test6.1.RData"))) -# testthat::expect_equal(elec_capital_clean, testResult) -# }) -# -# test_that("test6_v6. specify variables, regions, continents", { -# test_regions <- available_regions(T) -# testResult_regions <- c( -# "Africa_Eastern", "Africa_Northern", "Africa_Southern", -# "Africa_Western", "Argentina", "Australia_NZ", -# "Brazil", "Canada", "Central America and Caribbean", -# "Central Asia", "China", "Colombia", -# "European Free Trade Association", "EU-12", "EU-15", -# "Europe_Eastern", "Europe_Non_EU", "India", -# "Indonesia", "Japan", "Mexico", -# "Middle East", "Pakistan", "Russia", -# "South Africa", "South America_Northern", "South America_Southern", -# "South Asia", "South Korea", "Southeast Asia", -# "Taiwan", "USA", "World" -# ) -# testthat::expect_equal(test_regions, testResult_regions) -# -# test_continents <- available_continents(T) -# testResult_continents <- c("MAF", "LAM", "OECD90", "REF", "ASIA", "World") -# testthat::expect_equal(test_continents, testResult_continents) -# -# test_variables <- available_variables(T, GCAM_version = 'v6.0') -# testResult_variables <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test6.1.RData"))) -# testthat::expect_equal(test_variables, testResult_variables) -# -# rm(list = ls()) -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.1_test.dat", -# scenarios = "Reference", -# final_year = 2050, -# desired_continents = "OECD90", -# desired_variables = available_variables(F, GCAM_version = 'v6.0')[c(1, 3, 10, 11)], -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ) -# testthat::expect_equal(unique(report$Variable), c( -# "Agricultural Demand", -# "Agricultural Demand|Crops|Energy", -# "Agricultural Production", -# "Capacity Additions|Electricity|Biomass" -# )) -# testthat::expect_equal(unique(report$Region), c( -# "Australia_NZ", "Canada", "EU-12", "EU-15", -# "Europe_Non_EU", "European Free Trade Association", -# "Japan", "USA", "World" -# )) -# -# rm(list = ls()) -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.2_test.dat", -# scenarios = "Reference", -# final_year = 2050, -# desired_continents = "OECD90", -# desired_variables = "Emissions*", -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ) -# testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test6.2.RData"))) -# testthat::expect_equal(unique(report$Variable), testResult) -# testthat::expect_equal(unique(report$Model), 'GCAM 6.0') -# -# rm(list = ls()) -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.3_test.dat", -# scenarios = "Reference", -# final_year = 2050, -# desired_regions = "USA", -# desired_variables = "Price|Carbon", -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ) -# testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test6.3.RData"))) -# testthat::expect_equal(unique(report$Variable), testResult) -# -# rm(list = ls()) -# generate_report( -# prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), -# scenarios = "Reference", -# final_year = 2050, -# desired_regions = "USA", -# desired_variables = "Price|Carbon", -# launch_ui = FALSE, -# save_output = FALSE, -# GCAM_version = 'v6.0' -# ) -# testthat::expect_equal(unique(report$Region), c("USA", "World")) -# -# rm(list = ls()) -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.4_test.dat", -# scenarios = "Reference", -# final_year = 2050, -# desired_regions = "USA", -# desired_variables = "Price|Carbon*", -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ) -# testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test6.4.RData"))) -# testthat::expect_equal(unique(report$Variable), testResult) -# }) -# -# test_that("Test8_v6. error messages", { -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.8_noCreated.dat", -# scenarios = "Reference", -# desired_variables = "dummy variable", -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ), -# "The variable dummy variable is not available for reporting." -# ) -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.8_noCreated.dat", -# scenarios = "Reference", -# desired_variables = c("dummy1", "dummy2"), -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ), -# "The variables dummy1, dummy2 are not available for reporting" -# ) -# -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.8_noCreated.dat", -# scenarios = "Reference", -# desired_variables = "Final|Energy*", -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ), -# "There is no variable containing the pattern Final|Energy* available for reporting." -# ) -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.8_noCreated.dat", -# scenarios = "Reference", -# desired_variables = c("Final|Energy*", "Emissions CH4*"), -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ), -# "There are no variables containing the patterns Final|Energy*, Emissions CH4* available for reporting" -# ) -# -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.8_noCreated.dat", -# scenarios = "Reference", -# desired_regions = "dummy region", -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ), -# "The desired region dummy region is not available for reporting." -# ) -# -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.8_noCreated.dat", -# scenarios = "Reference", -# desired_regions = c("dummy1", "dummy2"), -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ), -# "The desired regions dummy1, dummy2 are not available for reporting." -# ) -# -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.8_p1.dat", -# scenarios = "Reference", -# desired_continents = "dummy continent", -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ), -# "The desired continent/region group dummy continent is not available for reporting." -# ) -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.8_p1.dat", -# scenarios = "Reference", -# desired_continents = c("dummy1", "dummy2"), -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ), -# "The desired continent/region groups dummy1, dummy2 are not available for reporting." -# ) -# -# expect_error( -# generate_report( -# db_name = "dummy_db_name", -# prj_name = "gcamv6.8_p1.dat", -# scenarios = "Reference", -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ), -# "The 'db_path' parameter is required to create a GCAM project but was not specified." -# ) -# -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# prj_name = "gcamv6.8_p1.dat", -# scenarios = "Reference", -# launch_ui = FALSE -# ), -# "The 'db_name' parameter is required to create a GCAM project but was not specified." -# ) -# -# expect_error( -# generate_report( -# db_path = "dummy name", -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ), -# 'argument "prj_name" is missing, with no default' -# ) -# -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.8_p1.dat", -# scenarios = "Reference", -# desired_regions = "dummy region", -# desired_continents = "dummy continent", -# launch_ui = FALSE -# ), -# "You specified both 'desired_regions' and 'desired_continents'. Only one can be specified at a time." -# ) -# -# expect_error( -# generate_report( -# prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), -# scenarios = "Reference3", -# desired_regions = "EU-12", -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ), -# "The desired scenario Reference3 is not present in the loaded project." -# ) -# -# expect_error( -# generate_report( -# prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), -# scenarios = c("Reference3", "Reference4"), -# desired_regions = "EU-12", -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ), -# "The desired scenarios Reference3, Reference4 are not present in the loaded project." -# ) -# -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.9_noCreated.dat", -# scenarios = "Reference", -# final_year = 2009, -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ), -# "'final_year' is set to '2009' but must be at least 2025. Please select a valid year: '2025, 2030, 2035, 2040, 2045, 2050, 2055, 2060, 2065, 2070, 2075, 2080, 2085, 2090, 2095, 2100." -# ) -# -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.9_noCreated.dat", -# scenarios = "Reference", -# final_year = 2031, -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ), -# "'final_year' is set to '2031' but must align with available 5-year intervals. Please select a valid year: '2025, 2030, 2035, 2040, 2045, 2050, 2055, 2060, 2065, 2070, 2075, 2080, 2085, 2090, 2095, 2100." -# ) -# -# }) -# -# test_that("Test9_v6. CO2 Price", { -# # # World CO2 price - TODO -# # generate_report( -# # prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/database_basexdb_CO2price_test.dat"), -# # desired_variables = c("Price|Carbon*"), -# # launch_ui = FALSE, -# # GCAM_version = 'v6.0' -# # ) -# # testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test9.1.RData"))) -# # testthat::expect_equal(report, testResult) -# # rm(list = ls()) -# -# # Regional CO2 price -# generate_report( -# prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/database_basexdb_policy.dat"), -# desired_variables = c("Price|Carbon*"), -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ) -# testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test9.2.RData"))) -# testthat::expect_equal(report, testResult) -# }) -# -# test_that("Test10_v6. vetting", { -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.10.1_test.dat", -# scenarios = "Reference", -# final_year = 2050, -# desired_regions = "All", -# desired_variables = c("Emissions|CH4*"), -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ) -# -# testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test10.1.RData"))) -# testthat::expect_equal(vetting_summary, testResult) -# -# rm(list = ls()) -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.10.2_test.dat", -# scenarios = "Reference", -# final_year = 2050, -# desired_regions = "All", -# desired_variables = c("Emissions|Sulfur*"), -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ) -# -# testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test10.2.RData"))) -# testthat::expect_equal(vetting_summary, testResult) -# -# rm(list = ls()) -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.10.3_test.dat", -# scenarios = "Reference", -# final_year = 2050, -# desired_regions = "South Africa", -# desired_variables = c("Final Energy*"), -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ) -# -# testthat::expect(exists("vetting_summary"), "Vetting performed when not all regions were selected") -# }) -# -# test_that("Test11_v6. scenarios", { -# # check when creating project -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.11.1_p1.dat", -# scenarios = c("dummy", "Reference"), -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ), -# "The desired scenario dummy is not present in the database." -# ) -# -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.11.2_p1.dat", -# scenarios = c("dummy1", "dummy2", "Reference"), -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ), -# "The desired scenarios dummy1, dummy2 are not present in the database." -# ) -# -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.11.3_test_scenarios.dat", -# final_year = 2050, -# desired_regions = "All", -# desired_variables = c("Emissions|CH4*"), -# launch_ui = FALSE -# ) -# -# testResult <- rgcam::listScenarios(prj) -# testthat::expect_equal("Reference", testResult) -# -# # check when loading project -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.11.4_test_scenarios.dat", -# scenarios = c("dummy", "Reference"), -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ), -# "The desired scenario dummy is not present in the database" -# ) -# -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.11.5_test_scenarios.dat", -# scenarios = c("dummy1", "dummy2", "Reference"), -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ), -# "The desired scenarios dummy1, dummy2 are not present in the database" -# ) -# -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.11.5_test.dat", -# scenarios = c("dummy1", "dummy2", "Reference"), -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ), -# "The desired scenarios dummy1, dummy2 are not present in the database" -# ) -# -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.11.6_test_scenarios.dat", -# final_year = 2050, -# desired_regions = "All", -# desired_variables = c("Emissions|CH4*"), -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ) -# -# testResult <- rgcam::listScenarios(prj) -# testthat::expect_equal("Reference", testResult) -# -# -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.11.7_test_scenarios", -# final_year = 2050, -# desired_regions = "All", -# desired_variables = c("Emissions|CH4*"), -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ) -# -# testResult <- rgcam::listScenarios(prj) -# testthat::expect_equal("Reference", testResult) -# -# generate_report( -# prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/database_basexdb_ssps.dat"), -# final_year = 2030, -# scenarios = "GCAM_SSP4", -# desired_regions = "USA", -# desired_variables = "Emissions|CH4*", -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ) -# -# testResult <- rgcam::listScenarios(prj) -# testthat::expect_equal("GCAM_SSP4", testResult) -# }) -# -# -# test_that("Test12_v6. other functions", { -# # gather_map -# co2_sector_map <- read.csv(file.path(rprojroot::find_root(rprojroot::is_testthat), "inst/extdata/mappings/GCAM6.0", "CO2_sector_map.csv"), -# skip = 1, na = "", -# stringsAsFactors = FALSE -# ) %>% gather_map() -# -# testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test12.1.RData"))) -# testthat::expect_equal(co2_sector_map, testExpect) -# -# # approx_fun -# expect_error( -# approx_fun(2030, 3, rule = 3), -# "Use fill_exp_decay_extrapolate!" -# ) -# -# # get_iron_steel_map & get_co2_iron_steel -# generate_report( -# prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), -# final_year = 2050, -# scenarios = "Reference", -# desired_regions = "USA", -# desired_variables = "Emissions|CO2|Energy|Demand|Industry|Steel", -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ) -# -# testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test12.2.RData"))) -# testthat::expect_equal(report, testExpect) -# -# # get_ghg -# generate_report( -# prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), -# final_year = 2050, -# scenarios = "Reference", -# desired_regions = "USA", -# desired_variables = "Emissions|Kyoto Gases*", -# launch_ui = FALSE, -# GCAM_version = 'v6.0' -# ) -# -# testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test12.3.RData"))) -# testthat::expect_equal(report, testExpect) -# -# # get_regional_emission -# testResult <- get_regional_emission() -# testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test12.4.RData"))) -# testthat::expect_equal(testResult, testExpect) -# -# }) -# -# test_that("Test13_v6. specify queries", { -# -# # transform_to_xml ancillary function -# testResult <- transform_to_xml(gcamreport::queries_nonCO2_v6.0) -# testExpect <- xml2::read_xml(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test13.1.xml")) -# testthat::expect_equal(testResult, testExpect) -# -# # generate standardize report specifying the query file -# db_path <- file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0") -# db_name <- "database_basexdb_ref" -# prj_name <- "gcamv6.0_test_specify_queries.dat" -# scenarios <- "Reference" -# generate_report(db_path = db_path, db_name = db_name, prj_name = prj_name, -# scenarios = scenarios, final_year = 2050, desired_variables = c('Price|Carbon*'), -# save_output = T, launch_ui = F, GCAM_version = 'v6.0', -# queries_general_file = file.path(rprojroot::find_root(rprojroot::is_testthat), "inst/extdata/queries/GCAM6.0/queries_gcamreport_general.xml")) -# testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/gcamv6.0_test_specify_queries_standardized.RData"))) -# testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test13.2.RData"))) -# testthat::expect_equal(testResult, testExpect) -# -# }) -# -# -# test_that("Test14_v6. ghg GWP", { -# -# generate_report( -# prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), -# final_year = 2050, -# scenarios = "Reference", -# desired_variables = "Emissions*", -# launch_ui = FALSE, -# GWP_version = 'AR4', -# GCAM_version = 'v6.0' -# ) -# testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test14.1.RData"))) -# testthat::expect_equal(report, testExpect) -# -# rm(list = ls()) -# generate_report( -# prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), -# final_year = 2050, -# scenarios = "Reference", -# desired_variables = "Emissions*", -# launch_ui = FALSE, -# GWP_version = 'AR5', -# GCAM_version = 'v6.0' -# ) -# testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test14.2.RData"))) -# testthat::expect_equal(report, testExpect) -# -# rm(list = ls()) -# generate_report( -# prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), -# final_year = 2050, -# scenarios = "Reference", -# desired_variables = "Emissions*", -# launch_ui = FALSE, -# GWP_version = 'AR6', -# GCAM_version = 'v6.0' -# ) -# testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test14.3.RData"))) -# testthat::expect_equal(report, testExpect) -# -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.8_noCreated.dat", -# scenarios = "Reference", -# desired_variables = c("dummy1", "dummy2"), -# launch_ui = FALSE, -# GWP_version = 4, -# GCAM_version = 'v6.0' -# ), -# "GWP_version must be a character string, but you provided a value of type 'numeric'. Please specify the GWP_version as a string, e.g., GWP_version = 'AR5'." -# ) -# -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.8_noCreated.dat", -# scenarios = "Reference", -# desired_variables = c("dummy1", "dummy2"), -# launch_ui = FALSE, -# GWP_version = '4', -# GCAM_version = 'v6.0' -# ), -# "Invalid GWP_version '4'. Available versions are: AR4, AR5, AR6. Please choose one of these versions." -# ) -# -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.8_noCreated.dat", -# scenarios = "Reference", -# desired_variables = c("dummy1", "dummy2"), -# launch_ui = FALSE, -# GCAM_version = 4 -# ), -# "GCAM_version must be a character string, but you provided a value of type 'numeric'. Please specify the GCAM_version as a string, e.g., GCAM_version = 'v7.0'." -# ) -# -# expect_error( -# generate_report( -# db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), -# db_name = "database_basexdb_ref", -# prj_name = "gcamv6.8_noCreated.dat", -# scenarios = "Reference", -# desired_variables = c("dummy1", "dummy2"), -# launch_ui = FALSE, -# GCAM_version = '4' -# ), -# "Invalid GCAM_version '4'. Available versions are: v6.0, v7.0, v7.1. Please choose one of these versions." -# ) -# -# -# }) -# -# +library(gcamreport) +library(testthat) +library(magrittr) + +test_that("Test1_v6. download db, create project, and run", { + # load a reference GCAM db form a Zenodo repository + db_path <- file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0") + rpackageutils::download_unpack_zip( + data_directory = db_path, + url = "https://zenodo.org/record/8162970/files/database_basexdb_ref.zip?download=1" + ) + testthat::expect_equal(1, 1) + + # create the prj + db_name <- "database_basexdb_ref" + prj_name <- "gcamv6.0_test.dat" + scenarios <- "Reference" + + create_project(db_path, db_name, prj_name, scenarios, GCAM_version = 'v6.0') + prj_tmp <- prj + testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test6.dat"))) + prj <- prj_tmp + testthat::expect_equal(prj$Reference$`nonCO2 emissions by region`, testResult$Reference$`nonCO2 emissions by region`) + testthat::expect_equal(prj$Reference$`nonCO2 emissions by sector`, testResult$Reference$`nonCO2 emissions by sector`) + testthat::expect_equal(prj$Reference$`CO2 prices`, testResult$Reference$`CO2 prices`) + + # check nonCO2 emissions query + dt_sec <- data_query("nonCO2 emissions by sector", db_path, db_name, prj_name, scenarios, GCAM_version = 'v6.0') + testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test1.RData"))) + testthat::expect_equal(dt_sec, testResult) +}) + +test_that("Test2_v6. load project", { + testResult <- as.numeric(length(load_project(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat")))) + testthat::expect(!is.null(testResult), 'Null project. Check if the path exists or the "load_project" function works correctly.') +}) + +test_that("Test3_v6. run - dataset created", { + generate_report(prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), launch_ui = FALSE, GCAM_version = 'v6.0') + testthat::expect(!is.null(report) & dplyr::n_distinct(report) > 0, 'Empty dataset. Check if the project path exists or the "run" function works correctly.') +}) + +test_that("Test4_v6. run - dataset saved with output_file specified", { + generate_report( + prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), launch_ui = FALSE, + output_file = file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test6_output"), GCAM_version = 'v6.0' + ) + + testResult1 <- read.csv(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test6_output.csv")) + testthat::expect(dplyr::n_distinct(testResult1) > 0, 'Dataset not saved. Check if the project path exists or the "run" function works correctly.') + testResult2 <- read.csv(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test4.1.csv")) + testthat::expect_equal( + testResult1 %>% + dplyr::select(-Unit), + testResult2 %>% + dplyr::select(-Unit) + ) + + testResult1 <- readxl::read_excel(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test6_output.xlsx")) + testthat::expect(dplyr::n_distinct(testResult1) > 0, 'Dataset not saved. Check if the project path exists or the "run" function works correctly.') + testResult2 <- readxl::read_excel(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test4.2.xlsx")) + testthat::expect_equal( + testResult1 %>% + dplyr::select(-Unit), + testResult2 %>% + dplyr::select(-Unit) + ) +}) + +test_that("Test5_v6. run - dataset saved with default output_file", { + generate_report(prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), launch_ui = FALSE, GCAM_version = 'v6.0') + + testResult <- read.csv(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6_standardized.csv")) + testthat::expect(dplyr::n_distinct(testResult) > 0, 'Dataset not saved. Check if the project path exists or the "run" function works correctly.') + + testResult <- readxl::read_excel(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6_standardized.xlsx")) + testthat::expect(dplyr::n_distinct(testResult) > 0, 'Dataset not saved. Check if the project path exists or the "run" function works correctly.') +}) + +test_that("Test6_v6. load variable and get function", { + # load prj + generate_report(prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), launch_ui = FALSE, GCAM_version = 'v6.0') + + # load variables + vv <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/results_test6.RData"))) + loaded_internal_variables.global <<- c() + desired_regions <<- "All" + desired_variables <<- "All" + GCAM_version <- "v6.0" + template_internal_variable <- get(paste('template',GCAM_version,sep='_'), envir = asNamespace("gcamreport"))[['Internal_variable']] + variables_base <- data.frame( + "name" = unique(template_internal_variable)[!is.na(unique(template_internal_variable)) & unique(template_internal_variable) != ""], + "required" = TRUE, + stringsAsFactors = FALSE + ) + variables.global <<- merge(variables_base, var_fun_map, by = "name", all = TRUE) %>% + tidyr::replace_na(list(required = FALSE)) + + # test + load_variable(vv, GCAM_version = GCAM_version) + + testthat::expect(exists("ag_prices_wld"), "Loading variables function is broken.") + + get_elec_capital() + testthat::expect(exists("elec_capital_clean"), "get_elec_capital() function is broken.") + testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test6.RData"))) + testthat::expect_equal(elec_capital_clean, testResult) +}) + +test_that("test6_v6. specify variables, regions, continents", { + test_regions <- available_regions(T) + testResult_regions <- c( + "Africa_Eastern", "Africa_Northern", "Africa_Southern", + "Africa_Western", "Argentina", "Australia_NZ", + "Brazil", "Canada", "Central America and Caribbean", + "Central Asia", "China", "Colombia", + "European Free Trade Association", "EU-12", "EU-15", + "Europe_Eastern", "Europe_Non_EU", "India", + "Indonesia", "Japan", "Mexico", + "Middle East", "Pakistan", "Russia", + "South Africa", "South America_Northern", "South America_Southern", + "South Asia", "South Korea", "Southeast Asia", + "Taiwan", "USA", "World" + ) + testthat::expect_equal(test_regions, testResult_regions) + + test_continents <- available_continents(T) + testResult_continents <- c("MAF", "LAM", "OECD90", "REF", "ASIA", "World") + testthat::expect_equal(test_continents, testResult_continents) + + test_variables <- available_variables(T, GCAM_version = 'v6.0') + testResult_variables <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test6.1.RData"))) + testthat::expect_equal(test_variables, testResult_variables) + + rm(list = ls()) + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.1_test.dat", + scenarios = "Reference", + final_year = 2050, + desired_continents = "OECD90", + desired_variables = available_variables(F, GCAM_version = 'v6.0')[c(1, 3, 10, 11)], + launch_ui = FALSE, + GCAM_version = 'v6.0' + ) + testthat::expect_equal(unique(report$Variable), c( + "Agricultural Demand", + "Agricultural Demand|Crops|Energy", + "Agricultural Production", + "Capacity Additions|Electricity|Biomass" + )) + testthat::expect_equal(unique(report$Region), c( + "Australia_NZ", "Canada", "EU-12", "EU-15", + "Europe_Non_EU", "European Free Trade Association", + "Japan", "USA", "World" + )) + + rm(list = ls()) + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.2_test.dat", + scenarios = "Reference", + final_year = 2050, + desired_continents = "OECD90", + desired_variables = "Emissions*", + launch_ui = FALSE, + GCAM_version = 'v6.0' + ) + testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test6.2.RData"))) + testthat::expect_equal(unique(report$Variable), testResult) + testthat::expect_equal(unique(report$Model), 'GCAM 6.0') + + rm(list = ls()) + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.3_test.dat", + scenarios = "Reference", + final_year = 2050, + desired_regions = "USA", + desired_variables = "Price|Carbon", + launch_ui = FALSE, + GCAM_version = 'v6.0' + ) + testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test6.3.RData"))) + testthat::expect_equal(unique(report$Variable), testResult) + + rm(list = ls()) + generate_report( + prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), + scenarios = "Reference", + final_year = 2050, + desired_regions = "USA", + desired_variables = "Price|Carbon", + launch_ui = FALSE, + save_output = FALSE, + GCAM_version = 'v6.0' + ) + testthat::expect_equal(unique(report$Region), c("USA", "World")) + + rm(list = ls()) + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.4_test.dat", + scenarios = "Reference", + final_year = 2050, + desired_regions = "USA", + desired_variables = "Price|Carbon*", + launch_ui = FALSE, + GCAM_version = 'v6.0' + ) + testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test6.4.RData"))) + testthat::expect_equal(unique(report$Variable), testResult) +}) + +test_that("Test8_v6. error messages", { + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.8_noCreated.dat", + scenarios = "Reference", + desired_variables = "dummy variable", + launch_ui = FALSE, + GCAM_version = 'v6.0' + ), + "The variable dummy variable is not available for reporting." + ) + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.8_noCreated.dat", + scenarios = "Reference", + desired_variables = c("dummy1", "dummy2"), + launch_ui = FALSE, + GCAM_version = 'v6.0' + ), + "The variables dummy1, dummy2 are not available for reporting" + ) + + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.8_noCreated.dat", + scenarios = "Reference", + desired_variables = "Final|Energy*", + launch_ui = FALSE, + GCAM_version = 'v6.0' + ), + "There is no variable containing the pattern Final|Energy* available for reporting." + ) + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.8_noCreated.dat", + scenarios = "Reference", + desired_variables = c("Final|Energy*", "Emissions CH4*"), + launch_ui = FALSE, + GCAM_version = 'v6.0' + ), + "There are no variables containing the patterns Final|Energy*, Emissions CH4* available for reporting" + ) + + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.8_noCreated.dat", + scenarios = "Reference", + desired_regions = "dummy region", + launch_ui = FALSE, + GCAM_version = 'v6.0' + ), + "The desired region dummy region is not available for reporting." + ) + + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.8_noCreated.dat", + scenarios = "Reference", + desired_regions = c("dummy1", "dummy2"), + launch_ui = FALSE, + GCAM_version = 'v6.0' + ), + "The desired regions dummy1, dummy2 are not available for reporting." + ) + + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.8_p1.dat", + scenarios = "Reference", + desired_continents = "dummy continent", + launch_ui = FALSE, + GCAM_version = 'v6.0' + ), + "The desired continent/region group dummy continent is not available for reporting." + ) + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.8_p1.dat", + scenarios = "Reference", + desired_continents = c("dummy1", "dummy2"), + launch_ui = FALSE, + GCAM_version = 'v6.0' + ), + "The desired continent/region groups dummy1, dummy2 are not available for reporting." + ) + + expect_error( + generate_report( + db_name = "dummy_db_name", + prj_name = "gcamv6.8_p1.dat", + scenarios = "Reference", + launch_ui = FALSE, + GCAM_version = 'v6.0' + ), + "The 'db_path' parameter is required to create a GCAM project but was not specified." + ) + + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + prj_name = "gcamv6.8_p1.dat", + scenarios = "Reference", + launch_ui = FALSE + ), + "The 'db_name' parameter is required to create a GCAM project but was not specified." + ) + + expect_error( + generate_report( + db_path = "dummy name", + launch_ui = FALSE, + GCAM_version = 'v6.0' + ), + 'argument "prj_name" is missing, with no default' + ) + + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.8_p1.dat", + scenarios = "Reference", + desired_regions = "dummy region", + desired_continents = "dummy continent", + launch_ui = FALSE + ), + "You specified both 'desired_regions' and 'desired_continents'. Only one can be specified at a time." + ) + + expect_error( + generate_report( + prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), + scenarios = "Reference3", + desired_regions = "EU-12", + launch_ui = FALSE, + GCAM_version = 'v6.0' + ), + "The desired scenario Reference3 is not present in the loaded project." + ) + + expect_error( + generate_report( + prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), + scenarios = c("Reference3", "Reference4"), + desired_regions = "EU-12", + launch_ui = FALSE, + GCAM_version = 'v6.0' + ), + "The desired scenarios Reference3, Reference4 are not present in the loaded project." + ) + + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.9_noCreated.dat", + scenarios = "Reference", + final_year = 2009, + launch_ui = FALSE, + GCAM_version = 'v6.0' + ), + "'final_year' is set to '2009' but must be at least 2025. Please select a valid year: '2025, 2030, 2035, 2040, 2045, 2050, 2055, 2060, 2065, 2070, 2075, 2080, 2085, 2090, 2095, 2100." + ) + + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.9_noCreated.dat", + scenarios = "Reference", + final_year = 2031, + launch_ui = FALSE, + GCAM_version = 'v6.0' + ), + "'final_year' is set to '2031' but must align with available 5-year intervals. Please select a valid year: '2025, 2030, 2035, 2040, 2045, 2050, 2055, 2060, 2065, 2070, 2075, 2080, 2085, 2090, 2095, 2100." + ) + +}) + +test_that("Test9_v6. CO2 Price", { + # # World CO2 price - TODO + # generate_report( + # prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/database_basexdb_CO2price_test.dat"), + # desired_variables = c("Price|Carbon*"), + # launch_ui = FALSE, + # GCAM_version = 'v6.0' + # ) + # testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test9.1.RData"))) + # testthat::expect_equal(report, testResult) + # rm(list = ls()) + + # Regional CO2 price + generate_report( + prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/database_basexdb_policy.dat"), + desired_variables = c("Price|Carbon*"), + launch_ui = FALSE, + GCAM_version = 'v6.0' + ) + testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test9.2.RData"))) + testthat::expect_equal(report, testResult) +}) + +test_that("Test10_v6. vetting", { + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.10.1_test.dat", + scenarios = "Reference", + final_year = 2050, + desired_regions = "All", + desired_variables = c("Emissions|CH4*"), + launch_ui = FALSE, + GCAM_version = 'v6.0' + ) + + testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test10.1.RData"))) + testthat::expect_equal(vetting_summary, testResult) + + rm(list = ls()) + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.10.2_test.dat", + scenarios = "Reference", + final_year = 2050, + desired_regions = "All", + desired_variables = c("Emissions|Sulfur*"), + launch_ui = FALSE, + GCAM_version = 'v6.0' + ) + + testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test10.2.RData"))) + testthat::expect_equal(vetting_summary, testResult) + + rm(list = ls()) + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.10.3_test.dat", + scenarios = "Reference", + final_year = 2050, + desired_regions = "South Africa", + desired_variables = c("Final Energy*"), + launch_ui = FALSE, + GCAM_version = 'v6.0' + ) + + testthat::expect(exists("vetting_summary"), "Vetting performed when not all regions were selected") +}) + +test_that("Test11_v6. scenarios", { + # check when creating project + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.11.1_p1.dat", + scenarios = c("dummy", "Reference"), + launch_ui = FALSE, + GCAM_version = 'v6.0' + ), + "The desired scenario dummy is not present in the database." + ) + + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.11.2_p1.dat", + scenarios = c("dummy1", "dummy2", "Reference"), + launch_ui = FALSE, + GCAM_version = 'v6.0' + ), + "The desired scenarios dummy1, dummy2 are not present in the database." + ) + + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.11.3_test_scenarios.dat", + final_year = 2050, + desired_regions = "All", + desired_variables = c("Emissions|CH4*"), + launch_ui = FALSE + ) + + testResult <- rgcam::listScenarios(prj) + testthat::expect_equal("Reference", testResult) + + # check when loading project + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.11.4_test_scenarios.dat", + scenarios = c("dummy", "Reference"), + launch_ui = FALSE, + GCAM_version = 'v6.0' + ), + "The desired scenario dummy is not present in the database" + ) + + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.11.5_test_scenarios.dat", + scenarios = c("dummy1", "dummy2", "Reference"), + launch_ui = FALSE, + GCAM_version = 'v6.0' + ), + "The desired scenarios dummy1, dummy2 are not present in the database" + ) + + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.11.5_test.dat", + scenarios = c("dummy1", "dummy2", "Reference"), + launch_ui = FALSE, + GCAM_version = 'v6.0' + ), + "The desired scenarios dummy1, dummy2 are not present in the database" + ) + + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.11.6_test_scenarios.dat", + final_year = 2050, + desired_regions = "All", + desired_variables = c("Emissions|CH4*"), + launch_ui = FALSE, + GCAM_version = 'v6.0' + ) + + testResult <- rgcam::listScenarios(prj) + testthat::expect_equal("Reference", testResult) + + + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.11.7_test_scenarios", + final_year = 2050, + desired_regions = "All", + desired_variables = c("Emissions|CH4*"), + launch_ui = FALSE, + GCAM_version = 'v6.0' + ) + + testResult <- rgcam::listScenarios(prj) + testthat::expect_equal("Reference", testResult) + + generate_report( + prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/database_basexdb_ssps.dat"), + final_year = 2030, + scenarios = "GCAM_SSP4", + desired_regions = "USA", + desired_variables = "Emissions|CH4*", + launch_ui = FALSE, + GCAM_version = 'v6.0' + ) + + testResult <- rgcam::listScenarios(prj) + testthat::expect_equal("GCAM_SSP4", testResult) +}) + + +test_that("Test12_v6. other functions", { + # gather_map + co2_sector_map <- read.csv(file.path(rprojroot::find_root(rprojroot::is_testthat), "inst/extdata/mappings/GCAM6.0", "CO2_sector_map.csv"), + skip = 1, na = "", + stringsAsFactors = FALSE + ) %>% gather_map() + + testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test12.1.RData"))) + testthat::expect_equal(co2_sector_map, testExpect) + + # approx_fun + expect_error( + approx_fun(2030, 3, rule = 3), + "Use fill_exp_decay_extrapolate!" + ) + + # get_iron_steel_map & get_co2_iron_steel + generate_report( + prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), + final_year = 2050, + scenarios = "Reference", + desired_regions = "USA", + desired_variables = "Emissions|CO2|Energy|Demand|Industry|Steel", + launch_ui = FALSE, + GCAM_version = 'v6.0' + ) + + testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test12.2.RData"))) + testthat::expect_equal(report, testExpect) + + # get_ghg + generate_report( + prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), + final_year = 2050, + scenarios = "Reference", + desired_regions = "USA", + desired_variables = "Emissions|Kyoto Gases*", + launch_ui = FALSE, + GCAM_version = 'v6.0' + ) + + testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test12.3.RData"))) + testthat::expect_equal(report, testExpect) + + # get_regional_emission + testResult <- get_regional_emission() + testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test12.4.RData"))) + testthat::expect_equal(testResult, testExpect) + +}) + +test_that("Test13_v6. specify queries", { + + # transform_to_xml ancillary function + testResult <- transform_to_xml(gcamreport::queries_nonCO2_v6.0) + testExpect <- xml2::read_xml(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test13.1.xml")) + testthat::expect_equal(testResult, testExpect) + + # generate standardize report specifying the query file + db_path <- file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0") + db_name <- "database_basexdb_ref" + prj_name <- "gcamv6.0_test_specify_queries.dat" + scenarios <- "Reference" + generate_report(db_path = db_path, db_name = db_name, prj_name = prj_name, + scenarios = scenarios, final_year = 2050, desired_variables = c('Price|Carbon*'), + save_output = T, launch_ui = F, GCAM_version = 'v6.0', + queries_general_file = file.path(rprojroot::find_root(rprojroot::is_testthat), "inst/extdata/queries/GCAM6.0/queries_gcamreport_general.xml")) + testResult <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/gcamv6.0_test_specify_queries_standardized.RData"))) + testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test13.2.RData"))) + testthat::expect_equal(testResult, testExpect) + +}) + + +test_that("Test14_v6. ghg GWP", { + + generate_report( + prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), + final_year = 2050, + scenarios = "Reference", + desired_variables = "Emissions*", + launch_ui = FALSE, + GWP_version = 'AR4', + GCAM_version = 'v6.0' + ) + testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test14.1.RData"))) + testthat::expect_equal(report, testExpect) + + rm(list = ls()) + generate_report( + prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), + final_year = 2050, + scenarios = "Reference", + desired_variables = "Emissions*", + launch_ui = FALSE, + GWP_version = 'AR5', + GCAM_version = 'v6.0' + ) + testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test14.2.RData"))) + testthat::expect_equal(report, testExpect) + + rm(list = ls()) + generate_report( + prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), + final_year = 2050, + scenarios = "Reference", + desired_variables = "Emissions*", + launch_ui = FALSE, + GWP_version = 'AR6', + GCAM_version = 'v6.0' + ) + testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/result_test14.3.RData"))) + testthat::expect_equal(report, testExpect) + + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.8_noCreated.dat", + scenarios = "Reference", + desired_variables = c("dummy1", "dummy2"), + launch_ui = FALSE, + GWP_version = 4, + GCAM_version = 'v6.0' + ), + "GWP_version must be a character string, but you provided a value of type 'numeric'. Please specify the GWP_version as a string, e.g., GWP_version = 'AR5'." + ) + + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.8_noCreated.dat", + scenarios = "Reference", + desired_variables = c("dummy1", "dummy2"), + launch_ui = FALSE, + GWP_version = '4', + GCAM_version = 'v6.0' + ), + "Invalid GWP_version '4'. Available versions are: AR4, AR5, AR6. Please choose one of these versions." + ) + + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.8_noCreated.dat", + scenarios = "Reference", + desired_variables = c("dummy1", "dummy2"), + launch_ui = FALSE, + GCAM_version = 4 + ), + "GCAM_version must be a character string, but you provided a value of type 'numeric'. Please specify the GCAM_version as a string, e.g., GCAM_version = 'v7.0'." + ) + + expect_error( + generate_report( + db_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/"), + db_name = "database_basexdb_ref", + prj_name = "gcamv6.8_noCreated.dat", + scenarios = "Reference", + desired_variables = c("dummy1", "dummy2"), + launch_ui = FALSE, + GCAM_version = '4' + ), + "Invalid GCAM_version '4'. Available versions are: v6.0, v7.0, v7.1. Please choose one of these versions." + ) + + +}) + + diff --git a/tests/testthat/testUI_v6.0.R b/tests/testthat/testUI_v6.0.R index aaa74e8d..2c959fb9 100644 --- a/tests/testthat/testUI_v6.0.R +++ b/tests/testthat/testUI_v6.0.R @@ -1,183 +1,183 @@ -# library(gcamreport) -# library(testthat) -# library(magrittr) -# -# test_that("Test1. test tree functions", { -# generate_report(prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), launch_ui = FALSE, GCAM_version = 'v6.0') -# # load data -# data <- report -# # define the dataset for launching the ui -# sdata <<- suppressWarnings( -# data %>% -# tidyr::separate(Variable, into = c("col1", "col2", "col3", "col4", "col5", "col6", "col7"), sep = "([\\|])", extra = "merge", remove = FALSE) -# ) -# # create vector of available years for launching the ui -# available_years <<- as.numeric(names(sdata)[13:length(names(sdata))]) -# # develop a nested list of the variables and regions for launching the ui -# cols.global <<- unique(sdata[, grepl("col", names(sdata))]) -# tree_vars <<- do_mount_tree(cols.global, names(cols.global), selec = TRUE) -# tree_reg <<- do_mount_tree(reg_cont, names(reg_cont), selec = TRUE) -# # save a list of all variables -# all_varss <<- do_collapse_df(cols.global) -# -# # do_mount_tree with regions -# testResult1 <- do_mount_tree(reg_cont, names(reg_cont), selec = TRUE) -# testExpect1 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_1.RData"))) -# testthat::expect_equal(testResult1, testExpect1) -# -# # do_unmount_tree with regions -# testResult1.2 <- do_unmount_tree(get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_unmount_tree_regions.RData"))), "regions") -# testExpect1.2 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_1.2.RData"))) -# testthat::expect_equal(testResult1.2, testExpect1.2) -# -# # do_mount_tree with variables -# testResult2 <- do_mount_tree(cols.global, names(cols.global), selec = TRUE) -# testExpect2 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_2.RData"))) -# testthat::expect_equal(testResult2, testExpect2) -# -# # do_unmount_tree with variables -# testResult2.2 <- do_unmount_tree(get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_unmount_tree_variables.RData"))), "variables") -# testExpect2.2 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_2.2.RData"))) -# testthat::expect_equal(testResult2.2, testExpect2.2) -# -# # do_unmount_tree NULL -# testResult2.3 <- do_unmount_tree(NULL, "variables") -# testthat::expect_equal(testResult2.3, NULL) -# -# # do_collapse_df -# testResult3 <- do_collapse_df(cols.global) -# testExpect3 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_3.RData"))) -# testthat::expect_equal(testResult3, testExpect3) -# -# # change_style -# test4_pre <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_4_pre.RData"))) -# testExpect4 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_4_post.RData"))) -# testResult4 <- change_style(test4_pre, "regions") -# testthat::expect_equal(testResult4, testExpect4) -# -# # check_user_choices_plot -# testResult5 <- check_user_choices_plot(c("var1", "var2"), c("scen1", "scen2"), c("year1", "year2"), NULL, grouped = TRUE) -# testExpect5 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_5.RData"))) -# testthat::expect_equal(testResult5, testExpect5) -# -# testResult6 <- check_user_choices_plot(c("var1", "var2"), c("scen1", "scen2"), c("year1", "year2"), NULL, grouped = FALSE) -# testExpect6 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_6.RData"))) -# testthat::expect_equal(testResult6, testExpect6) -# -# testResult7 <- check_user_choices_plot(c("var1"), c("scen1", "scen2"), c("year1", "year2"), "reg1", grouped = FALSE) -# testExpect7 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_7.RData"))) -# testthat::expect_equal(testResult7, testExpect7) -# -# # compute_height -# testResult8 <- compute_height(c(reg_cont[, 2], "World")) -# testExpect8 <- 960 -# testthat::expect_equal(testResult8, testExpect8) -# -# testResult9 <- compute_height(c("MAF", "LAM")) -# testExpect9 <- 325 -# testthat::expect_equal(testResult9, testExpect9) -# }) -# -# test_that("Test2. error messages", { -# expect_error( -# launch_gcamreport_ui(), -# "Error: Neither 'data_path' nor 'data' has been provided. Please specify at least one of these: 'data_path' to point to the location of the dataset file or 'data' to provide the dataset directly." -# ) -# -# expect_error( -# launch_gcamreport_ui("dummy1", "dummy2"), -# "Error: Both 'data_path' and 'data' have been provided. Please specify only one: either 'data_path' to point to the dataset file or 'data' to provide the dataset directly. Providing both is not allowed." -# ) -# -# errorMessage1 <- check_user_choices_plot( -# vars = "var1", scen = c("scen1", "scen2"), -# years = NULL, reg = "Africa", grouped = TRUE -# ) -# errorExpect1 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_error1.RData"))) -# testthat::expect_equal(errorMessage1, errorExpect1) -# -# errorMessage2 <- check_user_choices_plot( -# vars = "var1", scen = NULL, -# years = "year", reg = "Africa", grouped = TRUE -# ) -# errorExpect2 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_error2.RData"))) -# testthat::expect_equal(errorMessage2, errorExpect2) -# -# errorMessage3 <- check_user_choices_plot( -# vars = NULL, scen = "scen1", -# years = "year", reg = "Africa", grouped = TRUE -# ) -# errorExpect3 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_error3.RData"))) -# testthat::expect_equal(errorMessage3, errorExpect3) -# }) -# -# test_that("Test3. reset", { -# sdata <<- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_3.RData"))) -# reset_first_load() -# -# testthat::expect_equal(firstLoad, TRUE) -# testthat::expect_equal(firstReg, TRUE) -# testthat::expect_equal(firstVars, TRUE) -# testthat::expect_equal(noReg, FALSE) -# testthat::expect_equal(noVars, FALSE) -# testthat::expect_equal(updatedVars, FALSE) -# testthat::expect_equal( -# tree_reg, -# get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_3.a.RData"))) -# ) -# testthat::expect_equal( -# cols.global, -# get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_3.b.RData"))) -# ) -# testthat::expect_equal( -# all_varss, -# get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_3.c.RData"))) -# ) -# }) -# -# test_that("Test5. do_data_sample", { -# -# # do_data_sample -# sdata <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_5.sdata.RData"))) -# sel_cols <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_5.sel_cols.RData"))) -# sel_reg <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_5.sel_reg.RData"))) -# sel_scen <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_5.sel_scen.RData"))) -# sel_vars <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_5.sel_vars.RData"))) -# sel_years <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_5.sel_years.RData"))) -# testResult <- do_data_sample(sdata, sel_scen, sel_years, sel_cols, sel_vars, sel_reg, 0, 0) -# testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_5.1.RData"))) -# testthat::expect_equal(testResult, testExpect) -# -# testResult <- do_data_sample(sdata, sel_scen, sel_years, sel_cols, sel_vars, sel_reg, 1, 0) -# testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_5.2.RData"))) -# testthat::expect_equal(testResult, testExpect) -# -# testResult <- do_data_sample(sdata, sel_scen, sel_years, sel_cols, sel_vars, sel_reg, 1, 1) -# testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_5.3.RData"))) -# testthat::expect_equal(testResult, testExpect) -# -# testResult <- do_data_sample(sdata, sel_scen, sel_years, sel_cols, sel_vars, sel_reg, 2, 1) -# testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_5.4.RData"))) -# testthat::expect_equal(testResult, testExpect) -# -# testResult <- do_data_sample(sdata, sel_scen, sel_years, sel_cols, sel_vars, sel_reg, 1, 2) -# testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_5.5.RData"))) -# testthat::expect_equal(testResult, testExpect) -# }) -# -# -# test_that("Test6. update_user_choices_plot", { -# -# # update_user_choices_plot -# firstReg <- firstVars <- T -# noReg <- noVars <- F -# selected_scen <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_6.selected_scen.RData"))) -# selected_years <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_6.selected_years.RData"))) -# sidebarItemExpanded <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_6.sidebarItemExpanded.RData"))) -# tree_regions <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_6.tree_regions.RData"))) -# tree_variables <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_6.tree_variables.RData"))) -# testResult <- update_user_choices_plot(selected_scen, selected_years, tree_regions, tree_variables, sidebarItemExpanded) -# testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_6.1.RData"))) -# testthat::expect_equal(testResult, testExpect) -# -# }) +library(gcamreport) +library(testthat) +library(magrittr) + +test_that("Test1. test tree functions", { + generate_report(prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test6.dat"), launch_ui = FALSE, GCAM_version = 'v6.0') + # load data + data <- report + # define the dataset for launching the ui + sdata <<- suppressWarnings( + data %>% + tidyr::separate(Variable, into = c("col1", "col2", "col3", "col4", "col5", "col6", "col7"), sep = "([\\|])", extra = "merge", remove = FALSE) + ) + # create vector of available years for launching the ui + available_years <<- as.numeric(names(sdata)[13:length(names(sdata))]) + # develop a nested list of the variables and regions for launching the ui + cols.global <<- unique(sdata[, grepl("col", names(sdata))]) + tree_vars <<- do_mount_tree(cols.global, names(cols.global), selec = TRUE) + tree_reg <<- do_mount_tree(reg_cont, names(reg_cont), selec = TRUE) + # save a list of all variables + all_varss <<- do_collapse_df(cols.global) + + # do_mount_tree with regions + testResult1 <- do_mount_tree(reg_cont, names(reg_cont), selec = TRUE) + testExpect1 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_1.RData"))) + testthat::expect_equal(testResult1, testExpect1) + + # do_unmount_tree with regions + testResult1.2 <- do_unmount_tree(get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_unmount_tree_regions.RData"))), "regions") + testExpect1.2 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_1.2.RData"))) + testthat::expect_equal(testResult1.2, testExpect1.2) + + # do_mount_tree with variables + testResult2 <- do_mount_tree(cols.global, names(cols.global), selec = TRUE) + testExpect2 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_2.RData"))) + testthat::expect_equal(testResult2, testExpect2) + + # do_unmount_tree with variables + testResult2.2 <- do_unmount_tree(get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_unmount_tree_variables.RData"))), "variables") + testExpect2.2 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_2.2.RData"))) + testthat::expect_equal(testResult2.2, testExpect2.2) + + # do_unmount_tree NULL + testResult2.3 <- do_unmount_tree(NULL, "variables") + testthat::expect_equal(testResult2.3, NULL) + + # do_collapse_df + testResult3 <- do_collapse_df(cols.global) + testExpect3 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_3.RData"))) + testthat::expect_equal(testResult3, testExpect3) + + # change_style + test4_pre <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_4_pre.RData"))) + testExpect4 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_4_post.RData"))) + testResult4 <- change_style(test4_pre, "regions") + testthat::expect_equal(testResult4, testExpect4) + + # check_user_choices_plot + testResult5 <- check_user_choices_plot(c("var1", "var2"), c("scen1", "scen2"), c("year1", "year2"), NULL, grouped = TRUE) + testExpect5 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_5.RData"))) + testthat::expect_equal(testResult5, testExpect5) + + testResult6 <- check_user_choices_plot(c("var1", "var2"), c("scen1", "scen2"), c("year1", "year2"), NULL, grouped = FALSE) + testExpect6 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_6.RData"))) + testthat::expect_equal(testResult6, testExpect6) + + testResult7 <- check_user_choices_plot(c("var1"), c("scen1", "scen2"), c("year1", "year2"), "reg1", grouped = FALSE) + testExpect7 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_7.RData"))) + testthat::expect_equal(testResult7, testExpect7) + + # compute_height + testResult8 <- compute_height(c(reg_cont[, 2], "World")) + testExpect8 <- 960 + testthat::expect_equal(testResult8, testExpect8) + + testResult9 <- compute_height(c("MAF", "LAM")) + testExpect9 <- 325 + testthat::expect_equal(testResult9, testExpect9) +}) + +test_that("Test2. error messages", { + expect_error( + launch_gcamreport_ui(), + "Error: Neither 'data_path' nor 'data' has been provided. Please specify at least one of these: 'data_path' to point to the location of the dataset file or 'data' to provide the dataset directly." + ) + + expect_error( + launch_gcamreport_ui("dummy1", "dummy2"), + "Error: Both 'data_path' and 'data' have been provided. Please specify only one: either 'data_path' to point to the dataset file or 'data' to provide the dataset directly. Providing both is not allowed." + ) + + errorMessage1 <- check_user_choices_plot( + vars = "var1", scen = c("scen1", "scen2"), + years = NULL, reg = "Africa", grouped = TRUE + ) + errorExpect1 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_error1.RData"))) + testthat::expect_equal(errorMessage1, errorExpect1) + + errorMessage2 <- check_user_choices_plot( + vars = "var1", scen = NULL, + years = "year", reg = "Africa", grouped = TRUE + ) + errorExpect2 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_error2.RData"))) + testthat::expect_equal(errorMessage2, errorExpect2) + + errorMessage3 <- check_user_choices_plot( + vars = NULL, scen = "scen1", + years = "year", reg = "Africa", grouped = TRUE + ) + errorExpect3 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_error3.RData"))) + testthat::expect_equal(errorMessage3, errorExpect3) +}) + +test_that("Test3. reset", { + sdata <<- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_3.RData"))) + reset_first_load() + + testthat::expect_equal(firstLoad, TRUE) + testthat::expect_equal(firstReg, TRUE) + testthat::expect_equal(firstVars, TRUE) + testthat::expect_equal(noReg, FALSE) + testthat::expect_equal(noVars, FALSE) + testthat::expect_equal(updatedVars, FALSE) + testthat::expect_equal( + tree_reg, + get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_3.a.RData"))) + ) + testthat::expect_equal( + cols.global, + get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_3.b.RData"))) + ) + testthat::expect_equal( + all_varss, + get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_3.c.RData"))) + ) +}) + +test_that("Test5. do_data_sample", { + + # do_data_sample + sdata <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_5.sdata.RData"))) + sel_cols <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_5.sel_cols.RData"))) + sel_reg <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_5.sel_reg.RData"))) + sel_scen <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_5.sel_scen.RData"))) + sel_vars <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_5.sel_vars.RData"))) + sel_years <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_5.sel_years.RData"))) + testResult <- do_data_sample(sdata, sel_scen, sel_years, sel_cols, sel_vars, sel_reg, 0, 0) + testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_5.1.RData"))) + testthat::expect_equal(testResult, testExpect) + + testResult <- do_data_sample(sdata, sel_scen, sel_years, sel_cols, sel_vars, sel_reg, 1, 0) + testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_5.2.RData"))) + testthat::expect_equal(testResult, testExpect) + + testResult <- do_data_sample(sdata, sel_scen, sel_years, sel_cols, sel_vars, sel_reg, 1, 1) + testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_5.3.RData"))) + testthat::expect_equal(testResult, testExpect) + + testResult <- do_data_sample(sdata, sel_scen, sel_years, sel_cols, sel_vars, sel_reg, 2, 1) + testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_5.4.RData"))) + testthat::expect_equal(testResult, testExpect) + + testResult <- do_data_sample(sdata, sel_scen, sel_years, sel_cols, sel_vars, sel_reg, 1, 2) + testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_5.5.RData"))) + testthat::expect_equal(testResult, testExpect) +}) + + +test_that("Test6. update_user_choices_plot", { + + # update_user_choices_plot + firstReg <- firstVars <- T + noReg <- noVars <- F + selected_scen <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_6.selected_scen.RData"))) + selected_years <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_6.selected_years.RData"))) + sidebarItemExpanded <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_6.sidebarItemExpanded.RData"))) + tree_regions <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_6.tree_regions.RData"))) + tree_variables <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_6.0/test_ui_6.tree_variables.RData"))) + testResult <- update_user_choices_plot(selected_scen, selected_years, tree_regions, tree_variables, sidebarItemExpanded) + testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_6.0/test_ui_6.1.RData"))) + testthat::expect_equal(testResult, testExpect) + +}) diff --git a/tests/testthat/testUI_v7.0.R b/tests/testthat/testUI_v7.0.R index e42adbc4..45410bdb 100644 --- a/tests/testthat/testUI_v7.0.R +++ b/tests/testthat/testUI_v7.0.R @@ -1,202 +1,202 @@ -# library(gcamreport) -# library(testthat) -# library(magrittr) +library(gcamreport) +library(testthat) +library(magrittr) + +test_that("Test1. test tree functions", { + generate_report(prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test7.dat"), launch_ui = FALSE) + # load data + data <- report + # define the dataset for launching the ui + sdata <<- suppressWarnings( + data %>% + tidyr::separate(Variable, into = c("col1", "col2", "col3", "col4", "col5", "col6", "col7"), sep = "([\\|])", extra = "merge", remove = FALSE) + ) + # create vector of available years for launching the ui + available_years <<- as.numeric(names(sdata)[13:length(names(sdata))]) + # develop a nested list of the variables and regions for launching the ui + cols.global <<- unique(sdata[, grepl("col", names(sdata))]) + tree_vars <<- do_mount_tree(cols.global, names(cols.global), selec = TRUE) + tree_reg <<- do_mount_tree(reg_cont, names(reg_cont), selec = TRUE) + # save a list of all variables + all_varss <<- do_collapse_df(cols.global) + + # do_mount_tree with regions + testResult1 <- do_mount_tree(reg_cont, names(reg_cont), selec = TRUE) + testExpect1 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_1.RData"))) + testthat::expect_equal(testResult1, testExpect1) + + # do_unmount_tree with regions + testResult1.2 <- do_unmount_tree(get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_unmount_tree_regions.RData"))), "regions") + testExpect1.2 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_1.2.RData"))) + testthat::expect_equal(testResult1.2, testExpect1.2) + + # do_mount_tree with variables + testResult2 <- do_mount_tree(cols.global, names(cols.global), selec = TRUE) + testExpect2 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_2.RData"))) + testthat::expect_equal(testResult2, testExpect2) + + # do_unmount_tree with variables + testResult2.2 <- do_unmount_tree(get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_unmount_tree_variables.RData"))), "variables") + testExpect2.2 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_2.2.RData"))) + testthat::expect_equal(testResult2.2, testExpect2.2) + + # do_unmount_tree NULL + testResult2.3 <- do_unmount_tree(NULL, "variables") + testthat::expect_equal(testResult2.3, NULL) + + # do_collapse_df + testResult3 <- do_collapse_df(cols.global) + testExpect3 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_3.RData"))) + testthat::expect_equal(testResult3, testExpect3) + + # change_style + test4_pre <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_4_pre.RData"))) + testExpect4 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_4_post.RData"))) + testResult4 <- change_style(test4_pre, "regions") + testthat::expect_equal(testResult4, testExpect4) + + # check_user_choices_plot + testResult5 <- check_user_choices_plot(c("var1", "var2"), c("scen1", "scen2"), c("year1", "year2"), NULL, grouped = TRUE) + testExpect5 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_5.RData"))) + testthat::expect_equal(testResult5, testExpect5) + + testResult6 <- check_user_choices_plot(c("var1", "var2"), c("scen1", "scen2"), c("year1", "year2"), NULL, grouped = FALSE) + testExpect6 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_6.RData"))) + testthat::expect_equal(testResult6, testExpect6) + + testResult7 <- check_user_choices_plot(c("var1"), c("scen1", "scen2"), c("year1", "year2"), "reg1", grouped = FALSE) + testExpect7 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_7.RData"))) + testthat::expect_equal(testResult7, testExpect7) + + # compute_height + testResult8 <- compute_height(c(reg_cont[, 2], "World")) + testExpect8 <- 960 + testthat::expect_equal(testResult8, testExpect8) + + testResult9 <- compute_height(c("MAF", "LAM")) + testExpect9 <- 325 + testthat::expect_equal(testResult9, testExpect9) +}) + +test_that("Test2. error messages", { + expect_error( + launch_gcamreport_ui(), + "Error: Neither 'data_path' nor 'data' has been provided. Please specify at least one of these: 'data_path' to point to the location of the dataset file or 'data' to provide the dataset directly." + ) + + expect_error( + launch_gcamreport_ui("dummy1", "dummy2"), + "Error: Both 'data_path' and 'data' have been provided. Please specify only one: either 'data_path' to point to the dataset file or 'data' to provide the dataset directly. Providing both is not allowed." + ) + + errorMessage1 <- check_user_choices_plot( + vars = "var1", scen = c("scen1", "scen2"), + years = NULL, reg = "Africa", grouped = TRUE + ) + errorExpect1 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_error1.RData"))) + testthat::expect_equal(errorMessage1, errorExpect1) + + errorMessage2 <- check_user_choices_plot( + vars = "var1", scen = NULL, + years = "year", reg = "Africa", grouped = TRUE + ) + errorExpect2 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_error2.RData"))) + testthat::expect_equal(errorMessage2, errorExpect2) + + errorMessage3 <- check_user_choices_plot( + vars = NULL, scen = "scen1", + years = "year", reg = "Africa", grouped = TRUE + ) + errorExpect3 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_error3.RData"))) + testthat::expect_equal(errorMessage3, errorExpect3) +}) + +test_that("Test3. reset", { + sdata <<- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_3.RData"))) + reset_first_load() + + testthat::expect_equal(firstLoad, TRUE) + testthat::expect_equal(firstReg, TRUE) + testthat::expect_equal(firstVars, TRUE) + testthat::expect_equal(noReg, FALSE) + testthat::expect_equal(noVars, FALSE) + testthat::expect_equal(updatedVars, FALSE) + testthat::expect_equal( + tree_reg, + get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_3.a.RData"))) + ) + testthat::expect_equal( + cols.global, + get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_3.b.RData"))) + ) + testthat::expect_equal( + all_varss, + get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_3.c.RData"))) + ) +}) + +test_that("Test5. do_data_sample", { + + # do_data_sample + sdata <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_5.sdata.RData"))) + sel_cols <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_5.sel_cols.RData"))) + sel_reg <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_5.sel_reg.RData"))) + sel_scen <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_5.sel_scen.RData"))) + sel_vars <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_5.sel_vars.RData"))) + sel_years <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_5.sel_years.RData"))) + testResult <- do_data_sample(sdata, sel_scen, sel_years, sel_cols, sel_vars, sel_reg, 0, 0) + testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_5.1.RData"))) + testthat::expect_equal(testResult, testExpect) + + testResult <- do_data_sample(sdata, sel_scen, sel_years, sel_cols, sel_vars, sel_reg, 1, 0) + testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_5.2.RData"))) + testthat::expect_equal(testResult, testExpect) + + testResult <- do_data_sample(sdata, sel_scen, sel_years, sel_cols, sel_vars, sel_reg, 1, 1) + testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_5.3.RData"))) + testthat::expect_equal(testResult, testExpect) + + testResult <- do_data_sample(sdata, sel_scen, sel_years, sel_cols, sel_vars, sel_reg, 2, 1) + testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_5.4.RData"))) + testthat::expect_equal(testResult, testExpect) + + testResult <- do_data_sample(sdata, sel_scen, sel_years, sel_cols, sel_vars, sel_reg, 1, 2) + testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_5.5.RData"))) + testthat::expect_equal(testResult, testExpect) +}) + + +test_that("Test6. update_user_choices_plot", { + + # update_user_choices_plot + firstReg <- firstVars <- T + noReg <- noVars <- F + selected_scen <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_6.selected_scen.RData"))) + selected_years <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_6.selected_years.RData"))) + sidebarItemExpanded <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_6.sidebarItemExpanded.RData"))) + tree_regions <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_6.tree_regions.RData"))) + tree_variables <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_6.tree_variables.RData"))) + testResult <- update_user_choices_plot(selected_scen, selected_years, tree_regions, tree_variables, sidebarItemExpanded) + testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_6.1.RData"))) + testthat::expect_equal(testResult, testExpect) + +}) + + +# +# test_that("Test4. launch ui", { +# launch_gcamreport_ui(data_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_launch_ui.RData")) +# +# testthat::expect_equal(available_years, c(2005, 2010, 2015, 2020, 2025, 2030, 2035, 2040, 2045, 2050)) +# testthat::expect_equal(sdata, +# get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_4.a.RData")))) +# testthat::expect_equal(cols.global, +# get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_4.b.RData")))) +# testthat::expect_equal(tree_vars, +# get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_4.c.RData")))) +# testthat::expect_equal(tree_reg, +# get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_4.d.RData")))) +# testthat::expect_equal(all_varss, +# get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_4.e.RData")))) # -# test_that("Test1. test tree functions", { -# generate_report(prj_name = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test7.dat"), launch_ui = FALSE) -# # load data -# data <- report -# # define the dataset for launching the ui -# sdata <<- suppressWarnings( -# data %>% -# tidyr::separate(Variable, into = c("col1", "col2", "col3", "col4", "col5", "col6", "col7"), sep = "([\\|])", extra = "merge", remove = FALSE) -# ) -# # create vector of available years for launching the ui -# available_years <<- as.numeric(names(sdata)[13:length(names(sdata))]) -# # develop a nested list of the variables and regions for launching the ui -# cols.global <<- unique(sdata[, grepl("col", names(sdata))]) -# tree_vars <<- do_mount_tree(cols.global, names(cols.global), selec = TRUE) -# tree_reg <<- do_mount_tree(reg_cont, names(reg_cont), selec = TRUE) -# # save a list of all variables -# all_varss <<- do_collapse_df(cols.global) -# -# # do_mount_tree with regions -# testResult1 <- do_mount_tree(reg_cont, names(reg_cont), selec = TRUE) -# testExpect1 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_1.RData"))) -# testthat::expect_equal(testResult1, testExpect1) -# -# # do_unmount_tree with regions -# testResult1.2 <- do_unmount_tree(get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_unmount_tree_regions.RData"))), "regions") -# testExpect1.2 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_1.2.RData"))) -# testthat::expect_equal(testResult1.2, testExpect1.2) -# -# # do_mount_tree with variables -# testResult2 <- do_mount_tree(cols.global, names(cols.global), selec = TRUE) -# testExpect2 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_2.RData"))) -# testthat::expect_equal(testResult2, testExpect2) -# -# # do_unmount_tree with variables -# testResult2.2 <- do_unmount_tree(get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_unmount_tree_variables.RData"))), "variables") -# testExpect2.2 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_2.2.RData"))) -# testthat::expect_equal(testResult2.2, testExpect2.2) -# -# # do_unmount_tree NULL -# testResult2.3 <- do_unmount_tree(NULL, "variables") -# testthat::expect_equal(testResult2.3, NULL) -# -# # do_collapse_df -# testResult3 <- do_collapse_df(cols.global) -# testExpect3 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_3.RData"))) -# testthat::expect_equal(testResult3, testExpect3) -# -# # change_style -# test4_pre <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_4_pre.RData"))) -# testExpect4 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_4_post.RData"))) -# testResult4 <- change_style(test4_pre, "regions") -# testthat::expect_equal(testResult4, testExpect4) -# -# # check_user_choices_plot -# testResult5 <- check_user_choices_plot(c("var1", "var2"), c("scen1", "scen2"), c("year1", "year2"), NULL, grouped = TRUE) -# testExpect5 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_5.RData"))) -# testthat::expect_equal(testResult5, testExpect5) -# -# testResult6 <- check_user_choices_plot(c("var1", "var2"), c("scen1", "scen2"), c("year1", "year2"), NULL, grouped = FALSE) -# testExpect6 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_6.RData"))) -# testthat::expect_equal(testResult6, testExpect6) -# -# testResult7 <- check_user_choices_plot(c("var1"), c("scen1", "scen2"), c("year1", "year2"), "reg1", grouped = FALSE) -# testExpect7 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_7.RData"))) -# testthat::expect_equal(testResult7, testExpect7) -# -# # compute_height -# testResult8 <- compute_height(c(reg_cont[, 2], "World")) -# testExpect8 <- 960 -# testthat::expect_equal(testResult8, testExpect8) -# -# testResult9 <- compute_height(c("MAF", "LAM")) -# testExpect9 <- 325 -# testthat::expect_equal(testResult9, testExpect9) -# }) -# -# test_that("Test2. error messages", { -# expect_error( -# launch_gcamreport_ui(), -# "Error: Neither 'data_path' nor 'data' has been provided. Please specify at least one of these: 'data_path' to point to the location of the dataset file or 'data' to provide the dataset directly." -# ) -# -# expect_error( -# launch_gcamreport_ui("dummy1", "dummy2"), -# "Error: Both 'data_path' and 'data' have been provided. Please specify only one: either 'data_path' to point to the dataset file or 'data' to provide the dataset directly. Providing both is not allowed." -# ) -# -# errorMessage1 <- check_user_choices_plot( -# vars = "var1", scen = c("scen1", "scen2"), -# years = NULL, reg = "Africa", grouped = TRUE -# ) -# errorExpect1 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_error1.RData"))) -# testthat::expect_equal(errorMessage1, errorExpect1) -# -# errorMessage2 <- check_user_choices_plot( -# vars = "var1", scen = NULL, -# years = "year", reg = "Africa", grouped = TRUE -# ) -# errorExpect2 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_error2.RData"))) -# testthat::expect_equal(errorMessage2, errorExpect2) -# -# errorMessage3 <- check_user_choices_plot( -# vars = NULL, scen = "scen1", -# years = "year", reg = "Africa", grouped = TRUE -# ) -# errorExpect3 <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_error3.RData"))) -# testthat::expect_equal(errorMessage3, errorExpect3) # }) -# -# test_that("Test3. reset", { -# sdata <<- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_3.RData"))) -# reset_first_load() -# -# testthat::expect_equal(firstLoad, TRUE) -# testthat::expect_equal(firstReg, TRUE) -# testthat::expect_equal(firstVars, TRUE) -# testthat::expect_equal(noReg, FALSE) -# testthat::expect_equal(noVars, FALSE) -# testthat::expect_equal(updatedVars, FALSE) -# testthat::expect_equal( -# tree_reg, -# get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_3.a.RData"))) -# ) -# testthat::expect_equal( -# cols.global, -# get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_3.b.RData"))) -# ) -# testthat::expect_equal( -# all_varss, -# get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_3.c.RData"))) -# ) -# }) -# -# test_that("Test5. do_data_sample", { -# -# # do_data_sample -# sdata <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_5.sdata.RData"))) -# sel_cols <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_5.sel_cols.RData"))) -# sel_reg <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_5.sel_reg.RData"))) -# sel_scen <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_5.sel_scen.RData"))) -# sel_vars <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_5.sel_vars.RData"))) -# sel_years <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_5.sel_years.RData"))) -# testResult <- do_data_sample(sdata, sel_scen, sel_years, sel_cols, sel_vars, sel_reg, 0, 0) -# testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_5.1.RData"))) -# testthat::expect_equal(testResult, testExpect) -# -# testResult <- do_data_sample(sdata, sel_scen, sel_years, sel_cols, sel_vars, sel_reg, 1, 0) -# testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_5.2.RData"))) -# testthat::expect_equal(testResult, testExpect) -# -# testResult <- do_data_sample(sdata, sel_scen, sel_years, sel_cols, sel_vars, sel_reg, 1, 1) -# testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_5.3.RData"))) -# testthat::expect_equal(testResult, testExpect) -# -# testResult <- do_data_sample(sdata, sel_scen, sel_years, sel_cols, sel_vars, sel_reg, 2, 1) -# testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_5.4.RData"))) -# testthat::expect_equal(testResult, testExpect) -# -# testResult <- do_data_sample(sdata, sel_scen, sel_years, sel_cols, sel_vars, sel_reg, 1, 2) -# testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_5.5.RData"))) -# testthat::expect_equal(testResult, testExpect) -# }) -# -# -# test_that("Test6. update_user_choices_plot", { -# -# # update_user_choices_plot -# firstReg <- firstVars <- T -# noReg <- noVars <- F -# selected_scen <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_6.selected_scen.RData"))) -# selected_years <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_6.selected_years.RData"))) -# sidebarItemExpanded <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_6.sidebarItemExpanded.RData"))) -# tree_regions <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_6.tree_regions.RData"))) -# tree_variables <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_ui_6.tree_variables.RData"))) -# testResult <- update_user_choices_plot(selected_scen, selected_years, tree_regions, tree_variables, sidebarItemExpanded) -# testExpect <- get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_6.1.RData"))) -# testthat::expect_equal(testResult, testExpect) -# -# }) -# -# -# # -# # test_that("Test4. launch ui", { -# # launch_gcamreport_ui(data_path = file.path(rprojroot::find_root(rprojroot::is_testthat), "testInputs/v_7.0/test_launch_ui.RData")) -# # -# # testthat::expect_equal(available_years, c(2005, 2010, 2015, 2020, 2025, 2030, 2035, 2040, 2045, 2050)) -# # testthat::expect_equal(sdata, -# # get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_4.a.RData")))) -# # testthat::expect_equal(cols.global, -# # get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_4.b.RData")))) -# # testthat::expect_equal(tree_vars, -# # get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_4.c.RData")))) -# # testthat::expect_equal(tree_reg, -# # get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_4.d.RData")))) -# # testthat::expect_equal(all_varss, -# # get(load(file.path(rprojroot::find_root(rprojroot::is_testthat), "testOutputs/v_7.0/test_ui_4.e.RData")))) -# # -# # })