A Worked Auto Driver Averaging Rating Plan with ratingtables"

In ratingtables: Table-Driven Insurance Rating

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.width = 7,
  fig.height = 5
)

library(ratingtables)

Overview

This vignette builds a compact but fairly complete personal-auto rating example. The purpose is not to recommend a particular rate plan. Instead, the example shows how ratingtables can represent and execute a range of common rating structures while keeping the factor data separate from the calculation order.

The example has two coverages, "BI" and "CL".

Driver-level rating uses four multiplicative factors:

• gender;
• marital status;
• driver age; and
• prior chargeable claims.

Each driver receives an indicated factor for each coverage. Driver factors are then averaged by household and joined to the vehicle records.

Vehicle-level rating uses:

1. a base rate;
2. territory;
3. the household average driver factor;
4. credit;
5. underwriting level;
6. an interpolated vehicle-value factor;
7. a continuous additive geographic-score charge;
8. a continuous multiplicative mileage adjustment;
9. a custom high-score surcharge;
10. a custom composite-risk adjustment;
11. an additive expense fee;
12. a Collision deductible/coverage-option factor; and
13. final rounding.

The example concludes by applying rate-change caps to a small number of coverage records and by inspecting the calculation trace.

A helper for building factor-table rows

ratingtables stores rating values in a normalized long-format factor table. For this example all table-based terms are either constants or one-way factors, so only one variable/level slot is needed.

The following small helper keeps the example code readable.

coverages <- c("BI", "CL")

make_factor_rows <- function(term_name,
                             coverage,
                             term_value,
                             variable = NA_character_,
                             level = NA_character_) {
  n <- length(term_value)

  if (length(coverage) == 1L) {
    coverage <- rep(coverage, n)
  }
  if (length(variable) == 1L) {
    variable <- rep(variable, n)
  }
  if (length(level) == 1L) {
    level <- rep(level, n)
  }

  data.frame(
    coverage = as.character(coverage),
    term_name = rep(term_name, n),
    term_value = as.numeric(term_value),
    variable1 = as.character(variable),
    level1 = as.character(level),
    stringsAsFactors = FALSE
  )
}

Driver-level rating

Driver factor table

The driver plan uses ordinary multiplicative rating factors. The factors are intentionally simple and are included only to illustrate the workflow.

driver_factor_table <- rbind(
  # Gender
  make_factor_rows(
    "gender", "BI",
    c(1.07, 0.98),
    "gender", c("M", "F")
  ),
  make_factor_rows(
    "gender", "CL",
    c(1.04, 0.99),
    "gender", c("M", "F")
  ),

  # Marital status
  make_factor_rows(
    "marital_status", "BI",
    c(1.08, 0.96),
    "marital_status", c("single", "married")
  ),
  make_factor_rows(
    "marital_status", "CL",
    c(1.05, 0.97),
    "marital_status", c("single", "married")
  ),

  # Driver age
  make_factor_rows(
    "driver_age", "BI",
    c(1.40, 1.08, 1.00, 1.06),
    "driver_age", c("18_24", "25_39", "40_64", "65_plus")
  ),
  make_factor_rows(
    "driver_age", "CL",
    c(1.30, 1.06, 1.00, 1.05),
    "driver_age", c("18_24", "25_39", "40_64", "65_plus")
  ),

  # Prior chargeable claims
  make_factor_rows(
    "prior_chargeable_claims", "BI",
    c(0.95, 1.15, 1.35),
    "prior_chargeable_claims", c("0", "1", "2_plus")
  ),
  make_factor_rows(
    "prior_chargeable_claims", "CL",
    c(0.96, 1.12, 1.30),
    "prior_chargeable_claims", c("0", "1", "2_plus")
  )
)

head(driver_factor_table)

Driver rating specification

The rating specification defines the calculation order separately from the factor values. Every driver term in this example is an exact factor lookup applied multiplicatively.

driver_spec <- data.frame(
  coverage = rep(coverages, each = 4),
  step_number = rep(1:4, times = length(coverages)),
  term_name = rep(
    c(
      "gender",
      "marital_status",
      "driver_age",
      "prior_chargeable_claims"
    ),
    times = length(coverages)
  ),
  value_source = "factor_lookup",
  calculation_type = "multiplicative",
  stringsAsFactors = FALSE
)

driver_plan <- new_rating_plan(
  factor_table = driver_factor_table,
  rating_spec = driver_spec,
  coverages = coverages,
  max_vars = 1,
  policy_id_col = "driver_id"
)

Driver data

There are ten drivers belonging to five households. Some households have more than one driver, which allows the entity-aggregation workflow to be shown.

drivers <- data.frame(
  driver_id = paste0("D", 1:10),
  household_id = c(
    "H1", "H1",
    "H2", "H2", "H2",
    "H3",
    "H4", "H4",
    "H5", "H5"
  ),
  gender = c("M", "F", "F", "M", "M", "F", "M", "F", "M", "F"),
  marital_status = c(
    "single", "single",
    "married", "married", "single",
    "married",
    "single", "single",
    "married", "married"
  ),
  driver_age = c(
    "18_24", "40_64",
    "40_64", "65_plus", "25_39",
    "25_39",
    "18_24", "25_39",
    "40_64", "65_plus"
  ),
  prior_chargeable_claims = c(
    "0", "0",
    "0", "1", "0",
    "1",
    "2_plus", "1",
    "0", "0"
  ),
  stringsAsFactors = FALSE
)

drivers

Rate the drivers

rate_entities() applies a rating plan to entity-level records and retains the same trace information available for policy- or vehicle-level rating.

driver_result <- rate_entities(
  entity_data = drivers,
  plan = driver_plan
)

scored_drivers <- driver_result$rated_data

scored_drivers[
  ,
  c(
    "driver_id",
    "household_id",
    "gender",
    "marital_status",
    "driver_age",
    "prior_chargeable_claims",
    "indicated_BI",
    "indicated_CL"
  )
]

Because the driver plan begins with multiplicative factors rather than a dollar base rate, the indicated_BI and indicated_CL values are rating relativities. Each is the product of the four applicable driver factors.

Average driver factors by household

The driver factors are averaged by household separately for BI and CL.

driver_avgs <- aggregate_entity_values(
  rated_entity_data = scored_drivers,
  group_col = "household_id",
  value_cols = c("indicated_BI", "indicated_CL"),
  aggregation = "mean",
  output_names = c(
    "avg_driver_factor_BI",
    "avg_driver_factor_CL"
  )
)

driver_avgs

This produces one BI and one CL driver factor for each household. Those household-level values can now be treated like any other vehicle rating input.

Vehicle-level rating

Vehicle factor table

The vehicle factor table contains constants, categorical factors, an interpolation curve, coefficients for the continuous calculations, and the final additive expense fee.

vehicle_factor_table <- rbind(
  # Base rate: one value per coverage
  make_factor_rows("base_rate", "BI", 220),
  make_factor_rows("base_rate", "CL", 180),

  # Territory
  make_factor_rows(
    "territory", "BI",
    c(0.90, 1.00, 1.10, 1.20),
    "territory", c("T1", "T2", "T3", "T4")
  ),
  make_factor_rows(
    "territory", "CL",
    c(0.95, 1.00, 1.08, 1.15),
    "territory", c("T1", "T2", "T3", "T4")
  ),

  # Credit
  make_factor_rows(
    "credit", "BI",
    c(0.90, 1.00, 1.10, 1.20),
    "credit", c("A", "B", "C", "D")
  ),
  make_factor_rows(
    "credit", "CL",
    c(0.92, 1.00, 1.08, 1.15),
    "credit", c("A", "B", "C", "D")
  ),

  # Underwriting level
  make_factor_rows(
    "underwriting_level", "BI",
    c(0.92, 1.00, 1.20),
    "underwriting_level",
    c("preferred", "standard", "nonstandard")
  ),
  make_factor_rows(
    "underwriting_level", "CL",
    c(0.95, 1.00, 1.15),
    "underwriting_level",
    c("preferred", "standard", "nonstandard")
  ),

  # Vehicle-value interpolation curve
  make_factor_rows(
    "vehicle_value_factor", "BI",
    c(0.95, 1.00, 1.05, 1.10, 1.15),
    "vehicle_value",
    c("10000", "20000", "30000", "40000", "50000")
  ),
  make_factor_rows(
    "vehicle_value_factor", "CL",
    c(0.90, 0.98, 1.08, 1.18, 1.28),
    "vehicle_value",
    c("10000", "20000", "30000", "40000", "50000")
  ),

  # Continuous additive coefficient:
  # coefficient * geo_score is added to the running premium
  make_factor_rows("geo_score_charge", "BI", 1.25),
  make_factor_rows("geo_score_charge", "CL", 0.75),

  # Continuous multiplicative coefficient:
  # factor applied is 1 + coefficient * annual_mileage_000
  make_factor_rows("mileage_adjustment", "BI", 0.004),
  make_factor_rows("mileage_adjustment", "CL", 0.003),

  # Additive expense fee
  make_factor_rows("expense_fee", "BI", 18),
  make_factor_rows("expense_fee", "CL", 12),

  # Collision deductible / coverage option.
  # "no coverage" is intentionally listed first. Under the current package
  # design this term is placed last in the CL calculation so that a factor of
  # zero leaves the completed CL premium at zero.
  make_factor_rows(
    "cl_deductible", "CL",
    c(0.00, 1.00, 0.88),
    "cl_deductible",
    c("no coverage", "1000", "2000")
  )
)

vehicle_factor_table

Vehicle data

There are eight vehicle records. Each vehicle belongs to one of the households rated above.

vehicles <- data.frame(
  vehicle_id = paste0("V", 1:8),
  policy_id = c("P1", "P1", "P2", "P2", "P3", "P4", "P5", "P5"),
  household_id = c("H1", "H1", "H2", "H2", "H3", "H4", "H5", "H5"),
  territory = c("T1", "T2", "T3", "T4", "T2", "T4", "T3", "T4"),
  credit = c("A", "B", "C", "D", "B", "C", "D", "C"),
  underwriting_level = c(
    "preferred",
    "standard",
    "nonstandard",
    "standard",
    "standard",
    "nonstandard",
    "nonstandard",
    "preferred"
  ),
  vehicle_value = c(
    12500,
    21750,
    32000,
    18000,
    27500,
    39000,
    46500,
    23500
  ),
  geo_score = c(3.2, 5.8, 7.5, 2.1, 6.9, 8.0, 7.8, 4.7),
  annual_mileage_000 = c(8, 12, 16, 10, 14, 18, 20, 7),
  cl_deductible = c(
    "1000",
    "no coverage",
    "2000",
    "1000",
    "no coverage",
    "1000",
    "2000",
    "no coverage"
  ),
  stringsAsFactors = FALSE
)

vehicles

Join the household driver averages back to the vehicle data:

vehicles_with_driver_avgs <- join_entity_values(
  parent_data = vehicles,
  entity_values = driver_avgs,
  by = "household_id"
)

vehicles_with_driver_avgs[
  ,
  c(
    "vehicle_id",
    "household_id",
    "avg_driver_factor_BI",
    "avg_driver_factor_CL"
  )
]

Custom rating functions

Most rating elements are easier to inspect and maintain when they remain in the ordinary factor table and rating specification. Custom functions are therefore best treated as an escape hatch rather than the default way to express rating logic.

They can still be useful when reproducing an existing rater that contains conditional or interdependent logic. A rater-modernization project may also be a good opportunity to reconsider whether unusual legacy rules should continue to exist at all.

A custom function receives six arguments:

• row: the one-row record being rated;
• coverage: the coverage currently being rated;
• current_premium: the running premium immediately before the step;
• plan: the complete rating-plan object;
• spec_row: the rating-specification row for the current step; and
• lookup: a helper that can retrieve values from the plan's factor table.

Custom function 1: high-score surcharge

The first custom function is intentionally simple. A high geographic score combined with nonstandard underwriting produces a 3 percent surcharge.

custom_high_score_surcharge <- function(
  row,
  coverage,
  current_premium,
  plan,
  spec_row,
  lookup
) {
  score <- as.numeric(row$geo_score[[1]])
  uw <- as.character(row$underwriting_level[[1]])

  if (score >= 7 && uw == "nonstandard") {
    1.03
  } else {
    1.00
  }
}

This function only needs fields from row. The other arguments are still available because every custom function receives the same interface.

Custom function 2: legacy composite-risk adjustment

The second custom function demonstrates a different use case. It looks up three ordinary rating factors that have already been used elsewhere in the rate calculation: territory, credit, and underwriting level.

If exactly two of the three factors are adverse, a 3 percent surcharge applies. If all three are adverse, a 7 percent surcharge applies.

legacy_composite_risk_adjustment <- function(
  row,
  coverage,
  current_premium,
  plan,
  spec_row,
  lookup
) {
  territory_factor <- lookup("territory")$value
  credit_factor <- lookup("credit")$value
  underwriting_factor <- lookup("underwriting_level")$value

  adverse_count <- sum(
    c(
      territory_factor > 1,
      credit_factor > 1,
      underwriting_factor > 1
    )
  )

  if (adverse_count == 3) {
    1.07
  } else if (adverse_count == 2) {
    1.03
  } else {
    1.00
  }
}

This is the kind of rule that may be awkward to encode as another normalized factor table. The function can query the factor table directly and combine the results using arbitrary R logic.

The flexibility is useful, but such logic should not automatically be viewed as good rating-plan design merely because it can be reproduced.

Vehicle rating specification

The two custom functions are placed next to each other in the calculation order.

For BI, the additive expense fee is the final step and the completed premium is rounded to the nearest dime. For CL, a deductible/coverage-option factor follows the expense fee and is the final step.

Under the current package design, every coverage listed in the rating plan is rated for every record. The "no coverage" CL deductible level therefore has a factor of zero and is deliberately placed last. This produces a final CL premium of zero for vehicles that did not select the coverage.

base_vehicle_terms <- c(
  "base_rate",
  "territory",
  "average_driver_factor",
  "credit",
  "underwriting_level",
  "vehicle_value_factor",
  "geo_score_charge",
  "mileage_adjustment",
  "custom_high_score_surcharge",
  "legacy_composite_risk_adjustment",
  "expense_fee"
)

base_vehicle_value_sources <- c(
  "factor_lookup",
  "factor_lookup",
  "input_value",
  "factor_lookup",
  "factor_lookup",
  "interpolated_lookup",
  "factor_lookup",
  "factor_lookup",
  "custom_function",
  "custom_function",
  "factor_lookup"
)

base_vehicle_calculation_types <- c(
  "multiplicative",
  "multiplicative",
  "multiplicative",
  "multiplicative",
  "multiplicative",
  "multiplicative",
  "continuous_additive",
  "continuous_multiplicative",
  "multiplicative",
  "multiplicative",
  "additive"
)

make_vehicle_spec <- function(coverage, driver_input) {
  terms <- base_vehicle_terms
  value_sources <- base_vehicle_value_sources
  calculation_types <- base_vehicle_calculation_types

  input_vars <- c(
    NA,
    NA,
    driver_input,
    NA,
    NA,
    NA,
    "geo_score",
    "annual_mileage_000",
    NA,
    NA,
    NA
  )

  lookup_vars <- c(
    NA,
    NA,
    NA,
    NA,
    NA,
    "vehicle_value",
    NA,
    NA,
    NA,
    NA,
    NA
  )

  bounds <- c(
    NA,
    NA,
    NA,
    NA,
    NA,
    "error",
    NA,
    NA,
    NA,
    NA,
    NA
  )

  custom_functions <- c(
    NA,
    NA,
    NA,
    NA,
    NA,
    NA,
    NA,
    NA,
    "custom_high_score_surcharge",
    "legacy_composite_risk_adjustment",
    NA
  )

  if (coverage == "CL") {
    terms <- c(terms, "cl_deductible")
    value_sources <- c(value_sources, "factor_lookup")
    calculation_types <- c(calculation_types, "multiplicative")
    input_vars <- c(input_vars, NA)
    lookup_vars <- c(lookup_vars, NA)
    bounds <- c(bounds, NA)
    custom_functions <- c(custom_functions, NA)
  }

  rounding_rules <- rep(NA_character_, length(terms))
  rounding_rules[length(terms)] <- "nearest_dime"

  data.frame(
    coverage = coverage,
    step_number = seq_along(terms),
    term_name = terms,
    value_source = value_sources,
    calculation_type = calculation_types,
    input_var = input_vars,
    lookup_var = lookup_vars,
    bounds = bounds,
    custom_function = custom_functions,
    rounding_rule = rounding_rules,
    stringsAsFactors = FALSE
  )
}

vehicle_spec <- rbind(
  make_vehicle_spec("BI", "avg_driver_factor_BI"),
  make_vehicle_spec("CL", "avg_driver_factor_CL")
)

vehicle_spec[
  ,
  c(
    "coverage",
    "step_number",
    "term_name",
    "value_source",
    "calculation_type",
    "input_var",
    "lookup_var",
    "custom_function",
    "rounding_rule"
  )
]

Create the completed vehicle rating plan and register both custom functions by name.

vehicle_plan <- new_rating_plan(
  factor_table = vehicle_factor_table,
  rating_spec = vehicle_spec,
  coverages = coverages,
  max_vars = 1,
  policy_id_col = "vehicle_id",
  custom_functions = list(
    custom_high_score_surcharge = custom_high_score_surcharge,
    legacy_composite_risk_adjustment = legacy_composite_risk_adjustment
  )
)

vehicle_plan

Rate the vehicles

vehicle_result <- rate_policies_with_trace(
  rating_data = vehicles_with_driver_avgs,
  plan = vehicle_plan
)

rated_vehicles <- vehicle_result$rated_data

rated_vehicles[
  ,
  c(
    "vehicle_id",
    "policy_id",
    "household_id",
    "territory",
    "credit",
    "underwriting_level",
    "vehicle_value",
    "geo_score",
    "annual_mileage_000",
    "cl_deductible",
    "avg_driver_factor_BI",
    "avg_driver_factor_CL",
    "indicated_BI",
    "indicated_CL"
  )
]

The final indicated premiums include the complete sequence of multiplicative, additive, continuous, interpolated, and custom calculations. Rounding is attached only to the final step for each coverage, so intermediate calculations retain their full precision and the completed premium is rounded to the nearest dime.

For vehicles with cl_deductible == "no coverage", the final CL deductible factor is zero and indicated_CL is therefore zero.

rated_vehicles[
  rated_vehicles$cl_deductible == "no coverage",
  c("vehicle_id", "cl_deductible", "indicated_BI", "indicated_CL")
]

This is a workable representation with the current API, but it also illustrates a distinction between coverage selection and coverage rating. The engine still evaluates the earlier CL steps before the final zero factor is applied. A rating system with first-class coverage selection could instead skip the CL calculation entirely for these records.

Inspect interpolation and custom-function trace rows

The trace retains one row per rating step. The following subset focuses on the interpolated vehicle-value factor and the two custom calculations.

interesting_terms <- c(
  "vehicle_value_factor",
  "custom_high_score_surcharge",
  "legacy_composite_risk_adjustment"
)

interesting_trace <- vehicle_result$term_trace[
  vehicle_result$term_trace$term_name %in% interesting_terms,
  c(
    "record_id",
    "coverage",
    "step_number",
    "term_name",
    "value_source",
    "calculation_type",
    "input_value",
    "looked_up_value",
    "applied_value",
    "lower_level",
    "upper_level",
    "lower_value",
    "upper_value",
    "interpolation_weight",
    "value_before_step",
    "value_after_step",
    "custom_function"
  )
]

interesting_trace

For the interpolation step, the trace records the lower and upper vehicle-value points, their factor values, and the interpolation weight. For custom functions, the trace records the function name and the value applied to the running premium.

A complete explanation for one vehicle and coverage can also be requested:

explain_rating(
  rating_result = vehicle_result,
  row_number = 1,
  coverage = "BI"
)

Apply rate-change caps

Rate capping is applied after the indicated premium has been calculated.

For this compact example, the prior premiums are deliberately constructed so that only a few vehicle/coverage records fall outside the permitted range. This makes the capping behavior visible without turning the example into a large renewal analysis.

bi_change_targets <- c(
  1.05, 1.02, 1.25, 0.98,
  1.00, 1.03, 0.85, 1.04
)

cl_change_targets <- c(
  1.04, 0.95, 1.03, 1.22,
  1.00, 1.01, 0.92, 1.02
)

prior_vehicle_premium <- data.frame(
  vehicle_id = rated_vehicles$vehicle_id,
  prior_BI = rated_vehicles$indicated_BI / bi_change_targets,
  prior_CL = rated_vehicles$indicated_CL / cl_change_targets,
  stringsAsFactors = FALSE
)

rated_vehicles_capped <- apply_caps(
  rating_data = rated_vehicles,
  prior_data = prior_vehicle_premium,
  by = "vehicle_id",
  coverages = coverages,
  max_increase = 0.15,
  max_decrease = 0.10
)

rated_vehicles_capped$cap_applied_BI <-
  abs(
    rated_vehicles_capped$capped_BI -
      rated_vehicles_capped$indicated_BI
  ) > 1e-8

rated_vehicles_capped$cap_applied_CL <-
  abs(
    rated_vehicles_capped$capped_CL -
      rated_vehicles_capped$indicated_CL
  ) > 1e-8

rated_vehicles_capped[
  ,
  c(
    "vehicle_id",
    "prior_BI",
    "indicated_BI",
    "capped_BI",
    "cap_applied_BI",
    "prior_CL",
    "indicated_CL",
    "capped_CL",
    "cap_applied_CL"
  )
]

To focus only on records where at least one coverage was capped:

rated_vehicles_capped[
  rated_vehicles_capped$cap_applied_BI |
    rated_vehicles_capped$cap_applied_CL,
  c(
    "vehicle_id",
    "prior_BI",
    "indicated_BI",
    "capped_BI",
    "prior_CL",
    "indicated_CL",
    "capped_CL"
  )
]

What this example demonstrates

This vignette uses one coherent rating workflow to demonstrate several parts of ratingtables:

• normalized factor tables;
• coverage-specific rating specifications;
• multiplicative driver factors;
• driver/entity rating;
• averaging entity-level factors to a parent household;
• joining aggregated factors back to vehicle records;
• a coverage-specific base rate;
• exact factor lookup;
• an input-value step;
• linear interpolation;
• continuous additive calculation;
• continuous multiplicative calculation;
• two different custom-function patterns;
• an additive expense fee;
• an optional Collision deductible/coverage-option factor;
• final-step rounding;
• step-by-step trace output; and
• post-rating rate-change caps.

The standard table-driven calculations should generally remain the preferred representation when they are sufficient. Custom functions are most useful as a controlled escape hatch for logic that is genuinely difficult to represent cleanly in the ordinary specification, particularly when recreating or validating an existing rater.

Because the factor data, calculation specification, custom code, and example rating records are all ordinary R objects, each component can be inspected, tested, version-controlled, and modified independently.

ratingtables documentation built on Sept. 6, 2026, 1:06 a.m.