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.05
we 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"))