The maximal margin classifier, support vector classifier, and support vector machine are all classification methods that use a hyperplane to separate data into different classes. The maximal margin classifier finds the hyperplane that creates the largest possible margin between two classes but requires the data to be perfectly linearly separable. The support vector classifier builds on this by allowing some data points to fall within the margin or be misclassified, making it more flexible with real-world data. The support vector machine (SVM) extends the support vector classifier by using a technique called the kernel trick, which allows it to create nonlinear decision boundaries when the data cannot be separated using a straight line. The main difference is that each method becomes more flexible: the maximal margin classifier requires perfect separation, the support vector classifier allows some errors, and the SVM can handle nonlinear relationships.
SVMs are naturally designed for binary classification, but they can be adapted to handle multiple classes using two common approaches: one-vs-one and one-vs-rest. In the one-vs-one approach, a separate SVM is trained for every possible pair of classes, and the model predicts the final class based on which class wins the most comparisons. In the one-vs-rest approach, a separate SVM is trained for each class, where that class is compared against all the remaining classes combined. The model then assigns a new observation to the class with the highest prediction score. Both methods allow SVMs to classify data into more than two categories.
library(ggplot2)
data <- data.frame(
X1 = c(3, 2, 4, 1, 2, 4, 4),
X2 = c(4, 2, 4, 4, 1, 3, 1),
Y = c("Red", "Red", "Red", "Red", "Blue", "Blue", "Blue"))
ggplot(data, aes(x = X1, y = X2, color = Y)) +
geom_point(size = 3) +
scale_color_manual(values = c("Red" = "red","Blue" = "blue")) +
labs(title = "Toy Dataset", x = "X1", y = "X2") +
theme_minimal()
ggplot(data, aes(x = X1, y = X2, color = Y)) +
geom_point(size = 3) +
geom_abline(intercept = -0.5, slope = 1,
color = "black", linewidth = 1) +
scale_color_manual(values = c("Red" = "red",
"Blue" = "blue")) +
labs(title = "Optimal Separating Hyperplane",
x = "X1", y = "X2") +
theme_minimal()
support_vectors <- data[c(2, 3, 5, 6), ]
ggplot(data, aes(x = X1, y = X2, color = Y)) +
geom_point(size = 3) +
geom_abline(intercept = -0.5, slope = 1,
color = "black", linewidth = 1) +
geom_abline(intercept = 0, slope = 1,
color = "darkgreen", linetype = "dashed") +
geom_abline(intercept = -1, slope = 1,
color = "darkgreen", linetype = "dashed") +
geom_point(data = support_vectors,
aes(x = X1, y = X2),
inherit.aes = FALSE,
shape = 21, size = 5,
fill = NA, color = "black") +
scale_color_manual(values = c("Red" = "red",
"Blue" = "blue")) +
labs(title = "Margins and Support Vectors",
x = "X1", y = "X2") +
theme_minimal()
M = 1/√(-2)^2 + (2)^2 = .354
Observation 7 is not a support vector because it is far from the separating hyperplane. Therefore, slightly moving this observation does not affect the optimal hyperplane because the hyperplane is determined by the support vectors.
ggplot(data, aes(x = X1, y = X2, color = Y)) +
geom_point(size = 3) +
geom_abline(intercept = -0.5, slope = 1,
color = "black", linewidth = 1) +
geom_abline(intercept = -0.25, slope = 1,
color = "orange", linetype = "dashed",
linewidth = 1) +
scale_color_manual(values = c("Red" = "red",
"Blue" = "blue")) +
labs(title = "Optimal vs. Non-Optimal Hyperplane",
x = "X1", y = "X2") +
theme_minimal()
One possible non-optimal seperating hyperplane is X1 - X2 = .25. It is not optimal because it still seperates the two classes but does not maximize the margin between them.
data_new <- rbind(
data,
data.frame(X1 = 2, X2 = 2, Y = "Blue")
)
ggplot(data_new, aes(x = X1, y = X2, color = Y)) +
geom_point(size = 4,
position = position_jitter(width = 0.04,
height = 0.04)) +
scale_color_manual(values = c("Red" = "red",
"Blue" = "blue")) +
labs(title = "Overlapping Classes",
x = "X1", y = "X2") +
theme_minimal()
Adding a Blue observation at (2,2), where a Red observation already exists, makes the two classes no longer perfectly linearly separable because observations from different classes share the same coordinates.
library(ISLR2)
?OJ
data <- OJlibrary(tidyverse)── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr 1.2.1 ✔ readr 2.1.5
✔ forcats 1.0.0 ✔ stringr 1.5.1
✔ lubridate 1.9.4 ✔ tibble 3.3.0
✔ purrr 1.1.0 ✔ tidyr 1.3.1
── 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 errorslibrary(corrplot)corrplot 0.95 loadeddim(data)[1] 1070 18str(data)'data.frame': 1070 obs. of 18 variables:
$ Purchase : Factor w/ 2 levels "CH","MM": 1 1 1 2 1 1 1 1 1 1 ...
$ WeekofPurchase: num 237 239 245 227 228 230 232 234 235 238 ...
$ StoreID : num 1 1 1 1 7 7 7 7 7 7 ...
$ PriceCH : num 1.75 1.75 1.86 1.69 1.69 1.69 1.69 1.75 1.75 1.75 ...
$ PriceMM : num 1.99 1.99 2.09 1.69 1.69 1.99 1.99 1.99 1.99 1.99 ...
$ DiscCH : num 0 0 0.17 0 0 0 0 0 0 0 ...
$ DiscMM : num 0 0.3 0 0 0 0 0.4 0.4 0.4 0.4 ...
$ SpecialCH : num 0 0 0 0 0 0 1 1 0 0 ...
$ SpecialMM : num 0 1 0 0 0 1 1 0 0 0 ...
$ LoyalCH : num 0.5 0.6 0.68 0.4 0.957 ...
$ SalePriceMM : num 1.99 1.69 2.09 1.69 1.69 1.99 1.59 1.59 1.59 1.59 ...
$ SalePriceCH : num 1.75 1.75 1.69 1.69 1.69 1.69 1.69 1.75 1.75 1.75 ...
$ PriceDiff : num 0.24 -0.06 0.4 0 0 0.3 -0.1 -0.16 -0.16 -0.16 ...
$ Store7 : Factor w/ 2 levels "No","Yes": 1 1 1 1 2 2 2 2 2 2 ...
$ PctDiscMM : num 0 0.151 0 0 0 ...
$ PctDiscCH : num 0 0 0.0914 0 0 ...
$ ListPriceDiff : num 0.24 0.24 0.23 0 0 0.3 0.3 0.24 0.24 0.24 ...
$ STORE : num 1 1 1 1 0 0 0 0 0 0 ...summary(data) Purchase WeekofPurchase StoreID PriceCH PriceMM
CH:653 Min. :227.0 Min. :1.00 Min. :1.690 Min. :1.690
MM:417 1st Qu.:240.0 1st Qu.:2.00 1st Qu.:1.790 1st Qu.:1.990
Median :257.0 Median :3.00 Median :1.860 Median :2.090
Mean :254.4 Mean :3.96 Mean :1.867 Mean :2.085
3rd Qu.:268.0 3rd Qu.:7.00 3rd Qu.:1.990 3rd Qu.:2.180
Max. :278.0 Max. :7.00 Max. :2.090 Max. :2.290
DiscCH DiscMM SpecialCH SpecialMM
Min. :0.00000 Min. :0.0000 Min. :0.0000 Min. :0.0000
1st Qu.:0.00000 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000
Median :0.00000 Median :0.0000 Median :0.0000 Median :0.0000
Mean :0.05186 Mean :0.1234 Mean :0.1477 Mean :0.1617
3rd Qu.:0.00000 3rd Qu.:0.2300 3rd Qu.:0.0000 3rd Qu.:0.0000
Max. :0.50000 Max. :0.8000 Max. :1.0000 Max. :1.0000
LoyalCH SalePriceMM SalePriceCH PriceDiff Store7
Min. :0.000011 Min. :1.190 Min. :1.390 Min. :-0.6700 No :714
1st Qu.:0.325257 1st Qu.:1.690 1st Qu.:1.750 1st Qu.: 0.0000 Yes:356
Median :0.600000 Median :2.090 Median :1.860 Median : 0.2300
Mean :0.565782 Mean :1.962 Mean :1.816 Mean : 0.1465
3rd Qu.:0.850873 3rd Qu.:2.130 3rd Qu.:1.890 3rd Qu.: 0.3200
Max. :0.999947 Max. :2.290 Max. :2.090 Max. : 0.6400
PctDiscMM PctDiscCH ListPriceDiff STORE
Min. :0.0000 Min. :0.00000 Min. :0.000 Min. :0.000
1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:0.140 1st Qu.:0.000
Median :0.0000 Median :0.00000 Median :0.240 Median :2.000
Mean :0.0593 Mean :0.02731 Mean :0.218 Mean :1.631
3rd Qu.:0.1127 3rd Qu.:0.00000 3rd Qu.:0.300 3rd Qu.:3.000
Max. :0.4020 Max. :0.25269 Max. :0.440 Max. :4.000 colSums(is.na(data)) Purchase WeekofPurchase StoreID PriceCH PriceMM
0 0 0 0 0
DiscCH DiscMM SpecialCH SpecialMM LoyalCH
0 0 0 0 0
SalePriceMM SalePriceCH PriceDiff Store7 PctDiscMM
0 0 0 0 0
PctDiscCH ListPriceDiff STORE
0 0 0 # Class balance
table(data$Purchase)
CH MM
653 417 prop.table(table(data$Purchase))
CH MM
0.6102804 0.3897196 # Redundancy checks
all.equal(data$SalePriceMM, data$PriceMM - data$DiscMM)[1] TRUEall.equal(data$SalePriceCH, data$PriceCH - data$DiscCH)[1] TRUEall.equal(data$PriceDiff, data$SalePriceMM - data$SalePriceCH)[1] TRUEall.equal(data$ListPriceDiff, data$PriceMM - data$PriceCH)[1] TRUEall.equal(data$PctDiscMM, data$DiscMM / data$PriceMM)[1] "Mean relative difference: 1.111884e-06"all.equal(data$PctDiscCH, data$DiscCH / data$PriceCH)[1] "Mean relative difference: 1.938302e-06"table(data$StoreID, data$STORE)
0 1 2 3 4
1 0 157 0 0 0
2 0 0 222 0 0
3 0 0 0 196 0
4 0 0 0 0 139
7 356 0 0 0 0table(data$StoreID, data$Store7)
No Yes
1 157 0
2 222 0
3 196 0
4 139 0
7 0 356# Plots
ggplot(data, aes(Purchase, fill = Purchase)) + geom_bar() +
labs(title = "Class balance of Purchase")
ggplot(data, aes(Purchase, LoyalCH, fill = Purchase)) + geom_boxplot() +
labs(title = "Brand loyalty to CH by purchase")
ggplot(data, aes(Purchase, PriceDiff, fill = Purchase)) + geom_boxplot() +
labs(title = "Sale price difference (MM - CH) by purchase")
ggplot(data, aes(factor(StoreID), fill = Purchase)) +
geom_bar(position = "fill") + labs(x = "StoreID", y = "Proportion")
ggplot(data, aes(factor(SpecialMM), fill = Purchase)) +
geom_bar(position = "fill") + labs(x = "SpecialMM", y = "Proportion")
num <- data %>% select(where(is.numeric))
corrplot(cor(num), method = "color", tl.cex = 0.7)
There are 1070 observations.
There are 17 predictors plus the response Purchase. WeekofPurchase, StoreID, PriceCH, PriceMM, DiscCH, DiscMM, SpecialCH, SpecialMM, LoyalCH, SalePriceCH, SalePriceMM, PriceDiff, Store7, PctDiscCH, PctDiscMM, ListPriceDiff, and STORE.
There are multiple redundant predictors. SalePriceMM = PriceMM - DiscMM and SalePriceCH = PriceCH - DiscCH, PriceDiff = SalePriceMM - SalePriceCH, ListPriceDiff = PriceMM − PriceCH, PctDiscMM = DiscMM / PriceMM and PctDiscCH = DiscCH / PriceCH, and STORE7 is just StoreID == 7, and STORE is the same store information as StoreID. I’d handle them by dropping Store7 and STORE, keeping StoreID as one store variable. For the price block, keep a non-redundant subset such as PriceCH, PriceMM, DiscCH, DiscMM, and drop the variables derived from them (SalePriceCH, SalePriceMM, PriceDiff, ListPriceDiff, PctDiscCH, PctDiscMM). Alternatively, keep PriceDiff and drop the components. Removing these avoids multicollinearity, which is especially a problem for logistic regression, LDA and QDA.
StoreID is stored as a number but is a categorical label, so it should be converted to a factor. The same applies to STORE if you keep it.SpecialCH and SpecialMM are 0/1 indicators, so convert them to factors (or leave them as 0/1 dummies). WeekofPurchase is a week index, not a measurement. It can be kept as numeric, though it only reflects time. It is the weakest predictor and could also be dropped. Purchase is already a factor with levels CH and MM, which is the correct format. The continuous predictors are on very different scales (loyalty is 0 to 1, week is 227 to 278), so standardize them before scale-sensitive methods such as SVM or KNN.
data <- data %>%
select(-Store7, -STORE, -SalePriceCH, -SalePriceMM, -PriceDiff,
-ListPriceDiff, -PctDiscCH, -PctDiscMM) %>%
mutate(StoreID = factor(StoreID),
SpecialCH = factor(SpecialCH),
SpecialMM = factor(SpecialMM))It is moderately imbalanced. About 653 (61%) are CH and 417 (39%) are MM. This is not severe, but accuracy should be judged against the 61% baseline of always predicting CH. Use a stratified train/test split and look at the confusion matrix, sensitivity and specificity, not just accuracy.
Class bar chart: confirms the 61/39 split in favor of CH. LoyalCH by Purchase: this is the strongest relationship. CH buyers have clearly higher loyalty to CH, and MM buyers have clearly lower loyalty, with little overlap. LoyalCH should be the most important predictor. PriceDiff by Purchase: when MM is relatively expensive (large positive PriceDiff), customers are more likely to buy CH. When MM is discounted, MM purchases rise. The effect is weaker than loyalty. Purchase by StoreID and by SpecialMM: the MM share varies somewhat across stores, and MM promotions are associated with more MM purchases. These are modest effects compared with loyalty. Correlation plot: shows the clusters of highly correlated price and discount variables, supporting the removal of redundant predictors above.
library(caret)Loading required package: lattice
Attaching package: 'caret'The following object is masked from 'package:purrr':
liftset.seed(320)
data <- OJ
data <- data %>%
select(-Store7, -STORE, -SalePriceCH, -SalePriceMM, -PriceDiff,
-ListPriceDiff, -PctDiscCH, -PctDiscMM) %>%
mutate(StoreID = factor(StoreID),
SpecialCH = factor(SpecialCH),
SpecialMM = factor(SpecialMM))
train_idx <- createDataPartition(data$Purchase, p = 0.8, list = FALSE)
train <- data[train_idx, ]
test <- data[-train_idx, ]
prop.table(table(train$Purchase))
CH MM
0.6102684 0.3897316 prop.table(table(test$Purchase))
CH MM
0.6103286 0.3896714 num_vars <- c("WeekofPurchase", "PriceCH", "PriceMM",
"DiscCH", "DiscMM", "LoyalCH")
pp <- preProcess(train[, num_vars], method = c("center", "scale"))
train_scaled <- train
test_scaled <- test
train_scaled[, num_vars] <- predict(pp, train[, num_vars])
test_scaled[, num_vars] <- predict(pp, test[, num_vars])
round(colMeans(train_scaled[, num_vars]), 3)WeekofPurchase PriceCH PriceMM DiscCH DiscMM
0 0 0 0 0
LoyalCH
0 round(apply(train_scaled[, num_vars], 2, sd), 3)WeekofPurchase PriceCH PriceMM DiscCH DiscMM
1 1 1 1 1
LoyalCH
1 dim(train_scaled); dim(test_scaled)[1] 857 10[1] 213 10library(e1071)
Attaching package: 'e1071'The following object is masked from 'package:ggplot2':
elementset.seed(1)
tune.out <- tune(svm, Purchase ~ ., data = train_scaled,
kernel = "linear",
ranges = list(cost = seq(0.01, 5, length.out = 10)))
summary(tune.out)
Parameter tuning of 'svm':
- sampling method: 10-fold cross validation
- best parameters:
cost
0.5644444
- best performance: 0.149316
- Detailed performance results:
cost error dispersion
1 0.0100000 0.1539808 0.03649852
2 0.5644444 0.1493160 0.03611452
3 1.1188889 0.1504788 0.03837685
4 1.6733333 0.1504788 0.03837685
5 2.2277778 0.1504788 0.03837685
6 2.7822222 0.1504788 0.03837685
7 3.3366667 0.1504788 0.03837685
8 3.8911111 0.1504788 0.03837685
9 4.4455556 0.1504788 0.03837685
10 5.0000000 0.1504788 0.03837685tune.out$best.parameters cost
2 0.5644444tune.out$best.parameters$cost[1] 0.5644444best.svc <- tune.out$best.model
summary(best.svc)
Call:
best.tune(METHOD = svm, train.x = Purchase ~ ., data = train_scaled,
ranges = list(cost = seq(0.01, 5, length.out = 10)), kernel = "linear")
Parameters:
SVM-Type: C-classification
SVM-Kernel: linear
cost: 0.5644444
Number of Support Vectors: 340
( 169 171 )
Number of Classes: 2
Levels:
CH MMThe most optimal cost is .564 with an error of .149.
library(e1071)
best.svc <- tune.out$best.model
best.cost <- tune.out$best.parameters$cost
best.cost[1] 0.5644444train_pred <- predict(best.svc, newdata = train_scaled)
table(Predicted = train_pred, Actual = train_scaled$Purchase) Actual
Predicted CH MM
CH 469 70
MM 54 264train_error <- mean(train_pred != train_scaled$Purchase)
train_error[1] 0.1446908test_pred <- predict(best.svc, newdata = test_scaled)
table(Predicted = test_pred, Actual = test_scaled$Purchase) Actual
Predicted CH MM
CH 105 23
MM 25 60test_error <- mean(test_pred != test_scaled$Purchase)
test_error[1] 0.2253521library(e1071)
set.seed(1)
tune.rad <- tune(svm, Purchase ~ ., data = train_scaled,
kernel = "radial",
ranges = list(cost = seq(0.01, 5, length.out = 10),
gamma = c(0.01, 0.05, 0.1, 0.5)))
summary(tune.rad)
Parameter tuning of 'svm':
- sampling method: 10-fold cross validation
- best parameters:
cost gamma
0.5644444 0.05
- best performance: 0.1469904
- Detailed performance results:
cost gamma error dispersion
1 0.0100000 0.01 0.3897401 0.04327648
2 0.5644444 0.01 0.1574966 0.04024617
3 1.1188889 0.01 0.1504788 0.03677768
4 1.6733333 0.01 0.1516553 0.03493582
5 2.2277778 0.01 0.1528181 0.03511068
6 2.7822222 0.01 0.1528181 0.03511068
7 3.3366667 0.01 0.1551847 0.03465063
8 3.8911111 0.01 0.1551847 0.03465063
9 4.4455556 0.01 0.1551710 0.03414290
10 5.0000000 0.01 0.1528454 0.03688794
11 0.0100000 0.05 0.3897401 0.04327648
12 0.5644444 0.05 0.1469904 0.03984653
13 1.1188889 0.05 0.1493023 0.03846395
14 1.6733333 0.05 0.1539672 0.04146380
15 2.2277778 0.05 0.1528044 0.04207208
16 2.7822222 0.05 0.1528044 0.04135175
17 3.3366667 0.05 0.1539672 0.03922970
18 3.8911111 0.05 0.1551300 0.03930958
19 4.4455556 0.05 0.1562927 0.04121583
20 5.0000000 0.05 0.1597811 0.04000484
21 0.0100000 0.10 0.3897401 0.04327648
22 0.5644444 0.10 0.1528044 0.03794142
23 1.1188889 0.10 0.1551300 0.03734986
24 1.6733333 0.10 0.1574555 0.04158192
25 2.2277778 0.10 0.1551300 0.03774994
26 2.7822222 0.10 0.1574555 0.04085295
27 3.3366667 0.10 0.1632969 0.04260846
28 3.8911111 0.10 0.1668126 0.04372937
29 4.4455556 0.10 0.1668126 0.04372937
30 5.0000000 0.10 0.1644733 0.04172210
31 0.0100000 0.50 0.3897401 0.04327648
32 0.5644444 0.50 0.1714911 0.03951409
33 1.1188889 0.50 0.1761286 0.04751050
34 1.6733333 0.50 0.1866621 0.04993846
35 2.2277778 0.50 0.1901642 0.05173790
36 2.7822222 0.50 0.1936662 0.05514261
37 3.3366667 0.50 0.1959918 0.05527579
38 3.8911111 0.50 0.1959918 0.05527579
39 4.4455556 0.50 0.1971546 0.05756433
40 5.0000000 0.50 0.1948153 0.05582772tune.rad$best.parameters cost gamma
12 0.5644444 0.05tune.rad$best.parameters$cost[1] 0.5644444tune.rad$best.parameters$gamma[1] 0.05tune.rad$best.performance[1] 0.1469904best.rad <- tune.rad$best.modelThe optimal cost is .564 with gamma = 0.05
library(e1071)
best.rad <- tune.rad$best.model
tune.rad$best.parameters cost gamma
12 0.5644444 0.05train_pred_rad <- predict(best.rad, newdata = train_scaled)
table(Predicted = train_pred_rad, Actual = train_scaled$Purchase) Actual
Predicted CH MM
CH 473 73
MM 50 261train_error_rad <- mean(train_pred_rad != train_scaled$Purchase)
train_error_rad[1] 0.1435239test_pred_rad <- predict(best.rad, newdata = test_scaled)
table(Predicted = test_pred_rad, Actual = test_scaled$Purchase) Actual
Predicted CH MM
CH 107 26
MM 23 57test_error_rad <- mean(test_pred_rad != test_scaled$Purchase)
test_error_rad[1] 0.2300469library(e1071)
set.seed(1)
tune.poly <- tune(svm, Purchase ~ ., data = train_scaled,
kernel = "polynomial",
ranges = list(cost = seq(0.01, 5, length.out = 10),
degree = c(2, 3, 5, 10)))
summary(tune.poly)
Parameter tuning of 'svm':
- sampling method: 10-fold cross validation
- best parameters:
cost degree
5 2
- best performance: 0.176156
- Detailed performance results:
cost degree error dispersion
1 0.0100000 2 0.3897401 0.04327648
2 0.5644444 2 0.2099179 0.04434368
3 1.1188889 2 0.1983174 0.04531856
4 1.6733333 2 0.1901231 0.04909223
5 2.2277778 2 0.1877975 0.04609385
6 2.7822222 2 0.1842818 0.04486603
7 3.3366667 2 0.1819562 0.04570209
8 3.8911111 2 0.1819836 0.04340923
9 4.4455556 2 0.1784679 0.04116267
10 5.0000000 2 0.1761560 0.03990779
11 0.0100000 3 0.3897401 0.04327648
12 0.5644444 3 0.2239672 0.04135592
13 1.1188889 3 0.2053078 0.04566565
14 1.6733333 3 0.2053078 0.04041331
15 2.2277778 3 0.1983037 0.04557853
16 2.7822222 3 0.1936252 0.04147047
17 3.3366667 3 0.1889877 0.04072439
18 3.8911111 3 0.1889877 0.03725667
19 4.4455556 3 0.1913406 0.03752360
20 5.0000000 3 0.1890014 0.03568125
21 0.0100000 5 0.3897401 0.04327648
22 0.5644444 5 0.3186047 0.03941497
23 1.1188889 5 0.2858550 0.03416847
24 1.6733333 5 0.2625034 0.03230318
25 2.2277778 5 0.2554446 0.03999361
26 2.7822222 5 0.2461423 0.03413498
27 3.3366667 5 0.2403146 0.03667708
28 3.8911111 5 0.2391518 0.03713181
29 4.4455556 5 0.2379754 0.03781402
30 5.0000000 5 0.2379754 0.03781402
31 0.0100000 10 0.3710807 0.04799501
32 0.5644444 10 0.3465937 0.04086517
33 1.1188889 10 0.3454309 0.03742819
34 1.6733333 10 0.3442681 0.03668100
35 2.2277778 10 0.3465937 0.03692017
36 2.7822222 10 0.3442544 0.03819324
37 3.3366667 10 0.3407661 0.03930503
38 3.8911111 10 0.3372640 0.03835313
39 4.4455556 10 0.3384268 0.03773923
40 5.0000000 10 0.3384268 0.03773923tune.poly$best.parameters cost degree
10 5 2tune.poly$best.parameters$cost[1] 5tune.poly$best.parameters$degree[1] 2tune.poly$best.performance[1] 0.176156best.poly <- tune.poly$best.modelUsing 10-fold CV over cost = seq(0.01, 5, length.out = 10) and degree = c(2, 3, 5, 10), the optimal hyperparameters are cost = 5 and degree = 2, with a CV error of .176.
library(e1071)
best.poly <- tune.poly$best.model
tune.poly$best.parameters cost degree
10 5 2train_pred_poly <- predict(best.poly, newdata = train_scaled)
table(Predicted = train_pred_poly, Actual = train_scaled$Purchase) Actual
Predicted CH MM
CH 487 95
MM 36 239train_error_poly <- mean(train_pred_poly != train_scaled$Purchase)
train_error_poly[1] 0.1528588test_pred_poly <- predict(best.poly, newdata = test_scaled)
table(Predicted = test_pred_poly, Actual = test_scaled$Purchase) Actual
Predicted CH MM
CH 117 33
MM 13 50test_error_poly <- mean(test_pred_poly != test_scaled$Purchase)
test_error_poly[1] 0.2159624This fits the EDA, where LoyalCH was by far the strongest predictor and the boundary between CH and MM buyers looks close to linear. Extra flexibility from the radial or polynomial kernels therefore gave little improvement, while adding complexity. The polynomial model also chose the largest cost (5) and the lowest degree (2), both at the edge of the grid. That suggests it was pushing toward the least flexible, most tightly fit option available, and a wider grid could change its result. I would choose the linear support vector classifier because it is the simplest model and generalizes about as well as the others.