| itle: “Examen M2” |
| ubtitle: “Langages de Programmation” |
| uthor: “Paco RUFAS” |
| utput: |
| html_document: |
| toc: true |
| theme: united |
| df_print: paged |
# Chargement des bibliothèques nécessaires
library(tidyverse)
library(cluster)
library(caret)
library(rmarkdown)
library(randomForest)
# Importation des données
clients <- read.csv('base_client.txt', sep = ';')
commandes <- read.csv('base_synthese_commandes.txt', sep = '\t')# Exploration des données
summary(clients)## id_client prenom sexe annee_naissance
## Length:2000 Length:2000 Length:2000 Min. :1949
## Class :character Class :character Class :character 1st Qu.:1968
## Mode :character Mode :character Mode :character Median :1979
## Mean :1978
## 3rd Qu.:1986
## Max. :2005
## NA's :276
## diplome etat_civil ville code_postal
## Length:2000 Length:2000 Length:2000 Min. : 1000
## Class :character Class :character Class :character 1st Qu.:33428
## Mode :character Mode :character Mode :character Median :59198
## Mean :56284
## 3rd Qu.:77533
## Max. :97660
##
## code_insee foyer_salaire foyer_nbr_enfants foyer_nbr_adolescents
## Min. : 1027 Length:2000 Min. :0.000 Min. :0.0000
## 1st Qu.:33232 Class :character 1st Qu.:0.000 1st Qu.:0.0000
## Median :59300 Mode :character Median :0.000 Median :0.0000
## Mean :56189 Mean :0.442 Mean :0.5015
## 3rd Qu.:77445 3rd Qu.:1.000 3rd Qu.:1.0000
## Max. :97611 Max. :2.000 Max. :2.0000
## summary(commandes)## id_client date_inscription recence montant_fruit
## Length:2000 Length:2000 Min. : 0.00 Min. : 0.00
## Class :character Class :character 1st Qu.:24.00 1st Qu.: 2.00
## Mode :character Mode :character Median :49.00 Median : 8.00
## Mean :48.75 Mean : 26.49
## 3rd Qu.:74.00 3rd Qu.: 33.00
## Max. :99.00 Max. :199.00
## montant_poisson montant_sucrerie montant_viande montant_vin
## Min. : 0.00 Min. : 0.00 Min. : 0.0 Min. : 0.0
## 1st Qu.: 3.00 1st Qu.: 1.00 1st Qu.: 16.0 1st Qu.: 23.0
## Median : 12.00 Median : 8.00 Median : 67.5 Median : 176.5
## Mean : 37.65 Mean : 26.73 Mean : 168.9 Mean : 304.7
## 3rd Qu.: 50.00 3rd Qu.: 32.00 3rd Qu.: 238.2 3rd Qu.: 505.0
## Max. :259.00 Max. :263.00 Max. :1725.0 Max. :1493.0
## nbr_achats_promo nbr_achats_catalogue nbr_achats_magasin nbr_achats_site
## Min. : 0.000 Min. : 0.000 Min. : 0.00 Min. : 0.000
## 1st Qu.: 1.000 1st Qu.: 0.000 1st Qu.: 3.00 1st Qu.: 2.000
## Median : 2.000 Median : 2.000 Median : 5.00 Median : 4.000
## Mean : 2.317 Mean : 2.694 Mean : 5.82 Mean : 4.072
## 3rd Qu.: 3.000 3rd Qu.: 4.000 3rd Qu.: 8.00 3rd Qu.: 6.000
## Max. :15.000 Max. :28.000 Max. :13.00 Max. :27.000
## nbr_visites_site_dernier_mois top_campagne_1_succes top_campagne_2_succes
## Min. : 0.00 Min. :0.00 Min. :0.000
## 1st Qu.: 3.00 1st Qu.:0.00 1st Qu.:0.000
## Median : 6.00 Median :0.00 Median :0.000
## Mean : 5.27 Mean :0.06 Mean :0.013
## 3rd Qu.: 7.00 3rd Qu.:0.00 3rd Qu.:0.000
## Max. :20.00 Max. :1.00 Max. :1.000
## top_campagne_3_succes top_campagne_4_succes top_campagne_5_succes
## Min. :0.0000 Min. :0.0000 Min. :0.00
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.00
## Median :0.0000 Median :0.0000 Median :0.00
## Mean :0.0725 Mean :0.0735 Mean :0.07
## 3rd Qu.:0.0000 3rd Qu.:0.0000 3rd Qu.:0.00
## Max. :1.0000 Max. :1.0000 Max. :1.00
## top_campagne_test_succes top_plainte
## Min. :0.000 Min. :0.0000
## 1st Qu.:0.000 1st Qu.:0.0000
## Median :0.000 Median :0.0000
## Mean :0.151 Mean :0.0095
## 3rd Qu.:0.000 3rd Qu.:0.0000
## Max. :1.000 Max. :1.0000# Visualisation de la distribution de l'âge des clients
clients <- clients %>%
mutate(age = 2024 - annee_naissance)
ggplot(clients, aes(x = age)) +
geom_histogram(binwidth = 5, fill = 'blue', color = 'white') +
labs(title = "Distribution de l'âge des clients", x = "Âge", y = "Nombre de clients")## Warning: Removed 276 rows containing non-finite values (`stat_bin()`).
On constate que la mojorité des ckients sont situé entre 30 et 50
ans
clients$foyer_salaire <- as.numeric(gsub(",", ".", clients$foyer_salaire))
summary(clients)## id_client prenom sexe annee_naissance
## Length:2000 Length:2000 Length:2000 Min. :1949
## Class :character Class :character Class :character 1st Qu.:1968
## Mode :character Mode :character Mode :character Median :1979
## Mean :1978
## 3rd Qu.:1986
## Max. :2005
## NA's :276
## diplome etat_civil ville code_postal
## Length:2000 Length:2000 Length:2000 Min. : 1000
## Class :character Class :character Class :character 1st Qu.:33428
## Mode :character Mode :character Mode :character Median :59198
## Mean :56284
## 3rd Qu.:77533
## Max. :97660
##
## code_insee foyer_salaire foyer_nbr_enfants foyer_nbr_adolescents
## Min. : 1027 Min. : 3626 Min. :0.000 Min. :0.0000
## 1st Qu.:33232 1st Qu.: 36765 1st Qu.:0.000 1st Qu.:0.0000
## Median :59300 Median : 54076 Median :0.000 Median :0.0000
## Mean :56189 Mean : 54217 Mean :0.442 Mean :0.5015
## 3rd Qu.:77445 3rd Qu.: 70144 3rd Qu.:1.000 3rd Qu.:1.0000
## Max. :97611 Max. :666799 Max. :2.000 Max. :2.0000
## NA's :329
## age
## Min. :19.00
## 1st Qu.:38.00
## Median :45.00
## Mean :46.01
## 3rd Qu.:56.00
## Max. :75.00
## NA's :276# Imputation des valeurs manquantes pour les clients
clients <- clients %>%
mutate(
annee_naissance = ifelse(is.na(annee_naissance), median(annee_naissance, na.rm = TRUE), annee_naissance),
foyer_salaire = ifelse(is.na(foyer_salaire), median(as.numeric(foyer_salaire), na.rm = FALSE), as.numeric(foyer_salaire)),
foyer_nbr_enfants = ifelse(is.na(foyer_nbr_enfants), 0, foyer_nbr_enfants),
foyer_nbr_adolescents = ifelse(is.na(foyer_nbr_adolescents), 0, foyer_nbr_adolescents)
)
# Imputation des valeurs manquantes pour les commandes
commandes <- commandes %>%
mutate(
recence = ifelse(is.na(recence), median(recence, na.rm = TRUE), recence),
montant_fruit = ifelse(is.na(montant_fruit), 0, montant_fruit),
montant_poisson = ifelse(is.na(montant_poisson), 0, montant_poisson),
montant_sucrerie = ifelse(is.na(montant_sucrerie), 0, montant_sucrerie),
montant_viande = ifelse(is.na(montant_viande), 0, montant_viande),
montant_vin = ifelse(is.na(montant_vin), 0, montant_vin)
)
# Jointure des données
data <- left_join(clients, commandes, by = "id_client")
# Vérifier les valeurs manquantes
summary(data)## id_client prenom sexe annee_naissance
## Length:2000 Length:2000 Length:2000 Min. :1949
## Class :character Class :character Class :character 1st Qu.:1971
## Mode :character Mode :character Mode :character Median :1979
## Mean :1978
## 3rd Qu.:1985
## Max. :2005
##
## diplome etat_civil ville code_postal
## Length:2000 Length:2000 Length:2000 Min. : 1000
## Class :character Class :character Class :character 1st Qu.:33428
## Mode :character Mode :character Mode :character Median :59198
## Mean :56284
## 3rd Qu.:77533
## Max. :97660
##
## code_insee foyer_salaire foyer_nbr_enfants foyer_nbr_adolescents
## Min. : 1027 Min. : 3626 Min. :0.000 Min. :0.0000
## 1st Qu.:33232 1st Qu.: 36765 1st Qu.:0.000 1st Qu.:0.0000
## Median :59300 Median : 54076 Median :0.000 Median :0.0000
## Mean :56189 Mean : 54217 Mean :0.442 Mean :0.5015
## 3rd Qu.:77445 3rd Qu.: 70144 3rd Qu.:1.000 3rd Qu.:1.0000
## Max. :97611 Max. :666799 Max. :2.000 Max. :2.0000
## NA's :329
## age date_inscription recence montant_fruit
## Min. :19.00 Length:2000 Min. : 0.00 Min. : 0.00
## 1st Qu.:38.00 Class :character 1st Qu.:24.00 1st Qu.: 2.00
## Median :45.00 Mode :character Median :49.00 Median : 8.00
## Mean :46.01 Mean :48.75 Mean : 26.49
## 3rd Qu.:56.00 3rd Qu.:74.00 3rd Qu.: 33.00
## Max. :75.00 Max. :99.00 Max. :199.00
## NA's :276
## montant_poisson montant_sucrerie montant_viande montant_vin
## Min. : 0.00 Min. : 0.00 Min. : 0.0 Min. : 0.0
## 1st Qu.: 3.00 1st Qu.: 1.00 1st Qu.: 16.0 1st Qu.: 23.0
## Median : 12.00 Median : 8.00 Median : 67.5 Median : 176.5
## Mean : 37.65 Mean : 26.73 Mean : 168.9 Mean : 304.7
## 3rd Qu.: 50.00 3rd Qu.: 32.00 3rd Qu.: 238.2 3rd Qu.: 505.0
## Max. :259.00 Max. :263.00 Max. :1725.0 Max. :1493.0
##
## nbr_achats_promo nbr_achats_catalogue nbr_achats_magasin nbr_achats_site
## Min. : 0.000 Min. : 0.000 Min. : 0.00 Min. : 0.000
## 1st Qu.: 1.000 1st Qu.: 0.000 1st Qu.: 3.00 1st Qu.: 2.000
## Median : 2.000 Median : 2.000 Median : 5.00 Median : 4.000
## Mean : 2.317 Mean : 2.694 Mean : 5.82 Mean : 4.072
## 3rd Qu.: 3.000 3rd Qu.: 4.000 3rd Qu.: 8.00 3rd Qu.: 6.000
## Max. :15.000 Max. :28.000 Max. :13.00 Max. :27.000
##
## nbr_visites_site_dernier_mois top_campagne_1_succes top_campagne_2_succes
## Min. : 0.00 Min. :0.00 Min. :0.000
## 1st Qu.: 3.00 1st Qu.:0.00 1st Qu.:0.000
## Median : 6.00 Median :0.00 Median :0.000
## Mean : 5.27 Mean :0.06 Mean :0.013
## 3rd Qu.: 7.00 3rd Qu.:0.00 3rd Qu.:0.000
## Max. :20.00 Max. :1.00 Max. :1.000
##
## top_campagne_3_succes top_campagne_4_succes top_campagne_5_succes
## Min. :0.0000 Min. :0.0000 Min. :0.00
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.00
## Median :0.0000 Median :0.0000 Median :0.00
## Mean :0.0725 Mean :0.0735 Mean :0.07
## 3rd Qu.:0.0000 3rd Qu.:0.0000 3rd Qu.:0.00
## Max. :1.0000 Max. :1.0000 Max. :1.00
##
## top_campagne_test_succes top_plainte
## Min. :0.000 Min. :0.0000
## 1st Qu.:0.000 1st Qu.:0.0000
## Median :0.000 Median :0.0000
## Mean :0.151 Mean :0.0095
## 3rd Qu.:0.000 3rd Qu.:0.0000
## Max. :1.000 Max. :1.0000
## # Vérifier les valeurs infinies et manquantes avant la standardisation
data <- data %>%
mutate(across(where(is.numeric), ~ifelse(is.infinite(.), NA, .))) %>%
mutate(across(where(is.numeric), ~ifelse(is.na(.), median(., na.rm = TRUE), .)))
# Standardisation des variables numériques
data_scaled <- data %>%
select(where(is.numeric)) %>%
scale() %>%
as.data.frame()
# Vérifier les valeurs infinies et manquantes après la standardisation
data_scaled <- data_scaled %>%
mutate(across(everything(), ~ifelse(is.infinite(.), NA, .))) %>%
mutate(across(everything(), ~ifelse(is.na(.), median(., na.rm = TRUE), .)))
# Vérification finale des valeurs NA/NaN/Inf
summary(data_scaled)## annee_naissance code_postal code_insee foyer_salaire
## Min. :-2.66400 Min. :-2.0953 Min. :-2.0901 Min. :-2.044715
## 1st Qu.:-0.67505 1st Qu.:-0.8663 1st Qu.:-0.8699 1st Qu.:-0.580143
## Median : 0.07938 Median : 0.1104 Median : 0.1179 Median :-0.004775
## Mean : 0.00000 Mean : 0.0000 Mean : 0.0000 Mean : 0.000000
## 3rd Qu.: 0.62805 3rd Qu.: 0.8054 3rd Qu.: 0.8054 3rd Qu.: 0.510051
## Max. : 2.45697 Max. : 1.5682 Max. : 1.5695 Max. :24.770599
## foyer_nbr_enfants foyer_nbr_adolescents age recence
## Min. :-0.8197 Min. :-0.9247 Min. :-2.45697 Min. :-1.691875
## 1st Qu.:-0.8197 1st Qu.:-0.9247 1st Qu.:-0.62805 1st Qu.:-0.858892
## Median :-0.8197 Median :-0.9247 Median :-0.07938 Median : 0.008798
## Mean : 0.0000 Mean : 0.0000 Mean : 0.00000 Mean : 0.000000
## 3rd Qu.: 1.0348 3rd Qu.: 0.9191 3rd Qu.: 0.67505 3rd Qu.: 0.876489
## Max. : 2.8892 Max. : 2.7630 Max. : 2.66400 Max. : 1.744179
## montant_fruit montant_poisson montant_sucrerie montant_viande
## Min. :-0.6654 Min. :-0.6890 Min. :-0.6545 Min. :-0.7409
## 1st Qu.:-0.6152 1st Qu.:-0.6341 1st Qu.:-0.6300 1st Qu.:-0.6707
## Median :-0.4644 Median :-0.4693 Median :-0.4586 Median :-0.4448
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.1636 3rd Qu.: 0.2261 3rd Qu.: 0.1292 3rd Qu.: 0.3041
## Max. : 4.3338 Max. : 4.0510 Max. : 5.7863 Max. : 6.8251
## montant_vin nbr_achats_promo nbr_achats_catalogue nbr_achats_magasin
## Min. :-0.9052 Min. :-1.2049 Min. :-0.9109 Min. :-1.7787
## 1st Qu.:-0.8369 1st Qu.:-0.6850 1st Qu.:-0.9109 1st Qu.:-0.8619
## Median :-0.3808 Median :-0.1651 Median :-0.2347 Median :-0.2506
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.5952 3rd Qu.: 0.3548 3rd Qu.: 0.4416 3rd Qu.: 0.6663
## Max. : 3.5305 Max. : 6.5937 Max. : 8.5566 Max. : 2.1944
## nbr_achats_site nbr_visites_site_dernier_mois top_campagne_1_succes
## Min. :-1.4717 Min. :-2.1968 Min. :-0.2526
## 1st Qu.:-0.7490 1st Qu.:-0.9462 1st Qu.:-0.2526
## Median :-0.0262 Median : 0.3043 Median :-0.2526
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.6966 3rd Qu.: 0.7211 3rd Qu.:-0.2526
## Max. : 8.2856 Max. : 6.1402 Max. : 3.9571
## top_campagne_2_succes top_campagne_3_succes top_campagne_4_succes
## Min. :-0.1147 Min. :-0.2795 Min. :-0.2816
## 1st Qu.:-0.1147 1st Qu.:-0.2795 1st Qu.:-0.2816
## Median :-0.1147 Median :-0.2795 Median :-0.2816
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.:-0.1147 3rd Qu.:-0.2795 3rd Qu.:-0.2816
## Max. : 8.7112 Max. : 3.5759 Max. : 3.5495
## top_campagne_5_succes top_campagne_test_succes top_plainte
## Min. :-0.2743 Min. :-0.4216 Min. :-0.09791
## 1st Qu.:-0.2743 1st Qu.:-0.4216 1st Qu.:-0.09791
## Median :-0.2743 Median :-0.4216 Median :-0.09791
## Mean : 0.0000 Mean : 0.0000 Mean : 0.00000
## 3rd Qu.:-0.2743 3rd Qu.:-0.4216 3rd Qu.:-0.09791
## Max. : 3.6440 Max. : 2.3706 Max. :10.20838# Exécution du clustering K-means
set.seed(123)
kmeans_result <- kmeans(data_scaled, centers = 3, nstart = 25)
# Ajout des clusters aux données d'origine
data <- data %>%
mutate(cluster = as.factor(kmeans_result$cluster))
# Affichage des résultats
table(data$cluster)##
## 1 2 3
## 899 600 501data <- left_join(clients, commandes, by = "id_client")data <- data %>%
select(-prenom, -ville, -code_postal, -code_insee)
# Séparation des données en ensembles d'entraînement et de test
set.seed(123)
trainIndex <- createDataPartition(data$top_campagne_test_succes, p = .8, list = FALSE, times = 1)
trainData <- data[ trainIndex,]
testData <- data[-trainIndex,]library(dplyr)
# Filtrer les données pour exclure les lignes avec NA dans top_campagne_test_succes
data <- data %>%
filter(!is.na(top_campagne_test_succes))
# Vérification après filtration
summary(data)## id_client sexe annee_naissance diplome
## Length:2000 Length:2000 Min. :1949 Length:2000
## Class :character Class :character 1st Qu.:1971 Class :character
## Mode :character Mode :character Median :1979 Mode :character
## Mean :1978
## 3rd Qu.:1985
## Max. :2005
##
## etat_civil foyer_salaire foyer_nbr_enfants foyer_nbr_adolescents
## Length:2000 Min. : 3626 Min. :0.000 Min. :0.0000
## Class :character 1st Qu.: 36765 1st Qu.:0.000 1st Qu.:0.0000
## Mode :character Median : 54076 Median :0.000 Median :0.0000
## Mean : 54217 Mean :0.442 Mean :0.5015
## 3rd Qu.: 70144 3rd Qu.:1.000 3rd Qu.:1.0000
## Max. :666799 Max. :2.000 Max. :2.0000
## NA's :329
## age date_inscription recence montant_fruit
## Min. :19.00 Length:2000 Min. : 0.00 Min. : 0.00
## 1st Qu.:38.00 Class :character 1st Qu.:24.00 1st Qu.: 2.00
## Median :45.00 Mode :character Median :49.00 Median : 8.00
## Mean :46.01 Mean :48.75 Mean : 26.49
## 3rd Qu.:56.00 3rd Qu.:74.00 3rd Qu.: 33.00
## Max. :75.00 Max. :99.00 Max. :199.00
## NA's :276
## montant_poisson montant_sucrerie montant_viande montant_vin
## Min. : 0.00 Min. : 0.00 Min. : 0.0 Min. : 0.0
## 1st Qu.: 3.00 1st Qu.: 1.00 1st Qu.: 16.0 1st Qu.: 23.0
## Median : 12.00 Median : 8.00 Median : 67.5 Median : 176.5
## Mean : 37.65 Mean : 26.73 Mean : 168.9 Mean : 304.7
## 3rd Qu.: 50.00 3rd Qu.: 32.00 3rd Qu.: 238.2 3rd Qu.: 505.0
## Max. :259.00 Max. :263.00 Max. :1725.0 Max. :1493.0
##
## nbr_achats_promo nbr_achats_catalogue nbr_achats_magasin nbr_achats_site
## Min. : 0.000 Min. : 0.000 Min. : 0.00 Min. : 0.000
## 1st Qu.: 1.000 1st Qu.: 0.000 1st Qu.: 3.00 1st Qu.: 2.000
## Median : 2.000 Median : 2.000 Median : 5.00 Median : 4.000
## Mean : 2.317 Mean : 2.694 Mean : 5.82 Mean : 4.072
## 3rd Qu.: 3.000 3rd Qu.: 4.000 3rd Qu.: 8.00 3rd Qu.: 6.000
## Max. :15.000 Max. :28.000 Max. :13.00 Max. :27.000
##
## nbr_visites_site_dernier_mois top_campagne_1_succes top_campagne_2_succes
## Min. : 0.00 Min. :0.00 Min. :0.000
## 1st Qu.: 3.00 1st Qu.:0.00 1st Qu.:0.000
## Median : 6.00 Median :0.00 Median :0.000
## Mean : 5.27 Mean :0.06 Mean :0.013
## 3rd Qu.: 7.00 3rd Qu.:0.00 3rd Qu.:0.000
## Max. :20.00 Max. :1.00 Max. :1.000
##
## top_campagne_3_succes top_campagne_4_succes top_campagne_5_succes
## Min. :0.0000 Min. :0.0000 Min. :0.00
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.00
## Median :0.0000 Median :0.0000 Median :0.00
## Mean :0.0725 Mean :0.0735 Mean :0.07
## 3rd Qu.:0.0000 3rd Qu.:0.0000 3rd Qu.:0.00
## Max. :1.0000 Max. :1.0000 Max. :1.00
##
## top_campagne_test_succes top_plainte
## Min. :0.000 Min. :0.0000
## 1st Qu.:0.000 1st Qu.:0.0000
## Median :0.000 Median :0.0000
## Mean :0.151 Mean :0.0095
## 3rd Qu.:0.000 3rd Qu.:0.0000
## Max. :1.000 Max. :1.0000
## # Graphiques exploratoires
# Par exemple, un graphique en barres pour le sexe des clients
ggplot(clients, aes(x = sexe)) +
geom_bar(fill = "steelblue") +
labs(title = "Répartition des clients par sexe")
# Un scatter plot pour visualiser la relation entre l'âge et le montant dépensé en vin
ggplot(data_scaled, aes(x = age, y = montant_vin)) +
geom_point(color = "darkgreen", alpha = 0.6) +
labs(title = "Relation entre l'âge et le montant dépensé en vin")
On dénombre ainsi plus de client homme et on constate que les montants
les plus élevé tendent a se rapprocher de l’age moyen
# Sélection des variables pertinentes
variables <- c("age", "foyer_salaire", "foyer_nbr_enfants", "montant_fruit", "montant_viande")
# Fusion des données
merged_data <- merge(clients, commandes, by = "id_client")
# Modèle de régression linéaire
model <- lm(top_campagne_test_succes ~ age + foyer_salaire + foyer_nbr_enfants + montant_fruit + montant_viande, data = merged_data)
# Résumé du modèle
summary(model)##
## Call:
## lm(formula = top_campagne_test_succes ~ age + foyer_salaire +
## foyer_nbr_enfants + montant_fruit + montant_viande, data = merged_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.70529 -0.14426 -0.10125 -0.08464 0.92402
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.728e-02 4.618e-02 1.890 0.059 .
## age -2.700e-04 8.109e-04 -0.333 0.739
## foyer_salaire -8.854e-08 4.057e-07 -0.218 0.827
## foyer_nbr_enfants 1.911e-02 2.019e-02 0.946 0.344
## montant_fruit 1.771e-04 2.713e-04 0.653 0.514
## montant_viande 3.723e-04 5.492e-05 6.778 1.77e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.3455 on 1438 degrees of freedom
## (556 observations effacées parce que manquantes)
## Multiple R-squared: 0.05487, Adjusted R-squared: 0.05159
## F-statistic: 16.7 on 5 and 1438 DF, p-value: 4.617e-16# Exemple de prédiction pour de nouvelles données
new_data <- data.frame(age = 40, foyer_salaire = 50000, foyer_nbr_enfants = 2, montant_fruit = 30, montant_viande = 150)
prediction <- predict(model, newdata = new_data, type = "response")
cat("Probabilité prédite de succès de la campagne :", prediction, "\n")## Probabilité prédite de succès de la campagne : 0.1714216afin d’améliorer le succès de cette campagne il pourrait etre pertinant d’affiner nos offres selon la ségmentation de la clientèle :
# Application de l'algorithme de k-means pour créer 3 clusters
set.seed(123) # pour la reproductibilité
kmeans_result <- kmeans(data_scaled, centers = 3, nstart = 25)
# Assignation des clusters aux données
merged_data$cluster <- as.factor(kmeans_result$cluster)
# Vérification du résultat du clustering
table(merged_data$cluster)##
## 1 2 3
## 899 600 501# Exemple de personnalisation des offres pour un segment spécifique (par exemple, cluster 1)
cluster_1 <- merged_data %>% filter(cluster == 1)
# Analyse des préférences d'achat
summary(cluster_1$montant_viande)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00 8.00 15.00 24.99 28.00 235.00summary(cluster_1$montant_fruit)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 0.500 2.000 5.489 6.000 90.000# Analyse de l'utilisation des canaux de communication par segment
ggplot(merged_data, aes(x = cluster, fill = sexe)) +
geom_bar(position = "fill") +
labs(title = "Utilisation des canaux de communication par segment")
Le model nous permetant de tester les probabilité avec differents
critère, il est pertinant de chosir ces critères selon les
caractèritiques du cluster :
# Exemple de prédiction pour de nouvelles données
new_data <- data.frame(age = 30, foyer_salaire = 600000, foyer_nbr_enfants = 3, montant_fruit = 250, montant_viande = 250)
prediction <- predict(model, newdata = new_data, type = "response")
cat("Probabilité prédite de succès de la campagne :", prediction, "\n")## Probabilité prédite de succès de la campagne : 0.2207308# Visualisation des clusters
ggplot(merged_data, aes(x = annee_naissance, y = foyer_salaire, color = factor(cluster))) +
geom_point(size = 3) +
labs(x = "Année de naissance", y = "Revenu du foyer", color = "Cluster") +
theme_minimal()## Warning: Removed 329 rows containing missing values (`geom_point()`).