Improve test coverage

Author: davidski

NAMESPACE

@@ -69,7 +69,6 @@ importFrom(dplyr,case_when)
 importFrom(dplyr,desc)
 importFrom(dplyr,do)
 importFrom(dplyr,filter)
-importFrom(dplyr,funs)
 importFrom(dplyr,group_by)
 importFrom(dplyr,group_by_at)
 importFrom(dplyr,left_join)

R/import.R

@@ -32,7 +32,6 @@ import_spreadsheet <- function(survey_file = system.file("survey",
                                       domains = domains)
 
   ## ----write_files---------------------------------------------------------
-  if (!dir.exists(output_dir)) dir.create(output_dir)
   readr::write_csv(capabilities, path = file.path(output_dir, "capabilities.csv"))
   readr::write_csv(qualitative_scenarios, path =
                      file.path(output_dir, "qualitative_scenarios.csv"))
@@ -44,7 +43,7 @@ import_spreadsheet <- function(survey_file = system.file("survey",
 
 #' Import scenarios from survey spreadsheet
 #'
-#' @importFrom dplyr funs select mutate mutate_at arrange
+#' @importFrom dplyr select mutate mutate_at arrange
 #' @importFrom rlang .data
 #' @importFrom utils data
 #' @importFrom purrr map
@@ -97,7 +96,7 @@ import_scenarios <- function(survey_file = NULL, domains = NULL) {
   dplyr::select(scenarios, scenario_id = "ScenarioID", scenario = "Scenario",
          tcomm = "TComm", tef = "TEF", tc = "TC", lm = "LM",
          domain_id = "domain_id", controls = "Capabilities") %>%
-    dplyr::mutate_at(vars("tef", "lm", "tc"), dplyr::funs(tolower)) %>%
+    dplyr::mutate_at(vars("tef", "lm", "tc"), tolower) %>%
     dplyr::arrange(.data$scenario_id)
 
 }

inst/explore_scenarios/explore_scenarios.Rmd

@@ -94,7 +94,7 @@ get_summary_table <- function(sid) {
   summary_data <- scenario_summary %>% 
     filter(scenario_id == sid) %>% select(-c(results, control_descriptions))
   # add pretty formatting
-  summary_data <- mutate_at(summary_data, .funs = funs(dollar), 
+  summary_data <- mutate_at(summary_data, .funs = dollar, 
                             .vars = vars(ale_median, ale_max, ale_var, sle_mean, 
                             sle_median, sle_max, sle_min)) %>% 
     mutate(mean_tc_exceedance = ifelse(is.nan(mean_tc_exceedance), 
@@ -103,7 +103,7 @@ get_summary_table <- function(sid) {
     mutate(mean_vuln = percent(mean_vuln))
   
   names(summary_data) <- stringi::stri_trans_totitle(gsub("_", " ", names(summary_data)))
-  summary_data <- summary_data %>% mutate_all(funs(as.character)) %>% 
+  summary_data <- summary_data %>% mutate_all(as.character) %>% 
     tidyr::gather(key = "Parameter", value = "Value")
   summary_data
 }
@@ -155,7 +155,7 @@ get_loss_distribution_table <- reactive({
   
   loss_data  <- as_tibble(scenario_data) %>% 
     filter(openfair_factor == "lm") %>% 
-    mutate_at(vars(min, mode, max), funs(dollar)) %>% 
+    mutate_at(vars(min, mode, max), dollar) %>% 
     select(Low = min, "Most Likely" = mode, "High" = max, "Confidence" = shape)
   loss_data
 })
@@ -194,7 +194,7 @@ All Scenarios Data Table
 ```{r show_all_table}
 DT::renderDataTable({
   summary_data <- scenario_summary
-  dat <- mutate_at(summary_data, .funs = funs(dollar), 
+  dat <- mutate_at(summary_data, .funs = scales::dollar, 
                    .vars = vars(starts_with("ale"), starts_with("sle"))) %>% 
     mutate(loss_events_mean = comma(loss_events_mean)) %>% 
     mutate(mean_tc_exceedance = percent(mean_tc_exceedance)) %>% 

inst/rmd/analyze_risk.Rmd

@@ -235,7 +235,7 @@ program are described in the following table.
 ```{r domain_impact, echo = FALSE}
 domain_summary %>% 
   arrange(desc(ale_var)) %>% 
-  mutate_at(vars(-one_of("domain_id", "domain")), funs(dollar)) %>% 
+  mutate_at(vars(-one_of("domain_id", "domain")), scales::dollar) %>% 
   select("Domain" = domain, 
          "Value at Risk" = ale_var,
          "Maximum" = ale_max, 
@@ -942,7 +942,7 @@ arrange(scenarios, domain_id, scenario_id) %>%
 left_join(scenarios, scenario_summary,
           by = c("scenario_id" = "scenario_id", "domain_id" = "domain_id")) %>% 
   arrange(desc(ale_median), desc(ale_var)) %>% 
-  mutate_at(vars("ale_median", "ale_var"), funs(dollar)) %>% 
+  mutate_at(vars("ale_median", "ale_var"), scales::dollar) %>% 
   mutate("Domain" = str_glue("{domain_id} - {scenario_id}")) %>% 
   select(Domain,
          "Scenario" = scenario_description, 

tests/testthat/test-summarize.R

@@ -58,3 +58,13 @@ test_that("Summarize to disk", {
   expect_equal(nrow(result), 2)
   unlink(tmpdata, recursive = TRUE)
 })
+
+test_that("Summarize to disk - non-existant directory", {
+  tmpdata <- file.path(tempdir(), "data")
+
+  result <- summarize_to_disk(evaluator::mc_simulation_results,
+                              results_dir = tmpdata)
+  expect_equal(nrow(result), 2)
+  unlink(tmpdata, recursive = TRUE)
+})
+

tests/testthat/test-tidyrisk-scenario.R

@@ -1,5 +1,5 @@
 context("Tidyrisk Scenario class")
-test_that("Scenario object can be created", {
+test_that("Scenario object can be created and coerced to tibble", {
   tidyrisk_scenario(
     diff_params = list(list(
       "2"  = list(min = 70L, mode = 85, max = 98L, shape = 4L, func = "mc2d::rpert"),
@@ -16,6 +16,7 @@ test_that("Scenario object can be created", {
                           func = "mc2d::rpert"))
   ) -> scenario
   expect_s3_class(scenario, "tidyrisk_scenario")
+  expect_s3_class(as_tibble(scenario), "tbl")
 })
 
 test_that("Unnamed parameters throw errors", {