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

## ----warning = FALSE, message = FALSE-----------------------------------------

library(insurancerating)
library(dplyr)

head(MTPL)


## -----------------------------------------------------------------------------

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

fa


## -----------------------------------------------------------------------------

autoplot(fa, metrics = c("exposure", "frequency", "risk_premium"))


## -----------------------------------------------------------------------------

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

autoplot(age_freq, show_observations = TRUE)


## -----------------------------------------------------------------------------

age_segments <- derive_tariff_segments(age_freq)
autoplot(age_segments)
summary(age_segments)


## -----------------------------------------------------------------------------

dat <- MTPL |>
  add_tariff_segments(age_segments, name = "age_cat") |>
  mutate(across(where(is.character), as.factor)) |>
  mutate(across(where(is.factor), ~ set_reference_level(., exposure)))


## -----------------------------------------------------------------------------

mod_freq <- glm(
  nclaims ~ age_cat,
  offset = log(exposure),
  family = poisson(),
  data = dat
)


## -----------------------------------------------------------------------------

severity_data <- dat |>
  filter(nclaims > 0, amount > 0) |>
  mutate(average_claim_amount = amount / nclaims)

mod_sev <- glm(
  average_claim_amount ~ age_cat,
  weights = nclaims,
  family = Gamma(link = "log"),
  data = severity_data
)


## -----------------------------------------------------------------------------

premium_df <- dat |>
  add_prediction(
    mod_freq,
    mod_sev,
    predictions = c("expected_claim_count", "expected_average_severity")
  ) |>
  mutate(
    claim_frequency = expected_claim_count / exposure,
    expected_loss = expected_claim_count * expected_average_severity,
    risk_premium = claim_frequency * expected_average_severity
  )

premium_df |>
  select(
    exposure,
    expected_claim_count,
    claim_frequency,
    expected_average_severity,
    expected_loss,
    risk_premium
  ) |>
  head()


## -----------------------------------------------------------------------------

burn_unrestricted <- glm(
  risk_premium ~ age_cat + zip,
  weights = exposure,
  family = Gamma(link = "log"),
  data = premium_df
)


## -----------------------------------------------------------------------------

rt <- rating_table(burn_unrestricted) |>
  add_portfolio_experience(
    data = premium_df,
    claim_count = "nclaims",
    exposure = "exposure",
    claim_amount = "amount",
    metric = "risk_premium"
  )
rt


## -----------------------------------------------------------------------------

autoplot(rt, metric = "risk_premium")


## -----------------------------------------------------------------------------

check_overdispersion(mod_freq)


## -----------------------------------------------------------------------------

model_performance(mod_freq)


## -----------------------------------------------------------------------------

bp <- bootstrap_performance(
  mod_freq,
  dat,
  n_resamples = 50,
  sample_fraction = 0.8,
  sampling = "bootstrap",
  show_progress = FALSE
)
autoplot(bp)


## -----------------------------------------------------------------------------

zip_restriction <- data.frame(
  zip = "3",
  relativity = 1.05
)

tariff_refinement <- prepare_refinement(
  burn_unrestricted,
  data = premium_df
) |>
  add_restriction(zip_restriction)

burn_refined <- refit(tariff_refinement, intercept_only = TRUE)
rating_table(burn_refined)


## ----eval = FALSE-------------------------------------------------------------
# 
# factor_analysis()             # analyse portfolio behaviour
# risk_factor_gam()             # analyse continuous variables
# derive_tariff_segments()      # derive tariff segments
# glm()                         # estimate frequency and severity
# add_prediction()              # construct technical risk premium
# glm()                         # represent risk in a tariff structure
# rating_table()                # interpret tariff relativities
# bootstrap_performance()       # assess stability
# prepare_refinement()          # prepare an actuarial refinement
# refit()                       # fit the refined tariff model
#