You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

#### 89 lines 2.9 KiB Raw Permalink Blame History

 ```# 14 Géométrie Ridge ``` ``` ``` ```# 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 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) ``` ```} ```