In davidski/collector: Quantified Risk Assessment Data Collection

class: title-slide, inverse, center

Scenarios and Capabilities

asssessment_title <- if (!is.null(params$assessment_title)) {
  params$assessment_title } else {
    "Strategic Risk Assessment"}
cat("## ", assessment_title, "\n", sep = "")

sme <- if (!is.null(params$sme)) params$sme else "SME Interview"
cat("### ", sme, "\n", sep = "")

options(htmltools.dir.version = FALSE)
library(collector)
library(dplyr)
library(tidyr)
library(purrr)

dat <- readRDS(params$questions_file)
domains <- questions$domains
scenarios <- questions$scenarios
capabilities <- questions$capabilities
rm(dat)

questions <- scenarios %>% dplyr::left_join(domains, by = "domain_id")
capabilities <- capabilities %>% dplyr::left_join(domains, by = "domain_id")

make_slide <- function(x) {
  cat("class: inverse scenario-slide\n")
  #cat("backgound-size: cover\n")
  #cat("background-image: url('img/word_risk.jpg')\n")
  cat("<div class='banner'></div>\n")
  cat("<p class='domain'>", x$domain, "</p>\n")
  cat("<p class='domain-description'>", x$description, "</p>\n")
  cat(".footer-left[", x$scenario_id, "]\n")
  cat(".scenario.middle-text.center[", 
      gsub(" (due to|resulting in) ", " __\\1__ ", x$scenario, fixed = FALSE), 
      "]", "\n\n")

  # cat("<hr>\n")
  # cat("--\n", ".pull-left[", 
  #     "### Frequency Statement\n\n", x$Frequency, 
  #     "]", "\n\n", sep = "")
  # cat("--\n", ".pull-right[", 
  #     "### Impact Statement\n", x$Impact, 
  #     "]", "\n\n", sep= "")

  cat("???\n", x$example, "\n\n", sep = "")
  cat("---\n")
}
make_capabilty_slide <- function(x) {
  cat("class: capability-slide\n")
  #cat("background-image: url('img/happy_transform.jpg')\n")
  #cat("backgound-size: cover\n")
  cat("<div class='banner'></div>\n")
  cat("<p class='domain'>", x$domain, "</p>\n")
  cat("<p class='domain-description'>", x$description, "</p>\n")
  cat(".footer-left[", x$capability_id, "]\n")
  cat(".middle[.center.capability[", x$capability, "]]", "\n\n")

  #cat("<div class = 'progress-image'>\n\n")
  #make_progress_graphic(x$ix, x$n) %>% print()
  #cat("\n</div>\n")

  cat("\n\n---\n")
}

domains_to_display <- if (!is.null(params$domain_list)) {
  params$domain_list } else {
    sort(unique(questions$domain))}
list(domain = domains_to_display, 
     ix = 1:length(domains_to_display), 
     n = length(domains_to_display)) %>% 
  purrr::pwalk(function(domain, ix, n) {
    questions[questions$domain == domain, ] %>% 
      dplyr::mutate(rown = row_number(), ix = ix*2 - 1, n = n*2) %>% 
      dplyr::group_by(rown) %>% tidyr::nest() %>% dplyr::pull(data) %>% 
      purrr::walk(function(x) make_slide(x))
    capabilities[capabilities$domain == domain, ] %>% 
      dplyr::mutate(rown = row_number(), ix = ix*2, n = n*2) %>% 
      dplyr::group_by(rown) %>% tidyr::nest() %>% dplyr::pull(data) %>% 
      purrr::walk(function(x) make_capabilty_slide(x))
})