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

## ----example-data-------------------------------------------------------------
make_rows <- function(charter, coverage, term_name, term_value,
                      variable1 = NA_character_, level1 = NA_character_,
                      variable2 = NA_character_, level2 = NA_character_) {
  n <- max(length(term_value), length(level1), length(level2), 1L)
  data.frame(
    state = rep("IL", n),
    charter = rep(charter, n),
    rate_eff_date = rep(as.Date("2026-01-01"), n),
    coverage = rep(coverage, n),
    term_name = rep(term_name, n),
    term_value = rep(term_value, length.out = n),
    variable1 = rep(variable1, length.out = n),
    level1 = rep(level1, length.out = n),
    variable2 = rep(variable2, length.out = n),
    level2 = rep(level2, length.out = n),
    stringsAsFactors = FALSE
  )
}

pieces <- list()
k <- 1L
for (charter in c("A", "B")) {
  for (coverage in c("BI", "CL")) {
    pieces[[k]] <- make_rows(
      charter, coverage, "base_rate",
      if (charter == "A") c(BI = 220, CL = 180)[coverage]
      else c(BI = 230, CL = 190)[coverage]
    ); k <- k + 1L

    pieces[[k]] <- make_rows(
      charter, coverage, "driver_age",
      c(1.60, 1.35, 1.18, 1.05, 1.00),
      "driver_age", c("16", "17", "18", "20", "52")
    ); k <- k + 1L

    pieces[[k]] <- make_rows(
      charter, coverage, "territory",
      c(.90, 1.00, 1.10, 1.20),
      "territory", c("T1", "T2", "T3", "T4")
    ); k <- k + 1L

    grid <- expand.grid(
      driver_age = c("16", "17", "20"),
      gender = c("M", "F"), stringsAsFactors = FALSE
    )
    pieces[[k]] <- make_rows(
      charter, coverage, "age_gender_interaction",
      c(1.08, 1.05, 1.02, .99, .99, 1.00),
      "driver_age", grid$driver_age,
      "gender", grid$gender
    ); k <- k + 1L
  }
}

current <- do.call(rbind, pieces)
current$factor_row_id <- seq_len(nrow(current))
rownames(current) <- NULL

head(current)

## ----validate-----------------------------------------------------------------
validate_rate_plan(current)

## ----validate-error, error=TRUE-----------------------------------------------
try({
bad <- rbind(current, current[1, ])
validate_rate_plan(bad)
})

## ----validate-inspect---------------------------------------------------------
issues <- validate_rate_plan(bad, error = FALSE)
issues

## ----wide---------------------------------------------------------------------
wide <- rate_tables_wide(current)
wide
head(wide$driver_age, 12)

## ----filters------------------------------------------------------------------
a_only <- rate_tables_wide(current, filters = list(state = "IL", charter = "A"))
head(a_only$driver_age)

## ----in-memory-roundtrip------------------------------------------------------
back_to_long <- rate_tables_long(wide)
rate_plan_diff(current, back_to_long, include_unchanged = FALSE)

## ----matrix-------------------------------------------------------------------
wide_matrix <- rate_tables_wide(
  current,
  matrix_terms = "age_gender_interaction"
)

interaction_names <- grep("age_gender_interaction", names(wide_matrix), value = TRUE)
interaction_names
wide_matrix[[interaction_names[1]]]

## ----excel-write, eval=FALSE--------------------------------------------------
# write_rate_workbook(
#   current,
#   "IL_rate_revision.xlsx",
#   filters = list(state = "IL"),
#   matrix_terms = "age_gender_interaction"
# )

## ----excel-read, eval=FALSE---------------------------------------------------
# proposed_from_excel <- read_rate_workbook("IL_rate_revision.xlsx")
# validate_rate_plan(proposed_from_excel)
# rate_plan_diff(current, proposed_from_excel, include_unchanged = FALSE)

## ----excel-tables, eval=FALSE-------------------------------------------------
# editable_tables <- read_rate_workbook("IL_rate_revision.xlsx", return = "tables")

## ----replacement--------------------------------------------------------------
new_age <- current[current$term_name == "driver_age", , drop = FALSE]
age <- as.numeric(new_age$level1)
new_age$term_value <- new_age$term_value * ifelse(age < 20, 1.04, .99)

proposed <- replace_factor_set(current, new_age)
head(rate_plan_diff(current, proposed, include_unchanged = FALSE))

## ----sparse-update------------------------------------------------------------
one_change <- proposed[
  proposed$charter == "A" &
    proposed$coverage == "BI" &
    proposed$term_name == "territory" &
    proposed$level1 == "T4",
  , drop = FALSE
]
one_change$term_value <- 1.28
proposed <- update_factors(proposed, one_change)

## ----add-level----------------------------------------------------------------
new_level <- one_change
new_level$level1 <- "T5"
new_level$term_value <- 1.35
new_level$factor_row_id <- NULL

proposed <- update_factors(
  proposed,
  new_level,
  allow_new_levels = TRUE
)

## ----rebase-------------------------------------------------------------------
rebased <- rebase_factor_set(
  proposed,
  term_name = "driver_age",
  base_level = "20"
)

rebased[
  rebased$term_name == "driver_age" & rebased$level1 == "20",
  c("charter", "coverage", "level1", "term_value")
]

## ----normalize----------------------------------------------------------------
territory <- proposed[proposed$term_name == "territory", , drop = FALSE]
territory$exposure <- c(T1 = 40, T2 = 30, T3 = 20, T4 = 8, T5 = 2)[territory$level1]

normalized_territory <- normalize_factor_set(
  territory,
  term_name = "territory",
  weights = "exposure",
  target_mean = 1
)

head(normalized_territory)

## ----diff---------------------------------------------------------------------
changes <- rate_plan_diff(current, proposed, include_unchanged = FALSE)
table(changes$status)
head(changes, 15)

## ----outputs------------------------------------------------------------------
current_output <- data.frame(
  vehicle_id = paste0("V", 1:5),
  charter = c("A", "A", "A", "B", "B"),
  territory = c("T1", "T2", "T4", "T2", "T4"),
  indicated_BI = c(400, 525, 610, 480, 650),
  indicated_CL = c(250, 0, 390, 300, 0),
  stringsAsFactors = FALSE
)

proposed_output <- current_output
proposed_output$indicated_BI <- c(420, 540, 655, 475, 705)
proposed_output$indicated_CL <- c(260, 0, 405, 315, 0)

impact <- compare_rating_outputs(
  current_output,
  proposed_output,
  id_cols = "vehicle_id",
  keep_cols = c("charter", "territory")
)

impact

## ----summaries----------------------------------------------------------------
summarize_rate_change(impact, by = NULL)
summarize_rate_change(impact, by = "coverage")
summarize_rate_change(impact, by = c("charter", "coverage"))

## ----distribution-------------------------------------------------------------
rate_change_distribution(impact)
rate_change_distribution(impact, by = "coverage")

## ----solve-simple-------------------------------------------------------------
solution <- solve_rate_target(
  current_premium = 1e6,
  target = .06,
  rate_function = function(x) 980000 * x,
  interval = c(.5, 1.5),
  parameter_name = "base-rate multiplier"
)
solution

## ----solve-arbitrary, eval=FALSE----------------------------------------------
# solution <- solve_rate_target(
#   current_premium = sum(current_rated$premium),
#   target = .06,
#   rate_function = function(x) {
#     proposed_rated <- completely_new_proposed_workflow(
#       input_data,
#       base_multiplier = x
#     )
#     proposed_rated$premium
#   }
# )

## ----territory-base-solve-----------------------------------------------------
current_bases <- c(T1 = 250, T2 = 275, T3 = 300, T4 = 330)
proposed_bases <- c(T1 = 245, T2 = 280, T3 = 315, T4 = 360)
counts <- c(T1 = 400, T2 = 350, T3 = 180, T4 = 70)

territory_solution <- solve_rate_target(
  current_premium = sum(current_bases * counts),
  target = .08,
  rate_function = function(x) proposed_bases * x * counts,
  interval = c(.5, 1.5),
  parameter_name = "common territory-base multiplier"
)

territory_solution
proposed_bases * territory_solution$parameter

## ----workflow-outline, eval=FALSE---------------------------------------------
# rate_book <- function(inputs, factor_table, base_multiplier = 1) {
#   factors <- factor_table
#   factors$term_value[factors$term_name == "base_rate"] <-
#     factors$term_value[factors$term_name == "base_rate"] * base_multiplier
# 
#   driver_plan <- ratingtables::new_rating_plan(
#     driver_factors, driver_spec,
#     coverages = c("BI", "CL"),
#     use_rate_set_key = TRUE
#   )
# 
#   drivers <- ratingtables::rate_entities(inputs$drivers, driver_plan)
# 
#   driver_avg <- ratingtables::aggregate_entity_values(
#     drivers$rated_data,
#     group_col = "household_id",
#     value_cols = c("indicated_BI", "indicated_CL"),
#     aggregation = "mean",
#     output_names = c("avg_driver_BI", "avg_driver_CL")
#   )
# 
#   vehicles <- ratingtables::join_entity_values(
#     inputs$vehicles, driver_avg, by = "household_id"
#   )
# 
#   vehicle_plan <- ratingtables::new_rating_plan(
#     vehicle_factors, vehicle_spec,
#     coverages = c("BI", "CL"),
#     use_rate_set_key = TRUE
#   )
# 
#   ratingtables::rate_policies(vehicles, vehicle_plan)
# }