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.

190 lines
4.5KB

  1. ```{r libs}
  2. library(tidyverse)
  3. ```
  4. # Cross-validation
  5. ## Création du set de données
  6. On initialise le RNG avec une graine fixe.
  7. On génère une distribution uniforme sur l'axe des **x**,
  8. et **y** selon un polynôme de degré 2 avec un bruit gaussien.
  9. ```{r dataset CV}
  10. set.seed(1234)
  11. tibble(x = runif(100, 0, 20),
  12. y = x ^ 2 + 2 * x + rnorm(100, 0, 4)) -> df
  13. ```
  14. ## Partition train/test
  15. Partition du set de données en un set d'**entraînement** (80%),
  16. et un set de **test** (les 20% restants).
  17. ```{r partition CV}
  18. df %>%
  19. sample_n(80) -> df_train
  20. df %>%
  21. anti_join(df_train) -> df_test
  22. ```
  23. ## Fonctions
  24. Création de quelques fonctions pour la réalisation de la cross-validation.
  25. ### Générateur de modèles
  26. Fonction prenant une dataframe et un degré de polynôme pour générer le modèle correspondant.
  27. La syntaxe `I(...)` dans un modèle sert à décrire des calculs littéraux sur les variables.
  28. Ici, on concatène `x^n` avec `n` allant de 1 au degré du polynôme, et on applique le modèle.
  29. ```{r model function}
  30. model_lm <- function(degre)
  31. {
  32. polynome <- str_c("I(x^", 1:degre, ")", collapse = " + ")
  33. formule <- str_c("y ~ ", polynome)
  34. # lm(as.formula(formule), data = df)
  35. partial(lm, formula = as.formula(formule))
  36. }
  37. ```
  38. ### Validateur de modèles
  39. Fonction prenant un set d'entraînement, un set de test, et un degré de polynôme, et calculant la _Mean Square Error_ du modèle polynomial correspondant.
  40. ```{r MSE of a model}
  41. mse <- function(train, test, model)
  42. {
  43. modele <- model(train)
  44. verite <- test$y
  45. predictions <- predict(modele, test)
  46. mean((verite - predictions) ^ 2)
  47. }
  48. ```
  49. ### Subsampling pour CV
  50. Fonction prenant un dataset et un nombre **k** comme arguments, et générant **k** permutations train/test.
  51. On passe par la création d'une variable _groupVar_ qui est un tirage aléatoire équilibré (le vecteur 1:k est répété sur la longueur du dataset, puis mélangé).
  52. Ensuite, chaque k-ième du dataset est pris comme set de test, pendant que le reste sert de set d'entraînement.
  53. ```{r subsampling}
  54. subsampl <- function(df, k)
  55. {
  56. df %>%
  57. mutate(groupVar = rep(1:k,
  58. length.out = nrow(df)) %>%
  59. sample) %>%
  60. group_nest(groupVar, .key = "test") %>%
  61. mutate(train = test %>% map(~ anti_join(df, .))) %>%
  62. select(-groupVar)
  63. }
  64. ```
  65. ### Cross-validation d'un modèle
  66. Fonction appliquant la procédure de cross-validation pour un modèle.
  67. On créé tout d'abord les k permutations, puis on calcule la **MSE** pour chaque permutation, avec le modèle donné.
  68. Enfin, on calcule la moyenne des MSE de chacune des permutations.
  69. ```{r CV_one}
  70. CV_one <- function(df, model, k)
  71. {
  72. df %>%
  73. subsampl(k) %>%
  74. mutate(mse = map2_dbl(train, test, ~mse(.x, .y, model))) %>%
  75. pull(mse) %>%
  76. mean
  77. }
  78. ```
  79. ### Cross-validation sur tous les modèles
  80. Fonction appliquant la procédure de cross-validation à tous les modèles en argument.
  81. Le dataset est dupliqué pour chaque modèle, et on applique ensuite la procédure unique pour chaque couple degré-modèle.
  82. ```{r CV}
  83. CV <- function(df, k, models)
  84. {
  85. df %>%
  86. crossing(degre = 1:length(models)) %>%
  87. group_nest(degre) %>%
  88. mutate(mse = map2_dbl(data, degre, ~ CV_one(.x, .y, k)))
  89. }
  90. ```
  91. ## Application
  92. Il ne reste plus qu'à appliquer la cross-validation souhaitée sur notre set d'entraînement, et choisir le modèle le plus approprié.
  93. ```{r application}
  94. 2:5 %>%
  95. map(model_lm) -> liste_modeles
  96. df_train %>%
  97. CV(80, liste_modeles)
  98. ```
  99. ## Modèle final
  100. ```{r modèle final}
  101. lm(y ~ x, data = df_train) -> fit
  102. predict(fit, df_test) -> predictions
  103. mean((df_test$y - predictions)^2)
  104. ```
  105. # Bootstrap
  106. Le bootstrap est une méthode de _resampling_ qui consiste à tirer un grand nombre **n** de tirages au sort avec remise de la distribution en entrée.
  107. ## Bootstrap de la moyenne
  108. Fonction prenant un vecteur à bootstrap, et le nombre de répétitions.
  109. Il s'agit d'un simple tirage avec remise, effectué **b** fois, dont on calcule la moyenne.
  110. ```{r bootstrap}
  111. bootstrap <- function(x, n)
  112. {
  113. replicate(n, sample(x, replace = T) %>% mean)
  114. }
  115. ```
  116. ## Exemple
  117. Calcul de l'intervalle à 95% de la moyenne.
  118. ### Données
  119. Distribution normale aléatoire de 30 sujets.
  120. ```{r}
  121. x <- rnorm(30)
  122. qplot(x)
  123. mean(x)
  124. t.test(x)$conf.int
  125. ```
  126. ### Production du bootstrap
  127. ```{r apply bootstrap}
  128. b <- bootstrap(x, 10000)
  129. tibble(x = b) %>%
  130. ggplot() +
  131. aes(x = x) +
  132. geom_histogram() +
  133. geom_vline(xintercept = mean(b)) +
  134. geom_vline(xintercept = quantile(b, probs = c(.025, .975)))
  135. mean(b)
  136. quantile(b, probs = c(.025, .975))
  137. ```