26 lines
1.3 KiB
R
26 lines
1.3 KiB
R
# Séparer le jeu de données en un jeu d'entraînement et un jeu de validation.
|
|
# INPUT : jeu de données initial et proportion des données conservées pour
|
|
# l'entraînement.
|
|
xvalpart <- function(data,p) {
|
|
n <- nrow(data$X)
|
|
nentr <- round(p*n)
|
|
entridx <- sample(1:n, nentr, replace=FALSE)
|
|
list(entr = list(X = data$X[entridx,,drop=FALSE], Y = data$Y[entridx]),
|
|
valid = list(X = data$X[-entridx,,drop=FALSE], Y = data$Y[-entridx]))
|
|
}
|
|
|
|
# Découper le jeu de données initial en entraînement et validation.
|
|
# Pour chaque valeur proposée de l'hyperparamètre alpha d'une régression ridge,
|
|
# apprendre un modèle sur le jeu d'entraînement.
|
|
# Retourner les coefficients du meilleur modèle avec la moyenne de la valeur
|
|
# absolue des erreurs commises par ce modèle sur le jeu de validation.
|
|
# La fonction ridge est défini dans le code source de la partie 3.
|
|
xvalridge <- function(alphas, data, degre, p) {
|
|
tmp <- xvalpart(data,p)
|
|
lcoef <- sapply(alphas, ridge, tmp$entr, degre)
|
|
pred <- sapply(split(lcoef,col(lcoef)), polyeval, tmp$valid$X)
|
|
meanabserrs <- colMeans(abs(pred - tmp$valid$Y))
|
|
minmeanabserr <- min(meanabserrs)
|
|
minidx <- which(meanabserrs == minmeanabserr)
|
|
list(meanabserr = minmeanabserr, coef = lcoef[,minidx], alpha = alphas[minidx])
|
|
} |