Introduction

Ce rapport analyse les dépenses totales des clients d’une entreprise de vente au détail numérique. L’objectif est de construire et valider un modèle prédictif pour expliquer ce qui motive les dépenses et générer des prédictions pour les futures campagnes marketing.

Challenge 1 : Préparation et Exploration des Données

Chargement des packages et du dataset

library(tidyverse)
library(broom)
library(car)
library(ggplot2)
library(tibble)
library(dplyr)
library(knitr)

# Chargement du dataset
analysis_df <- read_csv("regression_model_final.csv")
head(analysis_df)
## # A tibble: 6 × 10
##   CustomerID SignupDate   Age Income WebVisits NewsletterSubscriber DeviceUsed
##        <dbl> <date>     <dbl>  <dbl>     <dbl> <chr>                <chr>     
## 1       1521 2022-01-01    61 51957.         4 No                   Mobile    
## 2       1737 2022-01-08    19 55704.         5 Yes                  Mobile    
## 3       1740 2022-01-15    30 81732.         8 No                   Desktop   
## 4       1660 2022-01-22    57 63854.         5 Yes                  Desktop   
## 5       1411 2022-01-29    19 58253.         4 No                   Mobile    
## 6       1678 2022-02-05    37 61632.         8 Yes                  Desktop   
## # ℹ 3 more variables: PurchaseHistoryScore <dbl>, DaysSinceLastPurchase <dbl>,
## #   TotalSpend <dbl>

Nettoyage des données

# Conversion en numérique et suppression des valeurs manquantes
analysis_df <- analysis_df %>%
  mutate(
    Income     = as.numeric(Income),
    Age        = as.numeric(Age),
    TotalSpend = as.numeric(TotalSpend)
  ) %>%
  drop_na()

cat("Nombre de lignes après nettoyage :", nrow(analysis_df), "\n")
## Nombre de lignes après nettoyage : 150

Statistiques descriptives

mean_income     <- mean(analysis_df$Income,     na.rm = TRUE)
mean_age        <- mean(analysis_df$Age,         na.rm = TRUE)
mean_totalspend <- mean(analysis_df$TotalSpend,  na.rm = TRUE)

sd_income     <- sd(analysis_df$Income,     na.rm = TRUE)
sd_age        <- sd(analysis_df$Age,         na.rm = TRUE)
sd_totalspend <- sd(analysis_df$TotalSpend,  na.rm = TRUE)

# Tableau résumé
stats_table <- data.frame(
  Variable  = c("Income", "Age", "TotalSpend"),
  Moyenne   = round(c(mean_income, mean_age, mean_totalspend), 2),
  Ecart_type = round(c(sd_income, sd_age, sd_totalspend), 2)
)

kable(stats_table, caption = "Statistiques descriptives des variables clés")
Statistiques descriptives des variables clés
Variable Moyenne Ecart_type
Income 53698.12 15799.64
Age 43.39 15.10
TotalSpend 1202.26 328.35

Interprétation : Le revenu moyen est de 5.3698^{4}\(** avec un écart-type de **1.58\times 10^{4}\), indiquant une grande diversité de profils financiers. Les dépenses moyennes sont de **1202\(** avec une variation de ±328\).

Challenge 2 : Visualisation des Données

Distribution des dépenses totales

plot_1 <- ggplot(analysis_df, aes(x = TotalSpend)) +
  geom_histogram(fill = "skyblue", color = "black", bins = 30) +
  labs(
    title = "Distribution des dépenses totales",
    x     = "Total Spend ($)",
    y     = "Nombre de clients"
  ) +
  theme_minimal()

print(plot_1)

Interprétation : La distribution est légèrement asymétrique à droite. La majorité des clients dépense entre 900$ et 1 500\(**. Quelques clients dépassent **2 000\), représentant des outliers potentiels.

Revenu vs Dépenses totales par appareil

plot_2 <- ggplot(analysis_df, aes(x = Income, y = TotalSpend, color = DeviceUsed)) +
  geom_point(alpha = 0.7) +
  geom_smooth(method = "lm", se = FALSE) +
  labs(
    title = "Revenu vs Dépenses totales par appareil utilisé",
    x     = "Revenu ($)",
    y     = "Dépenses totales ($)",
    color = "Appareil"
  ) +
  theme_minimal()

print(plot_2)

Interprétation : - Les utilisateurs Desktop montrent une tendance positive légère - Les utilisateurs Mobile montrent une tendance positive plus marquée - La corrélation globale entre revenu et dépenses est très faible

Recommandations : - 🎯 Cibler les campagnes sur les utilisateurs mobiles à haut revenu - 💡 Développer des offres personnalisées selon l’historique d’achat

Challenge 3 : Développement du Modèle

Modèle de régression simple

model_simple <- lm(TotalSpend ~ Income, data = analysis_df)

r_squared_simple <- summary(model_simple)$r.squared
slope_simple     <- coef(model_simple)["Income"]

cat("R-squared :", round(r_squared_simple, 4), "\n")
## R-squared : 0.0015
cat("Pente     :", round(slope_simple, 6),     "\n")
## Pente     : 0.000804

Interprétation : R² = 0.0015 → Income n’explique que 0.15% de la variance de TotalSpend. Le revenu seul est un très mauvais prédicteur des dépenses.

Modèle de régression multiple

model_multi <- lm(TotalSpend ~ Income + Age + PurchaseHistoryScore, data = analysis_df)

model_summary    <- summary(model_multi)
broom_evaluation <- broom::glance(model_multi)

print(model_summary)
## 
## Call:
## lm(formula = TotalSpend ~ Income + Age + PurchaseHistoryScore, 
##     data = analysis_df)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -944.79 -211.07   -2.13  203.32  915.89 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)           1.300e+03  2.288e+02   5.684 6.91e-08 ***
## Income                9.285e-04  1.708e-03   0.543    0.588    
## Age                   2.358e+00  1.783e+00   1.322    0.188    
## PurchaseHistoryScore -3.331e+00  2.745e+00  -1.214    0.227    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 328 on 146 degrees of freedom
## Multiple R-squared:  0.02204,    Adjusted R-squared:  0.001947 
## F-statistic: 1.097 on 3 and 146 DF,  p-value: 0.3525
kable(broom_evaluation, caption = "Évaluation du modèle multiple avec broom::glance()")
Évaluation du modèle multiple avec broom::glance()
r.squared adj.r.squared sigma statistic p.value df logLik AIC BIC deviance df.residual nobs
0.0220421 0.001947 328.0334 1.096892 0.3525112 3 -1079.781 2169.562 2184.615 15710459 146 150

Interprétation : R² = 0.022 → Le modèle multiple explique seulement 2.2% de la variance. La p-value de 0.3525 indique que le modèle n’est pas significatif. D’autres variables non incluses expliquent mieux TotalSpend.

Challenge 4 : Validation et Prédiction

Graphiques de diagnostic

par(mfrow = c(2, 2))
plot(model_multi)

Interprétation : - Residuals vs Fitted : résidus aléatoires, pas de non-linéarité évidente ✅ - Q-Q Plot : points alignés sur la diagonale, normalité confirmée ✅ - Scale-Location : variance relativement constante ✅ - Residuals vs Leverage : pas de points très influents ✅

Vérification de la multicolinéarité (VIF)

vif_results <- vif(model_multi)
kable(as.data.frame(vif_results), caption = "Facteurs d'Inflation de la Variance (VIF)")
Facteurs d’Inflation de la Variance (VIF)
vif_results
Income 1.008815
Age 1.003341
PurchaseHistoryScore 1.010827

Interprétation : Toutes les valeurs VIF sont proches de 1, bien inférieures au seuil de 5. Pas de multicolinéarité entre les prédicteurs ✅

Test de normalité des résidus

shapiro_result <- shapiro.test(residuals(model_multi))
print(shapiro_result)
## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(model_multi)
## W = 0.99714, p-value = 0.9936
qqnorm(residuals(model_multi), main = "Q-Q Plot des résidus")
qqline(residuals(model_multi), col = "red")

Interprétation : p-value = 0.9936 >> 0.05 → Les résidus suivent une distribution normale ✅

Prédictions pour nouveaux clients

new_profiles <- tibble(
  Income               = c(45000, 65000, 80000),
  Age                  = c(25, 35, 40),
  PurchaseHistoryScore = c(3, 7, 8)
)

prediction_intervals <- predict(model_multi,
                                newdata  = new_profiles,
                                interval = "prediction")

results <- cbind(new_profiles, round(as.data.frame(prediction_intervals), 2))
kable(results, caption = "Prédictions avec intervalles de confiance")
Prédictions avec intervalles de confiance
Income Age PurchaseHistoryScore fit lwr upr
45000 25 3 1391.15 631.80 2150.50
65000 35 7 1419.97 669.28 2170.66
80000 40 8 1442.36 687.93 2196.78

Interprétation : - Client 1 (45k\(, 25 ans) → **1391\)** [632$ - 2150\(] - Client 2 (65k\), 35 ans) → 1420\(** [669\) - 2171\(] - Client 3 (80k\), 40 ans) → 1442\(** [688\) - 2197$]

Les intervalles larges reflètent la faible précision du modèle.

Régression logistique — Probabilité d’être HighSpender

analysis_df_final <- analysis_df %>%
  mutate(HighSpender = ifelse(TotalSpend > 500, TRUE, FALSE))

logistic_model <- glm(
  HighSpender ~ Income + Age + PurchaseHistoryScore,
  data   = analysis_df_final,
  family = "binomial"
)

test_customer <- tibble(
  Income               = 50000,
  Age                  = 40,
  PurchaseHistoryScore = 70
)

predicted_probability <- predict(
  logistic_model,
  newdata = test_customer,
  type    = "response"
)

cat("Probabilité HighSpender :", round(predicted_probability * 100, 2), "%\n")
## Probabilité HighSpender : 99.44 %

Interprétation : La probabilité estimée est de 99.44%. Un PurchaseHistoryScore de 70 contribue fortement à cette probabilité élevée. Recommandation marketing : Prioriser les clients avec PurchaseHistoryScore > 50 pour les campagnes de fidélisation et les offres premium.

Conclusion

Élément Résultat
R² modèle simple 0.0015 → Income seul insuffisant
R² modèle multiple 0.022 → modèle non significatif
VIF < 2 → Pas de multicolinéarité ✅
Shapiro-Wilk p = 0.9936 → Résidus normaux ✅
Probabilité HighSpender 99.44% → Client à fort potentiel

Recommandation finale : Collecter des variables supplémentaires (fidélité, fréquence d’achat) pour améliorer la puissance prédictive du modèle.