Sample narrative section.

---
title: "Risk Dashboard"
author: "Evaluator toolkit"
output:
  flexdashboard::flex_dashboard:
    css: "html-styles.css"
    favicon: "img/evaluator_hex_48px.png"
    logo: "img/evaluator_hex_48px.png"
    navbar:
    - align: right
      href: https://evaluator.tidyrisk.org
      title: About
    orientation: row
    source_code: embed
    vertical_layout: scroll
  pdf_document: default
params:
  input_directory: "~/evaluator/inputs"
  results_directory: "~/evaluator/results"
---

Sample narrative section.

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE) 
library(evaluator)
library(dplyr)

input_directory <- params$input_directory
results_directory <- params$results_directory
```

```{r load_data, echo = FALSE, message = FALSE}
dat <- read_quantitative_inputs(input_directory)

simulation_results <- readRDS(file.path(results_directory, "simulation_results.rds"))

scenario_summary <- mutate(simulation_results, summary = map(results, summarize_scenario)) 
scenario_summary <- unnest(scenario_summary, summary, .drop = TRUE)

scenario_outliers <- identify_outliers(scenario_summary) %>% 
  filter(outlier == TRUE) %>% pull(scenario_id)

iteration_summary <- summarize_iterations(simulation_results$results)

domains <- dat$domains
domain_summary <- summarize_domains(simulation_results)
domain_summary <- domain_summary %>% left_join(domains, by = "domain_id")
simulation_results_unnested <- unnest(simulation_results, results) %>% 
  mutate(outlier = scenario_id %in% scenario_outliers)

risk_tolerances <- dat$risk_tolerances
scenarios <- dat$quantitative_scenarios
```

```{r font_detection}
basefont <- get_base_fontfamily()
```

```{r calculate_max_losses}
max_loss <- calculate_max_losses(simulation_results, scenario_outliers)
```

Risk Dashboard
=======================================================================

Value Boxes
-----------------------------------------------------------------------

### Aggregate Risk

```{r var_valuebox}
agg_risk <- quantile(iteration_summary$ale_sum, 0.95)
flexdashboard::valueBox(dollar_millions(agg_risk), icon = "glyphicon-eye-open",
         caption = "Aggregate 95% Value at Risk",
         color = ifelse(agg_risk > risk_tolerances[risk_tolerances$level == "high", "amount"], "danger", ifelse(
           agg_risk > risk_tolerances[risk_tolerances$level == "medium", "amount"], "warning", "info")))
```

### Minimum Expected Annual Losses

```{r ale_exceedance_valuebox}
loss_exceedance <- min(iteration_summary$ale_sum)
flexdashboard::valueBox(dollar_millions(loss_exceedance), icon = "glyphicon-warning-sign",
         caption = "Minimum Expected Annual Losses",
         color = ifelse(
           loss_exceedance > risk_tolerances[risk_tolerances$level == "high", "amount"], "danger", 
           ifelse(loss_exceedance > risk_tolerances[risk_tolerances$level == "medium", "amount"], 
                  "warning", "info")))
```

### Expected Loss Events Per Year

```{r median_aggregate_loss_events}
loss_events <- median(iteration_summary$loss_events)
flexdashboard::valueBox(scales::comma(loss_events), icon = "glyphicon-flag",
         caption = "Expected Annual Loss Events",
         color = "info")
```

Domain Summary {data-height=150}
-----------------------------------------------------------------------

### Domain Heatmap {.no-padding}

```{r display, fig.width=15, fig.height=1}
gg <- generate_heatmap(domain_summary)
# modify the base plot for displaying on the dashboard
gg <- gg + labs(title = NULL, caption = NULL)
gg <- gg + theme(legend.position = "right")
gg <- gg + viridis::scale_fill_viridis(guide = FALSE, end = 0.75, option = "D")
gg <- gg + guides(fill = FALSE)
gg
```

Scenario Results {.data-height=250}
-----------------------------------------------------------------------

### Loss Ranges for Top 10 Scenarios {.no-padding}

```{r loss_across_scenarios, fig.width=10, fig.height=3}
# helper function to roll up scenarios that aren't in the top_n
sum_bottom_n <- function(dat, top_n=10, sortby="max_ale") {
  cluster_hack <- max(dat$cluster_id)
  full_label <- "full_label"
  sortby <- rlang::enquo(sortby)
  
  # assign a flag on outliers
  keep_nokeep <- dat %>% group_by_at(.vars = full_label) %>% 
    summarise(foo = max(!!sortby)) %>% 
    mutate(keep = ifelse(row_number() <= top_n, TRUE, FALSE)) %>% 
    select(-foo)
  
  # sum up the outliers
  others <- filter(keep_nokeep, keep == FALSE) %>% 
    left_join(dat, by = "full_label") %>% 
    group_by(iteration) %>% summarize(ale = max(ale), scenario_count = n()) %>% 
    mutate(full_label = paste0("others (", scenario_count, ")")) %>% 
    mutate(cluster_id = cluster_hack)
  
  # combine the outliers with the top_n items
  union_all(filter(keep_nokeep, keep == TRUE) %>% 
              left_join(dat, by = "full_label"), others)
}

# assign the text label to scenarios and order
simulation_results %>% unnest(results) %>% 
  mutate(full_label = paste0(domain_id, " - ", scenario_id)) %>% 
  arrange(domain_id, scenario_id) -> dat 

# identify the top 10 scenarios by VaR
top_n_scenarios <- group_by(dat, full_label) %>% 
  summarize(ale_var = quantile(ale, 0.95)) %>% 
  filter(row_number(desc(ale_var)) <= 10 ) %>% 
  .[["full_label"]]

# remove no loss scenarios, enhance, and cluster
dat <- group_by(dat, full_label) %>% filter(sum(ale) != 0) %>% 
  mutate(var = quantile(ale, 0.95), max_ale = max(ale), ale_median = median(ale)) %>% 
  ungroup %>% 
  mutate(cluster_id = kmeans(max_ale, 3)$cluster)

# assign labels to the clusters
text_labels <- c("High", "Medium", "Low")
cluster_descriptions <- group_by(dat, cluster_id, full_label) %>% 
  summarize(ale = max(max_ale)) %>% 
  summarise(highest_ale = max(ale), n = n()) %>% 
  arrange(desc(highest_ale)) %>% 
  mutate(cluster_labels = factor(text_labels, levels = text_labels),
         top_n = min(last(n), n))

# roll up on a per-cluster basis, addng descriptive text to the cluster
summed_dat <- group_by(dat, cluster_id) %>% 
  left_join(cluster_descriptions, by = "cluster_id") %>% 
  do(sum_bottom_n(., top_n = max(.$top_n))) %>% 
  select(-c(cluster_labels, n, top_n, highest_ale)) %>% 
  left_join(cluster_descriptions, by = "cluster_id") %>% 
  ungroup

summed_dat <- group_by(summed_dat, full_label) %>% mutate(ale_median = median(ale))
  
# slimmed down alternative view of the dataset
minimal_dat <- filter(dat, full_label %in% top_n_scenarios, ale != 0) %>% 
  group_by(full_label) %>% 
  mutate(ale_median = median(ale)) %>% ungroup %>% 
  mutate(full_label = forcats::fct_reorder(full_label, ale_median))

# plot!
gg <- ggplot(minimal_dat, aes(x = forcats::fct_reorder(full_label, desc(ale_median)), y = ale + 1))

gg <- gg + stat_boxplot(geom = 'errorbar', width = 0.4)
gg <- gg + geom_boxplot(fill = viridis::viridis(1), coef = 0, alpha = 1/3, outlier.shape = NA)
gg <- gg + viridis::scale_fill_viridis(discrete = TRUE)
gg <- gg + scale_y_log10(label = scales::dollar) + annotation_logticks(sides = "l")
gg <- gg + guides(fill = FALSE)
gg <- gg + labs(x = NULL, y = "Annual\nLoss") 
gg <- gg + theme_evaluator(base_family = basefont)
gg <- gg + theme(panel.grid.major.x = element_line())
gg <- gg + theme(panel.grid.minor.x = element_line(color = "grey92"))
gg <- gg + theme(axis.title.y = element_text(angle = 0, vjust = 0.5, hjust = 0))
gg
```


Details
-----------------------------------------------------------------------

### Control Gaps/Surplus by Domain

```{r control_table}
select(domain_summary, domain, mean_vuln, mean_tc_exceedance, 
       mean_diff_exceedance) %>% 
  mutate_at(vars(starts_with("mean_")), scales::percent) %>% 
  rename("Domain" = domain, 
         "Succesful Threat Events" = mean_vuln,
         "Control Gap" = mean_tc_exceedance,
         "Surplus Control Strength" = mean_diff_exceedance) %>% 
  pander::pander(justify = c("left", "right", "right", "right"), 
         split.cells = c(35, rep(10, 3)))
```

### Top Risk Scenarios

```{r top_risk_scenarios}
top_n(scenario_summary, 5, ale_var) %>% 
  arrange(desc(ale_var)) %>% 
  left_join(scenarios, by = c("scenario_id" = "scenario_id", 
                              "domain_id" = "domain_id")) %>%
  mutate(ale_var = scales::dollar(ale_var), ale_median = scales::dollar(ale_median),
         full_label = paste(domain_id, scenario_id, sep = " - ")) %>% 
  select("ID" = full_label, Scenario = scenario_description, 
         "Median Annual Loss" = ale_median, "Value at Risk" = ale_var) %>% 
  pander::pander(justify = c(rep("left", 2), rep("right", 2)), 
                 split.cells = c(12, rep(30, 3)))
```