L’objectif de ce chapitre est de créer une visualisation des données interactive pour expliquer le concept de séparateur à vaste marge (SVM), un modèle d’apprentissage automatique pour la classification binaire (Wikipédia 2026).
Plan du chapitre :
Nous commençons par générer deux fonctionnalités d’entrée, x1 et x2.
library(data.table)
N <- 50
set.seed(1)
getInput <- function(){
c(#rnorm(N, sd=0.3),
runif(N, -1, 1),
runif(N, -1, 1)
)
}
data.dt <- data.table(
x1=getInput(),
x2=getInput())
library(animint2)
ggplot()+
geom_point(aes(
x1, x2),
data=data.dt)
Le graphique ci-dessous montre les mêmes données, pour lesquelles deux fonctionnalités d’entrée supplémentaires ont été calculées (les carrés des deux entrées d’origine).
data.dt[, let(
x1.sq = x1^2,
x2.sq = x2^2)][] x1 x2 x1.sq x2.sq
1: -0.4689827 0.3094479 0.21994475 0.09575798
2: -0.2557522 -0.2936055 0.06540919 0.08620416
---
99: 0.6217405 -0.3640726 0.38656123 0.13254888
100: 0.2098666 0.5657027 0.04404398 0.32001952ggplot()+
geom_point(aes(
x1.sq, x2.sq),
data=data.dt)
Dans notre simulation, nous supposons que le score de sortie f est une fonction linéaire de x1.sq et ne tient pas compte de x2.sq. Le graphique ci-dessous permet de visualiser les scores de sortie avec aes(fill).
data.dt[, f := x1.sq]
true.decision.boundary <- 0.2
ggplot()+
theme_bw()+
scale_fill_gradient2(midpoint=true.decision.boundary)+
geom_point(aes(
x1.sq, x2.sq, fill=f),
color="grey",
data=data.dt)
Concrètement, nous supposons que l’étiquette y est négative (-1) si x1.sq + noise < threshold, et qu’elle est positive (1) dans le cas contraire. Le graphique ci-dessous permet de visualiser les scores et les étiquettes en fonction de la fonctionnalité d’entrée x1. Le graphique montre aussi la fonction de score réel (en noir). Bien entendu, une telle visualisation serait impossible avec des données réelles (seules les étiquettes sont connues, pas les scores).
-1 1
56 44 scores <- data.table(x1=seq(-1, 1, l=101))[
, x1.sq := x1^2
][
, f := x1.sq ]
x1.boundaries <- data.table(
boundary=c(1, -1)*sqrt(true.decision.boundary))
ggplot()+
scale_y_continuous(breaks=seq(0, 1, by=0.2))+
geom_vline(aes(
xintercept=boundary),
color="grey50",
data=x1.boundaries)+
geom_line(aes(
x1, f),
data=scores)+
geom_point(aes(
x1, f.noise, color=y),
fill=NA,
data=data.dt)
Le graphique ci-dessous montre les scores et les étiquettes en fonction du carré de la fonctionnalité x1.sq. Il est clair que la fonction de score est linéaire par rapport à x1.sq.
x1sq.boundary <- data.table(boundary=true.decision.boundary)
ggplot()+
scale_y_continuous(breaks=seq(0, 1, by=0.2))+
scale_x_continuous(breaks=seq(0, 1, by=0.2))+
geom_vline(aes(
xintercept=boundary),
color="grey50",
data=x1sq.boundary)+
geom_line(aes(x1.sq, f), data=scores)+
geom_point(aes(
x1.sq, f.noise, color=y),
fill=NA,
data=data.dt)
Nous visualisons ensuite les étiquettes dans l’espace bidimensionnel des fonctionnalités au carré. La limite de décision est manifestement linéaire dans cet espace.
ggplot()+
scale_y_continuous(breaks=seq(0, 1, by=0.2))+
scale_x_continuous(breaks=seq(0, 1, by=0.2))+
geom_vline(aes(
xintercept=boundary),
color="grey50",
data=x1sq.boundary)+
geom_point(aes(
x1.sq, x2.sq, color=y),
fill=NA,
data=data.dt)
Le graphique ci-dessous montre l’espace des fonctionnalités d’entrée (x1 et x2). Il est évident que la limite de décision n’est pas linéaire en x1.
ggplot()+
scale_y_continuous(breaks=seq(-1, 1, by=0.2))+
scale_x_continuous(breaks=seq(-1, 1, by=0.2))+
geom_vline(aes(
xintercept=boundary),
color="grey50",
data=x1.boundaries)+
geom_point(aes(
x1, x2, color=y),
fill=NA,
data=data.dt)
Le animint2 ci-dessous utilise clickSelects pour montrer la correspondance entre les points de l’espace d’entrée et ceux de l’espace des fonctions au carré. Il suffit de créer un data.i qui possède un identifiant unique pour chaque point de données.
data.dt[, data.i := 1:.N]
YVAR <- function(dt, y.var){
dt$y.var <- factor(y.var, c("x2", "x2.sq", "f"))
dt
}
animint(
input=ggplot()+
ggtitle("espace des fonctionnalités d'entrée")+
theme_bw()+
theme(panel.margin=grid::unit(0, "lines"))+
facet_grid(y.var ~ ., scales="free")+
scale_x_continuous(breaks=seq(-1, 1, by=0.2))+
ylab("")+
guides(color="none")+
geom_vline(aes(
xintercept=boundary),
color="grey50",
data=x1.boundaries)+
geom_point(aes(
x1, x2, color=y),
clickSelects="data.i",
size=4,
alpha=0.7,
data=YVAR(data.dt, "x2"))+
geom_line(aes(
x1, f),
data=YVAR(scores, "f"))+
geom_point(aes(
x1, f.noise, color=y),
clickSelects="data.i",
size=4,
alpha=0.7,
data=YVAR(data.dt, "f")),
square=ggplot()+
ggtitle("espace des fonctionnalités au carré")+
theme_bw()+
theme(panel.margin=grid::unit(0, "lines"))+
facet_grid(y.var ~ ., scales="free")+
ylab("")+
scale_x_continuous(breaks=seq(0, 1, by=0.2))+
geom_vline(aes(
xintercept=boundary),
color="grey50",
data=x1sq.boundary)+
geom_point(aes(
x1.sq, x2.sq, color=y),
clickSelects="data.i",
size=4,
alpha=0.7,
data=YVAR(data.dt, "x2.sq"))+
geom_line(aes(
x1.sq, f),
data=YVAR(scores, "f"))+
geom_point(aes(
x1.sq, f.noise, color=y),
clickSelects="data.i",
size=4,
alpha=0.7,
data=YVAR(data.dt, "f")))Notez que nous avons utilisé deux graphiques multipanneaux avec l’option rajouter des colonnes et des facettes plutôt que quatre graphiques distincts. Cette approche démontre que certains graphiques/facettes ont un axe x1 ou x1.sq commun. Notez que nous avons également masqué la légende des couleurs dans le premier graphique, puisqu’une seule légende suffit.
train.i <- 1:N
data.dt[
, set := "validation"
][
train.i, set := "subtrain"
]
table(data.dt$set)
subtrain validation
50 50 subtrain.dt <- data.dt[set=="subtrain",]
ggplot()+
theme_bw()+
theme(panel.margin=grid::unit(0, "lines"))+
facet_grid(set ~ .)+
geom_vline(aes(
xintercept=boundary),
color="grey50",
data=x1.boundaries)+
scale_y_continuous(breaks=seq(-1, 1, by=0.2))+
scale_x_continuous(breaks=seq(-1, 1, by=0.2))+
geom_point(aes(
x1, x2, color=y),
data=data.dt)
Nous commençons par ajuster un SVM linéaire aux données d’entraînement dans l’espace des fonctionnalités au carré, puis nous visualisons les vraies étiquettes y de même que les étiquettes prédites pred.y.
library(kernlab)
Attaching package: 'kernlab'The following object is masked from 'package:animint2':
alpha Setting default kernel parameters subtrain.dt$pred.y <- predict(fit)
ggplot()+
geom_point(aes(
x1.sq, x2.sq, color=pred.y, fill=y),
size=4,
stroke=2,
data=subtrain.dt)
Le graphique ci-dessus montre clairement que plusieurs points de données d’entrainement sont mal classifiés. Le graphique ci-dessous permet de visualiser la limite de décision et la marge :
predF <- function(fit, X){
fit.sc <- scaling(fit)$x.scale
if(is.null(fit.sc)){
fit.sc <- list(
"scaled:center"=c(0,0),
"scaled:scale"=c(1,1))
}
mu <- fit.sc[["scaled:center"]]
sigma <- fit.sc[["scaled:scale"]]
X.sc <- scale(X, mu, sigma)
kernelMult(
kernelf(fit),
X.sc,
xmatrix(fit)[[1]],
coef(fit)[[1]])-b(fit)
}
xsq.vec <- seq(0, 1, l=41)
grid.sq.dt <- data.table(expand.grid(
x1.sq=xsq.vec,
x2.sq=xsq.vec
))[
, pred.f := predF(fit, cbind(x1.sq, x2.sq))]
subtrain.dt[, train.error := ifelse(y==pred.y, "correct", "error")]
ggplot()+
theme_bw()+
scale_color_manual(values=c(error="black", correct=NA))+
geom_point(aes(
x1.sq, x2.sq, fill=y, color=train.error),
stroke=1,
size=4,
data=subtrain.dt)+
geom_vline(aes(
xintercept=boundary), color="grey50",
data=x1sq.boundary)+
geom_contour(aes(
x1.sq, x2.sq, z=pred.f),
breaks=0,
color="black",
data=grid.sq.dt)+
geom_contour(aes(
x1.sq, x2.sq, z=pred.f),
breaks=c(-1, 1),
color="black",
linetype="dashed",
data=grid.sq.dt)
Le graphique ci-dessus montre la véritable limite de décision à l’aide d’un vline gris. Il utilise également geom_contour() pour afficher la limite de décision (ligne noire continue, score prédit 0) et la marge (lignes noires pointillées, scores prédits -1 et 1). Puisque la limite de décision et la marge sont linéaires dans cet espace, nous pouvons également utiliser geom_abline() pour les afficher. Il faut alors effectuer quelques calculs mathématiques pour trouver les équations de la pente et de l’ordonnée à l’origine de ces droites (en fonction du biais appris b(fit) et du weight.vec, ainsi que des paramètres d’échelle mu et sigma).
## The equation of the margin lines is x2 = m2 + s2/w2[c+b+w1*m1/s1]
## -s2*w1/(w2*s1)*x1 for c=1 and -1. x is input feature, m is mean, s
## is scale, w is learned weight.
fit.sc <- scaling(fit)$x.scale
if(is.null(fit.sc)){
fit.sc <- list(
"scaled:center"=c(0,0),
"scaled:scale"=c(1,1))
}
mu <- fit.sc[["scaled:center"]]
sigma <- fit.sc[["scaled:scale"]]
weight.vec <- colSums(xmatrix(fit)[[1]]*coef(fit)[[1]])
predF.linear <- function(fit, X){
X.sc <- scale(X, mu, sigma)
X.sc %*% weight.vec - b(fit)
}
abline.dt <- data.table(
y=factor(c(-1,0,1)),
boundary=c("margin", "decision", "margin"),
intercept=mu[2]+sigma[2]/weight.vec[2]*(
c(-1, 0, 1)+b(fit)+weight.vec[1]*mu[1]/sigma[1]),
slope=-weight.vec[1]*sigma[2]/(weight.vec[2]*sigma[1]))
ggplot()+
theme_bw()+
scale_linetype_manual(values=c(margin="dashed", decision="solid"))+
geom_abline(aes(
slope=slope, intercept=intercept, linetype=boundary),
color="green",
size=1,
data=abline.dt)+
geom_point(aes(
x1.sq, x2.sq, color=y),
fill=NA,
size=4,
data=subtrain.dt)+
geom_contour(aes(
x1.sq, x2.sq, z=pred.f),
breaks=0,
color="black",
data=grid.sq.dt)+
geom_contour(aes(
x1.sq, x2.sq, z=pred.f),
breaks=c(-1, 1),
color="black",
linetype="dashed",
data=grid.sq.dt)
Le graphique ci-dessus confirme que notre calcul de la pente et des ordonnées à l’origine (lignes vertes) concorde avec les contours (lignes noires). Dans le graphique ci-dessous, nous présentons les coefficients alpha appris et ajoutons un geom_segment() pour visualiser la variable ressort (slack) :
subtrain.dt[, alpha := 0]
train.row.vec <- as.integer(rownames(xmatrix(fit)[[1]]))
subtrain.dt[train.row.vec, alpha := kernlab::alpha(fit)[[1]] ]
subtrain.dt[, status := ifelse(
alpha==0, "alpha=0",
ifelse(alpha==1, "alpha=C", "0<alpha<C"))]
slack.slope <- weight.vec[2]*sigma[1]/(weight.vec[1]*sigma[2])
slack.dt <- subtrain.dt[alpha==1,]
slack.join <- abline.dt[slack.dt, on=list(y)]
slack.join[, x1.sq.margin := (
x2.sq-slack.slope*x1.sq-intercept)/(slope-slack.slope)]
slack.join[, x2.sq.margin := slope*x1.sq.margin + intercept]
sv.colors <- c(
"alpha=0"="white",
"0<alpha<C"="black",
"alpha=C"="grey")
ggplot()+
theme_bw()+
scale_linetype_manual(values=c(margin="dashed", decision="solid"))+
geom_vline(aes(
xintercept=boundary), color="violet",
data=x1sq.boundary)+
geom_abline(aes(
slope=slope, intercept=intercept, linetype=boundary),
size=1,
data=abline.dt)+
geom_segment(aes(
x1.sq, x2.sq,
xend=x1.sq.margin, yend=x2.sq.margin),
color="grey",
data=slack.join)+
scale_fill_manual(values=sv.colors, breaks=names(sv.colors))+
geom_point(aes(
x1.sq, x2.sq, color=y, fill=status),
size=4,
data=subtrain.dt)
Le graphique ci-dessus montre le ressort (slack) dans les segments gris, et les lignes de décision et de marge en noir. La limite de décision de Bayes est représentée en arrière-plan par une ligne verticale violette. Les vecteurs de support sont les points dont les coefficients alpha ont une valeur non nulle. Les vecteurs de support en noir (pleins) se situent sur la marge, tandis que les vecteurs de support en gris sont du mauvais côté de la marge (et ont une marge de tolérance non nulle). Le graphique ci-dessous montre le modèle appris dans l’espace des fonctionnalités d’origine :
n.grid <- 41
x.vec <- seq(-1, 1, l=n.grid)
grid.dt <- data.table(expand.grid(
x1=x.vec,
x2=x.vec))
getBoundaryDF <- function(score.vec, level.vec=c(-1, 0, 1)){
stopifnot(length(score.vec) == n.grid * n.grid)
several.paths <- contourLines(
x.vec, x.vec,
matrix(score.vec, n.grid, n.grid),
levels=level.vec)
contour.list <- list()
for(path.i in seq_along(several.paths)){
contour.list[[path.i]] <- with(several.paths[[path.i]], data.table(
path.i,
level.num=as.numeric(level),
level.fac=factor(level, level.vec),
boundary=ifelse(level==0, "decision", "margin"),
x1=x, x2=y))
}
do.call(rbind, contour.list)
}
grid.dt[, pred.f := predF(fit, cbind(x1^2, x2^2))]
boundaries <- grid.dt[, getBoundaryDF(pred.f)]
ggplot()+
scale_linetype_manual(values=c(margin="dashed", decision="solid"))+
geom_vline(aes(
xintercept=boundary),
color="violet",
data=x1.boundaries)+
geom_path(aes(
x1, x2, group=path.i, linetype=boundary),
size=1,
data=boundaries)+
scale_fill_manual(values=sv.colors, breaks=names(sv.colors))+
scale_size_manual(values=c(correct=2, error=4))+
geom_point(aes(
x1, x2, color=y,
size=train.error,
fill=status),
data=subtrain.dt)
L’objectif de la démonstration ci-dessous est de créer une visualisation affichant l’évolution des variables (frontière de décision, marge, ressorts) en fonction du paramètre de coût. Le code ci-dessous contient une boucle sur les paramètres de coût. Pour chaque itération, nous utilisons le code de la section précédente, avec la méthode liste de tableau de données.
modelInfo.list <- list()
predictions.list <- list()
slackSegs.list <- list()
modelLines.list <- list()
inputBoundaries.list <- list()
setErrors.list <- list()
cost.by <- 0.2
for(cost.param in round(10^seq(-1, 1, by=cost.by),1)){
fit <- ksvm(
squared.mat, y.vec, kernel="vanilladot", scaled=FALSE, C=cost.param)
fit.sc <- scaling(fit)$x.scale
if(is.null(fit.sc)){
fit.sc <- list(
"scaled:center"=c(0,0),
"scaled:scale"=c(1,1))
}
mu <- fit.sc[["scaled:center"]]
sigma <- fit.sc[["scaled:scale"]]
weight.vec <- colSums(xmatrix(fit)[[1]]*coef(fit)[[1]])
grid.sq.dt[, pred.f := predF(fit, cbind(x1.sq, x2.sq))]
data.dt[, pred.y := predict(fit, cbind(x1.sq, x2.sq))]
one.error <- data.dt[, list(errors=sum(y!=pred.y)), by=set]
setErrors.list[[paste(cost.param)]] <- data.table(
cost.param, one.error)
subtrain.dt[, pred.f := predF(fit, cbind(x1^2, x2^2))]
grid.dt[, pred.f := predF(fit, cbind(x1^2, x2^2))]
boundaries <- getBoundaryDF(grid.dt$pred.f)
inputBoundaries.list[[paste(cost.param)]] <- data.table(
cost.param, boundaries)
subtrain.dt$alpha <- 0
train.row.vec <- as.integer(rownames(xmatrix(fit)[[1]]))
subtrain.dt[train.row.vec, alpha := kernlab::alpha(fit)[[1]] ]
subtrain.dt[, status := ifelse(
alpha==0, "alpha=0",
ifelse(alpha==cost.param, "alpha=C", "0<alpha<C"))]
## The equation of the margin lines is x2 = m2 + s2/w2[c+b+w1*m1/s1]
## -s2*w1/(w2*s1)*x1 for c=1 and -1. x is input feature, m is mean, s
## is scale, w is learned weight.
slack.slope <- weight.vec[2]*sigma[1]/(weight.vec[1]*sigma[2])
abline.dt <- data.table(
y=factor(c(-1,0,1)),
boundary=c("margin", "decision", "margin"),
intercept=mu[2]+sigma[2]/weight.vec[2]*(
c(-1, 0, 1)+b(fit)+weight.vec[1]*mu[1]/sigma[1]),
slope=-weight.vec[1]*sigma[2]/(weight.vec[2]*sigma[1]))
slack.dt <- subtrain.dt[alpha==cost.param]
slack.join <- abline.dt[slack.dt, on=list(y)]
slack.join[, x1.sq.margin := (
x2.sq-slack.slope*x1.sq-intercept)/(slope-slack.slope)]
slack.join[, x2.sq.margin := slope*x1.sq.margin + intercept]
norm.weights <- as.numeric(weight.vec %*% weight.vec)
modelInfo.list[[paste(cost.param)]] <- data.table(
cost.param,
slack=slack.join[, sum(1-pred.f*y.num)],
norm=norm.weights,
margin=2/sqrt(norm.weights))
predictions.list[[paste(cost.param)]] <- data.table(
cost.param, subtrain.dt)
slackSegs.list[[paste(cost.param)]] <- data.table(
cost.param, slack.join)
modelLines.list[[paste(cost.param)]] <- data.table(
cost.param, abline.dt)
} Setting default kernel parameters
Setting default kernel parameters
Setting default kernel parameters
Setting default kernel parameters
Setting default kernel parameters
Setting default kernel parameters
Setting default kernel parameters
Setting default kernel parameters
Setting default kernel parameters
Setting default kernel parameters
Setting default kernel parameters cost.param slack norm margin
1: 0.1 37.63794 0.6362061 2.5074431
2: 0.2 31.27588 2.5448243 1.2537216
---
10: 6.3 19.91634 22.5760602 0.4209262
11: 10.0 19.91682 22.5660064 0.4210199Le tableau ci-dessus comporte une ligne pour chaque coût. Les colonnes présentent les propriétés de chaque modèle :
slack est la quantité d’erreurs donnée par les variables ressorts.norm est la norme du vecteur poids.margin est la largeur entre les lignes de marge.Dans le code ci-dessous, nous restructurons les données dans une forme qui facilitera l’affichage :
modelInfo.tall <- melt(modelInfo, id.vars="cost.param")
grid.sq.dt$boundary <- "true"
setErrors$variable <- "errors"
inputBoundaries[, boundary := ifelse(
level.num==0, "decision", "margin")]
slackSegs$boundary <- "margin"
set.label.select <- data.table(
cost.param=range(setErrors$cost.param),
set=c("validation", "subtrain"),
hjust=c(1, 0))
set.labels <- setErrors[set.label.select, on=list(cost.param, set)]Nous commençons la visualisation avec un graphique pour choisir la régularisation.
(gg.choisir.reg <- ggplot()+
ggtitle("Choisir la régularisation")+
scale_x_continuous(
"log10(coût)",
limits=c(-1.5, 1.5))+
scale_y_continuous("")+
geom_tallrect(aes(
xmin=log10(cost.param)-cost.by/2,
xmax=log10(cost.param)+cost.by/2),
clickSelects="cost.param",
alpha=0.5,
data=modelInfo)+
theme_bw()+
facet_grid(variable ~ ., scales="free")+
geom_line(aes(
log10(cost.param), errors,
group=set, color=set),
data=setErrors)+
geom_text(aes(
log10(cost.param), errors-1, label=set,
hjust=hjust,
color=set),
data=set.labels)+
guides(color="none")+
geom_line(aes(
log10(cost.param), log10(value)),
data=modelInfo.tall))
Le graphique ci-dessus affiche les propriétés du modèle sur l’axe Y, en fonction du coût sur l’axe X. Ensuite, nous créons un graphique affichant l’espace des variables d’entrée.
gg.entrée.linéaire <- ggplot()+
ggtitle("L’espace des variables d’entrée")+
scale_fill_manual(values=sv.colors, breaks=names(sv.colors))+
geom_vline(aes(
xintercept=boundary),
color="violet",
data=x1.boundaries)+
guides(color="none", fill="none", linetype="none")+
scale_linetype_manual(values=c(
"-1"="dashed",
"0"="solid",
"1"="dashed"))+
geom_path(aes(
x1, x2,
group=path.i,
linetype=level.fac),
showSelected=c("boundary", "cost.param"),
color="black",
data=inputBoundaries)+
geom_point(aes(
x1, x2, fill=status),
showSelected=c("status", "y", "data.i", "cost.param"),
size=5,
color="grey",
data=predictions)+
geom_point(aes(
x1, x2, color=y, fill=status),
showSelected=c("cost.param", "status", "y"),
clickSelects="data.i",
size=3,
data=predictions)
gg.entrée.linéaire+facet_wrap("cost.param")
Dans le graphique ci-dessus, nous voyons une facette pour chaque paramètre de coût. Ensuite, nous faisons un graphique pour l’espace des variables au carré.
gg.carrée.linéaire <- ggplot()+
ggtitle("L’espace du noyau")+
geom_vline(aes(
xintercept=boundary), color="violet",
data=x1sq.boundary)+
geom_abline(aes(
slope=slope, intercept=intercept, linetype=boundary),
showSelected="cost.param",
color="black",
data=modelLines)+
scale_linetype_manual(values=c(
decision="solid",
margin="dashed",
true="solid"))+
geom_point(aes(
x1.sq, x2.sq, fill=status),
showSelected=c("data.i", "cost.param"),
size=5,
color="grey",
data=predictions)+
geom_point(aes(
x1.sq, x2.sq, color=y, fill=status),
clickSelects="data.i",
showSelected="cost.param",
size=3,
data=predictions)+
scale_fill_manual(values=sv.colors, breaks=names(sv.colors))+
geom_segment(aes(
x1.sq, x2.sq,
xend=x1.sq.margin, yend=x2.sq.margin),
showSelected=c("cost.param", "boundary"),
color="grey",
data=slackSegs)
gg.carrée.linéaire+facet_wrap("cost.param")
Ci-dessus nous voyons l’espace au carré, utilisé pour l’apprentissage avec le noyau polynôme d’ordre 2. Enfin, le code ci-dessous combine les graphiques dans une visualisation interactive.
(vis.linear.svm <- animint(
selectModel=gg.choisir.reg,
inputSpace=gg.entrée.linéaire+
theme_animint(last_in_row=TRUE),
kernelSpace=gg.carrée.linéaire+
theme_animint(width=700, colspan=2)))Dans la section précédente, nous avons ajusté un noyau linéaire dans l’espace des fonctionnalités au carré, ce qui a entraîné l’apprentissage d’une fonction non linéaire en termes d’espace des fonctionnalités d’origine. Dans cette section, nous procédons à l’ajustement direct d’un noyau polynomial non linéaire dans l’espace d’origine.
predictions.list <- list()
inputBoundaries.list <- list()
setErrors.list <- list()
cost.by <- 0.2
orig.mat <- subtrain.dt[, cbind(x1, x2)]
for(cost.param in 10^seq(-1, 3, by=cost.by)){
for(degree.num in seq(1, 6, by=1)){
k <- polydot(degree.num, offset=0)
fit <- ksvm(
orig.mat, y.vec, kernel=k, scaled=FALSE, C=cost.param)
grid.dt[, pred.f := predF(fit, cbind(x1, x2))]
grid.dt[, pred.y := predict(fit, cbind(x1, x2))]
grid.dt[, stopifnot(sign(pred.f) == pred.y)]
data.dt[, pred.y := predict(fit, cbind(x1, x2))]
one.error <- data.dt[, list(errors=sum(y != pred.y)), by=set]
setErrors.list[[paste(cost.param, degree.num)]] <- data.table(
cost.param, degree.num, one.error)
boundaries <- getBoundaryDF(grid.dt$pred.f)
if(is.data.frame(boundaries) && nrow(boundaries)){
cost.deg <- paste(cost.param, degree.num)
inputBoundaries.list[[cost.deg]] <- data.table(
cost.param, degree.num, boundaries)
}
subtrain.dt[, alpha := 0]
train.row.vec <- as.integer(rownames(xmatrix(fit)[[1]]))
subtrain.dt[train.row.vec, alpha := kernlab::alpha(fit)[[1]] ]
subtrain.dt[, status := ifelse(
alpha==0, "alpha=0",
ifelse(alpha==cost.param, "alpha=C", "0<alpha<C"))]
predictions.list[[paste(cost.param, degree.num)]] <- data.table(
cost.param, degree.num, subtrain.dt)
}
}
inputBoundaries <- do.call(rbind, inputBoundaries.list)
predictions <- do.call(rbind, predictions.list)
setErrors <- do.call(rbind, setErrors.list)
validationErrors <- setErrors[set=="validation"]
validationErrors$select <- "degree"
setErrors$select <- "cost"
animint(
selectModel=ggplot()+
ggtitle("Choisir hyper-paramètres")+
geom_tallrect(aes(
xmin=log10(cost.param)-cost.by/2,
xmax=log10(cost.param)+cost.by/2),
clickSelects="cost.param",
alpha=0.5,
data=setErrors[degree.num==1 & set=="subtrain",])+
theme_bw()+
theme(panel.margin=grid::unit(0, "lines"))+
theme_animint(width=350, rowspan=1)+
facet_grid(select ~ ., scales="free")+
ylab("")+
geom_line(aes(
log10(cost.param), errors,
key=set,
group=set,
color=set),
showSelected="degree.num",
data=setErrors)+
scale_fill_gradient("validErr", low="white", high="red")+
geom_tile(aes(
log10(cost.param), degree.num, fill=errors),
clickSelects="degree.num",
data=validationErrors),
inputSpace=ggplot()+
theme_bw()+
ggtitle("Espace des variables d'entrée")+
scale_fill_manual(values=sv.colors, breaks=names(sv.colors))+
geom_vline(aes(
xintercept=boundary),
color="violet",
data=x1.boundaries)+
scale_linetype_manual(values=c(
margin="dashed",
decision="solid"))+
geom_path(aes(
x1, x2,
group=path.i,
linetype=boundary),
showSelected=c("degree.num", "cost.param"),
color="black",
data=inputBoundaries)+
geom_point(aes(
x1, x2, color=y, fill=status),
showSelected=c("cost.param", "degree.num"),
size=3,
data=predictions))Nous avons utilisé des ggplots pour visualiser le modèle de séparateur à vaste marge pour la classification binaire. Nous avons utilisé animint() et l’interactivité pour montrer comment la limite de décision du SVM varie en fonction des hyperparamètres du modèle.
Exercices :
vis.linear.svm de manière à ce que les deux graphiques de l’espace des variables apparaissent l’un à côté de l’autre et que le graphique « Choisir la régularisation » apparaisse au-dessus ou au-dessous.
rbfdot comme fonction noyau. Calculez l’erreur de sous-entraînement et de validation, puis ajoutez un nouveau panneau au graphique « Choisir hyper-paramètres ».
y et set, ce qui peut prêter à confusion. Modifiez les couleurs de l’une des deux légendes pour les différencier.
color et color_off pour modifier l’apparence de geom_tile() selon son état de sélection, comme expliqué à la section préciser le mode d’affichage de l’état de la sélection du chapitre 6.Dans le chapitre 13, nous vous expliquerons comment visualiser la régression de Poisson.