Support Vector Machines & Kernel Methods (R) — e1071 · kernlab¶

Max-margin classification, the kernel trick, and kernel ridge = Gaussian process¶

e1071::svm (the R interface to LIBSVM) and kernlab are the reference R kernel-machine packages — the cross-check for the from-scratch Pegasos SVM and kernel ridge in the Python notebook. We fit a linear SVM (max-margin, hinge loss) against a row-matched logistic, show the kernel trick turning a linear machine nonlinear on the two-moons data, fit SVR and kernel ridge on California, and verify the bridge to the Bayesian Nonparametrics section: kernel ridge = the posterior mean of a Gaussian process (kernlab::gausspr), the same estimator benchmarked in Bayesian Nonparametric Prediction and developed at length in Gaussian-Process Regression. SVMs are $O(n^2)$, so the credit/California fits use subsamples (as the GP did). ROC-AUC is defined in the CART notebook.

In [1]:
options(repr.plot.width=12.5, repr.plot.height=4.8)
.libPaths(c("C:/Users/user/R/win-library/4.6", .libPaths()))
suppressMessages({library(e1071); library(kernlab)})
auc <- function(y,p){ r<-rank(p); n1<-sum(y==1); n0<-sum(y==0); (sum(r[y==1])-n1*(n1+1)/2)/(n1*n0) }
rmse <- function(a,b) sqrt(mean((a-b)^2))
cat("e1071", as.character(packageVersion("e1071")), "| kernlab", as.character(packageVersion("kernlab")), "\n")
e1071 1.7.17 | kernlab 0.9.33 

1. Max-margin — a linear SVM¶

The SVM seeks the widest-margin separating hyperplane under the hinge loss; only the support vectors (points on or inside the margin) shape it. The left panel shows the boundary, margins and support vectors on a 2-D toy; then we fit a linear SVM to the credit data and compare its out-of-sample AUC to a logistic baseline fit to the same rows, so that subsampling cannot be mistaken for a difference between the losses.

In [2]:
set.seed(0)
# 2-D toy: two gaussian blobs
n0<-120; A<-cbind(rnorm(n0,-1.3,0.85),rnorm(n0,-1.3,0.85)); B<-cbind(rnorm(n0,1.3,0.85),rnorm(n0,1.3,0.85))
Xt<-rbind(A,B); yt<-factor(rep(c(0,1),each=n0)); dt<-data.frame(x1=Xt[,1],x2=Xt[,2],y=yt)
sv<-svm(y~., data=dt, kernel="linear", cost=1, scale=FALSE)
par(mfrow=c(1,2), mar=c(4,4,3,1))
g<-expand.grid(x1=seq(-4,4,length=200), x2=seq(-4,4,length=200))
dv<-attr(predict(sv,g,decision.values=TRUE),"decision.values")[,1]
image(seq(-4,4,length=200),seq(-4,4,length=200),matrix(dv>0,200), col=c("#2b6cb022","#c5303022"),
      xlab="x1", ylab="x2", main="Max-margin linear SVM (e1071)")
contour(seq(-4,4,length=200),seq(-4,4,length=200),matrix(dv,200), levels=c(-1,0,1), lty=c(2,1,2), lwd=c(1,2,1), add=TRUE)
points(Xt, col=ifelse(yt==0,"#2b6cb0","#c53030"), pch=19, cex=0.6)
points(Xt[sv$index,], col="#2f855a", cex=1.6, lwd=1.5)
legend("topleft", c("support vectors"), col="#2f855a", pch=1, bty="n", cex=0.8)
# credit
d<-read.csv("credit_default.csv"); feat<-setdiff(names(d),"default")
set.seed(0); i<-sample(nrow(d),0.7*nrow(d)); tr<-d[i,]; te<-d[-i,]
sc<-scale(tr[,feat]); ctr<-as.data.frame(sc); ctr$y<-factor(tr$default)
cte<-as.data.frame(scale(te[,feat], center=attr(sc,"scaled:center"), scale=attr(sc,"scaled:scale")))
sub<-sample(nrow(ctr),3000)
lsv<-svm(y~., data=ctr[sub,], kernel="linear", cost=1, probability=TRUE)
plin<-attr(predict(lsv, cte, probability=TRUE),"probabilities")[,"1"]
svm_lin_auc<-auc(te$default, plin)
glm_auc<-auc(te$default, predict(glm(default~., tr, family=binomial), te, type="response"))
gsub_df<-ctr[sub,feat]; gsub_df$default<-tr$default[sub]                 # logistic on the SVM's own 3,000 rows
glm_sub_auc<-auc(te$default, predict(glm(default~., gsub_df, family=binomial), cte, type="response"))
plot.new(); text(0.5,0.5, sprintf("Credit default -- test AUC\n\n linear SVM (e1071, 3k) : %.3f\n logistic (glm, 3k)     : %.3f\n logistic (glm, full)   : %.3f\n\nThe linear SVM lands just under the\nlogistic -- and not for want of rows:\nmatched on the same 3,000, the logistic\nstill wins. Max-margin buys nothing when\nthe classes overlap and the boundary\nis near-linear.", svm_lin_auc, glm_sub_auc, glm_auc), cex=1.05, family="mono")
par(mfrow=c(1,1))
cat(sprintf("linear SVM %.3f against a logistic fit to the same 3,000 rows %.3f (and %.3f on all %d) -- the max-margin\n", svm_lin_auc, glm_sub_auc, glm_auc, nrow(tr)))
cat(sprintf("loss gives up about %.3f AUC here, and subsampling is not the reason: the logistic barely moves between\n", glm_sub_auc-svm_lin_auc))
cat(sprintf("3,000 rows and 21,000. Only the %d support vectors set the boundary; the rest could be moved freely.\n", lsv$tot.nSV))
Warning message:
"glm.fit: fitted probabilities numerically 0 or 1 occurred"
Warning message:
"glm.fit: fitted probabilities numerically 0 or 1 occurred"
linear SVM 0.699 against a logistic fit to the same 3,000 rows 0.713 (and 0.712 on all 21000) -- the max-margin
loss gives up about 0.014 AUC here, and subsampling is not the reason: the logistic barely moves between
3,000 rows and 21,000. Only the 1343 support vectors set the boundary; the rest could be moved freely.
No description has been provided for this image

2. The kernel trick — going nonlinear¶

Swapping the inner product for an RBF kernel $k(x,x')=e^{-\sigma\lVert x-x'\rVert^2}$ lifts the data into an implicit high-dimensional space where a linear margin becomes a curved boundary. On the two-moons data the linear SVM fails and the radial SVM separates cleanly. On the real credit data the RBF kernel adds little — overlapping, imbalanced classes offer scant nonlinear structure.

In [3]:
set.seed(1); n<-200; t<-runif(n,0,pi)
M<-rbind(cbind(cos(t),sin(t)), cbind(1-cos(t),1-sin(t)-0.5)) + matrix(rnorm(4*n,0,0.14),2*n,2)
dm<-data.frame(x1=M[,1],x2=M[,2],y=factor(rep(c(0,1),each=n)))
lin<-svm(y~.,dm,kernel="linear",cost=1,scale=FALSE); rad<-svm(y~.,dm,kernel="radial",cost=1,gamma=1,scale=FALSE)
gm<-expand.grid(x1=seq(-1.6,2.6,length=200), x2=seq(-1.4,1.9,length=200))
par(mfrow=c(1,2), mar=c(4,4,3,1))
for(pair in list(list(lin,"Linear SVM -- cannot separate"), list(rad,"RBF-kernel SVM -- curved margin"))){
  mdl<-pair[[1]]; z<-attr(predict(mdl,gm,decision.values=TRUE),"decision.values")[,1]
  image(seq(-1.6,2.6,length=200),seq(-1.4,1.9,length=200),matrix(z>0,200), col=c("#2b6cb022","#c5303022"),
        xlab="x1",ylab="x2",main=sprintf("%s (acc %.2f)", pair[[2]], mean(predict(mdl,dm)==dm$y)))
  contour(seq(-1.6,2.6,length=200),seq(-1.4,1.9,length=200),matrix(z,200), levels=0, lwd=2, add=TRUE)
  points(M, col=ifelse(dm$y==0,"#2b6cb0","#c53030"), pch=19, cex=0.5) }
par(mfrow=c(1,1))
rsv<-svm(y~., data=ctr[sub,], kernel="radial", cost=1, gamma=0.02, probability=TRUE)
prad<-attr(predict(rsv, cte, probability=TRUE),"probabilities")[,"1"]; svm_rbf_auc<-auc(te$default, prad)
cat(sprintf("RBF SVM on credit (subsample 3000): AUC %.3f, against the linear SVM's %.3f and the logistic's %.3f. The\n", svm_rbf_auc, svm_lin_auc, glm_sub_auc))
cat("kernel recovers part of the gap and finds no more -- overlapping, imbalanced classes hold little smooth structure,\n")
cat("and the curved boundary costs O(n^2) to buy it. The kernel earns its keep on the regression task instead.\n")
RBF SVM on credit (subsample 3000): AUC 0.706, against the linear SVM's 0.699 and the logistic's 0.713. The
kernel recovers part of the gap and finds no more -- overlapping, imbalanced classes hold little smooth structure,
and the curved boundary costs O(n^2) to buy it. The kernel earns its keep on the regression task instead.
No description has been provided for this image

3. Kernel ridge & SVR — California, and the GP bridge¶

For regression the kernel attaches to ridge regression: kernel ridge solves $\alpha=(K+\lambda I)^{-1}y$. We compute it by hand with a kernlab RBF kernel matrix, fit SVR (e1071, $\varepsilon$-insensitive) alongside, and — the key identity — verify that kernel ridge equals kernlab::gausspr, a Gaussian process with matched noise variance. Both beat the linear model; and kernel ridge and the GP produce the same predictions, differing only in that the GP also returns uncertainty. Fit on a 1,500-point subsample.

In [4]:
h<-read.csv("cali_housing.csv"); hf<-setdiff(names(h),"MedHouseVal")
set.seed(0); j<-sample(nrow(h),0.7*nrow(h)); htr<-h[j,]; hte<-h[-j,]
Rtr<-scale(htr[,hf]); Rte<-scale(hte[,hf], center=attr(Rtr,"scaled:center"), scale=attr(Rtr,"scaled:scale"))
Rtr<-matrix(as.numeric(Rtr),nrow(htr)); Rte<-matrix(as.numeric(Rte),nrow(hte))
set.seed(1); s2<-sample(nrow(Rtr),1500); Xs<-Rtr[s2,]; ys<-htr$MedHouseVal[s2]
ym<-mean(ys); ysd<-sd(ys); yz<-(ys-ym)/ysd
sig<-0.125                                             # RBF sigma (1/n_features)
rbf<-rbfdot(sigma=sig); K<-kernelMatrix(rbf, Xs); lambda<-1
alpha<-solve(K + lambda*diag(nrow(Xs)), yz)            # kernel ridge, by hand
Ktest<-kernelMatrix(rbf, Rte, Xs); pred_kr<-as.numeric(Ktest %*% alpha)*ysd + ym
gp<-gausspr(Xs, yz, kernel="rbfdot", kpar=list(sigma=sig), var=lambda, scaled=FALSE)  # GP, matched noise
pred_gp<-as.numeric(predict(gp, Rte))*ysd + ym
svr<-svm(x=Xs, y=ys, type="eps-regression", kernel="radial", gamma=sig, cost=1)
svr_ns<-svm(x=Xs, y=ys, type="eps-regression", kernel="radial", gamma=sig, cost=1, scale=FALSE)
svr_ns_rmse<-rmse(hte$MedHouseVal, as.numeric(predict(svr_ns, Rte)))
pred_svr<-as.numeric(predict(svr, Rte))
kr_rmse<-rmse(hte$MedHouseVal,pred_kr); svr_rmse<-rmse(hte$MedHouseVal,pred_svr)
cat(sprintf("California test RMSE -- kernel ridge %.3f  SVR %.3f  (linear model 0.737)\n", kr_rmse, svr_rmse))
cat(sprintf("kernel ridge vs GP (gausspr) posterior mean: max|diff| %.2e, correlation %.5f -- the SAME estimator.\n",
    max(abs(pred_kr-pred_gp)), cor(pred_kr,pred_gp)))
cat(sprintf("SVR beats kernel ridge here by %.3f, which the Python notebook does not see. The cause is a default: e1071\n", kr_rmse-svr_rmse))
cat(sprintf("scales x and y unless told otherwise, and with scale=FALSE the identical call gives %.3f instead. That is not\n", svr_ns_rmse))
cat("cosmetic. An isotropic RBF kernel measures distance in whatever units it is handed, so rescaling the features IS a\n")
cat("change of kernel. AveOccup is what makes it bite: its full-sample SD is set by a handful of extreme blocks, so the\n")
cat("standardised subsample is nearly constant along that axis (SD 0.11) until e1071 restandardises it back to 1.\n")
par(mfrow=c(1,2), mar=c(4,4,3,1))
plot(pred_kr, hte$MedHouseVal, pch=".", col="#a0aec0", xlab="kernel-ridge predicted ($100k)", ylab="actual",
     main=sprintf("California -- kernel ridge (RMSE %.3f)", kr_rmse)); abline(0,1,lty=2)
qb<-quantile(pred_kr,seq(0,1,length=11)); bb<-cut(pred_kr,unique(qb),include.lowest=TRUE)
points(tapply(pred_kr,bb,mean), tapply(hte$MedHouseVal,bb,mean), type="b", pch=19, col="#c53030", lwd=2)
plot(pred_kr, pred_gp, pch=".", col="#6b46c1", xlab="kernel ridge", ylab="GP posterior mean (gausspr)",
     main=sprintf("Same prediction: max|diff| %.1e", max(abs(pred_kr-pred_gp)))); abline(0,1,lty=2)
par(mfrow=c(1,1))
California test RMSE -- kernel ridge 0.655  SVR 0.601  (linear model 0.737)
kernel ridge vs GP (gausspr) posterior mean: max|diff| 5.46e-14, correlation 1.00000 -- the SAME estimator.
SVR beats kernel ridge here by 0.054, which the Python notebook does not see. The cause is a default: e1071
scales x and y unless told otherwise, and with scale=FALSE the identical call gives 0.656 instead. That is not
cosmetic. An isotropic RBF kernel measures distance in whatever units it is handed, so rescaling the features IS a
change of kernel. AveOccup is what makes it bite: its full-sample SD is set by a handful of extreme blocks, so the
standardised subsample is nearly constant along that axis (SD 0.11) until e1071 restandardises it back to 1.
No description has been provided for this image

4. Scoreboard and summary¶

Support-vector and kernel methods beside the running field. Linear and RBF SVM, kernel ridge and SVR are computed here, and the logistic and linear baselines are refitted; the forest, XGBoost, GP and GAM figures are carried from the R notebooks, which share this notebook's set.seed(0) 70/30 split. Python's corresponding numbers come from a different split and are not interchangeable with these.

In [5]:
lin_rmse<-rmse(hte$MedHouseVal, predict(lm(MedHouseVal~., htr), hte))
# carried figures are the R notebooks' own, on this same set.seed(0) 70/30 split -- not the Python ones,
# which come from a different split and would make the bars incomparable.
credit<-c("logistic"=glm_auc, "linear SVM"=svm_lin_auc, "RBF SVM"=svm_rbf_auc,
          "random forest"=0.774, "XGBoost"=0.776, "GP (R BNP nb)"=0.739, "GAM (R BNP nb)"=0.743)
cali  <-c("linear"=lin_rmse, "kernel ridge"=kr_rmse, "SVR"=svr_rmse,
          "random forest"=0.491, "XGBoost"=0.484, "GP (R BNP nb)"=0.611, "GAM (R BNP nb)"=0.607)
kerc<-c("#dd6b20","#dd6b20");
par(mfrow=c(1,2), mar=c(4,7,3,1))
colc<-ifelse(names(credit)%in%c("linear SVM","RBF SVM"),"#dd6b20", ifelse(grepl("BNP",names(credit)),"#6b46c1","#a0aec0"))
barplot(rev(credit), horiz=TRUE, las=1, xlim=c(0.5,0.8), col=rev(colc), main="Credit -- test AUC (higher better)")
cola<-ifelse(names(cali)%in%c("kernel ridge","SVR"),"#dd6b20", ifelse(grepl("BNP",names(cali)),"#6b46c1","#a0aec0"))
barplot(rev(cali), horiz=TRUE, las=1, col=rev(cola), main="California -- test RMSE (lower better)")
par(mfrow=c(1,1))
cat("Kernel methods (orange) land just under the logistic on credit and clear the linear model on California -- where\n")
cat("kernel ridge IS the GP mean. Trees and boosting still lead raw accuracy at full scale, and kernels pay the O(n^2)\n")
cat("cost that forces subsampling -- the standing reason they do not own large tabular problems.\n")
Kernel methods (orange) land just under the logistic on credit and clear the linear model on California -- where
kernel ridge IS the GP mean. Trees and boosting still lead raw accuracy at full scale, and kernels pay the O(n^2)
cost that forces subsampling -- the standing reason they do not own large tabular problems.
No description has been provided for this image

Are the Platt-scaled probabilities honest?¶

e1071 returns probabilities only when asked (probability=TRUE), and it obtains them by Platt scaling — a logistic fitted to the SVM's decision values by internal cross-validation, since a margin classifier has no probability of its own. The reliability curve tests whether that retro-fit produces something usable: bin by predicted probability, plot the observed default rate, and compare against a logistic that estimates one directly.

In [6]:
rel <- function(p, y, lab, col) {
  q <- unique(quantile(p, seq(0,1,length=11))); b <- cut(p, q, include.lowest=TRUE)
  pp <- tapply(p,b,mean); oo <- tapply(y,b,mean); w <- as.numeric(table(b))/length(y)
  ece <- sum(w*abs(oo-pp), na.rm=TRUE)
  list(pp=as.numeric(pp), oo=as.numeric(oo), ece=ece, lab=lab, col=col)
}
draw <- function(L, main) {
  xm <- max(sapply(L, function(z) max(z$pp))); ym <- max(sapply(L, function(z) max(z$oo)))
  plot(NA, xlim=c(0,xm), ylim=c(0,max(xm,ym)), xlab="predicted P(default)",
       ylab="observed default rate", main=main); abline(0,1,lty=2)
  for (z in L) lines(z$pp, z$oo, type="b", pch=19, col=z$col, lwd=2)
  legend("topleft", sapply(L, function(z) sprintf("%s (ECE %.3f)", z$lab, z$ece)),
         col=sapply(L, function(z) z$col), lwd=2, pch=19, bty="n", cex=0.8)
}
options(repr.plot.width=7, repr.plot.height=5); par(mar=c(4,4,3,1))
pglm <- predict(glm(default~., gsub_df, family=binomial), cte, type="response")
L <- list(rel(plin, te$default, "linear SVM + Platt", "#dd6b20"),
          rel(prad, te$default, "RBF SVM + Platt",    "#2b6cb0"),
          rel(pglm, te$default, "logistic",           "#a0aec0"))
draw(L, "Reliability of the Platt-scaled SVM scores")
for (z in L) cat(sprintf("%-22s ECE %.3f  mean predicted %.3f  base rate %.3f\n",
                         z$lab, z$ece, mean(get(c("plin","prad","pglm")[which(sapply(L,function(q) q$lab)==z$lab)])),
                         mean(te$default)))
cat("\nAn SVM has no probability of its own -- Platt scaling fits one to the decision values afterwards, so the\n")
cat("reliability curve is the check on whether that retro-fit is usable. Compare the ECE figures with the AUC\n")
cat("ranking earlier in the notebook: they measure different things, and a model can rank well while its fitted\n")
cat("probabilities drift. For triage the ranking is enough; for anything that feeds an expected-loss calculation\n")
cat("the diagonal is what matters.\n")
Warning message:
"glm.fit: fitted probabilities numerically 0 or 1 occurred"
linear SVM + Platt     ECE 0.054  mean predicted 0.220  base rate 0.221
RBF SVM + Platt        ECE 0.030  mean predicted 0.219  base rate 0.221
logistic               ECE 0.052  mean predicted 0.217  base rate 0.221
An SVM has no probability of its own -- Platt scaling fits one to the decision values afterwards, so the
reliability curve is the check on whether that retro-fit is usable. Compare the ECE figures with the AUC
ranking earlier in the notebook: they measure different things, and a model can rank well while its fitted
probabilities drift. For triage the ranking is enough; for anything that feeds an expected-loss calculation
the diagonal is what matters.
No description has been provided for this image

Summary¶

e1071 and kernlab reproduce the Python notebook: a max-margin linear SVM that lands just under the logistic on credit even when the two are matched row for row, the RBF kernel bending a linear machine around the two-moons data, and kernel ridge / SVR beating the linear model on California (0.74 → 0.65). The headline identity is verified in R too — kernel ridge equals kernlab::gausspr, a Gaussian process — so the frequentist kernel machine and the Bayesian nonparametric one are the same estimator, differing only in the GP's extra uncertainty. Kernels share the GP's $O(n^2\!-\!n^3)$ cost, the standing reason boosting dominates large tabular data.

This is the package mirror of svm_kernels_python.ipynb, closing the Regularized & Kernel Learning subsection: penalised linear models and their kernelised, max-margin relatives, cross-linked throughout to their Bayesian counterparts (shrinkage priors and Gaussian processes).