Retool for tibble and tidyr upsteam changes.

Author: davidski

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: evaluator
 Title: Quantified Risk Assessment Toolkit
-Version: 0.4.1
+Version: 0.4.2
 Authors@R: c(person("David", "Severski", email = "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-7867-0459")))
 Description: An open source risk analysis toolkit based on the OpenFAIR ontology 
   <https://www2.opengroup.org/ogsys/catalog/C13K> and risk assessment standard 

NAMESPACE

@@ -137,6 +137,7 @@ importFrom(stats,sd)
 importFrom(stringi,stri_split_fixed)
 importFrom(tibble,add_row)
 importFrom(tibble,as_tibble)
+importFrom(tibble,deframe)
 importFrom(tibble,rownames_to_column)
 importFrom(tibble,tibble)
 importFrom(tidyr,gather)

NEWS.md

@@ -1,3 +1,7 @@
+# evaluator 0.4.2
+
+* Internal updates for recent `tibble` and `tidyr` changes.
+
 # evaluator 0.4.1
 
 * Update for compatibility with `vctrs` 0.2.0 CRAN release.

R/common_graphs.R

@@ -39,7 +39,7 @@ theme_evaluator <- function(base_family = "BentonSansRE") {
 #' Display a heatmap of impact by domain
 #'
 #' Given a domain_summary and a list of all domains, generate a heatmap colored
-#'   by the 95% VaR. This plot displays the domains in which aggregreate risk is
+#'   by the 95% VaR. This plot displays the domains in which aggregate risk is
 #'   greater than others.
 #'
 #' @import ggplot2
@@ -134,7 +134,7 @@ generate_scatterplot <- function(simulation_results, scenario_id){
 #' @export
 #' @examples
 #' data(mc_simulation_results)
-#' loss_scatterplot(mc_simulation_results[[1, "results"]])
+#' loss_scatterplot(mc_simulation_results$results[[1]])
 loss_scatterplot <- function(simulation_result) {
   gg <- ggplot(simulation_result, aes(x = .data$loss_events, y = .data$ale))
   gg <- gg + geom_point(alpha = 1/4)
@@ -167,7 +167,7 @@ loss_scatterplot <- function(simulation_result) {
 #' @export
 #' @examples
 #' data(mc_simulation_results)
-#' result <- mc_simulation_results[[1, "results"]]
+#' result <- mc_simulation_results$results[[1]]
 #' exposure_histogram(result)
 exposure_histogram <- function(simulation_result, bins = 30, show_var_95 = FALSE){
   gg <- ggplot(simulation_result, aes(x = .data$ale))

R/encode.R

@@ -79,7 +79,7 @@ encode_scenarios <- function(scenarios, capabilities, mappings) {
 #'   IDs.
 #'
 #' @importFrom dplyr filter select
-#' @importFrom rlang .data set_names
+#' @importFrom tibble deframe
 #' @importFrom stringi stri_split_fixed
 #' @importFrom vctrs vec_cast
 #' @param capability_ids Comma-delimited list of capabilities in scope for a scenario.
@@ -89,7 +89,7 @@ encode_scenarios <- function(scenarios, capabilities, mappings) {
 #' @export
 #' @examples
 #' data(mc_capabilities)
-#' capability_ids <- c("1, 3")
+#' capability_ids <- c("CAP-01", "CAP-03")
 #' derive_control_key(capability_ids, mc_capabilities)
 derive_control_key <- function(capability_ids, capabilities) {
   control_list <- stringi::stri_split_fixed(capability_ids, ", ") %>% unlist()
@@ -98,8 +98,9 @@ derive_control_key <- function(capability_ids, capabilities) {
     dplyr::select(.data$capability_id, .data$capability)
 
   #rlang::as_list(control_frame$capability) %>%
-  vctrs::vec_cast(control_frame$capability, to = list()) %>%
-    rlang::set_names(control_frame$capability_id)
+  # vctrs::vec_cast(control_frame$capability, to = list()) %>%
+  #   rlang::set_names(control_frame$capability_id)
+  tibble::deframe(control_frame) %>% as.list()
 
 }
 

R/import.R

@@ -107,7 +107,6 @@ import_scenarios <- function(survey_file = NULL, domains = NULL) {
 #' @importFrom readxl read_excel
 #' @importFrom purrr map
 #' @importFrom rlang .data
-#' @inheritParams import_scenarios
 #' @param survey_file Path to survey Excel file. If not supplied, a default sample file is used.
 #' @param domains Dataframe of domains and domain IDs.
 #'

R/openfair.R

@@ -298,7 +298,7 @@ select_loss_opportunities <- function(tc, diff, n = NULL, ...) {
 #' @export
 #' @examples
 #' data(mc_quantitative_scenarios)
-#' params <- mc_quantitative_scenarios[[1, "scenario"]]$parameters
+#' params <- mc_quantitative_scenarios$scenario[[1]]$parameters
 #' openfair_tef_tc_diff_lm(params$tef, params$tc, params$diff, params$lm, 10)
 openfair_tef_tc_diff_lm <- function(tef, tc, diff, lm, n = 10^4, verbose = FALSE) {
 
@@ -318,15 +318,15 @@ openfair_tef_tc_diff_lm <- function(tef, tc, diff, lm, n = 10^4, verbose = FALSE
 
   # TEF - how many contacts do we have in each simulated period
   TEFestimate <- tef %>% purrr::flatten() %>%
-    tibble::as_tibble() %>% tidyr::nest(-.data$func, .key = "params")
+    tibble::as_tibble() %>% tidyr::nest(params = -.data$func)
   params <- TEFestimate$params %>% unlist()
   TEFsamples <- sample_tef(n = n, .func = TEFestimate$func, params = params)
   TEFsamples <- TEFsamples$samples
 
   # TC - what is the strength of each threat event
   #    - get the threat capability parameters for this scenario
   TCestimate <- tc %>% purrr::flatten() %>%
-    tibble::as_tibble() %>% tidyr::nest(-.data$func, .key = "params")
+    tibble::as_tibble() %>% tidyr::nest(params = -.data$func)
   #    - sample threat capability for each TEF event in each sample period
   TCsamples <- purrr::map(1:n, function(x) {
     params <- TCestimate$params %>% unlist()
@@ -360,7 +360,7 @@ openfair_tef_tc_diff_lm <- function(tef, tc, diff, lm, n = 10^4, verbose = FALSE
 
   # LM - determine the size of losses for each iteration
   LMestimate <- lm %>% purrr::flatten() %>%
-    tibble::as_tibble() %>% tidyr::nest(-.data$func, .key = "params")
+    tibble::as_tibble() %>% tidyr::nest(params = -.data$func)
   loss_samples <- purrr::map(LEFsamples, function(x) {
     params <- LMestimate$params %>% unlist()
     dat <- sample_lm(n = x, .func = LMestimate$func, params = params)
@@ -435,15 +435,15 @@ openfair_tef_tc_diff_plm_sr <- function(tef, tc, diff, plm, sr, n = 10^4, verbos
 
   # TEF - how many contacts do we have in each simulated period
   TEFestimate <- tef %>% purrr::flatten() %>%
-    tibble::as_tibble() %>% tidyr::nest(-.data$func, .key = "params")
+    tibble::as_tibble() %>% tidyr::nest(params = -.data$func)
   params <- TEFestimate$params %>% unlist()
   TEFsamples <- sample_tef(n = n, .func = TEFestimate$func, params = params)
   TEFsamples <- TEFsamples$samples
 
   # TC - what is the strength of each threat event
   #    - get the threat capability parameters for this scenario
   TCestimate <- tc %>% purrr::flatten() %>%
-    tibble::as_tibble() %>% tidyr::nest(-.data$func, .key = "params")
+    tibble::as_tibble() %>% tidyr::nest(params = -.data$func)
   #    - sample threat capability for each TEF event in each sample period
   TCsamples <- purrr::map(1:n, function(x) {
     params <- TCestimate$params %>% unlist()
@@ -474,9 +474,9 @@ openfair_tef_tc_diff_plm_sr <- function(tef, tc, diff, plm, sr, n = 10^4, verbos
 
   # LM - determine the size of losses for each iteration
   PLMestimate <- plm %>% purrr::flatten() %>%
-    tibble::as_tibble() %>% tidyr::nest(-.data$func, .key = "params")
+    tibble::as_tibble() %>% tidyr::nest(params = -.data$func)
   SRestimate <- sr %>% purrr::flatten() %>%
-    tibble::as_tibble() %>% tidyr::nest(-.data$func, .key = "params")
+    tibble::as_tibble() %>% tidyr::nest(params = -.data$func)
   loss_samples <- purrr::map(LEFsamples, function(x) {
     params <- PLMestimate$params %>% unlist()
     dat_p <- sample_lm(n = x, .func = PLMestimate$func, params = params)

R/simulate.R

@@ -18,7 +18,7 @@
 #' @return Dataframe of results.
 #' @examples
 #' data(mc_quantitative_scenarios)
-#' run_simulation(mc_quantitative_scenarios[[1, "scenario"]], 10)
+#' run_simulation(mc_quantitative_scenarios$scenario[[1]], 10)
 run_simulation <- function(scenario, iterations = 10000L,
                             ale_maximum = NULL,
                             verbose = FALSE, simulation_count = NULL) {
@@ -43,7 +43,7 @@ run_simulation <- function(scenario, iterations = 10000L,
     if ((!is.null(.pb)) & inherits(.pb, "Progress") && (.pb$i < .pb$n)) .pb$tick()$print()
 
     safe_calculate <- purrr::safely(eval(rlang::parse_expr(func)))
-    rlang::exec(safe_calculate, !!!params)
+    rlang::exec("safe_calculate", !!!params)
   }
 
   simulation_results <- wrapped_calc(scenario)
@@ -88,9 +88,9 @@ run_simulation <- function(scenario, iterations = 10000L,
 #' @examples
 #' # fetch three scenarios for this example
 #' data(mc_quantitative_scenarios)
-#' scenario_a <- mc_quantitative_scenarios[[1, "scenario"]]
-#' scenario_b <- mc_quantitative_scenarios[[2, "scenario"]]
-#' scenario_c <- mc_quantitative_scenarios[[3, "scenario"]]
+#' scenario_a <- mc_quantitative_scenarios$scenario[[1]]
+#' scenario_b <- mc_quantitative_scenarios$scenario[[2]]
+#' scenario_c <- mc_quantitative_scenarios$scenario[[3]]
 #' run_simulations(scenario_a, scenario_b, scenario_c, iterations = 10)
 #'
 run_simulations <- function(scenario, ..., iterations = 10000L,

R/summarize.R

@@ -22,7 +22,7 @@
 #' @examples
 #' data(mc_simulation_results)
 #' # summarize a single scenario
-#' summarize_scenario(mc_simulation_results[[1, "results"]])
+#' summarize_scenario(mc_simulation_results$results[[1]])
 #'
 summarize_scenario <- function(simulation_result) {
   if (!is.data.frame(simulation_result) ||

R/tidyrisk_scenario.R

@@ -24,7 +24,7 @@ new_tidyrisk_scenario <- function(..., model = "openfair_tef_tc_diff_lm") {
   scenario <- list(
     parameters = dots,
     model = model)
-  class(scenario) <- c("tidyrisk_scenario")
+  class(scenario) <- c("tidyrisk_scenario", "list")
   scenario
 }
 

cran-comments.md

@@ -1,12 +1,11 @@
 ## Update
 
-This is a resubmission of a minor hotfix to address `vctrs` compatability. 
-This resubmission fixes an invalid URI in the README.
+This is a hotfix to address recent breaking changes in `tibble`.
 
 ## Test environments
 
 * local Windows 10 64 install, R 3.5.3
-* local OS X, R 3.6.0
+* local OS X, R 3.6.3
 * Windows Server 2016 (on appveyor), R 3.5
 * Ubuntu 16.04 LTS (on travis-ci)
   * R-release (both with and without pandoc)

data/mc_capabilities.rda

@@ -217,7 +217,7 @@ test_that("SR model works as expected", {
     mutate(scenario = pmap(list(tef_params = tef_params, tc_params = tc_params,
                                 diff_params = diff_params, plm_params = plm_params,
                                 sr_params = sr_params, model = model), tidyrisk_scenario))
-  results <- run_simulation(scenario[[1, "scenario"]], 100L)
+  results <- scenario$scenario %>% map_df(run_simulation, 100L)
   expect_s3_class(results, "tbl_df")
   expect_equal(nrow(results), 100)
   expect_equal(length(results), 11)

data/mc_domain_summary.rda

@@ -4,34 +4,34 @@ context("Simulation-Model Interface")
 
 test_that("Simulation fails when given a simulation_count", {
   data("mc_quantitative_scenarios")
-  good_scen <- mc_quantitative_scenarios[[1, "scenario"]]
+  good_scen <- mc_quantitative_scenarios$scenario[[1]]
   expect_error(run_simulation(good_scen, simulation_count = 10L), regexp = "iteration")
 })
 
 test_that("Simulation fails when not given a scenario object", {
   data("mc_quantitative_scenarios")
-  bad_scen <- mc_quantitative_scenarios[[1, "scenario"]]
+  bad_scen <- mc_quantitative_scenarios$scenario[[1]]
   class(bad_scen) <- "list"
   expect_error(run_simulation(bad_scen, 10L), regexp = "object")
 })
 
 test_that("Simulation respects maximum ALE", {
   data("mc_quantitative_scenarios")
-  good_scen <- mc_quantitative_scenarios[[1, "scenario"]]
+  good_scen <- mc_quantitative_scenarios$scenario[[1]]
   results <- run_simulation(good_scen, 10L, ale_maximum = 100)
   expect_lte(max(results$ale), 100)
 })
 
 test_that("Missing mandatory OpenFAIR factors are detected", {
   data("mc_quantitative_scenarios")
-  bad_scen <- mc_quantitative_scenarios[[1, "scenario"]]
+  bad_scen <- mc_quantitative_scenarios$scenario[[1]]
   bad_scen$parameters$tef <- NULL
   expect_error(run_simulation(bad_scen, 10L), regexp = "Missing")
 })
 
 test_that("Bad scenario parameters throw an error", {
   data("mc_quantitative_scenarios")
-  bad_scen <- mc_quantitative_scenarios[[1, "scenario"]]
+  bad_scen <- mc_quantitative_scenarios$scenario[[1]]
   bad_scen$parameters$tef$func <- "stats::rlnorm"
   expect_error(run_simulation(bad_scen, 10L), regexp = "Error")
 })
@@ -45,13 +45,13 @@ test_that("Simulating multiple scenarios succeeds", {
 
 test_that("Multiple simulations run fails when not given a scenario object", {
   data("mc_quantitative_scenarios")
-  bad_scen <- mc_quantitative_scenarios[[1, "scenario"]]
+  bad_scen <- mc_quantitative_scenarios$scenario[[1]]
   class(bad_scen) <- "list"
   expect_error(run_simulations(bad_scen, iterations = 10L), regexp = "object")
 })
 
 test_that("Multiple simulations deprecates the simulation_count parameters", {
   data("mc_quantitative_scenarios")
-  good_scen <- mc_quantitative_scenarios[[1, "scenario"]]
+  good_scen <- mc_quantitative_scenarios$scenario[[1]]
   expect_error(run_simulations(good_scen, simulation_count = 10L), regexp = "iteration")
 })

data/mc_domains.rda

@@ -14,9 +14,9 @@ test_that("Scenario summary rejects non dataframe inputs", {
 
 test_that("Simulation summary handles NAs for tc/diff exceedance", {
   data("mc_simulation_results")
-  mc_simulation_results[[1, "results"]][[1, "mean_tc_exceedance"]] <- NA
+  mc_simulation_results[[1, "results"]][[1]]$mean_tc_exceedance <- NA
   #simulation_results[1, "mean_tc_exceedance"] <- NA
-  mc_simulation_results[[10, "results"]][[1, "mean_diff_exceedance"]] <- NA
+  mc_simulation_results[[10, "results"]][[1]]$mean_diff_exceedance <- NA
   dat <- mutate(mc_simulation_results,
                 result_summary = map(results, summarize_scenario)) %>%
     select(-results)