Pricing Optimization Workshop

# Read the dataset from a CSV file
# Sample dataset creation
set.seed(123)
data <- data.frame(
  Policy_ID = 1:1000,
  Customer_Age = sample(20:70, 1000, replace = TRUE),
  Annual_Premium = round(runif(1000, 500, 3000), 2),
  Claim_Frequency = rpois(1000, lambda = 1),
  Claim_Severity = round(rlnorm(1000, meanlog = 7, sdlog = 0.5), 2),
  Competitor_Price = round(runif(1000, 400, 3200), 2),
  Churn = sample(0:1, 1000, replace = TRUE, prob = c(0.8, 0.2))
)
write.csv(data, "insurance_pricing.csv", row.names = FALSE)
head(data,5)

##   Policy_ID Customer_Age Annual_Premium Claim_Frequency Claim_Severity
## 1         1           50        1277.92               3        1289.50
## 2         2           34         696.23               0        1193.53
## 3         3           70        1304.36               1        2217.35
## 4         4           33        2062.26               0        1817.03
## 5         5           22        1600.60               3        1246.00
##   Competitor_Price Churn
## 1           650.31     0
## 2          2853.44     0
## 3           807.67     0
## 4          2178.77     0
## 5          1649.47     0

# Load dataset
library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.1     ✔ tibble    3.2.1
## ✔ lubridate 1.9.4     ✔ tidyr     1.3.1
## ✔ purrr     1.0.4     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

data <- read.csv("insurance_pricing.csv")

# Explore dataset
str(data)

## 'data.frame':    1000 obs. of  7 variables:
##  $ Policy_ID       : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ Customer_Age    : int  50 34 70 33 22 61 69 62 56 33 ...
##  $ Annual_Premium  : num  1278 696 1304 2062 1601 ...
##  $ Claim_Frequency : int  3 0 1 0 3 2 2 1 2 0 ...
##  $ Claim_Severity  : num  1290 1194 2217 1817 1246 ...
##  $ Competitor_Price: num  650 2853 808 2179 1649 ...
##  $ Churn           : int  0 0 0 0 0 0 0 0 0 0 ...

summary(data)

##    Policy_ID       Customer_Age   Annual_Premium   Claim_Frequency
##  Min.   :   1.0   Min.   :20.00   Min.   : 502.9   Min.   :0.000  
##  1st Qu.: 250.8   1st Qu.:32.00   1st Qu.:1110.9   1st Qu.:0.000  
##  Median : 500.5   Median :44.50   Median :1748.8   Median :1.000  
##  Mean   : 500.5   Mean   :44.77   Mean   :1747.7   Mean   :1.001  
##  3rd Qu.: 750.2   3rd Qu.:57.00   3rd Qu.:2365.4   3rd Qu.:2.000  
##  Max.   :1000.0   Max.   :70.00   Max.   :2998.8   Max.   :6.000  
##  Claim_Severity   Competitor_Price     Churn      
##  Min.   : 162.0   Min.   : 404.6   Min.   :0.000  
##  1st Qu.: 778.5   1st Qu.:1154.8   1st Qu.:0.000  
##  Median :1098.6   Median :1782.4   Median :0.000  
##  Mean   :1232.3   Mean   :1811.6   Mean   :0.191  
##  3rd Qu.:1513.6   3rd Qu.:2501.5   3rd Qu.:0.000  
##  Max.   :7524.2   Max.   :3199.1   Max.   :1.000

ggplot(data, aes(x = Annual_Premium)) +
  geom_histogram(bins = 30, fill = "skyblue", color = "black") +
  labs(title = "Distribution of Annual Premiums")

# Create risk score
data_original<-data
data <- data %>%
  mutate(Risk_Score = Claim_Frequency * Claim_Severity / Annual_Premium)

# Categorize customers by age group
data <- data %>%
  mutate(Age_Group = case_when(
    Customer_Age < 30 ~ "Young",
    Customer_Age >= 30 & Customer_Age < 60 ~ "Middle-aged",
    TRUE ~ "Senior"
  ))

# Explore engineered features
summary(data$Risk_Score)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.0000  0.0000  0.5053  0.8479  1.1717 13.1114

# Fit a linear regression model
model <- lm(Annual_Premium ~ Claim_Frequency + Claim_Severity + Age_Group, data = data)
summary(model)

## 
## Call:
## lm(formula = Annual_Premium ~ Claim_Frequency + Claim_Severity + 
##     Age_Group, data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1311.76  -629.29     3.46   622.82  1324.94 
## 
## Coefficients:
##                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      1.720e+03  5.727e+01  30.029   <2e-16 ***
## Claim_Frequency  4.168e+01  2.361e+01   1.766   0.0778 .  
## Claim_Severity   1.193e-03  3.432e-02   0.035   0.9723    
## Age_GroupSenior -4.696e+01  5.907e+01  -0.795   0.4269    
## Age_GroupYoung  -2.871e+01  5.902e+01  -0.486   0.6268    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 726.3 on 995 degrees of freedom
## Multiple R-squared:  0.003776,   Adjusted R-squared:  -0.0002286 
## F-statistic: 0.9429 on 4 and 995 DF,  p-value: 0.4383

# Predict premiums
data$Predicted_Premium <- predict(model, data)

# Calculate RMSE
library(Metrics)
rmse(data$Annual_Premium, data$Predicted_Premium)

## [1] 724.5253

# Install optimization package
if (!require("nloptr")) install.packages("nloptr")

## Loading required package: nloptr

library(nloptr)

# Define objective function
objective <- function(price) {
  revenue <- sum(price * (1 - data$Churn))
  cost <- sum(data$Claim_Frequency * data$Claim_Severity)
  return(-1 * (revenue - cost))
}

# Optimization
opt_result <- nloptr(
  x0 = rep(mean(data$Annual_Premium), nrow(data)),
  eval_f = objective,
  lb = rep(500, nrow(data)),
  ub = rep(3000, nrow(data)),
  opts = list("algorithm" = "NLOPT_LN_COBYLA", "xtol_rel" = 1e-4)
)
opt_result

## 
## Call:
## 
## nloptr(x0 = rep(mean(data$Annual_Premium), nrow(data)), eval_f = objective, 
##     lb = rep(500, nrow(data)), ub = rep(3000, nrow(data)), opts = list(algorithm = "NLOPT_LN_COBYLA", 
##         xtol_rel = 1e-04))
## 
## 
## Minimization using NLopt version 2.8.0 
## 
## NLopt solver status: 5 ( NLOPT_MAXEVAL_REACHED: Optimization stopped because 
## maxeval (above) was reached. )
## 
## Number of Iterations....: 100 
## Termination conditions:  xtol_rel: 1e-04 
## Number of inequality constraints:  0 
## Number of equality constraints:    0 
## Current value of objective function:  -274800.86509 
## Current value of controls: 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 
## 2372.653 2372.653 2372.653 2372.653 1747.653 2372.653 2372.653 2372.653 
## 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 
## 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 
## 2372.653 2372.653 1747.653 2372.653 2372.653 2372.653 2372.653 2372.653 
## 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 
## 2372.653 2372.653 2372.653 1747.653 2372.653 2372.653 2372.653 2372.653 
## 2372.653 2372.653 2372.653 2372.653 1747.653 2372.653 2372.653 2372.653 
## 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 
## 2372.653 1747.653 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 
## 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 
## 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 2372.653 
## 2372.653 2372.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 
## 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653 1747.653

library(shiny)
library(ggplot2)

ui <- fluidPage(
  titlePanel("Pricing Optimization Dashboard"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("age", "Customer Age:", min = 20, max = 70, value = 40),
      numericInput("claims", "Claim Frequency:", value = 1, min = 0),
      numericInput("severity", "Claim Severity:", value = 5000, min = 0)
    ),
    mainPanel(
      plotOutput("premiumPlot")
    )
  )
)

server <- function(input, output) {
  output$premiumPlot <- renderPlot({
    predicted <- predict(model, data.frame(
      Claim_Frequency = input$claims,
      Claim_Severity = input$severity,
      Age_Group = ifelse(input$age < 30, "Young",
                         ifelse(input$age < 60, "Middle-aged", "Senior"))
    ))
    ggplot(data, aes(x = Predicted_Premium)) +
      geom_histogram(fill = "blue", color = "black", bins = 30) +
      geom_vline(xintercept = predicted, color = "red", linetype = "dashed") +
      labs(title = "Predicted Premium", x = "Premium", y = "Frequency")
  })
}

shinyApp(ui, server)

Shiny applications not supported in static R Markdown documents

Pricing Optimization Workshop

X

2025-04-04