Prévision de consommation électrique à plusieurs niveaux

Introduction

Dans ce projet, nous cherchons à prédire la consommation électrique de groupes de clients du \(1^{\text{er}}\) janvier \(2014\) au \(27\) février \(2014\). Pour cela, nous avons à notre disposition \(30\) échantillons de taille \(17520\) qui correspondent à différentes tailles de groupe :

• de X1 à X10, il s’agit de groupes de \(10\) personnes;
• de X11 à X20, il s’agit de groupes de \(100\) personnes;
• de X21 à X30, il s’agit de groupes de \(1000\) personnes.

Ces échantillons nous donnent la consommation électrique de ces différents groupes tout au long de l’année \(2013\) par intervalles de \(30\) minutes.

Dans un premier temps, nous allons faire une rapide analyse de nos données. Puis nous testerons trois méthodes de prédiction. Enfin, nous pourrons les comparer.

Compte-rendu

Prétraitement et mises-en-forme des données

Une grosse partie de ce projet consiste à bien sélectionner les variables que nous utilisons dans les prédictions. Pour cela, il faut les avoir sous le bon format et créer les data-frames adéquats.

Tout d’abord nous importons nos données :

data0 <- read.csv('Data/Data0.csv', header = TRUE)
data1 <- read.csv('Data/Data1.csv', header = TRUE)

La première variable data0 correspond aux données de consommation d’électricité de l’année \(2013\). Elle contient \(17520\) lignes et \(32\) colonnes dont les \(30\) échantillons, la température, la date et l’heure.

La deuxième variable data1 correspond aux données connues afin de réaliser nos prévisions. Elle contient \(83520\) lignes et \(4\) colonnes dont les températures connues du début de l’année \(2014\), la date, l’heure et l’indice de l’échantillon correspondant.

Par la suite nous créons de nombreuses variables contenant les différentes valeurs qui nous intéressent :

• date : pour avoir la date et l’heure à chaque instant sous le bon format;

date.debut <- strptime(c("01/01/2013 00:00:00"), '%d/%m/%Y %H:%M:%S')
date.fin <- strptime(c("31/12/2013 23:30:00"), "%d/%m/%Y %H:%M:%S")
date <- seq(date.debut, date.fin, by = '30 min')
rm(date.debut, date.fin)

• Temperature et Temperature.lag : il faut faire attention car la colonne des températures contient des NA, nous créons alors la fonction my.na.approx qui remplace les NA par des valeurs en faisant la moyenne (voir exemple plus loin), la deuxième variable contient les températures décalées de \(1\);

my.na.approx <- function(x) {
  if (sum(is.finite(x)) == 0L) return(x)
  if (sum(is.finite(x)) == 1L) return(na.approx(x, rule = 2, method = "constant"))
  na.approx(x, rule = 2)
}
Temperature <- data0$Temperature
Temperature <- my.na.approx(Temperature)
Temperature.lag <- as.numeric(sapply(1:length(Temperature), function(x) Temperature[x - 1]))
Temperature.lag[1] <- Temperature.lag[2]

• mois et jour : nous gardons uniquement le numero du mois correspondant et uniquement la date en retirant l’heure;

mois <- format(date, "%m")
jour <- format(date, "%d/%m/%Y")

• heure et heure.num : dans la premiere variable nous gardons uniquement l’heure correspondante et dans la deuxième nous la transformons en valeur numérique de telle sorte que \(12\)h\(30\) soit égal à \(12.5\);

heure <- format(date, "%H:%M:%S")
essai.heure <- as.POSIXlt(heure, format = "%H:%M:%S")
heure.num <- as.numeric(essai.heure$hour) + (as.numeric(essai.heure$min)/60)
rm(essai.heure)

• weekend : nous créons une variable qui vaut \(0\) si nous sommes en semaine et \(1\) si nous sommes en week-end;

day <- weekdays(as.Date(format(date, "%d/%m/%Y")))
weekend <- (day == "Sunday") + (day == "Saturday")
rm(day)

• week.num : cette variable correspond au numéro de la semaine à laquelle nous sommes.

week.num <- strftime(date, format = "%V")

Donnons un exemple d’utilisation de la fonction my.na.approx :

my.na.approx(c(NA, 1, NA, NA, 2, NA))

[1] 1.000000 1.000000 1.333333 1.666667 2.000000 2.000000

Ainsi, il a divisé \(2 - 1\) par \(3\) pour obtenir les deux valeurs du milieu et il a mis les valeurs \(1\) et \(2\) sur les bords.

Ensuite nous stockons toutes ces variables dans un data-frame nommé consom.csv :

consom.csv <- data.frame(date, mois, heure, weekend, week.num, data0[, c(2:31)], Temperature, Temperature.lag)

Nous créons les même variables suivies de l’extensions .pred qui correspondent à ces même valeurs mais associées aux données que nous souhaitons prédire. Nous les stockons dans un data-frame nommé consom.pred.csv.

Pour les prédictions, nous allons avoir besoin de variables croisées. En effet, elles permettent d’avoir un modèle plus proche de la réalité. Par exemple, la température en janvier ne va pas influer comme la température en mars, c’est pour cela que nous introduisons une variable Temperature fois mois. Nous les créons :

temp.heure <- Temperature*heure.num
temp.weekend <- Temperature*weekend
temp.mois <- Temperature*as.numeric(mois)
mois.heure <- as.numeric(mois)*heure.num
weekend.heure <- weekend*heure.num

Nous faisons de même pour les variables .pred.

Enfin, pour tester nos prédictions, nous allons réaliser des prédictions à partir de nos données connues data0. Pour cela, nous prenons \(75 \%\) de notre échantillon de façon aléatoire afin de ne pas avoir de biais à la construction de nos modèles. Puis, nous prédisons les \(25 \%\) restants que nous connaissons. Ainsi, nous pourrons comparer la prédiction aux vraies valeurs. Pour cela, nous calculons la rmse, si elle diminue c’est que les changements réalisés sont bons et vice-versa. Pour plus de précision, nous pouvons faire ces tests sur plusieurs échantillons Train et Test afin de prendre le paramètre qui correspond le mieux au plus grand nombre.

Nous implémentons donc la fonction qui permet de calculer le score :

rmse <- function(actual, predicted) {
  sqrt(mean((actual - predicted) ^ 2))
}

Cette fonction est basée sur la formule : \[ RMSE(Y, \widehat{Y}) = \sqrt{\dfrac{1}{n} \sum\limits_{i = 1}^n \left( y_i - \widehat{y}_i \right)^2} \] qui est donnée dans le sujet du projet.

Puis, nous créons les deux variables Train et Test :

smp_size <- floor(0.75 * nrow(consom.csv))
train_ind <- sample(seq_len(nrow(consom.csv)), size = smp_size)
Train <- consom.csv[train_ind, ]
Test <- consom.csv[-train_ind, ]
rm(smp_size)

où Train correspond donc au \(75 \%\) de notre échantillon sur lequel nous réaliserons les prévisions des \(25 \%\) restants dont les vraies valeurs sont contenues dans Test. Ainsi, il nous restera à calculer le score en faisant rmse(Test, pred).

Analyse descriptive des données

Représentation graphique

Nous représentons graphiquement trois échantillons de chaque taille : X2, X12 et X22.

Nous pouvons remarquer que X2 semble stationnaire. Tandis que X12 et X22 ne semblent pas stationnaires. Pour les trois échantillons, leur variance varie dans le temps.

Ces trois graphiques restent peu lisibles, nous allons donc représenter graphiquement la moyenne par jour :

X2.jour <- tapply(consom.csv$X2, as.factor(jour), mean)
X12.jour <- tapply(consom.csv$X12, as.factor(jour), mean)
X22.jour <- tapply(consom.csv$X22, as.factor(jour), mean)
temp.jour <- tapply(consom.csv$Temperature, as.factor(jour), mean)

Ces graphiques sont déjà moins saturés mais restent difficilement lisibles. La variance semble varier fortement pour X2, un peu moins pour X12 et encore moins pour X22. Cette fois-ci, ils semblent tous quasiment stationnaires.

Maintenant, nous allons représenter graphiquement la moyenne par mois :

X2.mois <- tapply(consom.csv$X2, as.factor(mois), mean)
X12.mois <- tapply(consom.csv$X12, as.factor(mois), mean)
X22.mois <- tapply(consom.csv$X22, as.factor(mois), mean)
temp.mean.mois <- tapply(consom.csv$Temperature, as.factor(mois), mean)

Pour les trois graphiques, nous remarquons que le minimum est atteint le \(8^{\text{ième}}\) mois de l’année donc en août, ce qui paraît cohérent. En observant en plus la courbe de la moyenne par mois de la température, nous remarquons que son maximum est atteint en juillet, il y aurait donc une influence de la température du mois précédent sur le mois suivant. Nous pouvons alors supposer que la température des \(30\) dernières minutes va influer sur notre consommation électrique. C’est pour cette raison que nous avons introduit la variable Temperature.lag qui nous donne la température \(30\) minutes avant le relevé de la consommation électrique.

Statistiques de base

Nous représentons l’histogramme de nos trois échantillons de référence :

Nous remarquons qu’il est rare que la consommation électrique soit supérieure à \(0.4\). En effet, la majorité des données se répartissent dans l’intervalle \([0.1, 0.4]\) pour X2 et \([0.1, 0.3]\) pour X12 et X22.

Nous appelons la fonction summary sur notre data-frame consom.csv.

Pour les échantillons de taille \(10\), nous obtenons :

       X1               X2               X3               X4               X5        
 Min.   :0.0464   Min.   :0.0387   Min.   :0.0483   Min.   :0.0281   Min.   :0.0295  
 1st Qu.:0.1150   1st Qu.:0.1086   1st Qu.:0.1121   1st Qu.:0.0836   1st Qu.:0.0790  
 Median :0.1681   Median :0.1870   Median :0.1636   Median :0.1308   Median :0.1151  
 Mean   :0.1923   Mean   :0.2185   Mean   :0.1826   Mean   :0.1558   Mean   :0.1296  
 3rd Qu.:0.2416   3rd Qu.:0.3024   3rd Qu.:0.2325   3rd Qu.:0.2008   3rd Qu.:0.1636  
 Max.   :0.7993   Max.   :0.8645   Max.   :0.6966   Max.   :0.7811   Max.   :0.5634  
       X6               X7               X8               X9               X10        
 Min.   :0.0356   Min.   :0.0389   Min.   :0.0670   Min.   :0.06389   Min.   :0.0610  
 1st Qu.:0.0935   1st Qu.:0.1113   1st Qu.:0.1370   1st Qu.:0.12089   1st Qu.:0.1500  
 Median :0.1588   Median :0.1610   Median :0.2120   Median :0.16463   Median :0.2192  
 Mean   :0.1978   Mean   :0.1965   Mean   :0.2387   Mean   :0.18094   Mean   :0.2475  
 3rd Qu.:0.2586   3rd Qu.:0.2563   3rd Qu.:0.3100   3rd Qu.:0.22478   3rd Qu.:0.3096  
 Max.   :1.0005   Max.   :0.8715   Max.   :0.9404   Max.   :0.62978   Max.   :1.2252  

Nous remarquons que la moyenne varie beaucoup d’un échantillon à l’autre, en effet elle varie de \(0.1179\), ce qui confirme notre remarque sur la variance qui change au cours du temps.

Pour les échantillons de taille \(100\), nous obtenons :

      X11               X12               X13               X14               X15         
 Min.   :0.07404   Min.   :0.08239   Min.   :0.07937   Min.   :0.08299   Min.   :0.07637  
 1st Qu.:0.15252   1st Qu.:0.14930   1st Qu.:0.16067   1st Qu.:0.16284   1st Qu.:0.14715  
 Median :0.19958   Median :0.19838   Median :0.20673   Median :0.20896   Median :0.19836  
 Mean   :0.20684   Mean   :0.21067   Mean   :0.22000   Mean   :0.22257   Mean   :0.20652  
 3rd Qu.:0.25186   3rd Qu.:0.25489   3rd Qu.:0.26754   3rd Qu.:0.26763   3rd Qu.:0.25615  
 Max.   :0.47418   Max.   :0.53622   Max.   :0.56355   Max.   :0.54974   Max.   :0.50513  
      X16               X17               X18               X19               X20         
 Min.   :0.08057   Min.   :0.07538   Min.   :0.07226   Min.   :0.08219   Min.   :0.07013  
 1st Qu.:0.16341   1st Qu.:0.16036   1st Qu.:0.13704   1st Qu.:0.14839   1st Qu.:0.14158  
 Median :0.22237   Median :0.21009   Median :0.17704   Median :0.19689   Median :0.17463  
 Mean   :0.24079   Mean   :0.22543   Mean   :0.18785   Mean   :0.20321   Mean   :0.18552  
 3rd Qu.:0.30082   3rd Qu.:0.27603   3rd Qu.:0.22638   3rd Qu.:0.24586   3rd Qu.:0.21774  
 Max.   :0.62920   Max.   :0.54530   Max.   :0.43365   Max.   :0.47149   Max.   :0.43013  

Cette fois-ci, la moyenne varie de \(0.05527\), ce qui réduit de moitié la variabilité observée pour les échantillons de taille \(10\).

Pour les échantillons de taille \(1000\), nous obtenons :

      X21               X22               X23               X24               X25         
 Min.   :0.09255   Min.   :0.08978   Min.   :0.09128   Min.   :0.09042   Min.   :0.09152  
 1st Qu.:0.16373   1st Qu.:0.16381   1st Qu.:0.15974   1st Qu.:0.15589   1st Qu.:0.15544  
 Median :0.20969   Median :0.20793   Median :0.20564   Median :0.19834   Median :0.20100  
 Mean   :0.21856   Mean   :0.21811   Mean   :0.21478   Mean   :0.20883   Mean   :0.21075  
 3rd Qu.:0.26222   3rd Qu.:0.26100   3rd Qu.:0.25784   3rd Qu.:0.25006   3rd Qu.:0.25350  
 Max.   :0.49736   Max.   :0.49901   Max.   :0.49160   Max.   :0.50714   Max.   :0.47620  
      X26               X27              X28               X29               X30         
 Min.   :0.09081   Min.   :0.0924   Min.   :0.09053   Min.   :0.09133   Min.   :0.08895  
 1st Qu.:0.16072   1st Qu.:0.1633   1st Qu.:0.15928   1st Qu.:0.16276   1st Qu.:0.15788  
 Median :0.20350   Median :0.2063   Median :0.20487   Median :0.20536   Median :0.20089  
 Mean   :0.21259   Mean   :0.2155   Mean   :0.21381   Mean   :0.21560   Mean   :0.21040  
 3rd Qu.:0.25500   3rd Qu.:0.2569   3rd Qu.:0.25728   3rd Qu.:0.25777   3rd Qu.:0.25276  
 Max.   :0.46788   Max.   :0.4878   Max.   :0.47927   Max.   :0.48296   Max.   :0.48571  

Enfin, cette fois-ci la moyenne varie de \(0.00973\). La variabilité est donc minime.

Pour la température, nous obtenons :

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  -3.33    6.11   10.84   11.16   15.84   32.78 

Corrélations

Nous allons maintenant étudier la corrélation entre nos échantillons de référence et les différentes variables que nous avons créées pour réaliser nos prédictions.

X2 <- data0[, 3]
summary(lm(X2 ~ mois + heure + weekend + Temperature + I(Temperature^2) + temp.heure + temp.weekend + temp.mois + mois.heure + weekend.heure + Temperature.lag, data = consom.csv))

Call:
lm(formula = X2 ~ mois + heure + weekend + Temperature + I(Temperature^2) + 
    temp.heure + temp.weekend + temp.mois + mois.heure + weekend.heure + 
    Temperature.lag, data = consom.csv)

Residuals:
     Min       1Q   Median       3Q      Max 
-0.28276 -0.04242 -0.00395  0.03277  0.45221 

Coefficients:
                   Estimate Std. Error t value Pr(>|t|)    
(Intercept)       2.728e-01  4.772e-03  57.161  < 2e-16 ***
mois02           -2.204e-02  2.710e-03  -8.133 4.46e-16 ***
mois03           -5.069e-02  2.709e-03 -18.713  < 2e-16 ***
mois04           -5.917e-02  2.919e-03 -20.267  < 2e-16 ***
mois05           -6.088e-02  3.281e-03 -18.555  < 2e-16 ***
mois06           -6.722e-02  3.819e-03 -17.600  < 2e-16 ***
mois07           -5.458e-02  4.680e-03 -11.662  < 2e-16 ***
mois08           -9.009e-02  5.148e-03 -17.500  < 2e-16 ***
mois09           -6.595e-02  5.367e-03 -12.289  < 2e-16 ***
mois10           -6.195e-02  5.765e-03 -10.745  < 2e-16 ***
mois11           -5.793e-02  5.045e-03 -11.482  < 2e-16 ***
mois12           -1.248e-02  5.322e-03  -2.345 0.019044 *  
heure00:30:00    -4.057e-02  5.251e-03  -7.726 1.17e-14 ***
heure01:00:00    -7.817e-02  5.256e-03 -14.875  < 2e-16 ***
heure01:30:00    -1.079e-01  5.262e-03 -20.511  < 2e-16 ***
heure02:00:00    -1.314e-01  5.271e-03 -24.921  < 2e-16 ***
heure02:30:00    -1.448e-01  5.282e-03 -27.421  < 2e-16 ***
heure03:00:00    -1.509e-01  5.295e-03 -28.501  < 2e-16 ***
heure03:30:00    -1.557e-01  5.310e-03 -29.327  < 2e-16 ***
heure04:00:00    -1.561e-01  5.325e-03 -29.323  < 2e-16 ***
heure04:30:00    -1.555e-01  5.342e-03 -29.102  < 2e-16 ***
heure05:00:00    -1.553e-01  5.360e-03 -28.977  < 2e-16 ***
heure05:30:00    -1.532e-01  5.383e-03 -28.463  < 2e-16 ***
heure06:00:00    -1.469e-01  5.403e-03 -27.193  < 2e-16 ***
heure06:30:00    -1.296e-01  5.434e-03 -23.844  < 2e-16 ***
heure07:00:00    -1.291e-01  5.454e-03 -23.666  < 2e-16 ***
heure07:30:00    -1.141e-01  5.503e-03 -20.730  < 2e-16 ***
heure08:00:00    -7.971e-02  5.522e-03 -14.434  < 2e-16 ***
heure08:30:00    -8.027e-02  5.585e-03 -14.374  < 2e-16 ***
heure09:00:00    -6.882e-02  5.605e-03 -12.278  < 2e-16 ***
heure09:30:00    -4.401e-02  5.642e-03  -7.800 6.54e-15 ***
heure10:00:00    -4.030e-02  5.667e-03  -7.110 1.20e-12 ***
heure10:30:00    -2.507e-02  5.703e-03  -4.396 1.11e-05 ***
heure11:00:00    -1.992e-02  5.734e-03  -3.474 0.000513 ***
heure11:30:00    -1.188e-02  5.734e-03  -2.072 0.038292 *  
heure12:00:00     6.260e-03  5.771e-03   1.085 0.278069    
heure12:30:00     2.014e-02  5.779e-03   3.485 0.000493 ***
heure13:00:00     3.348e-02  5.820e-03   5.752 8.95e-09 ***
heure13:30:00     4.015e-02  5.849e-03   6.864 6.91e-12 ***
heure14:00:00     4.198e-02  5.894e-03   7.122 1.11e-12 ***
heure14:30:00     4.926e-02  5.925e-03   8.313  < 2e-16 ***
heure15:00:00     5.611e-02  5.972e-03   9.394  < 2e-16 ***
heure15:30:00     6.875e-02  6.012e-03  11.435  < 2e-16 ***
heure16:00:00     8.905e-02  6.062e-03  14.689  < 2e-16 ***
heure16:30:00     1.013e-01  6.106e-03  16.594  < 2e-16 ***
heure17:00:00     1.204e-01  6.157e-03  19.552  < 2e-16 ***
heure17:30:00     1.379e-01  6.204e-03  22.224  < 2e-16 ***
heure18:00:00     1.622e-01  6.255e-03  25.934  < 2e-16 ***
heure18:30:00     1.986e-01  6.303e-03  31.512  < 2e-16 ***
heure19:00:00     2.292e-01  6.353e-03  36.071  < 2e-16 ***
heure19:30:00     2.371e-01  6.406e-03  37.021  < 2e-16 ***
heure20:00:00     2.220e-01  6.457e-03  34.375  < 2e-16 ***
heure20:30:00     2.159e-01  6.509e-03  33.173  < 2e-16 ***
heure21:00:00     1.980e-01  6.560e-03  30.180  < 2e-16 ***
heure21:30:00     1.916e-01  6.614e-03  28.967  < 2e-16 ***
heure22:00:00     1.802e-01  6.666e-03  27.025  < 2e-16 ***
heure22:30:00     1.826e-01  6.718e-03  27.185  < 2e-16 ***
heure23:00:00     1.610e-01  6.767e-03  23.797  < 2e-16 ***
heure23:30:00     1.238e-01  6.820e-03  18.147  < 2e-16 ***
weekend          -2.956e-03  2.918e-03  -1.013 0.310997    
Temperature       3.476e-03  1.615e-03   2.152 0.031434 *  
I(Temperature^2) -2.872e-05  1.514e-05  -1.897 0.057863 .  
temp.heure       -3.828e-04  1.543e-05 -24.808  < 2e-16 ***
temp.weekend      1.927e-04  1.895e-04   1.017 0.309189    
temp.mois         2.023e-04  5.406e-05   3.741 0.000184 ***
mois.heure        2.943e-05  2.467e-05   1.193 0.232955    
weekend.heure     1.801e-04  1.736e-04   1.037 0.299672    
Temperature.lag  -1.737e-03  1.572e-03  -1.105 0.269176    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.07092 on 17452 degrees of freedom
Multiple R-squared:  0.7058,    Adjusted R-squared:  0.7047 
F-statistic:   625 on 67 and 17452 DF,  p-value: < 2.2e-16

Les variables significatives correspondent à celles qui ont la valeur Pr(>|t|) inférieure à \(\alpha = 0.05\). Donc, dans ce modèle, les variables Temperature, temp.mois, temp.heure, heure et mois sont significatives. Cependant, nous ajoutons tout de même les autres variables car ça ne peut pas fausser nos prédictions, dans le pire des cas elles ne changent rien et elles peuvent même, éventuellement, améliorer notre prédiction.

En testant nos prédictions sur Train et Test avec différentes variables, nous avons remarqué que nos scores étaient meilleurs en prenant les variables mois et heure au format chr et non au format numérique. Pour toutes les variables croisées, nous avons fait les calculs au format numérique.

Méthodes de prédiction

Pour chaque prédiction, nous implémentons graphiquement les \(2520\) dernières lignes de l’échantillon puis, à la suite, la prédiction réalisée. Nous allons représenter ces courbes pour nos trois échantillons de référence : X2, X12 et X22. De plus, nous avons choisi de ne pas montrer l’échantillon en entier afin de gagner en lisibilité et de nous permettre d’analyser graphiquement la prédiction.

Pour chaque méthode, nous avons créé une fonction qui dépend d’un paramètre \(k\) et qui réalise la prédiction de l’échantillon Xk. Pour construire la prédiction finale, nous avons tout simplément fait une boucle sur \(k\) allant de \(1\) à \(30\) et nous avons concaténer tous les vecteurs en un.

Régression linéaire

Nous avons d’abord réalisé des prédictions par régression linéaire à l’aide de la fonction lm. Pour ce modèle, ce qui est important est de bien choisir les variables par rapport auxquelles nous réalisons la régression.

Dans un premier temps, nous avons réalisé une régression avec les variables de base mois, heure et Temperature.

reglin1 <- function(k) {
  # modèle
  Xk <- data0[, k + 1]
  model <- lm(Xk ~ mois + heure + Temperature, data = consom.csv)
  
  # prédiction
  data.pred <- data1[c((2784*(k - 1) + 1):(2784*k)), ]
  temp.Xk <- my.na.approx(data.pred$Temperature)
  Xk.pred <- data.frame(mois.pred, heure.pred, temp.Xk)
  names(Xk.pred) <- c("mois", "heure", "Temperature")
  pred <- unname(predict(model, newdata = Xk.pred))
}

Dans un second temps, nous avons ajouté la variable weekend ainsi que les variables croisées à la régression.

reglin2 <- function(k) {
  # modèle
  Xk <- data0[, k + 1]
  model <- lm(Xk ~ mois + heure + weekend + Temperature + temp.heure + temp.weekend + temp.mois + mois.heure + weekend.heure, data = consom.csv)
  
  # prédiction
  data.pred <- data1[c((2784*(k - 1) + 1):(2784*k)), ]
  temp.Xk <- my.na.approx(data.pred$Temperature)
  temp.heure.pred <- temp.Xk*heure.num.pred
  temp.mois.pred <- temp.Xk*as.numeric(mois.pred)
  temp.weekend.pred <- temp.Xk*weekend.pred
  
  Xk.pred <- data.frame(mois.pred, heure.pred, weekend.pred, temp.Xk, temp.heure.pred, temp.mois.pred, temp.weekend.pred, mois.heure.pred, weekend.heure.pred)
  names(Xk.pred) <- c("mois", "heure", "weekend", "Temperature", "temp.heure", "temp.mois", "temp.weekend", "mois.heure", "weekend.heure")
  pred <- unname(predict(model, newdata = Xk.pred))
}

Finalement, nous avons ajouté la variable Temperature.lag ainsi que la Temperature au carré.

reglin3 <- function(k) {
  # modèle
  Xk <- data0[, k + 1]
  model <- lm(Xk ~ mois + heure + weekend + Temperature + I(Temperature^2) + Temperature.lag + temp.heure + temp.weekend + temp.mois + mois.heure + weekend.heure, data = consom.csv)
  
  # prédiction
  data.pred <- data1[c((2784*(k - 1) + 1):(2784*k)), ]
  temp.Xk <- my.na.approx(data.pred$Temperature)
  temp.Xk.lag <- sapply(1:length(temp.Xk), function(x) temp.Xk[x - 1])
  temp.Xk.lag[1] <- temp.Xk.lag[2]
  
  temp.heure.pred <- temp.Xk*heure.num.pred
  temp.mois.pred <- temp.Xk*as.numeric(mois.pred)
  temp.weekend.pred <- temp.Xk*weekend.pred
  
  Xk.pred <- data.frame(mois.pred, heure.pred, weekend.pred, temp.Xk, temp.Xk^2, temp.Xk.lag, temp.heure.pred, temp.mois.pred, temp.weekend.pred, mois.heure.pred, weekend.heure.pred)
  names(Xk.pred) <- c("mois", "heure", "weekend", "Temperature", "I(Temperature^2)", "Temperature.lag", "temp.heure", "temp.mois", "temp.weekend", "mois.heure", "weekend.heure")
  pred <- unname(predict(model, newdata = Xk.pred))
}

Comparons ces trois régressions linéaires pour X2, X12 et X22.

Les graphiques de l’échantillon X2 sont :

Nous remarquons que pour les trois prédictions, la variation de la partie de droite est trop petite par rapport a la partie de gauche. En effet, l’échantillon de base varie entre \(0\) et \(0.75\), tandis que la prédiction varie entre \(0.1\) et \(0.5\). Cependant, la troisième prédiction semble plus large que les deux autres. Pour les groupes de taille \(10\), le troisième modèle de régression linéaire semble mieux correspondre.

Les graphiques de l’échantillon X12 sont :

Pour les échantillons de taille \(100\), nous pouvons faire la même remarque que pour les échantillons de taille \(10\). De plus, le troisième modèle de régression linéaire réalise une prédiction qui semble assez stationnaire et périodique. Cependant, notre échantillon de base ne l’est pas. Bien que la largeur de la prédiction réalisée avec le deuxième modèle est plus petite, elle est plus semblable à l’échantillon dans son attitude. Pour les groupes de taille \(100\), le deuxième modèle de régression linéaire semble mieux correspondre.

Les graphiques de l’échantillon X22 sont :

Nous pouvons faire les mêmes remarques que pour les échantillons de taille \(100\). Cependant, comme la variance des échantillons est plus petite dans ce cas-là, la différence est moins flagrante. À nouveau, le comportement de la troisième prédiction semble trop régulier. Pour les groupes de taille \(1000\), le deuxième modèle de régression linéaire semble mieux correspondre.

Modèle additif généralisé

Ensuite, nous avons réalisé des prédictions avec un modèle additif généralisé à l’aide de la fonction gam. Pour ce modèle, ce qui est important est de bien choisir les variables ainsi que les paramètres qui lui sont associées.

Nous avons pris les variables :

• Temperature avec comme paramètre \(k = 54\);
• heure en numérique avec comme paramètre \(k = 48\);
• mois en numérique avec comme paramètre \(k = 12\);
• mois.heure avec comme paramètre \(k = 191\);
• weekend.heure avec comme paramètre \(k = 10\);
• temp.weekend avec comme paramètre \(k = 40\);
• temp.mois avec comme paramètre \(k = 20\);
• temp.heure avec comme paramètre \(k = 18\);
• Temperature.lag avec comme paramètre \(k = 10\).

Pour sélectionner ces paramètres, à nouveau, nous avons fait des prédictions tests sur Train et Test. Pour cela, nous avons testé plusieurs valeurs de \(k\) pour chaque variable et comparé les scores à l’aide de la fonction rmse. Nous avons gardé les paramètres qui nous permettaient d’obtenir le plus petit score.

Nous avons donc implémenté notre fonction de prédiction avec les paramètres trouvés.

gam.pred <- function (k) {
  # modèle
  Xk <- data0[, k + 1]
  model <- gam(Xk ~ s(Temperature, k = 54) + s(heure.num, k = 48) + s(as.numeric(mois), k = 12) + s(mois.heure, k = 191) + s(weekend.heure, k = 10) + s(temp.weekend, k = 40) + s(temp.mois, k = 20) + s(Temperature.lag, k = 10) + s(temp.heure, k = 18), data = consom.csv)
  
  # prédiction
  data.pred <- data1[c((2784*(k - 1) + 1):(2784*k)), ]
  temp.Xk <- my.na.approx(data.pred$Temperature)
  temp.Xk.lag <- sapply(1:length(temp.Xk), function(x) temp.Xk[x - 1])
  temp.Xk.lag[1] <- temp.Xk.lag[2]
  
  Xk.pred <- data.frame(temp.Xk, heure.num.pred, as.numeric(mois.pred), mois.heure.pred,
                        weekend.heure.pred, temp.Xk*weekend.pred, temp.Xk*as.numeric(mois.pred),
                        temp.Xk.lag, temp.Xk*heure.num.pred)
  names(Xk.pred) <- c("Temperature", "heure.num", "mois", "mois.heure", "weekend.heure", "temp.weekend", "temp.mois", "Temperature.lag", "temp.heure")
  pred <- predict(model, newdata = Xk.pred)
}

Le graphique de l’échantillon X2 est :

Tout comme pour les prédictions par régression linéaire, la variance de la partie de droite est plus petite que la partie de gauche. Cependant, cette prédiction équivaut à la troisième prédiction par lm.

Le graphique de l’échantillon X12 est :

À nouveau, cette prédiction équivaut à la troisième prédiction par lm. La prédiction est plutôt stationnaire et périodique.

Le graphique de l’échantillon X22 est :

Enfin, même pour les groupes de taille \(1000\), nous faisons les mêmes observations que pour les autres groupes de tailles différentes.

Les plus proches voisins

Enfin, nous avons réalisé des prédictions avec la méthode des plus proches voisins. Si nous souhaitons classifier l’ensemble \(\{ x_i \text{ pour } i \in 1, \cdots, N \}\), cette méthode associe à chaque élément une classe \(c(x_i)\) qui correspond à la classe des \(k\) voisins les plus proches de cet élément. Pour ce modèle, ce qui est important est de bien choisir les variables ainsi que les paramètres qui sont associés à chaque échantillon. Les paramètres sont les différents \(k\) qui définissent le nombre de plus proches voisins auxquels nous nous intéressons. Donnons un exemple pour illustrer cette classification :

• Si nous prenons en compte les trois plus proches voisins, le point vert sera de classe bleue :

• Si nous prenons en compte les sept plus proches voisins, le point vert sera de classe orange :

À nouveau, pour déterminer les meilleurs paramètres, nous allons prédire nos données Test à partir des données Train. Pour chaque colonne d’échantillon X nous aurons un paramètre \(k\) différent. Nous enregistrons ces paramètres dans une variable nommée best_k.

test.knn <- function (k = 1, i = 1) {
  # variables pour Train
  mois.tra <- as.numeric(Train$mois)
  heure.tra <- heure.num[train_ind]
  we.tra <- Train$weekend
  we.num.tra <- as.numeric(Train$week.num)
  temp.tra <- Train$Temperature
  temp.lag.tra <- Train$Temperature.lag
  
  # variables pour Test
  mois.tes <- as.numeric(Test$mois)
  heure.tes <- heure.num[-train_ind]
  we.tes <- Test$weekend
  we.num.tes <- as.numeric(Test$week.num)
  temp.tes <- Test$Temperature
  temp.lag.tes <- Test$Temperature.lag
  
  tra <- data.frame(mois.tra, heure.tra, we.tra, we.num.tra, temp.tra, temp.lag.tra, temp.tra*heure.tra, temp.tra*we.tra, temp.tra*mois.tra, mois.tra*heure.tra, we.tra*heure.tra)
  
  tes <- data.frame(mois.tes, heure.tes, we.tes, we.num.tes, temp.tes, temp.lag.tes, temp.tes*heure.tes, temp.tes*we.tes, temp.tes*mois.tes, mois.tes*heure.tes, we.tes*heure.tes)
  
  conso <- Train[, i + 5]
  pred <- knn.reg(train = tra, test = tes, y = conso, k = k)$pred
  act <- Test[, i + 5]
  rmse(pred, act)
}
best_k <- vector()
for (I in 1:30) {
  ListK <- c(1:10)
  List <- sapply(ListK, test.knn, i = I)
  best_k <- c(best_k, which.min(List))
}

La liste best_k vaut :

print(best_k)

 [1] 9 8 7 6 9 6 5 6 9 5 4 4 4 4 5 4 4 4 4 4 3 4 4 3 3 3 3 3 3 3

Une fois cette liste créée, nous réalisons notre prédiction en prenant en compte les variables mois en numérique, heure en numérique, weekend, week.num, Temperature et Temperature.lag.

tra <- data.frame(as.numeric(consom.csv$mois), heure.num, consom.csv$weekend, as.numeric(consom.csv$week.num), consom.csv$Temperature, consom.csv$Temperature.lag)
knn.pred <- function (i) {
  tes <- data.frame(as.numeric(mois.pred), heure.num.pred, weekend.pred, as.numeric(week.num.pred), Temperature.pred, Temperature.lag.pred)
  tes <- tes[c((2784*(i - 1) + 1):(2784*i)), ]
  conso <- consom.csv[, i + 5]
  pred <- knn.reg(train = tra, test = tes, y = conso, k = best_k[i])$pred
}

Le graphique de l’échantillon X2 est :

Cette fois-ci, contrairement aux deux méthodes précédentes, la variance de la prédiction est bien plus proche de la variance de l’échantillon. De plus, la prédiction ne semble ni particulièrement stationnaire ni particulièrement périodique. L’allure de la courbe est plutôt cohérente.

Le graphique de l’échantillon X12 est :

À nouveau, nous pouvons faire les mêmes commentaires que pour les échantillons de taille \(10\). En effet, l’allure de la courbe est cohérente et les deux parties semblent se comporter de la même façon. Les variances sont encore plus semblables.

Le graphique de l’échantillon X22 est :

Pour les échantillons de taille \(1000\), il se passe la même chose que précédemment avec une différence de variance très faible.

Graphiquement, les prédictions faites par la méthode des plus proches voisins semblent les meilleures.

Conclusion

De façon générale, nous remarquons que plus la taille de l’échantillon est grande, plus la variance est petite. La difficulté vient donc du fait qu’il faut prédire correctement cette variance qui change pour chaque échantillon.

La régression linéaire nous a permis d’avoir nos meilleurs scores. Cependant, à la représentation graphique, nous avons remarqué que pour les échantillons de taille \(10\), la prédiction n’est pas cohérente, en effet, le modèle ne retrouve pas la bonne variance. Par contre, plus la taille du groupe est grande, plus la variance diminue et plus la prédiction est cohérente.

Le modèle additif généralisé n’a pas amélioré nos scores. Cependant, à la représentation graphique, la variance est plus conservée pour toutes les tailles d’échantillon. En effet, pour les groupes de taille \(10\), la variance de la prédiction est bien plus grande que pour la régression linéaire. Dès les groupes de taille \(100\), les variances sont quasiment égales.

Le modèle des plus proches voisins n’a pas amélioré nos scores. Cependant, les représentations graphiques des prédictions semblent tout à fait cohérentes. En effet, la prédiction de l’échantillon X2 est bien plus large que dans les deux autres méthodes. De plus, les courbes des prédictions semblent se comporter de la même façon que les courbes des échantillons.

Pour tenter d’améliorer nos scores, nous pourrions utiliser des modèles de séries temporelles comme ARIMA par exemple. Il faudrait, pour ce faire, trouver les paramètres \(p\) et \(q\) associés à chaque échantillon Xk.