---
title: "Risk Scenario Explorer"
author: "Evaluator toolkit"
output:
  flexdashboard::flex_dashboard:
    vertical-layout: fill
    favicon: img/evaluator_logo_48px.png
    logo: img/evaluator_logo_48px.png
    navbar:
    - align: right
      href: https://evaluator.severski.net
      title: About
    orientation: columns
    css: styles/html-styles.css
runtime: shiny
params:
  input_directory: "~/evaluator/inputs"
  results_directory: "~/evaluator/results"
---

```{r setup, include=FALSE}
# Load packages and initialize data here
library(scales)
library(viridis)
library(ggplot2)
library(dplyr)
library(tibble)
library(evaluator)
library(extrafont)
input_directory <- params$input_directory
results_directory <- params$results_directory
```

```{r load_data, include=FALSE}
dat <- load_data(input_directory, results_directory)
simulation_results <- dat$simulation_results
scenario_summary <- dat$scenario_summary
domain_summary <- dat$domain_summary
domains <- dat$domains
mappings <- dat$mappings
capabilities <-  dat$capabilities
risk_tolerances <-  dat$risk_tolerances
risk_tolerance <- dat$risk_tolerance
scenario_outliers <-  dat$scenario_outliers
scenarios <- dat$scenarios
```

```{r helper_functions, include=FALSE}
# determine the correct base font family to use
basefont <- get_base_fontfamily()

mappings <- mappings

# for values stored as full precentages, divide by 100 and pretty format 
# with scales::percent()
custom_percent <- function(x) {
    x <- as.integer(x)
    return(percent(x/100 %>% round(digits = 2)))
}

get_loss_table <- function(tid) {
  scenario_data <- simulation_results[simulation_results$scenario_id == tid, ]
  loss_table <- tibble::tibble(Category = c("Loss Events / Year", "Loss Magnitude", 
                                            "Total Loss Exposure"),
                               Minimum = c(min(scenario_data$loss_events), 
                                           min(scenario_data$sle_min) %>% dollar,
                                           min(scenario_data$ale) %>% dollar),
                                   Mean = c(mean(scenario_data$loss_events, na.rm = TRUE), 
                                            mean(scenario_data$sle_mean, na.rm = TRUE) %>% dollar,
                                            mean(scenario_data$ale, na.rm = TRUE) %>% dollar),
                                   Mode = c(statip::mfv(scenario_data$loss_events)[1], 
                                            statip::mfv(scenario_data$sle_median)[1] %>% as.numeric %>% dollar,
                                            statip::mfv(scenario_data$ale)[1] %>% as.numeric %>% dollar),
                                   Maximum = c(max(scenario_data$loss_events), 
                                       max(scenario_data$sle_max) %>% dollar,
                                       max(scenario_data$ale) %>% dollar)
  )
  return(loss_table)
}

get_scenario_data <- function(sid){
  scenario_data <- simulation_results %>% filter(scenario_id == sid)
  return(scenario_data)
}

get_scenario_id <- function(x){
  scenario_id <- as.numeric(strsplit(x, " - ")[[1]][2])
  return(scenario_id)
}

get_summary_table <- reactive({
  #filter_input <- get_threat_id(input$input_threat)
  summary_data <- scenario_summary %>% filter(scenario_id == 
                                              get_scenario_id(input$input_scenario))
  # add pretty formatting
  summary_data <- mutate_at(summary_data, .funs = funs(dollar), 
                            .vars = vars(ale_median, ale_max, ale_var, sle_mean, 
                            sle_median, sle_max, sle_min)) %>% 
     mutate(mean_tc_exceedance = custom_percent(mean_tc_exceedance)) %>% 
     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)) %>% 
    tidyr::gather(key = "Parameter", value = "Value")
  return(summary_data)
})

get_threat_table <- reactive({
  #filter_input <- get_threat_id(input$input_threat)
  threat_data <- scenarios %>%
    filter(scenario_id == get_scenario_id(input$input_scenario)) %>% 
    select(scenario_id, tef, tc) %>% 
    tidyr::gather(type, label, c(tef, tc)) %>% 
    left_join(mappings, by = c("label" = "label", "type" = "type")) %>% 
    tidyr::gather(param, value, c(l:conf)) %>% 
    mutate(value = ifelse(type == "tef" | param == "conf", 
                          as.integer(value), custom_percent(value))) %>% 
    tidyr::spread(param, value) %>% 
    mutate(type = ifelse(type == "tc", "Capability", "Frequency"))
  threat_data <- threat_data %>% select(Type = type, Low = l, "Most Likely" = ml,
                                        "High" = h, Confidence = conf)
  return(threat_data)
})

get_control_table <- reactive({
  
  #filter_input <- get_threat_id(input$input_threat)
  control_list <- scenarios %>%
    filter(scenario_id == get_scenario_id(input$input_scenario)) %>% 
    select(controls) %>% stringi::stri_split_fixed(", ") %>% unlist()
  control_data <- capabilities[capabilities$id %in% as.numeric(control_list), "diff"] %>% 
    rename(label = diff) %>% 
    mutate(label = as.character(label), type = "diff") %>% 
    left_join(mappings, by = c("label" = "label", "type" = "type"))
  
  # format percentages
  control_data <- mutate_at(control_data, vars(-conf), funs(custom_percent)) %>%
    mutate(conf = as.integer(conf))
  control_data$control <- as.numeric(control_list)
  # add control description
  control_data <- left_join(control_data, capabilities, 
                            by = c("control" = "id")) %>% 
    select(Control = capability, Low = l, "Most Likely" = ml, High = h, 
           Confidence = conf)
  return(control_data)
})

get_loss_distribution_table <- reactive({
  #filter_input <- get_threat_id(input$input_threat)
  loss_list <- scenarios %>% 
    filter(scenario_id == get_scenario_id(input$input_scenario)) %>% 
    mutate(label = as.character(lm), type = "lm") %>% 
    left_join(mappings, by = c("label" = "label", "type" = "type")) %>% 
    mutate_at(vars(l, ml, h), funs(dollar)) %>% 
    select(Low = l, "Most Likely" = ml, "High" = h, "Confidence" = conf)
  return(loss_list)
})
```

All Scenarios {data-icon="fa-users" data-orientation=rows}
=======================================================================

Loss Distribution Scatterplot
-----------------------------------------------------------------------

### Loss Distributions Across All Threat Scenarios {.no-title}

```{r show_all_boxplot, fig.height=4}
shiny::renderPlot({
  gg <- ggplot(simulation_results, aes(x = scenario_id, y = ale))
  gg <- gg + scale_y_continuous(label = dollar_millions)
  gg <- gg + labs(x = "Risk Scenario", y = "Annual Loss")
  gg <- gg + stat_boxplot(geom = 'errorbar', width = 0.5)
  gg <- gg + geom_boxplot(fill = viridis(1), alpha = 1/3)
  gg <- gg + facet_grid(~ domain_id, scales = "free_x", space = "free_x", 
                        switch = "x")
  gg <- gg + theme_evaluator(base_family = basefont)
  gg <- gg + theme(panel.grid.major = element_blank())
  gg <- gg + theme(panel.grid.minor = element_blank())
  print(gg)
})
```

All Scenarios Data Table
-----------------------------------------------------------------------

### All Risk Scenarios

```{r show_all_table}
DT::renderDataTable({
 dat <- mutate_at(scenario_summary, .funs = funs(dollar), 
                  .vars = vars(starts_with("ale"), starts_with("sle"))) %>% 
   mutate(loss_events_mean = comma(loss_events_mean)) %>% 
   mutate(mean_tc_exceedance = custom_percent(mean_tc_exceedance)) %>% 
   mutate(mean_vuln = percent(mean_vuln))
 names(dat) <- stringi::stri_trans_totitle(names(dat))
 DT::datatable(dat, rownames = FALSE,
               options = list( 
                 scrollX = TRUE,
                 sScrollY = "300px",
                 fixedColumns = list(leftColumns = 2)), 
               extensions = c("Scroller", "FixedColumns"))
})
```

Individual Risk Scenarios {data-icon="fa-user"}
=======================================================================


Input Sidebar {.sidebar data-width=500}
-----------------------------------------------------------------------
Select a specific risk scenario for detailed analysis.

```{r inputs}
scenario_input <- paste(scenario_summary$domain_id, "-",
                        scenario_summary$scenario_id)
selectInput("input_scenario", "Risk Scenario", scenario_input)
```

### Scenario Description
```{r scenario_details}
shiny::renderText({
  scenarios[scenarios$scenario_id == get_scenario_id(input$input_scenario), 
                "scenario"][[1]]
})
```


#### Threat Profile

```{r threat_profile}
shiny::renderText({
  paste("Community:", scenarios[scenarios$scenario_id == get_scenario_id(input$input_scenario),
                               "tcomm"])
})
renderTable({
  get_threat_table()
}, include.rownames = FALSE, width=500)
```

#### Controls

```{r controls}
shiny::renderTable({
  get_control_table()
}, include.rownames = FALSE, width=500)
```

#### Loss Magnitude

```{r loss_magnitude}
shiny::renderTable({
  get_loss_distribution_table()
}, include.rownames = FALSE, width=500)
```

> Simulation data generated on `r format(attr(simulation_results, "generated_on"), 
"%b %d, %Y %H:%M:%S")`

Main Display {data-width=450}
-----------------------------------------------------------------------

### Loss Scatterplot

```{r show_scatterplot}
shiny::renderPlot({
  
  # get scenario_id via input$bins from ui.R
  scenario_id <- get_scenario_id(input$input_scenario)
  
  # draw the scatterplot for this threat scenario
  generate_scatterplot(simulation_results, scenario_id)
})
```

### Value at Risk

```{r var_values}
flexdashboard::renderValueBox({
  scenario_id <- get_scenario_id(input$input_scenario)
  scenario_data <- get_scenario_data(scenario_id)
  dat <- quantile(scenario_data$ale, 0.95, na.rm = TRUE)
  if(is.na(dat)) dat <- 0
  flexdashboard::valueBox(dollar(dat),
           caption = "Value at Risk", icon = "fa-pencil", 
           color = ifelse(dat >= risk_tolerance[["high"]], "danger", ifelse(
             dat >= risk_tolerance[["medium"]], "warning", "success")))
})
```

### Vulnerability

```{r vuln_value}
flexdashboard::renderValueBox({
  scenario_id <- get_scenario_id(input$input_scenario)
  dat <- scenario_summary[scenario_summary$scenario_id == scenario_id,
                          "mean_vuln"]$mean_vuln
  if(is.na(dat)) dat <- 0
  flexdashboard::valueBox(percent(dat),
           caption = "Vulnerability", icon = "ion-nuclear",
           color = ifelse(dat >= .75, "danger", ifelse(
             dat >= .50, "warning", "success")))
})
```

Detailed Display {data-width=350}
-----------------------------------------------------------------------

### Summary Data

```{r show_summary}
shiny::renderTable({
  get_summary_table()
}, include.rownames = FALSE)
```

### Loss Table

```{r show_loss_table}
loss_table <- reactive({
  scenario_id <- get_scenario_id(input$input_scenario)
  get_loss_table(scenario_id)
})

shiny::renderTable({loss_table()}, include.rownames = FALSE)
```
