inst/doc/pricing-workflow-building-blocks.R

In insurancerating: Actuarial Tools for Insurance Pricing Models

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## -----------------------------------------------------------------------------
library(insurancerating)

## -----------------------------------------------------------------------------
fa <- factor_analysis(
  MTPL,
  risk_factors = "zip",
  claim_count = "nclaims",
  claim_amount = "amount",
  exposure = "exposure"
)

head(fa)

## -----------------------------------------------------------------------------
outlier_histogram(
  MTPL2,
  x = "premium",
  upper = 100,
  density = FALSE
)

## ----eval = FALSE-------------------------------------------------------------
# portfolio <- data.frame(
#   policy_id = 1:10,
#   sector = rep(c("Industry", "Retail"), each = 5),
#   claim_count = c(0, 1, 1, 1, 1, 0, 1, 1, 1, 1),
#   claim_amount = c(
#     0, 25000, 120000, 50000, 175000,
#     0, 40000, 90000, 150000, 300000
#   ),
#   policy_years = rep(1, 10)
# )
# 
# thresholds <- assess_excess_threshold(
#   portfolio,
#   claim_amount = "claim_amount",
#   thresholds = c(25000, 50000, 100000, 150000),
#   exposure = "policy_years",
#   group = "sector",
#   claim_count = "claim_count"
# )
# 
# if (requireNamespace("gt", quietly = TRUE)) {
#   as_gt(thresholds)
# } else {
#   thresholds
# }

## ----eval = FALSE-------------------------------------------------------------
# adjusted <- redistribute_excess_loss(
#   portfolio,
#   claim_amount = "claim_amount",
#   threshold = 100000,
#   claim_count = "claim_count",
#   risk_factor = "sector",
#   redistribution_method = "partial",
#   output = "redistributed_claim"
# )

## ----eval = FALSE-------------------------------------------------------------
# severity_data <- adjusted[adjusted$claim_count > 0, ]
# severity_model <- glm(
#   claim_amount_adjusted_average ~ sector,
#   weights = claim_count,
#   family = Gamma(link = "log"),
#   data = severity_data
# )

## ----eval = FALSE-------------------------------------------------------------
# loading_result <- redistribute_excess_loss(
#   portfolio,
#   claim_amount = "claim_amount",
#   threshold = 100000,
#   claim_count = "claim_count",
#   redistribution_weight = "policy_years",
#   risk_factor = "sector",
#   redistribution_method = "partial",
#   output = "excess_loading"
# )
# 
# frequency_model <- glm(
#   claim_count ~ sector + offset(log(policy_years)),
#   family = poisson(link = "log"),
#   data = loading_result
# )
# retained_severity_model <- glm(
#   claim_amount_capped ~ sector,
#   weights = claim_count,
#   family = Gamma(link = "log"),
#   data = loading_result[loading_result$claim_count > 0, ]
# )
# 
# loading_result$predicted_frequency <-
#   predict(frequency_model, type = "response") / loading_result$policy_years
# loading_result$predicted_retained_severity <- predict(
#   retained_severity_model,
#   newdata = loading_result,
#   type = "response"
# )
# loading_result$predicted_retained_risk_premium <-
#   loading_result$predicted_frequency *
#   loading_result$predicted_retained_severity
# loading_result$predicted_total_risk_premium <-
#   loading_result$predicted_retained_risk_premium +
#   loading_result$excess_loading

## -----------------------------------------------------------------------------
age_gam <- risk_factor_gam(
  data = MTPL,
  claim_count = "nclaims",
  risk_factor = "age_policyholder",
  exposure = "exposure"
)

age_segments <- derive_tariff_segments(age_gam)
age_segments

## -----------------------------------------------------------------------------
portfolio <- MTPL |>
  add_tariff_segments(age_segments, name = "age_policyholder_segment")

head(portfolio[, c("age_policyholder", "age_policyholder_segment")])

## -----------------------------------------------------------------------------
portfolio$zip <- as.factor(portfolio$zip)

freq_model <- glm(
  nclaims ~ zip + age_policyholder_segment + offset(log(exposure)),
  family = poisson(),
  data = portfolio
)

rt <- rating_table(
  freq_model,
  model_data = portfolio,
  exposure = "exposure"
)

head(rt$df)

## -----------------------------------------------------------------------------
rt |>
  add_portfolio_experience(
    data = portfolio,
    claim_count = "nclaims",
    exposure = "exposure"
  ) |>
  autoplot(risk_factors = "zip", metric = "frequency")

## ----eval = FALSE-------------------------------------------------------------
# refined_model <- prepare_refinement(freq_model) |>
#   add_smoothing(
#     model_variable = "age_policyholder_segment",
#     source_variable = "age_policyholder",
#     weights = "exposure"
#   ) |>
#   add_restriction(restrictions) |>
#   refit()

## -----------------------------------------------------------------------------
check_overdispersion(freq_model)

## ----eval = FALSE-------------------------------------------------------------
# check_residuals(freq_model) |>
#   autoplot()