Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
source("manifesto_functions.R")
######################
### Naive Escape Rates
MakeBetaGraph(10, 100, xlab = "Rate", ylab = "Strength",
tlab = "January Escape Rates",
slab = "Mean and Highest Density Interval", xadj = .001)
###################################
### Coding Up Bayesian Escape Rates
### Step 1: SIMULATE DATA ###
# First call takes ~ 4 mins and saves to disc
group_count <- 500
record_count <- 50000
dt <- GetLargeVulnGroups(TRUE,group_count)
# Extract samples as years
dt_year_one <- dt[sample(nrow(dt), record_count, replace = FALSE), ]
dt_year_two <- dt[sample(nrow(dt), record_count, replace = FALSE), ]
dt_year_three <- dt[sample(nrow(dt), record_count, replace = FALSE), ]
### Step 2: GET TIDY DATA ###
year_one_group <- GetEscapeGroups(dt_year_one, group_count)
year_two_group <- GetEscapeGroups(dt_year_two, group_count)
year_three_group <- GetEscapeGroups(dt_year_three, group_count)
# Put years into one data frame
group_vals <- AddEscapeDF(year_one_group, year_two_group)
group_vals <- AddEscapeDF(group_vals, year_three_group)
### Step 3: EMPIRICAL BAYES ENRICHMENT ###
# Get Basic Average
group_vals <- group_vals %>%
mutate(escape_avg = prod_vuln / total_vulns)
# Get Long Run Groups That started in Q1
vgroups <- group_vals %>%
filter(total_weeks >= 40)
# Get the Maximum Likelihood Estimation for Priors
mle_vals <- GetBurnMLE(vgroups$prod_vuln, vgroups$dev_vuln )
# Use MLE's to set alpha and beta prior vars
alpha <- mle_vals[[1]]
beta <- mle_vals[[2]]
# Beta average per group
group_vals <- group_vals %>%
mutate(emp_bayes_avg =
(prod_vuln + alpha) / (total_vulns + alpha + beta))
# Posterior update for each group
group_vals <- group_vals %>%
mutate(alpha_update = alpha + prod_vuln,
beta_update = beta + dev_vuln)
# Confidence intervals for each group
group_vals <- group_vals %>%
mutate(low_ci = qbeta(.025, alpha_update, beta_update),
high_ci = qbeta(.975, alpha_update, beta_update))
### Step 4: VISUALIZE DATA ###
MakeBetaGraph(alpha, beta,"Empirical Bayes 'Prior' Escape Rate","Strength",
paste0("Escape Rates Derived From: ",sum(vgroups$total_vulns),
" Vulnerabilities"),
paste0("Across ", nrow(vgroups),
" groups supporting externally facing and audited services"),
xadj = .001)
# Get sample data for graph
short_year <- group_vals %>% filter(total_weeks <= 25) %>% head(25)
full_year <- group_vals %>% filter(total_weeks == max(total_weeks)) %>%
head(20)
# Merge sample data into one df
example_df <- bind_rows(short_year, full_year)
# Make graph that makes empirical bayes impact apparent
MakeProportionChart(df_val = example_df, kpis=c(.05,.1,.2))
####################################
### Escape Rates In 10 Lines Of Code
# Raw data
group_vals <- tibble(group = 1:100,
prod_vuln = sample(10:70,100, replace = TRUE),
dev_vuln = sample(70:300,100, replace = TRUE),
total_vulns = prod_vuln + dev_vuln)
# Groups with over 300 vulns
vgroups <- group_vals %>% filter(total_vulns > 300)
# Get the Maximum Likelihood Estimation
mle_vals <- GetBurnMLE(vgroups$prod_vuln, vgroups$dev_vuln )
# Use MLE's to set alpha and beta vars
alpha <- mle_vals[[1]]
beta <- mle_vals[[2]]
# Bayesian Average Update All Groups
group_vals <- group_vals %>%
mutate(emp_bayes_avg =
(prod_vuln + alpha) / (total_vulns + alpha + beta))
# Posterior Update
group_vals <- group_vals %>%
mutate(alpha_update = alpha + prod_vuln,
beta_update = beta + dev_vuln)
# Credible Intervals
group_vals <- group_vals %>%
mutate(low_ci = qbeta(.025, alpha_update, beta_update),
high_ci = qbeta(.975, alpha_update, beta_update))
# Basic Average
group_vals <- group_vals %>%
mutate(escape_avg = prod_vuln / total_vulns)
# Final Chart
MakeProportionChart(df_val = group_vals)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment