OpenFAIR Example

In evaluator: Quantified Risk Assessment Toolkit

library(dplyr)
library(extrafont)
library(evaluator)
library(flexdashboard)
library(ggplot2)
library(mc2d)
library(scales)
library(shiny)

# determine the proper base font to use for graphs
basefont <- get_base_fontfamily()

values <- reactiveValues() 

values$iterations <- 1000

observeEvent(input$runmodel, {

    values$iterations <- input$iterations

    TEFestimate <- list(func = "mc2d::rpert", min = input$tefl, 
                        mode = input$tefml, max = input$tefh,
                        shape = input$tefconf)
    TCestimate <- list(func = "mc2d::rpert", min = input$tcapl, 
                       mode = input$tcapml, max = input$tcaph,
                       shape = input$tcapconf)
    DIFFestimate <- list(list(func = "mc2d::rpert", min = input$csl, 
                              mode = input$csml, max = input$csh, 
                              shape = input$csconf))
  LMestimate <- list(func = "mc2d::rpert", min = input$lml, 
                     mode = input$lmml, max = input$lmh, 
                     shape = input$lmconf)
  single_scen <- tidyrisk_scenario(
    tef_params = TEFestimate, 
    tc_params = TCestimate, 
    diff_params = DIFFestimate, 
    lm_params = LMestimate)

  values$simulation_result <- run_simulation(single_scen, iterations = values$iterations)

})

Scenario Parameters {.sidebar data-width=400}

TEF

Frequency of action (events per year) by the actor.

fillRow(height = 50,
  numericInput("tefl", "Min:", 10, min = 0, max = 100),
  numericInput("tefml", "ML:", 20, min = 0, max = 100),
  numericInput("tefh", "Max:", 100, min = 0, max = 100),
  numericInput("tefconf", "Shape:", 1, min = 1, max = 5)
)

TC

Capabilities (in %) of the threat actor.

fillRow(height = 50,
  numericInput("tcapl", "Min:", .20, min = 0, max = 1, step = 0.01),
  numericInput("tcapml", "ML:", .30, min = 0, max = 1, step = 0.01),
  numericInput("tcaph", "Max:", .70, min = 0, max = 1, step = 0.01),
  numericInput("tcapconf", "Shape:", 1, min = 1, max = 5)
)

DIFF

Difficulty (in %) presented by the controls.

fillRow(height = 50,
  numericInput("csl", "Min:", .40, min = 0, max = 1, step = 0.01),
  numericInput("csml", "ML:", .50, min = 0, max = 1, step = 0.01),
  numericInput("csh", "Max:", .60, min = 0, max = 1, step = 0.01),
  numericInput("csconf", "Shape:", 2, min = 1, max = 5)
)

LM

Total losses (in $) for a single adverse event.

fillRow(height = 50,
  numericInput("lml", "Min:", 100, min = 0, step = 0.01),
  numericInput("lmml", "ML:", 500, min = 0, step = 0.01),
  numericInput("lmh", "Max:", 10000, min = 0, step = 0.01),
  numericInput("lmconf", "Shape:", 1, min = 1, max = 5)
)

Params {.no-title}

numericInput("iterations", "# Iterations:", 100, min = 10, max = 10000, 
             step = 100)
actionButton("runmodel", "Run Model")

Results {.tabset data-width=600}

Loss Distribution

renderPlot({
    if (input$runmodel != 0) {
        gg <- ggplot(values$simulation_result, aes(x = ale))
        gg <- gg + geom_histogram(binwidth = diff(range(values$simulation_result$ale) / 50), 
                                  aes(y = ..density..), 
                                  color = "black", 
                                  fill = "white")
        gg <- gg + geom_density(fill = "steelblue", alpha = 1/3)
        gg <- gg + scale_x_continuous(labels = comma)
        gg <- gg + labs(x = "Annual Expected Losses")
        gg <- gg + theme_evaluator(base_family = basefont)
        print(gg)
    }
})

Details

Loss Summary {.no-title}

renderPrint({
  if (input$runmodel != 0) {
    print(summary(values$simulation_result$ale))
    }
})

95% Value at Risk {.no-title}

renderText({
  if (input$runmodel != 0) {
    VAR <- summarize_scenario(values$simulation_result) %>% pull(ale_var)
    print(paste0("Losses at 95th percentile are $", 
                 format(VAR, nsmall = 2, big.mark = ",")
                 ))
    }
})

Scenario Result Summary {.no-title}

renderTable({
  if (input$runmodel != 0) {
    summarize_scenario(values$simulation_result)
    }
})

Loss Samples {data-height=200}

DT::renderDataTable(
  if (input$runmodel != 0) {
    dat <- data.frame(Losses = values$simulation_result$ale) %>% 
      arrange(desc(Losses)) %>% 
      transmute(Losses = scales::dollar(Losses))
    DT::datatable(dat, rownames = FALSE)
  }
)

Event Distribution

renderPlot({
  if (input$runmodel != 0) {
    VULNsamples <- values$simulation_result %>% 
       summarize(loss_events = sum(loss_events, na.rm = TRUE),
                 avoided_events = sum(threat_events, na.rm = TRUE) - loss_events) %>%  
      tidyr::gather("key", "value", loss_events, avoided_events) %>% 
      mutate(value = value / sum(value, na.rm = TRUE))
    gg <- ggplot(VULNsamples, aes(x = key, y = value)) + 
      geom_col(fill = "steelblue") +
      labs(x = "Event Type", y = "Percent") + 
      scale_y_continuous(labels = scales::percent) +
      theme_evaluator(base_family = evaluator::get_base_fontfamily())
    print(gg)
  }
})

evaluator documentation built on July 6, 2021, 9:06 a.m.