Scenarios and Capabilities

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))
})

background-image: url('img/espresso_machine.jpg') background-size: cover

.top-white-text[The End]

Thank you for your time!



Try the collector package in your browser

Any scripts or data that you put into this service are public.

collector documentation built on Feb. 22, 2020, 1:11 a.m.