86 lines
2.9 KiB
R
86 lines
2.9 KiB
R
# Séparer le jeu de données en un jeu d'entraînement et un jeu de test
|
|
# INPUT : jeu de données initial et proportion des données conservées pour
|
|
# l'entraînement.
|
|
splitdata <- 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]),
|
|
test = list(X = data$X[-entridx,,drop=FALSE], Y = data$Y[-entridx]))
|
|
}
|
|
|
|
# Résolution d'un système linéaire correspondant à la matrice de Gram pour
|
|
# un polynôme de degré fixé et avec l'ajout d'un facteur de régularisation en
|
|
# norme L2 dont l'importance est contrôlée par l'hyperparamètre alpha.
|
|
ridge.gram <- function(alpha, data, degre) {
|
|
A <- scale(outer(c(data$X), 1:degre, "^"))
|
|
Y <- data$Y
|
|
Ym <- mean(Y)
|
|
Y <- Y - Ym
|
|
gram <- t(A) %*% A
|
|
diag(gram) <- diag(gram) + alpha
|
|
coef <- solve(gram, as.vector(t(A) %*% Y))
|
|
coef <- coef / attr(A,"scaled:scale")
|
|
inter <- Ym - coef %*% attr(A,"scaled:center")
|
|
coef <- c(inter, coef)
|
|
}
|
|
|
|
ridge.svd <- function(data, degre, fold = FALSE) {
|
|
if (length(fold) == 1 && fold == FALSE) {
|
|
X <- data$X
|
|
Y <- data$Y
|
|
} else {
|
|
X <- data$X[!fold,]
|
|
Y <- data$Y[!fold]
|
|
}
|
|
A <- scale(outer(c(X), 1:degre, "^"))
|
|
Ym <- mean(Y)
|
|
Y <- Y - Ym
|
|
As <- svd(A)
|
|
d <- As$d
|
|
function(alpha) {
|
|
coef <- c(As$v %*% ((d / (d^2 + alpha)) * (t(As$u) %*% Y)))
|
|
coef <- coef / attr(A,"scaled:scale")
|
|
inter <- Ym - coef %*% attr(A,"scaled:center")
|
|
coef <- c(inter, coef)
|
|
}
|
|
}
|
|
|
|
# alphas[l] est une liste de valeurs pour l'hyperparamètre alpha.
|
|
# Notons Ridge[l] un modèle avec alpha <- alphas[l].
|
|
# Découper aléatoirement le jeu de données d'entraînement en K plis F[i] disjoints.
|
|
# Pour l <- [1,...,L]
|
|
# Pour i <- [1,...,K]
|
|
# Apprendre Ridge[l] sur l'union des plis F[j] avec j!=i
|
|
# Calculer le score de Ridge[l] sur le pli de validation F[i]
|
|
# Conserver les résultats du modèle sur les plis de validation.
|
|
# Soit Moy[l] la moyenne des résultats de Ridge[l] sur les plis de validation.
|
|
# Soit l' l'indice du maximum de Moy[l]
|
|
# Apprendre Ridge[l'] sur l'ensemble du jeu de données d'entraînement.
|
|
# Retourner ce modèle.
|
|
kfoldridge <- function(K, alphas, data, degre) {
|
|
N <- nrow(data$X)
|
|
folds <- rep_len(1:K, N)
|
|
folds <- sample(folds, N)
|
|
maes <- matrix(data = NA, nrow = K, ncol = length(alphas))
|
|
colnames(maes) <- alphas
|
|
for(k in 1:K) {
|
|
fold <- folds == k
|
|
ridge <- ridge.svd(data, degre, fold)
|
|
alpha_idx <- 1
|
|
X <- data$X[fold,]
|
|
Y <- data$Y[fold]
|
|
for(alpha in alphas) {
|
|
coef <- ridge(alpha)
|
|
pred <- polyeval(coef, X)
|
|
maes[k,alpha_idx] <- mean(abs(pred - Y))
|
|
alpha_idx <- alpha_idx + 1
|
|
}
|
|
}
|
|
mmaes <- colMeans(maes)
|
|
minmmaes <- min(mmaes)
|
|
bestalpha <- alphas[which(mmaes == minmmaes)]
|
|
ridge <- ridge.svd(data, degre)
|
|
coef <- ridge(bestalpha)
|
|
list(coef = coef, maes = maes, alpha = bestalpha)
|
|
} |