Comment Utiliser R et Shiny pour l’analyse exploratoire des données et la prédiction afin de répondre à une problématique Business (Question commerciale) ?

Context et Justification

L’objectif du présent chapitre est de montrer aux apprenants comment développer une application WEB avec R-Shiny pour analyser, explorer et prédire des variables dans un jeu de données.

Le premier partie du chapitre couvre les bases de R-Shiny (Machine Learning), on y expliquera certaines fonctionalités. De plus, nous ferons une analyse exploratoire des données (EDA) des vélos en libre-service à Washington-DC, sous forme de graphiques interactifs.

Ensuite, nous construirons un modèle de prédiction pour aider l’utilisateur de l’application à prédire le nombre total de vélos enrégistrés dans le système en tenant compte des conditions météorologiques et du jour de l’année.En effet, Nous allons décrire des données permettant de répondre à plusieurs questions commerciales auxquelles l’application Web aura pour but de répondre.

Contenu

1.Qu’est-ce que R-Shiny?

R-Shiny est un package de R, capable de créer une application sous forme de page Web interactive directement à partir de R. et Ceci sans utiliser de langages d’application Web tels que HTML, CSS ou JavaScript.

Shiny contient deux paramètres fondamentaux, l’interface utilisateur et le serveur.

1.1 Structure d’une application Shiny simple en un seul fichier

C’est une simple page HTML

#library(shiny)
#ui <- fluidPage(Title="Application Shiny Basique")
#server <- function(input, output){}
#shinyApp(ui = ui, server = server)

1.2 Structure d’une application ShinyDashboard simple en un seul fichier

C’est une page HTML avec entête, Menu de sélection et zone de visualisation

#library(shiny)
#library(shinydashboard)

#ui <- dashboardPage(
  #dashboardHeader(title = "ShinyDashboard"),
  #dashboardSidebar(),
  #dashboardBody()
#)

#server <- function(input, output) {
#}

#shinyApp(ui, server)

1.3 Structure d’une application ShinyDashboardPlus simple en un seul fichier

C’est un DashboardPlus avec de plus beaux visuels

#library(shiny)
#library(shinydashboard)
#library(shinydashboardPlus)
#shinyApp(
 # ui = dashboardPage(
  #  dashboardHeader(title = "ShinyDashboardPlus"),
   # dashboardSidebar(),
   # dashboardBody("Ici les visuels sont plus beaux comme dans le framework Bootstrap 4"),
  #),
  #server = function(input, output, session) {})

Pour aller plus loin vous avez une formation intégrale ici (une série de tutos sur shiny):

Exemple de lien

2.Comepréhension des Données

2.1 Système de location des vélos à Washington-DC

Le système gère un groupe de vélos situés dans six juridictions différentes à Washington-DC. Les vélos sont verrouillés dans un réseau de stations, pour que les utilisateurs puissent effectuer leur déplacement quotidien. Les utilisateurs peuvent déverrouiller les vélos avec une application et, après avoir fait leurs trajets, les ramener à n’importe quelle autre station à proximité d’eux.

Le jeu de données contient le décompte horaire d’utilisation des vélos, entre les années 2011 et 2012, en tenant compte des conditions météorologiques et des informations saisonnières. Il contient 16 variables et 17,379 observations dans lesquelles chaque ligne de données représente une heure spécifique de la journée à partir du 1er janvier 2011 jusqu’au 31 décembre 2012.

library(readr)
library(kableExtra)
hour <- read_csv("D:/EDA & Prediction/Bike-Sharing-Dataset/hour.csv")

head(hour)%>%
  kbl(caption = "Tableau 1: Utilisation horaire des vélos") %>%
  kable_classic(full_width = F, html_font = "Cambria")
Tableau 1: Utilisation horaire des vélos
instant dteday season yr mnth hr holiday weekday workingday weathersit temp atemp hum windspeed casual registered cnt
1 2011-01-01 1 0 1 0 0 6 0 1 0.24 0.2879 0.81 0.0000 3 13 16
2 2011-01-01 1 0 1 1 0 6 0 1 0.22 0.2727 0.80 0.0000 8 32 40
3 2011-01-01 1 0 1 2 0 6 0 1 0.22 0.2727 0.80 0.0000 5 27 32
4 2011-01-01 1 0 1 3 0 6 0 1 0.24 0.2879 0.75 0.0000 3 10 13
5 2011-01-01 1 0 1 4 0 6 0 1 0.24 0.2879 0.75 0.0000 0 1 1
6 2011-01-01 1 0 1 5 0 6 0 2 0.24 0.2576 0.75 0.0896 0 1 1

Dans ce tableau il existe 9 variables qualitatives, qui sont les suivantes :

  • jour (dteday): date
  • saison (season) : saison (1 = hiver, 2 = printemps, 3 = été, 4 = automne)
  • an (yr) : année (0 = 2011, 1 = 2012)
  • mois (mnth) : mois (1 à 12)
  • heure (hr) : heure (0 à 23)
  • jour férié (holiday) : le jour de la météo est férié ou non (0 = non, 1 = oui)
  • jour de la semaine (weekday): jour de la semaine
  • jour ouvré (workingday): le jour météorologique est un jour ouvré ou non (si le jour n’est ni - un week-end ni un jour férié vaut 1, sinon vaut 0)
  • conditions météorologiques (Weathersit): (1 = clair, peu de nuages, partiellement nuageux, partiellement nuageux ; 2 = brouillard + nuageux, brouillard + nuages fragmentés, brouillard + quelques nuages, brouillard ; 3 = neige légère, pluie légère + orage + nuages épars, léger pluie + nuages épars ; 4 = fortes pluies + nappes de glace + orage + brouillard, neige + brouillard)

De plus, les données ont 7 variables numériques:

  • température (temp) : température normalisée en degrés Celsius (les valeurs sont dérivées via (t-t_min)/(t_max-t_min), t_min=-8, t_max=+39)
  • température ressentie (atemp): également normalisée en degrés Celsius (les valeurs sont dérivées via (t-t_min)/(t_max-t_min), t_min=-16, t_max=+50)
  • humidité (hum) : également normalisée (les valeurs sont divisées par 100 (max))
  • vitesse du vent normalisée (windspeed3) : (les valeurs sont divisées en 67 (max)
  • nombre d’utilisateurs occasionnels (casual): ayant utilisé le système de vélos en libre-service à une heure donnée
  • inscrits (registered): nombre de nouveaux utilisateurs inscrits pour utiliser le système de vélos en libre-service à une heure précise
  • décompte (cnt): nombre total de vélos de location à une heure spécifique (inclus à la fois, occasionnels et enregistrés)

2.2 Questions Commerciales

Une fois les données comprises, Posons nous quelques questions commerciales dont les réponses montreront comment utiliser l’application R-Shiny dans la vraie vie.

# 1- Y a-t-il une différence Significative entre le nombre de nouveaux clients et celui des clients occasionnels dans notre jeu de données ?.``

# 2- Au cours des deux années, quelles étaient les conditions météorologiques qui prédominaient le plus lors des balades à vélo?

# 3- Au cours de l'année 2012, quel mois a enregistré le plus grand nombre de nouveaux utilisateurs inscrits au système de vélos en libre-service?

# 4- Quelle saison a enregistré le plus grand nombre d'inscriptions d'utilisateurs occasionnels et de nouveaux utilisateurs dans des conditions météorologiques de type "Bonne" en 2012?

# 5- L'entreprise souhaite prévoir le nombre d'inscriptions de vélos pour demain (qui est un jour ouvré), à 15 heures ; avec les informations météo suivantes : (35% d'humidité, une température de 17 degrés Celsius et une température ressentie de 15 degrés Celsius. une vitesse de vent de 10 mph, Et le type de temps « Beau ») Pouvez-vous l'aider ?

3.Préparation des Données

Pour avoir les données au bon format dans l’application R-Shiny, il faut d’abord les préparer. Pour ce faire, je procède au chargement de l’ensemble de données dans RStudio et vérifie le type de données de chaque variable.

str(hour)
## spc_tbl_ [17,379 x 17] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ instant   : num [1:17379] 1 2 3 4 5 6 7 8 9 10 ...
##  $ dteday    : Date[1:17379], format: "2011-01-01" "2011-01-01" ...
##  $ season    : num [1:17379] 1 1 1 1 1 1 1 1 1 1 ...
##  $ yr        : num [1:17379] 0 0 0 0 0 0 0 0 0 0 ...
##  $ mnth      : num [1:17379] 1 1 1 1 1 1 1 1 1 1 ...
##  $ hr        : num [1:17379] 0 1 2 3 4 5 6 7 8 9 ...
##  $ holiday   : num [1:17379] 0 0 0 0 0 0 0 0 0 0 ...
##  $ weekday   : num [1:17379] 6 6 6 6 6 6 6 6 6 6 ...
##  $ workingday: num [1:17379] 0 0 0 0 0 0 0 0 0 0 ...
##  $ weathersit: num [1:17379] 1 1 1 1 1 2 1 1 1 1 ...
##  $ temp      : num [1:17379] 0.24 0.22 0.22 0.24 0.24 0.24 0.22 0.2 0.24 0.32 ...
##  $ atemp     : num [1:17379] 0.288 0.273 0.273 0.288 0.288 ...
##  $ hum       : num [1:17379] 0.81 0.8 0.8 0.75 0.75 0.75 0.8 0.86 0.75 0.76 ...
##  $ windspeed : num [1:17379] 0 0 0 0 0 0.0896 0 0 0 0 ...
##  $ casual    : num [1:17379] 3 8 5 3 0 0 2 1 1 8 ...
##  $ registered: num [1:17379] 13 32 27 10 1 1 0 2 7 6 ...
##  $ cnt       : num [1:17379] 16 40 32 13 1 1 2 3 8 14 ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   instant = col_double(),
##   ..   dteday = col_date(format = ""),
##   ..   season = col_double(),
##   ..   yr = col_double(),
##   ..   mnth = col_double(),
##   ..   hr = col_double(),
##   ..   holiday = col_double(),
##   ..   weekday = col_double(),
##   ..   workingday = col_double(),
##   ..   weathersit = col_double(),
##   ..   temp = col_double(),
##   ..   atemp = col_double(),
##   ..   hum = col_double(),
##   ..   windspeed = col_double(),
##   ..   casual = col_double(),
##   ..   registered = col_double(),
##   ..   cnt = col_double()
##   .. )
##  - attr(*, "problems")=<externalptr>

Maintenant, que les données sont chargées, il est primordial de vérifier qu’elles possèdent toutes (les variables) le bon type de données. En visualisant le résultat du code ci-dessus, nous pouvons voir que huit (08) des neuf (09) variables catégorielles ont un type incorrect. Changeons le type de données de num (numerique) en facteur (factor). En plus de changer les types, nous changeons également les valeurs numérotées par leur nom de modalité respectif pour rendre leur manipulation/interprétation plus aisée.

Il ne vous a pas échappé que la première colonne de l’ensemble de données était l’index de ligne, qui ne contient aucune valeur prédictive. Pour cette raison, nous excluons la première colonne du jeu de données.

library(kableExtra)
data <- hour[,-1]

head(data)%>%
  kbl(caption = "Tableau 2: Utilisation horaire des vélos sans l'index de ligne") %>%
  kable_classic(full_width = F, html_font = "Cambria")
Tableau 2: Utilisation horaire des vélos sans l’index de ligne
dteday season yr mnth hr holiday weekday workingday weathersit temp atemp hum windspeed casual registered cnt
2011-01-01 1 0 1 0 0 6 0 1 0.24 0.2879 0.81 0.0000 3 13 16
2011-01-01 1 0 1 1 0 6 0 1 0.22 0.2727 0.80 0.0000 8 32 40
2011-01-01 1 0 1 2 0 6 0 1 0.22 0.2727 0.80 0.0000 5 27 32
2011-01-01 1 0 1 3 0 6 0 1 0.24 0.2879 0.75 0.0000 3 10 13
2011-01-01 1 0 1 4 0 6 0 1 0.24 0.2879 0.75 0.0000 0 1 1
2011-01-01 1 0 1 5 0 6 0 2 0.24 0.2576 0.75 0.0896 0 1 1

Il faudra remarquer qu’un critère différent a été utilisé pour étiqueter la variable conditions météorologiques. En analysant chacune des sorties de la météo, une nouvelle échelle a été définit: de « bon » à « très mauvais » ; où 1 représente le beau temps et 4 indique le très mauvais temps.

#Préparation des Données

  #Etiquettage des données et changement du type de variable

data$yr <- as.factor(ifelse(data$yr == 0, '2011', '2012'))
data$mnth <- as.factor(months(as.Date(data$dteday), 
                              abbreviate = TRUE))
data$hr <- factor(data$hr)
data$weekday <- as.factor(weekdays(as.Date(data$dteday)))
data$season <- as.factor(ifelse(data$season == 1, 'Spring',
                                ifelse(data$season == 2, 'Summer',
                                       ifelse(data$season == 3, 
                                              'Fall', 'Winter'))))
data$weathersit <- as.factor(ifelse(data$weathersit == 1, 'Good',
                                    ifelse(data$weathersit == 2, 
                                           'Fair',
                                           ifelse(data$weathersit == 
                                                    3, 'Bad', 
                                                  'Very Bad'))))
data$holiday<-as.factor(ifelse(data$holiday == 0, 'No', 'Yes'))
data$workingday<-as.factor(ifelse(data$workingday == 0, 'No', 
                                  'Yes'))

head(data)%>%
  kbl(caption = "Tableau 3: Données étiquettées avec types changés") %>%
  kable_classic(full_width = F, html_font = "Cambria")
Tableau 3: Données étiquettées avec types changés
dteday season yr mnth hr holiday weekday workingday weathersit temp atemp hum windspeed casual registered cnt
2011-01-01 Spring 2011 Jan 0 No Saturday No Good 0.24 0.2879 0.81 0.0000 3 13 16
2011-01-01 Spring 2011 Jan 1 No Saturday No Good 0.22 0.2727 0.80 0.0000 8 32 40
2011-01-01 Spring 2011 Jan 2 No Saturday No Good 0.22 0.2727 0.80 0.0000 5 27 32
2011-01-01 Spring 2011 Jan 3 No Saturday No Good 0.24 0.2879 0.75 0.0000 3 10 13
2011-01-01 Spring 2011 Jan 4 No Saturday No Good 0.24 0.2879 0.75 0.0000 0 1 1
2011-01-01 Spring 2011 Jan 5 No Saturday No Fair 0.24 0.2576 0.75 0.0896 0 1 1

De plus, on change les noms des colonnes “registered” et “cnt” avec “new” et “total”, respectivement. Ce qui nous permet de bien distinguer ceux qui utilisent le service pour la première fois et ceux qui sont des utilisateurs habituels.

 #Changing columns names
names(data)[names(data) == "registered"] <- "new"
names(data)[names(data) == "cnt"] <- "total"

head(data)%>%
  kbl(caption = "Tableau 4: Renommage des variables: registered et cnt en new et total") %>%
  kable_classic(full_width = F, html_font = "Cambria")
Tableau 4: Renommage des variables: registered et cnt en new et total
dteday season yr mnth hr holiday weekday workingday weathersit temp atemp hum windspeed casual new total
2011-01-01 Spring 2011 Jan 0 No Saturday No Good 0.24 0.2879 0.81 0.0000 3 13 16
2011-01-01 Spring 2011 Jan 1 No Saturday No Good 0.22 0.2727 0.80 0.0000 8 32 40
2011-01-01 Spring 2011 Jan 2 No Saturday No Good 0.22 0.2727 0.80 0.0000 5 27 32
2011-01-01 Spring 2011 Jan 3 No Saturday No Good 0.24 0.2879 0.75 0.0000 3 10 13
2011-01-01 Spring 2011 Jan 4 No Saturday No Good 0.24 0.2879 0.75 0.0000 0 1 1
2011-01-01 Spring 2011 Jan 5 No Saturday No Fair 0.24 0.2576 0.75 0.0896 0 1 1

Enfin, pour la dernière étape de la préparation des données, on dénormalise les valeurs des variables « temp », « atemp », « hum », et « windspeed » ; afin que plus tard nous puissions analyser les observations réelles (observées) et non les données transformées. Notamment lorsqu’on fera l’analyse exploratoire des données (EDA) et Modélisation.

 #Dénormalisation des variables
    #Température
for (i in 1:nrow(data)){
  tn = data[i, 10]
  t = (tn * (39 - (-8))) + (-8)
  data[i, 10] <- t
}
    #Température ressentie
for (i in 1:nrow(data)){
  tn = data[i, 11]
  t = (tn * (50 - (-16))) + (-16)
  data[i, 11] <- t
}
    #Humidité
data$hum <- data$hum * 100
    #Vitesse du vent
data$windspeed <- data$windspeed * 67

head(data)%>%
  kbl(caption = "Tableau 5: Dénormalisation des Données") %>%
  kable_classic(full_width = F, html_font = "Cambria")
Tableau 5: Dénormalisation des Données
dteday season yr mnth hr holiday weekday workingday weathersit temp atemp hum windspeed casual new total
2011-01-01 Spring 2011 Jan 0 No Saturday No Good 3.28 3.0014 81 0.0000 3 13 16
2011-01-01 Spring 2011 Jan 1 No Saturday No Good 2.34 1.9982 80 0.0000 8 32 40
2011-01-01 Spring 2011 Jan 2 No Saturday No Good 2.34 1.9982 80 0.0000 5 27 32
2011-01-01 Spring 2011 Jan 3 No Saturday No Good 3.28 3.0014 75 0.0000 3 10 13
2011-01-01 Spring 2011 Jan 4 No Saturday No Good 3.28 3.0014 75 0.0000 0 1 1
2011-01-01 Spring 2011 Jan 5 No Saturday No Fair 3.28 1.0016 75 6.0032 0 1 1

Pour l’arrangement final on enlève la date qui ne nous servira pas dans la suite et on sauvegarde le nouveau fichier avec les données arrangées.

data <- data[-1]
# write.csv(data, "bike_sharing.csv", row.names = FALSE)
head(data)%>%
  kbl(caption = "Tableau 6: Données Préparées et prêtes à l'utilisation") %>%
  kable_classic(full_width = F, html_font = "Cambria")
Tableau 6: Données Préparées et prêtes à l’utilisation
season yr mnth hr holiday weekday workingday weathersit temp atemp hum windspeed casual new total
Spring 2011 Jan 0 No Saturday No Good 3.28 3.0014 81 0.0000 3 13 16
Spring 2011 Jan 1 No Saturday No Good 2.34 1.9982 80 0.0000 8 32 40
Spring 2011 Jan 2 No Saturday No Good 2.34 1.9982 80 0.0000 5 27 32
Spring 2011 Jan 3 No Saturday No Good 3.28 3.0014 75 0.0000 3 10 13
Spring 2011 Jan 4 No Saturday No Good 3.28 3.0014 75 0.0000 0 1 1
Spring 2011 Jan 5 No Saturday No Fair 3.28 1.0016 75 6.0032 0 1 1

4.Modélisation

Pour le modèle, nous voulons prédire le nombre total d’enregistrements qui peuvent se produire en une seule journée en tenant compte d’une période (mois, heure et jour de la semaine) et des conditions météorologiques. Pour cette question, la première étape consiste à supprimer les colonnes qui ne feront pas partie du modèle.

Les variables «saison» et «jour ouvré» sont supprimées car les variables «mois» et «jour de la semaine» peuvent fournir les mêmes informations. En effet, en indiquant le mois, on sait à quelle saison de l’année on se trouve. De plus, en fournissant des informations sur le jour de la semaine, nous identifions s’il s’agit d’un jour ouvrable ou non.

Étant donné que le modèle de prédiction est basé sur les conditions météorologiques et les informations spécifiques d’un jour, la variable année ne fournit aucune information essentielle à la modélisation. C’est pourquoi nous éliminons la variable “yr” du jeu de données. De même, les variables « casual » et « new » sont exclues du modèle car le but du modèle est de prédire le nombre total d’inscriptions pas le nombre de nouveau inscrits ou le nombre de clients habituels.

#Modélisation
  #Suppression des variables inutiles à la modélisation
data <- data[c(-1,-2,-7,-13,-14)]
head(data)%>%
  kbl(caption = "Tableau 7: Données strictement utiles à la modélisation") %>%
  kable_classic(full_width = F, html_font = "Cambria")
Tableau 7: Données strictement utiles à la modélisation
mnth hr holiday weekday weathersit temp atemp hum windspeed total
Jan 0 No Saturday Good 3.28 3.0014 81 0.0000 16
Jan 1 No Saturday Good 2.34 1.9982 80 0.0000 40
Jan 2 No Saturday Good 2.34 1.9982 80 0.0000 32
Jan 3 No Saturday Good 3.28 3.0014 75 0.0000 13
Jan 4 No Saturday Good 3.28 3.0014 75 0.0000 1
Jan 5 No Saturday Fair 3.28 1.0016 75 6.0032 1

4.1 Constitution des échantillons de test et d’apprentissage

Maintenant que les données sont prêtes pour la modélisation, nous procédons à la division de la base en deux: les données d’entraînement et les données de test. Ces nouveaux jeux de données sont sauvegardés dans des fichiers séparés. Pour les constituer les proportions suivantes ont été utilisées (les données de la base d’apprentissage (train) contiendront à 80% des observations totales et celle de la base de (test) les 20% restants).

#Division des données
library(caTools)
set.seed(123)
split = sample.split(data$total, SplitRatio = 0.8)
train_set = subset(data, split == TRUE)
test_set = subset(data, split == FALSE)
    #Creation des fichiers des deux jeux de données
write.csv(train_set, "bike_train.csv", row.names = FALSE)
write.csv(test_set, "bike_test.csv", row.names = FALSE)

Une fois les echantillons construit, il faut vérifier qu’ils ont la même structure au sens de la variable dépendante (le nombre total de bicyclettes louées). Ce qui garantira les populations utilisées pour entrainer le modèle d’une part et pour le tester sont identiques donc on peut utiliser l’une pour tester ce qu’on a observé sur l’autre.

#Structure de la variable explicative dans les deux échantillons
library(ggplot2)
library(dplyr)
library(kableExtra)
library(readr)
train_set <- read_csv("D:/DATAVIZ/bike_train.csv")
test_set <- read_csv("D:/DATAVIZ/bike_test.csv")
hist1<-data.frame(train_set$total)
hist1<-hist1%>%mutate(ECH="train")
names(hist1)<-c("total", "ECH")
hist2<-data.frame(test_set$total)
hist2<-hist2%>%mutate(ECH="test")
names(hist2)<-c("total", "ECH")
hist<-bind_rows(hist1,hist2)

str_sample <- hist%>%ggplot(aes(x = total)) +
  geom_histogram(aes(color = ECH, fill = ECH),
                position = "identity", bins = 30, show.legend = FALSE) +
  scale_color_manual(values = c("#000000", "#000000"))+
  scale_fill_manual(values = c("#00AFBB", "#E7B800"))+
  facet_grid(ECH ~ .)+
  ggtitle(label=expression(paste(bold(underline("Graphique 2:")),bold("Structure des échantillons d'apprentissage et de test"))), 
          subtitle ="(Ils ont la même structure: décroissance du nombre total de locations de bicyclettes)")+
  labs(x="total", fill=NULL, caption = expression(paste(italic(underline("Source:")),italic("https://archive.ics.uci.edu/ml/datasets/bike+sharing+dataset#"))))+
  Conrad_Theme()
str_sample

4.2 Les modèles

Maintenant il faut sélectionner le modèle pour la prédiction. Puisque la variable dépendante est numérique (total des inscriptions), cela signifie que nous sommes en présence d’une tâche de régression. Pour cette raison, nous postulons les modèles suivants: régression linéaire multiple, arbre de décision et forêt aléatoire pour prédire le résultat de la variable dépendante comme le préconise l’algorithme ci-dessous.

Graphique 1: Choix des 3 modèles qui seront spécifiés.

4.2.1 Regression linéaire

Pour l’étape suivante, nous spécifions un modèle de régression avec les données d’entraînement. Ensuite, nous évaluons ses performances en calculant l’erreur absolue moyenne (MAE) et l’erreur quadratique moyenne (RMSE).

En statistique, l’erreur moyenne absolue donne la moyenne de la différence absolue entre la prévision du modèle et la réalisation.

\[ Mean Absolute Error (MAE) = \sum_{i = 1}^{n}{|Y_i-{\hat{Y}_i}|/n} \]

et L’erreur quadratique moyenne (EQM) est un indicateur de vérification de la fiabilité d’un modèle. Cet outil étudie les écarts entre les valeurs réellement observées et les valeurs prédites par le modèle. L’erreur quadratique est une valeur toujours positive. Plus les valeurs obtenues avec le modèle sont proches des valeurs observées, plus les écarts sont faibles et l’erreur quadratique proche de zéro.

\[ Root Mean Square Error (RMSE) = \sqrt{\sum_{i = 1}^{n}{(Y_i-{\hat{Y}_i})^2/n}} \]

 #Regression Linéaire Multiple
multi = lm(formula = total ~ ., data = train_set)
    #Prédisons les valeurs du jeu de donné test
y_pred_m = predict(multi, newdata = test_set)
    #Mesurons la qualité du modèle
library(Metrics)
mae_m = mae(test_set[[10]], y_pred_m)
rmse_m = rmse(test_set[[10]], y_pred_m)
mae_m
## [1] 102.4675
rmse_m
## [1] 135.9963
4.2.2 L’arbre de décision
 #Decision tree
library(rpart)
dt = rpart(formula = total ~ ., data = train_set,
           control = rpart.control(minsplit = 3))
    #Predicting the test values
y_pred_dt = predict(dt, newdata = test_set)
    #Performance metrics
mae_dt = mae(test_set[[10]], y_pred_dt)
rmse_dt = rmse(test_set[[10]], y_pred_dt)
mae_dt
## [1] 71.50788
rmse_dt
## [1] 99.89058
4.2.3 La Forêt Aléatoire
 #Random forest
library(randomForest)
set.seed(123)
rf = randomForest(formula = total ~ ., data = train_set,
                  ntree = 100)
    #Predicting the test values
y_pred_rf = predict(rf, newdata = test_set)
    #Performance metrics
mae_rf = mae(test_set[[10]], y_pred_rf)
rmse_rf = rmse(test_set[[10]], y_pred_rf)
mae_rf
## [1] 47.73333
rmse_rf
## [1] 70.42231

Une fois quenous avons les métriques de performance de tous les modèles, nous choisissons le meilleur modèle. Comme nous le savons, l’erreur absolue moyenne (MAE) et l’erreur quadratique moyenne (RMSE) sont deux des mesures les plus courantes pour mesurer la précision d’un modèle de régression.

Puisque le MAE délivre une valeur moyenne des erreurs de la prédiction, il est préférable de sélectionner un modèle où la valeur du MAE est petite. En d’autres termes, celui pour lequel l’ampleur de l’erreur dans la prévision est minime, ce qui rend la prévision plus proche des valeurs réelles de notre variable à prédire. Même en considérant l’erreur quadratique moyenne (RMSE), la forêt aléatoire est toujours la bonne option. remarquons également que la différence entre le MAE et le RMSE de la forêt aléatoire est faible.

Modèle<-c("Regression multiple", "Arbre de Décision", "Forêt Aléatoire")
MAE <- c(mae_m, mae_dt, mae_rf)
RMSE <- c(rmse_m, rmse_dt, rmse_rf)
Choix <- data.frame(Modèle, MAE, RMSE)
Choix2<-Choix%>%tidyr::gather(Indicateur, Valeur, MAE, RMSE)

Choix2%>%ggplot(aes(fill=Indicateur, y=Valeur, x=Modèle)) +
  geom_bar(position='dodge', stat='identity')+
  geom_text(aes(label=round(Valeur, digits=2)), vjust=1.6, position = position_dodge(0.9),   color="black", size=3.5)+
  scale_fill_manual(values = c("#00AFBB", "#E7B800"))+
  ggtitle(label=expression(paste(bold(underline("Graphique 3:")),bold("Choix du Modèle"))), 
          subtitle ="(La Forêt Aléatoire est le meilleur modèle pour prédire le nombre total de locations de vélos)")+
  labs(x="Modèle", fill=NULL, caption = expression(paste(italic(underline("Source:")),italic("Nos Estimations sur R"))))

Le modèle de forêt aléatoire étant le meilleur, il est nécessaire de le sauvegarder pour l’utiliser dans l’application Shiny.

# Sauvegarde du meilleur modèle
saveRDS(rf, file = "./rf.rda")

5.Analyse Exploratoire des Données avec R-Shiny

Dans cette étape, construisons une application R-Shiny où on peux effectuer une analyse univariée des variables numériques et catégorielles. Aussi, développons un tableau de bord interactif pour répondre aux questions commerciales présentées en début d’article.

Pour créer une application shiny allons dans File -> New File -> ShinyWebApp choisissons les options soit en 2 fichiers soit en un seul est l’emplacement de l’application.

Dans un nouveau document R, procèdons à la création de l’application R-Shiny. Tout d’abord, attachons les libraries nécessaires pour l’application Shiny et les jeux de données. Pour ce qui est des données, les placer dans un fichier nommé www que vous créerez dans le même dossier que l’application.

#attachons les librairies
library(shiny)
library(shinydashboard)
library(ggplot2)
library(dplyr)
library(tidyverse)

setwd("D:/DATAVIZ/BIKE_APP/Location_Velos")
#Importons les données

bike <- read.csv("D:/DATAVIZ/BIKE_APP/Location_Velos/www//hour.csv") # Ceci suppose que les données sont déjà dans votre fichier www
bike$mnth <- as.factor(months(as.Date(bike$dteday), 
                              abbreviate = TRUE))
bike$yr <- as.factor(ifelse(bike$yr == 0, '2011', '2012'))
bike$weekday <- as.factor(ifelse(bike$weekday == 1, 'Sunday',
                                 ifelse(bike$weekday == 2, 'Monday',
                                        ifelse(bike$weekday == 3,'Tuesday', 
                                               ifelse(bike$weekday==4, 'Wednesday',
                                                              ifelse(bike$weekday==5, 'Thursday',
                                                                     ifelse(bike$weekday==6,
                                                                            'Friday','Saturday')))))))
bike$season <- as.factor(ifelse(bike$season == 1, 'Spring',
                                ifelse(bike$season == 2, 'Summer',
                                       ifelse(bike$season == 3, 
                                              'Fall', 'Winter'))))

bike$weathersit <- as.factor(ifelse(bike$weathersit == 1, 'Good',
                                    ifelse(bike$weathersit == 2,'Fair',
                                           ifelse(bike$weathersit == 3, 'Bad', 
                                                  'Very Bad'))))

names(bike)[names(bike) == "registered"] <- "new"
names(bike)[names(bike) == "cnt"] <- "total"

5.1 R-Shiny UI

Tout d’abord, créons la page Web (UI), qui va afficher toutes les informations et la visualisation pour l’analyse exploratoire des données.

L’interface utilisateur sera une variable contenant des informations sur des éléments tels que l’en-tête, la barre latérale et le corps du tableau de bord. Pour créer une nouvelle page de tableau de bord avec tous les composants nécessaires, changeons l’apparence par défaut des applications shiny basique et choisissons l’apparence d’un shiny Dashboard.

library(shiny)
library(shinydashboard)
library(ggplot2)
library(dplyr)

setwd("D:/DATAVIZ/BIKE_APP/Location_Velos")
#Importons les données
bike <- read.csv("D:/DATAVIZ/BIKE_APP/Location_Velos/www//bike_sharing.csv") # Ceci suppose que les données sont déjà dans votre fichier www
bike$yr <- as.factor(bike$yr)
bike$mnth <- factor(bike$mnth, levels = c('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'))
bike$weekday <- factor(bike$weekday, levels = c('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday'))
bike$season <- factor(bike$season, levels = c('Spring', 'Summer', 'Fall', 'Winter'))


ui <- dashboardPage(
  dashboardHeader(title = "ShinyDashboard"),
  dashboardSidebar(),
  dashboardBody()
)

server <- function(input, output) {
}

shinyApp(ui, server)
Shiny applications not supported in static R Markdown documents

Pour une meilleure compréhension du code, on le découper en segments. Cependant, il est nécessaire de savoir que pour que l’application fonctionne correctement, nous devons exécuter toutes les pièces ensemble.

Pour l’en-tête du tableau de bord, on spécifie le nom du titre de l’application Shiny et dispose la largeur de l’espace où le titre sera affiché.

#R Shiny ui Ce code n'est pas à exécuter vous voyez bien que tout est en commentaire
#ui <- dashboardPage(
  
  #Dashboard title
#  dashboardHeader(title = 'Location Velos', 
#                  titleWidth = 290),

Ensuite, on défini la disposition de la barre latérale, où on défini la largeur de la barre latérale. puis, avec la fonction sidebarMenu(), on attribué le nombre d’onglets que le menu de la barre latérale aura et les noms des onglets. Pour définir les onglets, j’ai utilisé la fonction menuItem(), où on fourni le nom réel de l’onglet (le nom révélé dans l’application), le nom de l’onglet de référence (l’alias utilisé pour appeler l’onglet dans le code) et définir l’icône ou le chiffre à ajouter au nom réel.

Pour l’EDA, on créé deux onglets appelés Plots et Dashboard. Dans le premier onglet, on affiche l’analyse univariée de toutes les variables. L’autre onglet présente une analyse bivariée de variables spécifiques pour répondre aux questions commerciales.

#Sidebar layout
 # dashboardSidebar(width = 290,
  #                 sidebarMenu(menuItem("Plots", tabName = "plots", icon = icon('poll')),
   #                            menuItem("Dashboard", tabName = "dash", icon = icon('tachometer-alt')))),

De plus, dans le corps du tableau de bord, on décrit le contenu et la disposition de chacun des onglets créés.

Tout d’abord, on utilise un composant CSS, pour changer le titre en caractères gras. Puis, dans le tabItems(), on défini le contenu de chacun des onglets créés ci-dessus. À l’aide de la fonction tabItem(), on défini le nom de référence de l’onglet, puis on décrit les différents éléments qu’il contiendra.

Une fois déterminé le nom de l’onglet de référence (“plots”), on procède à la recherche de quatre espaces différents pour mettre les informations en utilisant la fonction box(). Avec cette fonction, on défini le style de la boîte (statut), le titre, ajouté un pied de page est optionnel, un widget de contrôle et la sortie d’un tracé.

Dans ce code,on a d’abord défini quatre cases. Deux d’entre elles contiennent un widget, et les deux autres boîtes sont destinées à afficher les tracés créés ultérieurement à partir des fonction qu’on mettra dans le serveur.

Le widget de contrôle utilisé est le selectInput(), qui est un menu déroulant avec différents choix à sélectionner. Dans la même fonction, on décrit le nom de référence du widget, le nom réel et une liste d’options qui apparaîtront dans le menu.

D’autre part, on utilise les deux dernières cases pour présenter la sortie des graphiques. on a d’ailleurs défini la fonction plotOutput() et indiqué son nom de référence.

#Apparence des Tabs
  #dashboardBody(tags$head(tags$style(HTML('.main-header .logo {font-weight: bold;}'))),
                #tabItems(
                         #Contenu de la Tab nommée Plots
                        # tabItem('plots', 
                                 #Les filtres pour l'histogramme
                         #        box(status = 'primary', title = 'Filter for the histogram plot', 
                          #           selectInput('num', "Numerical variables:", c('Temperature', 'Feeling temperature', 'Humidity', 'Wind speed', 'Casual', 'New', 'Total')),
                                   #  footer = 'Histogram plot for numerical variables'),
                                 #Les filtres pour les fréquences des variables qualitatives
                                # box(status = 'primary', title = 'Filter for the frequency plot',
                                  #   selectInput('cat', 'Categorical variables:', c('Season', 'Year', 'Month', 'Hour', 'Holiday', 'Weekday', 'Working day', 'Weather')),
                                #     footer = 'Frequency plot for categorical variables'),
                                 #Boxes to display the plots
                               #  box(plotOutput('histPlot')),
                               #  box(plotOutput('freqPlot'))),

Pour les éléments de l’onglet suivant (“Dashboard”), on utilise une conception similaire au code ci-dessus. La disposition de l’onglet contient trois cases. La première contient les filtres et les autres contiennent l’espace pour les tracés des graphiques.

Dans la boîte de filtre, on utilise la fonction splitLayout() pour structurer la disposition de la boîte en trois colonnes différentes. Pour ces filtres, on utilise un widget de contrôle appelé radioButtons(), où on indique le nom de référence, le nom réel et la liste des choix que nous aurons dans l’application.

Ensuite, dans les autres cases du tableau de bord, on indique le contenu, comme étant des graphiques, et déclare les noms de référence. Enfin, pour la dernière case, saisissons la fonction column(), où on indiqué sa largeur.

De plus, on a créé deux colonnes différentes dans lesquelles on écrit une description de la signification de chaque filtre de condition météo en utilisant la fonction helpText().

#Dashboard tab content
                      #   tabItem('dash',
                          #Les filtres du Dashboard 
                       #   box(title = 'Faites vos filtres ici', status = 'primary', width = 12,
                           #   splitLayout(cellWidths = c('20%', '22%', '25%'),
                                   #       div(),
                                   #       radioButtons( 'year', 'Year:', c('2011 and 2012', '2011', '2012')),
                                     #     radioButtons( 'regis', 'Registrations:', c('Total', 'New', 'Casual')),
                                     #     radioButtons( 'weather', 'Weather choice:', c('All', 'Good', 'Fair', 'Bad', 'Very Bad')))
                         #     ),
                          #Les Boxes pour afficher les graphiques
                         # box(plotOutput('linePlot')),
                        #  box(plotOutput('barPlot'), 
                          #    height = 550, 
                          #    h4('Interprétation des conditions météo:'),
                            #  column(6, 
                            #         helpText('- Good: clear, few clouds, partly cloudy.'),
                            #         helpText('- Fair: mist, cloudy, broken clouds.')),
                            #  helpText('- Bad: light snow, light rain, thunderstorm, scattered clouds.'),
                            #  helpText('- Very Bad: heavy rain, ice pallets, thunderstorm, mist, snow, fog.')))

Ceci marque la fin de la partie interface utilisateur de notre application pour l’analyse exploratoire des données. Si on fait des sélections on verra que l’application ne réagit pas. c’est parceque nous n’avons encore rien mis dans la partie serveur.

5.2 R-Shiny server

Dans la variable server, on procède à la création des graphiques construits pour l’analyse afin de répondre aux questions commerciales

Le premier graphique que est le tracé de l’histogramme (pour les variables quantitatives). En utilisant le vecteur output$histPlot, on peut accédé à la zone de tracé de l’histogramme indiquée dans l’interface utilisateur, on lui attribue la fonction réactive renderPlot({}). Cette fonction partira des données de l’interface utilisateur et implémentera le graphe dans le serveur.

Puis on créé une nouvelle variable appelée “num_val”. Cette variable stockera le nom de la colonne dans l’ensemble de données qui fait référence au filtre des variables numériques. Maintenant, avec cette nouvelle variable, on procède à la construction du tracé de l’histogramme.

#Analyse univariée
  #output$histPlot <- renderPlot({
    #Choisissons une variable qu'om met dans num_val
    #num_val = ifelse(input$num == 'Temperature', 'temp',
                     #ifelse(input$num == 'Feeling temperature', 'atemp',
                            #ifelse(input$num == 'Humidity', 'hum',
                                  #ifelse(input$num == 'Wind speed', 'windspeed',
                                         # ifelse(input$num == 'Casual', 'casual',
                                                # ifelse(input$num == 'New', 'new', 'total'))))))
    
    #Dessin de l'histogramme
    #ggplot(data = bike, aes(x = bike[[num_val]]))+ 
      #geom_histogram(stat = "bin", fill = 'steelblue3', 
                   #  color = 'lightgrey')+
      #theme(axis.text = element_text(size = 12),
         #   axis.title = element_text(size = 14),
         #   plot.title = element_text(size = 16, face = 'bold'))+
     # labs(title = sprintf('Histogram plot of the variable %s', num_val),
        #   x = sprintf('%s', input$num),y = 'Frequency')+
      #stat_bin(geom = 'text', 
            #   aes(label = ifelse(..count.. == max(..count..), as.character(max(..count..)), '')),
          #     vjust = -0.6)
 # })

Ensuite, on développe le diagramme de barres pour les variables catégorielles. En suivant les mêmes étapes qu’auparavant, on appelle le vecteur output$freqPlot pour tracer le graphique à l’aide de la fonction réactive renderPlot({}). De même, on génère une nouvelle variable pour stocker les noms de colonne de l’ensemble de données liés aux valeurs sélectionnées sur le filtre. Ensuite, en utilisant la nouvelle variable, on construit le diagramme de fréquence.

 #output$freqPlot <- renderPlot({
    #Selection de la variable qualitative
    # cat_val = ifelse(input$cat == 'Season', 'season',
                    #  ifelse(input$cat == 'Year', 'yr',
                          #   ifelse(input$cat == 'Month', 'mnth',
                                  #  ifelse(input$cat == 'Hour', 'hr',
                                         #  ifelse(input$cat == 'Holiday', 'holiday',
                                                #  ifelse(input$cat == 'Weekday', 'weekday',
                                                      #   ifelse(input$cat == 'Working day', 'workingday', 'weathersit')))))))
    
    #Traçage du diagramme à barres
   #  ggplot(data = bike, aes(x = bike[[cat_val]]))+
     #  geom_bar(stat = 'count', fill = 'mediumseagreen', 
        #        width = 0.5)+
     #  stat_count(geom = 'text', size = 4,
        #          aes(label = ..count..),
         #         position = position_stack(vjust = 1.03))+
     #  theme(axis.text.y = element_blank(),
         #    axis.ticks.y = element_blank(),
          #   axis.text = element_text(size = 12),
           #  axis.title = element_text(size = 14),
            # plot.title = element_text(size = 16, face="bold"))+
      # labs(title = sprintf('Frecuency plot of the variable %s', cat_val),
         #   x = sprintf('%s', input$cat), y = 'Count')
    
  # })

Maintenant, on continue à construire les graphiques pour l’onglet du tableau de bord (Dashboard). Pour répondre à la 3ème question métier, on va créér un graphique linéaire visualisant le nombre d’inscriptions par mois. De plus, on pourrai filtrer le graphique par année et type d’inscription.

Tout d’abord, on indique le vecteur de sortie et la fonction réactive. Ensuite, on développe un tableau qui contiendra la colonne nécessaire utilisée pour le tracé du graphique.

Plus tard, on génère une nouvelle variable (“regis_val”) pour stocker le nom de la colonne du jeu de données qui a été sélectionnée, en tenant compte du type d’enregistrement de l’utilisateur sur le filtre. Enfin,on construit la courbe.

 #Dashboard
   #output$linePlot <- renderPlot({
    
     #if(input$year != '2011 and 2012'){
      
      #creation du filtre annuel pour une courbe
      # counts <- bike %>% group_by(mnth) %>% filter(yr == input$year) %>% summarise(new = sum(new), casual = sum(casual), total = sum(total))
    # } else{
      
     #  counts <- bike %>% group_by(mnth) %>% summarise(new = sum(new), casual = sum(casual), total = sum(total))
    #}
    #La variable qui va stocker les informations à présenter
    # regis_val = ifelse(input$regis == 'Total', 'total',
                   #     ifelse(input$regis == 'New', 'new','casual'))
    
    #Visualisation de la courbe
    # ggplot(counts, aes(x = mnth, y = counts[[regis_val]], group = 1))+
      # geom_line(size = 1.25)+
      # geom_point(size = 2.25,
            #      color = ifelse(counts[[regis_val]] == max(counts[[regis_val]]), 'red','black'))+
      # labs(title = sprintf('%s bike sharing registrations by month', input$regis),
          #  subtitle = sprintf('Throughout the year %s \nMaximum value for %s registrations: %s \nTotal of %s registrations: %s', input$year, regis_val, max(counts[[regis_val]]), regis_val, sum(counts[[regis_val]])),
        #    x = 'Month', 
        #    y = sprintf('Count of %s registrations', regis_val))+
       #theme(axis.text = element_text(size = 12),
         #    axis.title = element_text(size = 14),
           #  plot.title = element_text(size = 16, face = 'bold'),
            # plot.subtitle = element_text(size = 14))+
      # ylim(NA, max(counts[[regis_val]])+7000)+
      # geom_text(aes(label = ifelse(counts[[regis_val]] == max(counts[[regis_val]]), as.character(counts[[regis_val]]),'')),
                # col ='red',hjust = 0.5, vjust = -0.7)
  # })

On continue à développer le graphique à barres pour répondre à la question commerciale numéro 4. on suit les mêmes étapes que précédemment. Tout d’abord, on créé des restrictions pour générer le tableau utilisé selon les différents filtres, celui-ci prendra en compte l’année et les conditions météorologiques.

Ensuite, on créé la variable qui va stocker le nom de colonne du type d’inscriptions sélectionné sur le filtre. Et enfin, on construit le diagramme de fréquence à barres pour afficher le nombre d’inscriptions par année, type d’inscription selon les conditions météorologiques.

 #output$barPlot <- renderPlot({
    
    # if(input$year != '2011 and 2012'){
      
     #  if(input$weather != 'All'){
        
        
       #  weather <- bike %>% group_by(season, weathersit) %>% filter(yr == input$year) %>%  summarise(new = sum(new), casual = sum(casual), total = sum(total))
        
       #  weather <- weather %>% filter(weathersit == input$weather)
 #} else{
        
        
      #   weather <- bike %>% group_by(season, weathersit) %>% filter(yr == input$year) %>%  summarise(new = sum(new), casual = sum(casual), total = sum(total))
        
     #  }
      
    # } else{
      
     #  if(input$weather != 'All'){
        
        
      #   weather <- bike %>% group_by(season, weathersit) %>% filter(weathersit == input$weather) %>%  summarise(new = sum(new), casual = sum(casual), total = sum(total))
        
    #   } else{
        
        
       #  weather <- bike %>% group_by(season, weathersit) %>%  summarise(new = sum(new), casual = sum(casual), total = sum(total))
        
    #   }
    # }
    
    
    # regis_val = ifelse(input$regis == 'Total', 'total', 
         #               ifelse(input$regis == 'New', 'new','casual'))
    
    
    # ggplot(weather, aes(x = season, y = weather[[regis_val]], 
          #               fill = weathersit))+
      # geom_bar(stat = 'identity', position=position_dodge())+
      # geom_text(aes(label = weather[[regis_val]]),
           #      vjust = -0.3, position = position_dodge(0.9), 
           #      size = 4)+
      # theme(axis.text.y = element_blank(),
         #    axis.ticks.y = element_blank(),
          #   axis.text = element_text(size = 12),
          #   axis.title = element_text(size = 14),
           #  plot.title = element_text(size = 16, face = 'bold'),
           #  plot.subtitle = element_text(size = 14),
           #  legend.text = element_text(size = 12))+
       #labs(title = sprintf('%s bike sharing registrations by season and weather', input$regis),
         #   subtitle = sprintf('Throughout the year %s', input$year),
          #  x = 'Season', 
           # y = sprintf('Count of %s registrations', regis_val))+
      # scale_fill_manual(values = c('Bad' = 'salmon2', 'Fair' = 'steelblue3', 'Good' = 'mediumseagreen', 'Very Bad' = 'tomato4'),
                    #     name = 'Weather')
    
  # })

Pour la suite nous allons développer l’onglet qui permet de faire la prévision à partir du modèle (Ce sera l’objet du cours de demain)