---
title: "Partie 2 : Feature Engineering et Préparation"
---
```{r}
#| label: setup
#| include: false
#| cache: false
source(here::here("utils.R"))
```
```{r}
#| label: load
#| include: false
data_rated <- readRDS(here::here("output", "data_rated.rds"))
accords_freq <- readRDS(here::here("output", "accords_freq.rds"))
accord_cols <- c("mainaccord1", "mainaccord2", "mainaccord3", "mainaccord4", "mainaccord5")
```
# Feature Engineering
## Mapping des accords vers les familles olfactives
Plutôt que d'utiliser les `r nrow(accords_freq)` accords individuels (trop nombreux et bruités), nous les regroupons en **10 familles olfactives** standardisées, inspirées de la classification de la Société Française des Parfumeurs (Ellena, 2007). Voici un extrait du dictionnaire de correspondance :
| Famille | Accords regroupés (exemples) |
|---------|------------------------------|
| **Fruity** | fruity, citrus, tropical |
| **Floral** | floral, rose, white floral, yellow floral |
| **Woody** | woody, earthy, mossy |
| **Sweet** | sweet, vanilla, caramel, powdery, gourmand |
| **Oriental** | oriental, amber, balsamic, warm, musky |
| **Fresh** | fresh, aquatic, ozonic, marine, clean |
| **Spicy** | spicy, warm spicy, cinnamon |
| **Herbal** | herbal, aromatic, green, lavender |
| **Leather** | leather, animalic |
| **Smoky** | smoky, tobacco |
: Mapping des accords vers les 10 familles olfactives {#tbl-mapping}
Par exemple, un parfum dont les accords sont *« citrus, floral, vanilla, woody, amber »* sera classé dans les familles **fruity** (via citrus), **floral**, **sweet** (via vanilla), **woody** et **oriental** (via amber) — soit 5 familles simultanément. Cette approche réduit la dimensionnalité tout en conservant le sens olfactif.
```{r}
#| label: accords-mapping
#| tbl-cap: "Distribution des familles olfactives (accords)"
data_rated <- map_accords_to_families(data_rated, accord_cols)
fam_cols <- grep("^fam_", names(data_rated), value = TRUE)
fam_sums <- colSums(data_rated[fam_cols])
fam_df <- data.frame(
Famille = gsub("^fam_", "", names(fam_sums)),
Effectif = fam_sums,
Pct = round(fam_sums / nrow(data_rated) * 100, 1)
)
fam_df <- fam_df[order(-fam_df$Effectif), ]
kable(fam_df, col.names = c("Famille", "Parfums", "%"), row.names = FALSE)
```
Les pourcentages totalisent plus de 100 % car un parfum peut appartenir à plusieurs familles (il possède jusqu'à 5 accords). Les familles **fruity**, **woody** et **sweet** dominent, reflétant la tendance actuelle du marché vers les parfums fruités-boisés et gourmands.
## Satisfaction par famille olfactive
```{r}
#| label: fig-family-sat
#| fig-cap: "Taux de satisfaction par famille olfactive"
#| fig-height: 2.5
sat_by_fam <- data.frame(
Famille = gsub("^fam_", "", fam_cols),
Taux = sapply(fam_cols, function(f) {
idx <- data_rated[[f]] == 1
if (sum(idx) > 0) mean(data_rated$Satisfaction[idx] == "Oui") else NA
})
) %>% filter(!is.na(Taux))
mean_sat <- mean(data_rated$Satisfaction == "Oui")
ggplot(sat_by_fam, aes(x = reorder(Famille, Taux), y = Taux)) +
geom_bar(stat = "identity", fill = COL_PRIMARY) +
coord_flip() +
geom_hline(yintercept = mean_sat, linetype = "dashed", color = COL_NEGATIVE) +
scale_y_continuous(labels = percent) +
labs(x = NULL, y = "Taux de satisfaction",
title = "Satisfaction par famille olfactive") +
THEME_REPORT
```
Les écarts de satisfaction entre familles sont modestes (~47 % à ~54 %), la ligne rouge pointillée indiquant la moyenne globale. Les familles *smoky*, *spicy* et *leather* affichent les taux les plus élevés — ces familles plus niches attirent un public passionné et averti. À l'inverse, *fresh*, *floral* et *fruity* sont légèrement en dessous : ces familles très répandues englobent un grand nombre de parfums de qualité variable, ce qui tire leur taux moyen vers le bas. Ces différences, bien que faibles, seront exploitées par les modèles.
## Encodage du genre
```{r}
#| label: encode-gender
data_rated <- data_rated %>%
mutate(
gender_women = as.integer(Gender == "women"),
gender_men = as.integer(Gender == "men"),
gender_unisex = as.integer(Gender == "unisex")
)
```
## Partition entraînement / test
Le split 70/30 est un compromis standard : 70 % des données suffisent pour entraîner les modèles avec CV interne, et 30 % assurent une évaluation fiable. **Toutes les transformations impliquant des statistiques apprises** (top-10 des notes, seuil de regroupement des pays, imputation médiane) sont réalisées **après le split**, ajustées **uniquement sur le jeu d'entraînement**, afin d'éviter toute fuite d'information du test vers le train.
```{r}
#| label: split
#| tbl-cap: "Pays après regroupement (seuil 5 %, calculé sur train)"
set.seed(42)
base_features <- c("Year", "Rating_Count", "gender_women", "gender_men", "gender_unisex",
grep("^fam_", names(data_rated), value = TRUE))
df_presplit <- data_rated %>%
select(all_of(c(base_features, "Satisfaction", "Country", "Top", "Middle", "Base")))
train_index <- createDataPartition(df_presplit$Satisfaction, p = 0.7, list = FALSE)
train_raw <- df_presplit[train_index, ]
test_raw <- df_presplit[-train_index, ]
# Regroupement des pays calculé sur train
train_raw <- merge_rare_categories(train_raw, "Country", threshold_pct = 5)
train_countries <- unique(train_raw$Country[!is.na(train_raw$Country)])
test_raw$Country[!is.na(test_raw$Country) & !(test_raw$Country %in% train_countries)] <- "Other"
country_freq <- train_raw %>%
filter(!is.na(Country)) %>%
count(Country, sort = TRUE) %>%
mutate(Pct = round(n / sum(n) * 100, 1))
kable(country_freq, col.names = c("Pays", "Effectif", "%"))
for (country in country_freq$Country) {
col_name <- paste0("country_", make.names(country))
train_raw[[col_name]] <- as.integer(train_raw$Country == country & !is.na(train_raw$Country))
test_raw[[col_name]] <- as.integer(test_raw$Country == country & !is.na(test_raw$Country))
}
# Notes top-10 par phase, calculées sur train, alignées sur test
train_raw <- map_notes_to_columns(train_raw, "top", "Top")
train_raw <- map_notes_to_columns(train_raw, "mid", "Middle")
train_raw <- map_notes_to_columns(train_raw, "base", "Base")
note_cols <- grep("^(top|mid|base)_", names(train_raw), value = TRUE)
for (col in note_cols) if (!(col %in% names(test_raw))) test_raw[[col]] <- 0L
test_raw <- map_notes_to_columns(test_raw, "top", "Top")
test_raw <- map_notes_to_columns(test_raw, "mid", "Middle")
test_raw <- map_notes_to_columns(test_raw, "base", "Base")
feature_cols <- c(
"Year", "Rating_Count", "gender_women", "gender_men", "gender_unisex",
grep("^country_", names(train_raw), value = TRUE),
grep("^fam_", names(train_raw), value = TRUE),
grep("^(top|mid|base)_", names(train_raw), value = TRUE)
)
common_cols <- intersect(names(train_raw), names(test_raw))
feature_cols <- intersect(feature_cols, common_cols)
train_data <- train_raw %>% select(all_of(c(feature_cols, "Satisfaction")))
test_data <- test_raw %>% select(all_of(c(feature_cols, "Satisfaction")))
# Imputation médiane apprise sur train uniquement
preprocess_median <- preProcess(train_data[, feature_cols], method = "medianImpute")
train_data[, feature_cols] <- predict(preprocess_median, train_data[, feature_cols])
test_data[, feature_cols] <- predict(preprocess_median, test_data[, feature_cols])
```
```{r}
#| label: split-summary
#| tbl-cap: "Répartition entraînement / test (stratifié)"
kable(data.frame(
Ensemble = c("Entraînement", "Test"),
Observations = c(nrow(train_data), nrow(test_data)),
Variables = c(length(feature_cols), length(feature_cols)),
Prop_Oui = c(round(mean(train_data$Satisfaction == "Oui"), 3),
round(mean(test_data$Satisfaction == "Oui"), 3))
), col.names = c("Ensemble", "Observations", "Variables", "Prop. Oui"))
```
Le pipeline produit `r length(feature_cols)` variables explicatives. La stratification assure que la proportion de parfums satisfaisants est identique dans les deux ensembles, garantissant une évaluation non biaisée.
```{r}
#| label: save-train-test
#| include: false
saveRDS(train_data, here::here("output", "train_data.rds"))
saveRDS(test_data, here::here("output", "test_data.rds"))
saveRDS(feature_cols, here::here("output", "feature_cols.rds"))
```
