The purpose of this report is to walk through the various allocation procedures utilized in the shiny application.
In order to provide knowledgeable insights from this report, we have supplied reasonable inputs that mimic the user-driven aspects of the allocation procedures.
The first step is to ingest all of the various user-driven inputs and demo-data to form a dataset to perform the allocation with.
Specify various ‘user-defined’ inputs:
# specify experience period based on loss run
min_year <- min(loss_run$year)
max_year <- max(loss_run$year)
experience_period <- c(min_year:max_year)
experience_period_display <- paste0(
lubridate::ymd(paste0(min_year, "-01-01")) %>% format("%B %d, %Y"), " to ",
lubridate::ymd(paste0(max_year, "-12-31")) %>% format("%B %d, %Y")
)
# specify percent change capping threshold
cap_threshold <- .25
# A 5% budget guidance increase factor
budget_guidance_percent <- 0.05we need to extract the costs to be allocated in the model, specifically:
To do this, I utilize an internal, custom utility function
extract_costs_for_allocation().
The resulting Costs for Allocation are:
# extract costs from renewal cost table
costs <- extract_costs(renewal_costs)
# derive current and prior overall rates and percent change
curr_rate <- costs$risk_transfer / sum(sov$tiv)
prior_rate <- sum(priors$prior_risk_transfer_premium) /
sum(priors$prior_tiv)
pct_change <- (curr_rate / prior_rate) - 1
tibble::as_tibble(costs) %>%
as.matrix() %>%
t() %>%
as.data.frame() %>%
tibble::rownames_to_column(var = "Cost Type") %>%
dplyr::rename("Dollar Amount" = V1) %>%
tibble::as_tibble() %>%
kkable(currency_cols = "Dollar Amount",
proper_cols = "Cost Type",
caption = "Extracted Costs for Allocation:")This step involves taking the user-defined relativity’s and multiplying them by the initial Total Insured Values defined in the Schedule of Values (SOV).
Specifically, we take the user-input Relativity Table and
apply a custom utility function
derive_relativity_adjusted_tivs() to derive our final
relativity adjusted TIVs.
First, lets look at the input relativities:
rel_tables <- list(bu_rels, combustible_rels, sprinkler_tier_rels) %>%
purrr::set_names(c("Business Unit Relativity",
"AOP Combustible Relativity",
"AOP Sprinkler Tier Relativity")) %>%
purrr::map(apply_labels, dict = dictionary, dataset_name = "rels") %>%
purrr::map(tibble::as_tibble)
purrr::map2(rel_tables, names(rel_tables), function(x, y) {
kkable(data = x, caption = y, col_names = NULL, digits = 3, add_digits = TRUE)
})Relativities are then applied directly to each entity’s TIV. For each relativity type, a separate relativity-adjusted TIV is calculated and used as required in eithe catastrophy allocation, All Other Peril allocation, or terrorism allocation.
rels_list <- list(
relativity_data = list(
bu_rels[, c(1, 2)], bu_rels[, c(1, 3)], bu_rels[, c(1, 4)], bu_rels[, c(1, 5)],
bu_rels[, c(1, 6)], sprinkler_tier_rels, combustible_rels
),
coverage = list(
"aop", "cat_eq", "cat_wind", "cat_flood", "terrorism", "aop", "aop"
),
sov_linker = list(
"bu", "bu", "bu", "bu", "bu", "aop_sprinkler_tier", "aop_combustible"
)
)
rel_adjusted_tivs <- ingest_relativities(rels_list, sov = sov)
kkable(head(rel_adjusted_tivs),
proper_cols = "entity_id",
currency_cols = names(rel_adjusted_tivs[2:ncol(rel_adjusted_tivs)]))For entities that have experienced claims, the client may wish to increase their allocated premium. The rules for doing so are limited in this application to: applying a % surcharge to the TIV for each claim made by the entity in a certain time period, or adding a $ surcharge to the allocated premium (at this stage in the calculation) for each claim made in a certain time period.
The demo data, count_buckets, sets out a typical
specification for such functionality.
count_buckets %>%
select(name:dollar_surcharge) %>%
kkable(
col_names = c("Label", "Minimum", "Maximum", "Percent Surcharge", "Dollar Surcharge"),
caption = "User-Defined Claim Count Bucket Surcharges",
currency_cols = c("min", "max", "dollar_surcharge"),
percent_cols = c("percent_surcharge")
)Here, count_buckets are applied to the loss run ready
for surcharging the premiums calculated in the main part of the
model:
entity_loss_data <- entity_loss_summary(loss_run, count_buckets, experience_period)
col_names <- c("Entity ID",
count_buckets$name,
"Total Counts", "Total Incurred")
kkable(entity_loss_data %>%
# dplyr::mutate(entity_id = toproper(entity_id)) %>%
dplyr::arrange(dplyr::desc(total_incurred)) %>%
head(10),
col_names = col_names,
proper_cols = "entity_id",
currency_cols = length(col_names),
caption = "Summarized Loss Data by Entity (Top 10 Entities by Total Incurred)")The steps involved are:
rates to relativity_adjusted_tivs
and also to priors (to simultaneously obtain an allocation
of prior premiums)entity_loss_data to surcharge the resulting
premiums pased on count_buckets and the loss run
experiencecosts
budget_guidance_percent to prior premium
rates to perform this allocation scenariothreshold <- 0.25), and if the prior premium allocated
for a particular entity was 1m USD, then roughly the current premium
allocation would be between 750k USD, and 1.25m USD.
# merge entity data (sov, rel adjusted tivs, loss data, market and model rates,
# and priors)
allocation_data <- merge_entity_data(
sov,
rel_adjusted_tivs,
entity_loss_data,
rates,
priors
) %>%
# perform initial preliminary allocation (CAT first, back into AOP, terror)
# this is uncapped. before surcharges, and excluding expenses
preliminary_allocation(costs, budget_guidance_percent) %>%
# apply surcharges
apply_surcharges(count_buckets) %>%
# adjust column names for apply threshold function
# TODO: add arguments to apply threshold functions for specifying column
# so don't have to add this step.
mutate(
prior_allocated = prior_risk_transfer_premium,
prior_allocated_rate = prior_allocated / prior_tiv,
uncapped_allocated = surcharged_premium
) %>%
# apply capping using a default 25% threshold
# TODO: add argument to apply threshold for whether or not to net the
# total pct change or not - currently it does this
apply_threshold(
total_pct_chg = pct_change,
threshold = cap_threshold
) %>%
# final rebalancing and allocate expenses
allocate_expenses(costs, weight_variable = "tiv")And the result is:
# declutter results and output
allocation_data %>%
mutate(current_allocated_rate = rebalanced_allocated / tiv) %>% # excl expense
select(
entity_id,
tiv,
prior_tiv,
aop_adj_tiv:terrorism_adj_tiv,
model_aop_rate,
model_cat_eq_rate,
model_cat_wind_rate,
model_cat_flood_rate,
model_terrorism_rate,
prior_risk_transfer_premium,
preliminary_model_premium = total_model_premium_adj,
surcharge,
surcharged_premium,
prior_allocated,
prior_allocated_rate,
uncapped_allocated,
capped_allocated = allocated,
final_allocated = rebalanced_allocated,
current_allocated_rate,
rate_percent_change = capped_rate_percent_change,
allocated_expenses,
final_allocated_w_expense
) %>%
kkable()propalloc comes with functionality to split out the
effects of each of the stages of premium allocation as they contribute
to its change between prior and current premium allocations. This
function uses argument filter_vector to show such a split
for a subset of entities if desired.
driver_summary <- prepare_driver_summary(allocation_data, filter_vector = c())
driver_summary_bu_b_only <- prepare_driver_summary(allocation_data, filter_vector = c(bu = "bu_b"))