La Marne - Attachement des habitants au territoire

1 Présentation de l’échantillon

Camemberts des variables socio-démographiques

Les camemberts ci-dessous illustrent la répartition des individus de notre échantillon en fonction de différentes variables socio-démographiques. Chaque camembert représente une variable spécifique, offrant ainsi un aperçu visuel de la diversité au sein de notre population d’étude.

Affichez le code

# Liste des variables à visualiser
variables_socio_demographiques <- c("age", "genre", "profession", "duree_residence", "PTOT")

# Boucle sur chaque variable
for (variable in variables_socio_demographiques) {
  
  if (variable != "profession") {
    # Calculer le nombre de couleurs nécessaires
    colors_num <- length(unique(donnees_individu_population[[variable]]))
    
    # Créer une palette de couleurs avec une transparence de 60%
    colorspalette_greens <- adjustcolor(brewer.pal(colors_num - 1, "Greens"), alpha.f = 0.6)
    
    # Ajouter la couleur grise pour la catégorie "Non renseigné" avec une transparence de 60%
    colorspalette_greens <- c(colorspalette_greens, adjustcolor("gray", alpha.f = 0.6))
    
    # Créer un camembert pour des variables socio-démographiques
    graphique_camembert <- ggplot(data = donnees_individu_population, aes(x = "", fill = .data[[variable]])) +
      geom_bar(width = 1) +
      coord_polar("y", start = 0) +
      geom_text(aes(label = stat(count)), stat = "count", position = position_stack(vjust = 0.5), size = 5, color = "black") +
      labs(fill = variable, x = NULL, y = NULL, title = paste("Répartition par", variable)) +
      scale_fill_manual(values = colorspalette_greens) +
      theme_void()
    
  } else if (variable == "profession") {
    
    # Créer un camembert pour la variable profession
    graphique_camembert <- ggplot(data = donnees_individu_population, aes(x = "", fill = profession)) +
      geom_bar(width = 1) +
      coord_polar("y", start = 0) +
      geom_text(aes(label = stat(count)), stat = "count", position = position_stack(vjust = 0.5), size = 5, color = "black") +
      labs(fill = "Profession", x = NULL, y = NULL, title = "Répartition par profession") +
      scale_fill_manual(values = adjustcolor(c("grey", brewer.pal(5, "Greens")), alpha.f = 0.6)) +
      theme_void()
  }
  
  # Affiche le graphique
  print(graphique_camembert)
    
  # ggsave(filename = paste0("Figures/graphique_", variable, ".png"), plot = graphique_camembert)

}

La carte ci-dessous illustre la répartition géographique des individus de notre échantillon dans le département 51. Chaque commune est représentée par une couleur correspondant à sa taille de population, offrant ainsi un aperçu visuel de la densité démographique dans cette région spécifique.

Affichez le code

# Joindre les données géographiques avec les données individuelles
carte_marne <- left_join(marne, donnees_individu_population, by = 'codes_postaux')
# Ajouter les coordonnées du centre de chaque commune
carte_marne <- cbind(carte_marne, st_coordinates(st_centroid(carte_marne)))
# Créer une colonne de texte pour étiqueter chaque ville avec son nom et sa population
carte_marne$texte <- paste("Ville :", carte_marne$Commune, "|", "Population :", carte_marne$PTOT)

# Créer la carte de la Marne
graphique_lamarne <- ggplot(data = carte_marne) +
  geom_sf(aes(fill = PTOT))  +
  theme(axis.line = element_blank(), axis.text = element_blank(),
        axis.ticks = element_blank(), axis.title = element_blank()) +
  scale_fill_manual(values = adjustcolor(c(brewer.pal(3, "Greens"), "#185640"), alpha.f = 0.6))+
  geom_text(data = carte_marne, aes(x = X, y = Y, label = Commune),  color = "black", check_overlap = FALSE, size = 2.5) +
  theme_void() +
  coord_sf()

print(graphique_lamarne)

Affichez le code

# ggsave(filename = "Figures/carte_LaMarne.png", plot = graphique_lamarne)

Affichez le code

get_population <- function(data, indice) {
  result <- table(data$Commune, data$PTOT)[, indice]
  result <- result[result > 0]
  return(result)
}

indices <- c(1, 2, 3, 4, 5)

communes_villages <- get_population(donnees_individu_population, indices[1])
petites_villes <- get_population(donnees_individu_population, indices[2])
villes_moyennes <- get_population(donnees_individu_population, indices[3])
villes_importantes <- get_population(donnees_individu_population, indices[4])
villes_hors_51 <- get_population(donnees_individu_population, indices[5])

cat("Les villages : \n\n")

Les villages :

Affichez le code

print(communes_villages)

                                      Anglure 
                                            6 
                                        Avize 
                                            3 
                                       Damery 
                                           13 
                             Givry-en-Argonne 
                                            4 
                                        Gueux 
                                            6 
                                  Hermonville 
                                            5 
                           Jonchery-sur-Vesle 
                                           12 
                        La Chaussée-sur-Marne 
                                           11 
                                      Magenta 
                                           12 
                                Montmort-Lucy 
                                            2 
                             Pargny-sur-Saulx 
                                            3 
                   Pontfaverger-Moronvilliers 
                                            3 
                            Rilly-la-Montagne 
                                           15 
Saint-Remy-en-Bouzemont-Saint-Genest-et-Isson 
                                            5 
                                    Sommesous 
                                            1 
                              Tours-sur-Marne 
                                           13 
                                     Verzenay 
                                            3 
                                        Verzy 
                                            6

Affichez le code

cat("Les petites villes : \n\n")

Les petites villes :

Affichez le code

print(petites_villes)

          Aÿ-Champagne             Bazancourt                Bétheny 
                    14                      7                      2 
        Blancs-Coteaux           Cormontreuil             Courtisols 
                    10                      2                      9 
               Dormans              Fagnières       Fère-Champenoise 
                    10                      6                      4 
                Fismes             Montmirail     Mourmelon-le-Grand 
                     8                      4                     11 
Saint-Brice-Courcelles           Saint-Memmie       Sainte-Menehould 
                     2                      2                      7 
                 Sarry                Sézanne                Suippes 
                     5                      6                     11 
              Tinqueux      Vitry-le-François        Witry-lès-Reims 
                    12                     19                      3

Affichez le code

cat("Les villes moyennes : \n\n")

Les villes moyennes :

Affichez le code

print(villes_moyennes)

Châlons-en-Champagne              Épernay 
                  68                   25

Affichez le code

cat("Les villes importantes : \n\n")

Les villes importantes :

Affichez le code

print(villes_importantes)

Reims 
  100

Affichez le code

cat("Les villes hors du 51 : \n\n")

Les villes hors du 51 :

Affichez le code

print(villes_hors_51)

                 Angers                   Arras                  Asfeld 
                      1                       1                       1 
       Champs-sur-Marne    Charleville-Mézières         Château-Thierry 
                      1                       1                       1 
          Condé-en-Brie       Neuilly-sur-Marne                  Rethel 
                      2                       1                       1 
      Romilly-sur-Seine Saint-Julien-les-Villas          Sainte-Florine 
                      1                       1                       1 
               Toulouse                 Wingles 
                      1                       1

2 Les degrés d’attachement au territoire

Histogrammes des % des réponses à la fleur

Les histogrammes ci-dessous illustrent la répartition des réponses en pourcentage pour chaque niveau d’attachement, offrant ainsi un aperçu des différentes nuances dans les sentiments d’attachement des individus à leur territoire.

Affichez le code

# Calculer les pourcentages de chaque réponse
data_attachment_degree <- donnees_individu_population %>%
  filter(!is.na(fleur)) %>%
  group_by(fleur) %>%
  summarise(nb=n()) %>%
  mutate(Pourcentage=nb/sum(nb)*100) %>%
  mutate(fleur = factor(fleur, levels = c("Pas du tout", "Un peu", "Beaucoup", "Très attaché")))


# Créer l'histogramme - Répartition des réponses à la fleur (degré d’attachement)
graphique_fleur <- ggplot(data = data_attachment_degree, aes(x = fleur, y = Pourcentage)) +
  geom_bar(stat = "identity", fill = "#E51495") +  
  geom_text(aes(label = sprintf("%.0f%%", Pourcentage)), vjust = -0.5, size = 4) +  
  geom_text(aes(label = paste(nb, "individus")), vjust = 2, color = "black", nudge_y = -0.5, size=3) +
  labs(title = " ",
       x = "Réponse à la fleur",
       y = "Pourcentage") + 
  theme_minimal()  

print(graphique_fleur)

Affichez le code

# ggsave(filename = "Figures/graphique_degres_attachement.png", plot = graphique_fleur)

2.1 Corrélations entre les variables socio-démographiques et le niveau d’attachement

Quelles sont les corrélations significatives entre les variables socio-démographiques et les réponses à la fleur ?

Cette analyse vise à identifier les relations significatives entre les caractéristiques socio-démographiques et les niveaux d’attachement exprimés par les individus envers leur territoire, en se concentrant uniquement sur les réponses renseignées.

Affichez le code

for (variable in variables_socio_demographiques) {
  Test_chi2_fleur_variable(donnees_individu_population, variable)
}

Test du chi-deux entre age et la fleur :

    Pearson's Chi-squared test

data:  table_contingence
X-squared = 19.887, df = 9, p-value = 0.01862

L'hypothèse nulle (H0) est rejetée, il y a une association significative entre age et la fleur.

Test du chi-deux entre genre et la fleur :

    Pearson's Chi-squared test

data:  table_contingence
X-squared = 3.5449, df = 3, p-value = 0.315

L'hypothèse nulle (H0) n'est pas rejetée, il n'y a pas suffisamment de preuves pour affirmer qu'il existe une association significative entre genre et la fleur.

Test du chi-deux entre profession et la fleur :

    Pearson's Chi-squared test

data:  table_contingence
X-squared = 26.306, df = 12, p-value = 0.009711

L'hypothèse nulle (H0) est rejetée, il y a une association significative entre profession et la fleur.

Test du chi-deux entre duree_residence et la fleur :

    Pearson's Chi-squared test

data:  table_contingence
X-squared = 25.678, df = 12, p-value = 0.01192

L'hypothèse nulle (H0) est rejetée, il y a une association significative entre duree_residence et la fleur.

Test du chi-deux entre PTOT et la fleur :

    Pearson's Chi-squared test

data:  table_contingence
X-squared = 13.049, df = 9, p-value = 0.1604

L'hypothèse nulle (H0) n'est pas rejetée, il n'y a pas suffisamment de preuves pour affirmer qu'il existe une association significative entre PTOT et la fleur.

Pour chaque corrélation significative «variable x degré d’attachement », faire des tests pour définir quelle(s) modalité(s) présente une moyenne significativement différente.

Cette étape de l’analyse consiste à effectuer des tests statistiques pour déterminer quelles modalités des variables socio-démographiques présentent une différence significative dans les niveaux d’attachement exprimés. En d’autres termes, nous cherchons à identifier les groupes au sein de chaque variable qui ont des moyennes d’attachement significativement différentes.

Affichez le code

for (variable in variables_socio_demographiques) {
  Test_anova_fleur_variable(donnees_individu_population, variable)
}

                 age fleur_num sup_mean
1     plus de 66 ans      3.04      Oui
2 entre 41 et 65 ans      3.00      Oui
3 entre 26 et 40 ans      2.80      Non
4    moins de 25 ans      2.64      Non
                                                     profession fleur_num
1 Cadres, Chef d'entreprise, Profession libérale et Commerçants      3.07
2                                        Agriculteurs, Artisans      3.03
3                                                      Retraité      3.02
4                  Profession intermédiaire, Employés, Ouvriers      2.84
5              Personnes sans activité professionnelle ou autre      2.71
  sup_mean
1      Oui
2      Oui
3      Oui
4      Non
5      Non
     duree_residence fleur_num sup_mean
1             natifs      3.00      Oui
2     moins de 4 ans      2.97      Oui
3     plus de 20 ans      2.97      Oui
4 entre 10 et 19 ans      2.88      Non
5   entre 5 et 9 ans      2.43      Non

Ces graphiques ci-dessous illustrent les variations des pourcentages de chaque niveau d’attachement pour chaque modalité. Cette présentation visuelle offre un aperçu clair des différences observées entre les groupes démographiques, facilitant ainsi la compréhension des corrélations entre les variables socio-démographiques et les degrés d’attachement au territoire.

Affichez le code

lapply(variables_socio_demographiques, function(variable) {
  graphique_modalités_degres <- graphique_modalités_degresAttachement(donnees_individu_population,variable)
  # print(graphique_modalités_degres)
  # nom_fichier_image <- paste0("Figures/graph_modalités_degresAttachement_", variable, ".png")
  # ggsave(nom_fichier_image, graphique_modalités_degres)
})

[[1]]


[[2]]


[[3]]


[[4]]


[[5]]

3 Le climat émotionnel global

Histogramme des désirs

Cet histogramme présente la distribution des réponses concernant les désirs des individus, offrant ainsi un aperçu du climat émotionnel global de l’échantillon.

Affichez le code

# Calculer les statistiques descriptives pertinentes pour chaque désir
data_indicateur_desirs <- donnees_individu_population %>%
  select(clust, Enfant, Sens, Harmonie, Inconnu,Instant) %>%
  pivot_longer(cols = -clust, names_to = "Desir", values_to = "Valeur") %>%
  mutate(Desir = factor(Desir, levels = c("Enfant", "Sens", "Harmonie", "Inconnu","Instant"))) %>%
  group_by(Desir) %>%
  summarise(
    Moyenne = round(mean(Valeur), digits = 1),
    Mediane = round(median(Valeur), digits = 1),
    EcartType = round(sd(Valeur), digits = 1),
  )

# Créer un histogramme des moyennes représentant le climat émotionnel global de la Marne à partir des données sur les 5 désirs
graphique_desirs <- ggplot(data_indicateur_desirs, aes(x = Desir, y = Moyenne, fill = Desir)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = Moyenne), position = position_stack(vjust = 0.5), color = "black", size = 5) + 
  theme_minimal() +
  guides(fill = FALSE) 

print(graphique_desirs)

Affichez le code

# ggsave(filename = "Figures/graphique_desirs.png", plot = graphique_desirs)

Boites à moustache

Cette boîte à moustaches illustre la répartition des réponses concernant les désirs des individus, offrant ainsi un aperçu du climat émotionnel global de l’échantillon.

Affichez le code

# Créer des boîtes à moustaches pour chaque désir
data_boxplot_desirs <- donnees_individu_population %>%
   select(clust, Enfant, Sens, Harmonie, Inconnu,Instant) %>%
  pivot_longer(cols = c(Enfant, Sens, Harmonie, Inconnu, Instant), names_to = "Desir")  %>%
  mutate(Desir = factor(Desir, levels = c("Enfant", "Sens", "Harmonie", "Inconnu","Instant")))

# Visualiser les boîtes à moustaches
graphique_desirs_baxplot <- ggplot(data_boxplot_desirs, aes(x = Desir, y = value, fill= Desir)) +
  geom_boxplot() +
  labs(title = " ", x = "Désir", y = "Valeur") +
  theme_minimal() +
  guides(fill = FALSE) 

print(graphique_desirs_baxplot)

Affichez le code

# ggsave(filename = "Figures/graphique_desirs_baxplot.png", plot = graphique_desirs_baxplot)

Les mots-images qui ont le plus de poids dans le calcul des valeurs moyennes des indicateurs de désirs

Cette analyse nous révèle les mots-images qui ont la plus influence sur la manière dont les individus expriment leurs sentiments à l’égard de leur territoire, à travers leurs attachements, leurs perceptions et les émotions qu’ils associent à cet environnement géographique spécifique.

Affichez le code

extraire_mots_images(donnees_individu_population, "Données initiales")



Résultats pour  Données initiales :



Top 5 mots-images pour l'indicateur Enfant :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Enfant </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> souvenirs d’enfance </td>
   <td style="text-align:right;"> 453.03 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> chez moi. ailleurs </td>
   <td style="text-align:right;"> 151.29 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> dans une bulle </td>
   <td style="text-align:right;"> 140.23 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> petit nid douillet </td>
   <td style="text-align:right;"> 139.74 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> petit plaisir </td>
   <td style="text-align:right;"> 121.28 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Sens :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Sens </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> au rythme de la nature </td>
   <td style="text-align:right;"> 144.02 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> retraite </td>
   <td style="text-align:right;"> 91.97 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> retour à l’essentiel </td>
   <td style="text-align:right;"> 91.81 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> dépouillement </td>
   <td style="text-align:right;"> 81.15 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> montagne sacrée </td>
   <td style="text-align:right;"> 63.45 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Harmonie :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Harmonie </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> écrin de verdure </td>
   <td style="text-align:right;"> 160.11 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> respire l’élégance </td>
   <td style="text-align:right;"> 131.05 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> au rythme de la nature </td>
   <td style="text-align:right;"> 96.01 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> petit coin de paradis </td>
   <td style="text-align:right;"> 92.26 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> joyau caché </td>
   <td style="text-align:right;"> 74.90 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Inconnu :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Inconnu </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> chez moi. ailleurs </td>
   <td style="text-align:right;"> 151.29 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> hasard des rencontres </td>
   <td style="text-align:right;"> 128.48 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> exploration </td>
   <td style="text-align:right;"> 70.01 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> voyage dans le temps </td>
   <td style="text-align:right;"> 68.47 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> contrées inhabitées </td>
   <td style="text-align:right;"> 57.17 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Instant :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Instant </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> au rythme de la nature </td>
   <td style="text-align:right;"> 288.03 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> temps libre pour respirer </td>
   <td style="text-align:right;"> 201.33 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> écrin de verdure </td>
   <td style="text-align:right;"> 200.14 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> dans une bulle </td>
   <td style="text-align:right;"> 196.32 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> petit plaisir </td>
   <td style="text-align:right;"> 181.92 </td>
  </tr>
</tbody>
</table>

3.1 Corrélations entre les variables socio-démographiques et les moyennes d’indicateurs de désir

Quelles sont les corrélations significatives entre les variables socio-démographiques et les désirs ?

Cette analyse vise à déterminer les corrélations significatives entre les variables socio-démographiques et les désirs exprimés par les individus, en excluant les réponses non renseignées et en regroupant les modalités pour garantir une taille d’échantillon adéquate. Les résultats présentés seront ceux qui révèlent des différences significatives, évitant ainsi de surcharger les informations avec des résultats non significatifs.

Affichez le code

donnees_individu_population_nouveaux <- creation_modalites(donnees_individu_population)

# Variables sociodémographiques (catégorielles)
variables_catégorielles <- variables_socio_demographiques

# Variables indicateurs de désir (numériques)
indicateurs_desirs <- c("Enfant", "Sens", "Harmonie", "Inconnu", "Instant")
variables_numériques <- indicateurs_desirs

# Effectuer l'ANOVA pour chaque combinaison de variables catégorielles et numériques
for (var_cat in variables_catégorielles) {
  for (var_num in variables_numériques) {
    
     # Filtrer les données pour les nouvelles modalités
     donnees_filtrees <- filtrage_nouveaux_modalités(donnees_individu_population_nouveaux, var_cat) 
    
    # Effectuer l'ANOVA
    aov_result_var_desirs <- aov(donnees_filtrees[[var_num]] ~ donnees_filtrees[[var_cat]])
    p_value <- summary(aov_result_var_desirs)[[1]]$`Pr(>F)`[1]  
    if (p_value < 0.05) {
      cat("Variables Quantitative:", var_num, "\n")
      cat("Variables Qualitative:", var_cat, "\n")
      print(summary(aov_result_var_desirs))
      cat("Rejet de l'hypothèse nulle\n")
      cat("Différence significative entre les groupes\n\n")
    }
  }
}

Variables Quantitative: Inconnu 
Variables Qualitative: age 
                             Df Sum Sq Mean Sq F value  Pr(>F)   
donnees_filtrees[[var_cat]]   2   38.2  19.081   5.087 0.00651 **
Residuals                   483 1811.6   3.751                   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Rejet de l'hypothèse nulle
Différence significative entre les groupes

Variables Quantitative: Inconnu 
Variables Qualitative: profession 
                             Df Sum Sq Mean Sq F value   Pr(>F)    
donnees_filtrees[[var_cat]]   2   57.5  28.738   7.745 0.000489 ***
Residuals                   483 1792.3   3.711                     
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Rejet de l'hypothèse nulle
Différence significative entre les groupes

Variables Quantitative: Instant 
Variables Qualitative: profession 
                             Df Sum Sq Mean Sq F value  Pr(>F)   
donnees_filtrees[[var_cat]]   2   33.8  16.912   5.106 0.00639 **
Residuals                   483 1599.9   3.312                   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Rejet de l'hypothèse nulle
Différence significative entre les groupes

Variables Quantitative: Enfant 
Variables Qualitative: duree_residence 
                             Df Sum Sq Mean Sq F value   Pr(>F)    
donnees_filtrees[[var_cat]]   3  169.5   56.50   12.82 4.73e-08 ***
Residuals                   449 1978.5    4.41                     
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Rejet de l'hypothèse nulle
Différence significative entre les groupes

Variables Quantitative: Inconnu 
Variables Qualitative: duree_residence 
                             Df Sum Sq Mean Sq F value   Pr(>F)    
donnees_filtrees[[var_cat]]   3   84.8   28.25   7.416 7.39e-05 ***
Residuals                   449 1710.7    3.81                     
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Rejet de l'hypothèse nulle
Différence significative entre les groupes

Variables Quantitative: Harmonie 
Variables Qualitative: PTOT 
                             Df Sum Sq Mean Sq F value  Pr(>F)   
donnees_filtrees[[var_cat]]   3   29.3   9.764   3.882 0.00924 **
Residuals                   466 1172.2   2.515                   
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Rejet de l'hypothèse nulle
Différence significative entre les groupes

Pour chaque corrélation significative « variable x désir », faire des tests pour définir quelle(s) modalité(s) présente une moyenne significativement différente

Cette étape de l’analyse consiste à effectuer des tests statistiques pour déterminer quelles modalités des variables socio-démographiques présentent une différence significative dans les niveaux de désirs exprimés. En d’autres termes, nous cherchons à identifier les groupes au sein de chaque variable qui ont des moyennes de désirs significativement différentes.

Affichez le code

# Liste des paires de variables et de désirs avec leur nom dans les données
paires_variables_desirs <- list(
  c("age", "Inconnu"),
  c("profession", "Inconnu"),
  c("profession", "Instant"),
  c("duree_residence", "Enfant"),
  c("duree_residence", "Inconnu"),
  c("PTOT", "Harmonie")
)

# Boucle pour réaliser les tests post hoc pour chaque paire
for (pair in paires_variables_desirs) {
  
  # Filtrer les données pour la variable de contrôle de la paire
  donnees_filtrees <- filtrage_nouveaux_modalités(donnees_individu_population_nouveaux, pair[1]) 

  # Réaliser l'ANOVA
 formule_anova_pair <- as.formula(paste(pair[2], "~", pair[1]))
  resultat_anova_pair <- aov(formule_anova_pair, data = donnees_filtrees)
  summary_result <- summary(resultat_anova_pair)
  p_valeur <- summary_result[[1]]$`Pr(>F)`[1]
  
if (p_valeur < 0.05) {
   
    # Extraire les rangs moyens
    rangs_moyens_pair <- donnees_filtrees %>%
      group_by(!!as.name(pair[1])) %>%
      summarise(mean_value = round(mean(!!as.name(pair[2])), 2)) %>%
      arrange(desc(mean_value)) %>%
      mutate(sup_mean = ifelse(mean_value > round(mean(donnees_filtrees[[pair[2]]]), 2), "Oui", "Non"))
    
    print(rangs_moyens_pair)
}
   
}

# A tibble: 3 × 3
  age                mean_value sup_mean
  <fct>                   <dbl> <chr>   
1 Moins de 40 ans          2.77 Oui     
2 Entre 41 et 65 ans       2.18 Non     
3 Plus de 66 ans           1.93 Non     
# A tibble: 3 × 3
  profession                                       mean_value sup_mean
  <fct>                                                 <dbl> <chr>   
1 Personnes sans activité professionnelle ou autre       3.27 Oui     
2 Personnes exerçant une activité profesionnelle         2.26 Oui     
3 Les retraités                                          1.9  Non     
# A tibble: 3 × 3
  profession                                       mean_value sup_mean
  <fct>                                                 <dbl> <chr>   
1 Les retraités                                          5.4  Oui     
2 Personnes exerçant une activité profesionnelle         5.23 Oui     
3 Personnes sans activité professionnelle ou autre       4.36 Non     
# A tibble: 4 × 3
  duree_residence    mean_value sup_mean
  <fct>                   <dbl> <chr>   
1 Natifs                   4.49 Oui     
2 Plus de 20 ans           3.32 Non     
3 Moins de 10 ans          3.21 Non     
4 Entre 10 et 19 ans       3.21 Non     
# A tibble: 4 × 3
  duree_residence    mean_value sup_mean
  <fct>                   <dbl> <chr>   
1 Moins de 10 ans          2.88 Oui     
2 Entre 10 et 19 ans       2.8  Oui     
3 Plus de 20 ans           2.56 Oui     
4 Natifs                   1.84 Non     
# A tibble: 4 × 3
  PTOT               mean_value sup_mean
  <fct>                   <dbl> <chr>   
1 Villes importantes       2.34 Oui     
2 Villages                 2.29 Oui     
3 Petites villes           1.9  Non     
4 Villes moyennes          1.71 Non

Ces graphiques ci-dessous illustrent les variations des moyennes de désirs pour chaque modalité. Cette présentation visuelle offre un aperçu clair des différences observées entre les groupes démographiques, facilitant ainsi la compréhension des corrélations entre les variables socio-démographiques et les niveaux de désirs exprimés.

Affichez le code

# Appliquer la fonction pour chaque paire de variables
for (pair in paires_variables_desirs) {
  graphique_modalites_desirs <- graphique_modalités_indicateurDesirs(donnees_individu_population_nouveaux, pair[1], pair[2])

  nom_fichier_image <- paste0("Figures/graph_", pair[1], "_", pair[2], ".png")
  ggsave(nom_fichier_image, graphique_modalites_desirs)
}

Pour chaque couple « modalité x désir » quels mots-images sont les plus importants ?

Pour chaque couple “modalité x désir”, nous cherchons à identifier les mots-images les plus importants. Cette analyse nous permet de comprendre les émotions et les sentiments associés à chaque groupe démographique, en examinant les mots-images qui ont le plus d’influence sur leur niveau de désir.

Affichez le code

# Définir la liste des couples « modalité x désir »
pairs_mots_images_var_desirs <- list(
  c("age", "met_inconnu"),
  c("profession", "met_inconnu"),
  c("profession", "met_instant"),
  c("duree_residence", "met_enfant"),
  c("duree_residence", "met_inconnu"),
  c("PTOT", "met_harmonie")
)

# Initialisation de la liste pour stocker les résultats finaux
resultats_modalites_globaux <- list()

# Boucle pour chaque paire de variables et de désirs
for (pair_mots in pairs_mots_images_var_desirs) {
  colonne_data <- pair_mots[1]
  colonne_metrique <- pair_mots[2]
  
  # Filtrer les données et identifier les modalités uniques de la variable 
  donnees_filtrees <- filtrage_nouveaux_modalités(donnees_individu_population_nouveaux, colonne_data)
  modalites <- unique(as.character(donnees_filtrees[[colonne_data]]))
  
  # Initialiser une liste pour stocker les résultats pour chaque modalité
  resultats_modalites <- list() 
  
  # Boucle pour chaque modalité de la variable
  for (mod in modalites) {
    
      # Filtrer les données et créer des mots-images pour la modalité actuelle
      donnees_filtrees_modalites <- donnees_filtrees[donnees_filtrees[[colonne_data]] == mod,]
      donnees_mots_images_modalites <- creation_dataframe_mots(donnees_filtrees_modalites$imaginaryTags, metrique_xenia)
    
      # Calculer les mots-images les plus importants pour la modalité actuelle
      data_top5_mots_modalites <- donnees_mots_images_modalites %>%
        group_by(mots_images) %>%
        summarise(poids_total = round(sum(poids)*mean(!!sym(colonne_metrique)), 2), frequence = n()) %>%
        arrange(desc(poids_total)) %>%
        head(5)  # Sélectionner les 5 premiers mots-images
    
      # Stocker les résultats pour cette modalité dans la liste
      resultats_modalites[[as.character(mod)]] <- data_top5_mots_modalites  
  }
  
  # Stocker les résultats pour cette paire de variables et de désirs dans la liste globale
  resultats_modalites_globaux[[paste(colonne_data, colonne_metrique, sep = "_")]] <- resultats_modalites
}

# Affichage des résultats avec titre pour chaque paire
for (key in names(resultats_modalites_globaux)) {
  cat("Tableau pour", key, ":\n")
  for (subkey in names(resultats_modalites_globaux[[key]])) {
    cat("Modalité:", subkey, "\n")
    # Création du titre en utilisant la key et subkey
    titre <- paste("Tableau pour", key, "-", subkey)
    
    # Création de la table avec kable et kable_styling
    tableau_kable <- resultats_modalites_globaux[[key]][[subkey]] %>%
      kable(booktabs = TRUE, format = "html", caption = titre) %>%
      kable_styling(full_width = FALSE, position = "center")
    
    # Afficher le titre et le tableau
    print(tableau_kable)
  }
}

Ici, on va esayer de remplacer la colonne “poids_total_” par “poids_moyen” et diviser la valeur par le nombre de répondants :

Affichez le code

# Définir la liste des couples « modalité x désir »
pairs_mots_images_var_desirs <- list(
  c("age", "met_inconnu"),
  c("profession", "met_inconnu"),
  c("profession", "met_instant"),
  c("duree_residence", "met_enfant"),
  c("duree_residence", "met_inconnu"),
  c("PTOT", "met_harmonie")
)

# Initialisation de la liste pour stocker les résultats finaux
resultats_modalites_globaux <- list()

# Boucle pour chaque paire de variables et de désirs
for (pair_mots in pairs_mots_images_var_desirs) {
  colonne_data <- pair_mots[1]
  colonne_metrique <- pair_mots[2]
  
  # Filtrer les données et identifier les modalités uniques de la variable 
  donnees_filtrees <- filtrage_nouveaux_modalités(donnees_individu_population_nouveaux, colonne_data)
  modalites <- unique(as.character(donnees_filtrees[[colonne_data]]))
  
  # Initialiser une liste pour stocker les résultats pour chaque modalité
  resultats_modalites <- list() 
  
  # Boucle pour chaque modalité de la variable
  for (mod in modalites) {
    
      # Filtrer les données et créer des mots-images pour la modalité actuelle
      donnees_filtrees_modalites <- donnees_filtrees[donnees_filtrees[[colonne_data]] == mod,]
      donnees_mots_images_modalites <- creation_dataframe_mots(donnees_filtrees_modalites$imaginaryTags, metrique_xenia)
    
      # Calculer les mots-images les plus importants pour la modalité actuelle
      data_top5_mots_modalites <- donnees_mots_images_modalites %>%
        group_by(mots_images) %>%
        summarise(poids_moyen = round((sum(poids) / nrow(donnees_filtrees_modalites))*mean(!!sym(colonne_metrique)), 2), frequence = n()) %>%
        arrange(desc(poids_moyen)) %>%
        head(5)  # Sélectionner les 5 premiers mots-images
    
      # Stocker les résultats pour cette modalité dans la liste
      resultats_modalites[[as.character(mod)]] <- data_top5_mots_modalites  
  }
  
  # Stocker les résultats pour cette paire de variables et de désirs dans la liste globale
  resultats_modalites_globaux[[paste(colonne_data, colonne_metrique, sep = "_")]] <- resultats_modalites
}

# Affichage des résultats avec titre pour chaque paire
for (key in names(resultats_modalites_globaux)) {
  cat("Tableau pour", key, ":\n")
  for (subkey in names(resultats_modalites_globaux[[key]])) {
    cat("Modalité:", subkey, "\n")
    # Création du titre en utilisant la key et subkey
    titre <- paste("Tableau pour", key, "-", subkey)
    
    # Création de la table avec kable et kable_styling
    tableau_kable <- resultats_modalites_globaux[[key]][[subkey]] %>%
      kable(booktabs = TRUE, format = "html", caption = titre) %>%
      kable_styling(full_width = FALSE, position = "center")
    
    # Afficher le titre et le tableau
    print(tableau_kable)
  }
}

4 Les climats émotionnels par degré d’attachement

Histogrammes des moyennes de désirs par réponse à la fleur, avec la comparaison de la moyenne globale

Les histogrammes ci-dessous présentent les moyennes de désirs pour chaque réponse à la fleur, ainsi qu’une comparaison avec la moyenne globale. Ces visualisations permettent de voir comment les niveaux d’attachement exprimés à travers la réponse à la fleur sont associés aux différents niveaux de désirs, tout en fournissant une référence avec la moyenne globale pour mettre en évidence les écarts.

Affichez le code

# Calcul des moyennes par "Desir" et par niveau de "fleur"
data_attachement_indicateurs <- donnees_individu_population %>%
  select(fleur, Enfant, Sens, Harmonie, Inconnu, Instant) %>%
  filter(!is.na(fleur)) %>%
  pivot_longer(-fleur, names_to = "Desir", values_to = "Valeur")  %>%
  group_by(fleur, Desir) %>%
  summarize(Valeur = mean(Valeur, na.rm = TRUE))

# Définition de l'ordre des niveaux de la variable "Desir"
data_attachement_indicateurs$Desir <- factor(data_attachement_indicateurs$Desir, levels = indicateurs_desirs)

# Calcul des moyennes globales pour chaque "Désir"
data_desirs_moyenne_globale <- data_indicateur_desirs %>%
  select(Desir, Moyenne)

# Création de l'histogramme avec la comparaison des moyennes globales
graphique_desirs_attachement <- ggplot(data_attachement_indicateurs, aes(x = fleur, y = Valeur, fill = Desir)) +
  geom_bar(stat = "identity", position = "dodge") +
  geom_text(aes(label = round(Valeur, 1)), position = position_dodge(width = 0.9), vjust = -0.5) +
  geom_hline(data = data_desirs_moyenne_globale, aes(yintercept = Moyenne), linetype = "dashed", color = "black", size = 1) +
  facet_wrap(~Desir, scales = "free_y", ncol = 2) +
  labs(x = " ", y = "Désir moyen", fill = NULL) +
  coord_cartesian(ylim = c(0, 7)) +
  theme_minimal() +
  guides(fill = FALSE) +
  theme(panel.border = element_rect(color = "black", fill = NA, size = 1))

print(graphique_desirs_attachement)

Affichez le code

ggsave(filename = "Figures/graphique_desirs_degresAttachement.png", plot = graphique_desirs_attachement)

Quels souffles de désirs sont significativement plus forts en fonction du degré d’attachement ?

Cette analyse vise à identifier les souffles de désirs qui sont significativement plus forts en fonction du degré d’attachement exprimé par les individus. En d’autres termes, nous cherchons à déterminer quels désirs sont plus prononcés chez les personnes ayant des niveaux d’attachement différents à leur territoire.

Affichez le code

# Boucle pour effectuer l'ANOVA pour chaque indicateur de désir
for (indicateur in indicateurs_desirs) {
  
  data_attachement_indicateurs_test <- data.frame(
  fleur = donnees_individu_population$fleur,
  Enfant = donnees_individu_population$Enfant,
  Sens = donnees_individu_population$Sens,
  Harmonie = donnees_individu_population$Harmonie,
  Inconnu = donnees_individu_population$Inconnu,
  Instant = donnees_individu_population$Instant)
  
  anova_result <- aov(as.formula(paste(indicateur, "~ fleur")), data = data_attachement_indicateurs_test)
  summary_result <- summary(anova_result)
  
  # Extraire la p-valeur
  p_value <- summary_result[[1]]$`Pr(>F)`[1]
  
  # Afficher les résultats
  cat("P-valeur pour l'ANOVA de", indicateur, ":", p_value, "\n")
  
  # Interpréter les résultats
  if (p_value < 0.05) {
    cat("Il y a une différence significative entre les groupes de fleurs pour", indicateur, "\n\n")
    
    # Effectuer un test post hoc si le résultat de l'ANOVA est significatif
    test_tukey <- HSD.test(anova_result, "fleur", console = FALSE)
     print( test_tukey$groups)
    
  } else {
    cat("Il n'y a pas de différence significative entre les groupes de fleurs pour", indicateur, "\n\n")
  }
}

P-valeur pour l'ANOVA de Enfant : 0.01887993 
Il y a une différence significative entre les groupes de fleurs pour Enfant 

               Enfant groups
Beaucoup     4.031355      a
Très attaché 3.813893     ab
Un peu       3.556071     ab
Pas du tout  2.492166      b
P-valeur pour l'ANOVA de Sens : 6.119214e-13 
Il y a une différence significative entre les groupes de fleurs pour Sens 

                 Sens groups
Pas du tout  4.962759      a
Un peu       2.805962      b
Très attaché 2.010979      c
Beaucoup     1.907204      c
P-valeur pour l'ANOVA de Harmonie : 5.599825e-06 
Il y a une différence significative entre les groupes de fleurs pour Harmonie 

              Harmonie groups
Très attaché 2.5402933      a
Beaucoup     2.1034402     ab
Un peu       1.6499646     bc
Pas du tout  0.7245125      c
P-valeur pour l'ANOVA de Inconnu : 3.830025e-14 
Il y a une différence significative entre les groupes de fleurs pour Inconnu 

              Inconnu groups
Pas du tout  5.540038      a
Un peu       2.966019      b
Très attaché 2.198282      c
Beaucoup     1.928335      c
P-valeur pour l'ANOVA de Instant : 1.420775e-10 
Il y a une différence significative entre les groupes de fleurs pour Instant 

              Instant groups
Beaucoup     5.446881      a
Très attaché 5.207204      a
Un peu       4.358445      b
Pas du tout  2.962004      c

5 Focus sur les potentiels détracteurs et potentiels ambassadeurs

5.1 Focus sur les « Pas du tout » attachés

Combien ? En proportion ?

Cette section se concentre sur les individus qui ont indiqué ne pas être du tout attachés à leur territoire. Nous cherchons à déterminer leur nombre total et leur proportion par rapport à l’ensemble de l’échantillon.

Affichez le code

donnees_pas_du_tout <- donnees_individu_population %>%
  filter(fleur=="Pas du tout")

# Nombre d'individus qui ne sont «Pas du tout» attachés
nombre_pas_du_tout <- nrow(donnees_pas_du_tout)

# Nombre total d'individus
nombre_total <- nrow(donnees_individu_population)

# Proportion d'individus qui ne sont «Pas du tout» attachés par rapport au total
proportion_pas_du_tout <- nombre_pas_du_tout / nombre_total

# Affichage des résultats
cat("Nombre d'individus qui ne sont «Pas du tout» attachés :", nombre_pas_du_tout, "\n")

Nombre d'individus qui ne sont «Pas du tout» attachés : 16

Affichez le code

cat("Proportion d'individus qui ne sont «Pas du tout» attachés :", round(proportion_pas_du_tout * 100,1), "%\n")

Proportion d'individus qui ne sont «Pas du tout» attachés : 2.9 %

Y a-t-il des modalités significativement surreprésentées ?

Dans cette analyse, nous recherchons des modalités qui sont significativement surreprésentées parmi les individus qui ont indiqué ne pas être du tout attachés à leur territoire, comparativement à l’ensemble de l’échantillon.

Affichez le code

# Création des nouvelles modalités pour les données "pas du tout"
donnees_pas_du_tout_nouveaux <- creation_modalites(donnees_pas_du_tout)

# Initialisation de la liste pour stocker les modalités significativement surreprésentées
liste_modalites_surrepresentees <- list()

# Boucle pour chaque variable socio-démographique
for (variable in variables_socio_demographiques) {
  
  # Filtrage des données "pas du tout" selon la variable actuelle
  if (variable == "profession") {
    donnees_pas_du_tout_filtrees <- filtrer_donnees_initiales(donnees_pas_du_tout, variable)
  } else {
    donnees_pas_du_tout_filtrees <- filtrage_nouveaux_modalités(donnees_pas_du_tout_nouveaux, variable)
  }
  

  # Conversion des données en facteurs
  donnees_pas_du_tout_filtrees <- donnees_pas_du_tout_filtrees %>%
    mutate_all(as.character) %>%
    mutate_all(as.factor)
  
  # Filtrage des données générales selon la variable actuelle
  if (variable == "profession") {
    donnees_filtrees <- filtrer_donnees_initiales(donnees_individu_population, variable)
  } else {
    donnees_filtrees <- filtrage_nouveaux_modalités(donnees_individu_population_nouveaux, variable)
  }

  # Identification des modalités surreprésentées
  modalities_pas_du_tout <- identifier_modalites_surrepresentees(donnees_pas_du_tout_filtrees, donnees_filtrees)
  
  # Ajout des résultats dans la liste
  liste_modalites_surrepresentees[[variable]] <- modalities_pas_du_tout
}

# Affichage des modalités significativement surreprésentées pour chaque variable
print("Modalités significativement surreprésentées parmi ceux qui ne sont «pas du tout» attachés à la Marne :")

[1] "Modalités significativement surreprésentées parmi ceux qui ne sont «pas du tout» attachés à la Marne :"

Affichez le code

for (variable in variables_socio_demographiques) {
  print(paste("Variable :", variable))
  print(liste_modalites_surrepresentees[[variable]])
}

[1] "Variable : age"
$age
# A tibble: 1 × 1
  age            
  <fct>          
1 Moins de 40 ans

[1] "Variable : genre"
$genre
# A tibble: 1 × 1
  genre   
  <fct>   
1 Un homme

[1] "Variable : profession"
$profession
# A tibble: 2 × 1
  profession                                      
  <fct>                                           
1 Personnes sans activité professionnelle ou autre
2 Profession intermédiaire, Employés, Ouvriers    

[1] "Variable : duree_residence"
$duree_residence
# A tibble: 2 × 1
  duree_residence
  <fct>          
1 Moins de 10 ans
2 Plus de 20 ans 

[1] "Variable : PTOT"
$PTOT
# A tibble: 2 × 1
  PTOT           
  <fct>          
1 Villages       
2 Villes moyennes

Si certains désirs sont significativement plus forts pour ces individus, quels mots-images portent-ils le plus ?

Nous allons d’abord examiner les désirs en les comparant avec les données globales. Ensuite, nous nous concentrerons sur les mots-images associés aux désirs qui se révèlent être significativement plus forts pour ces individus.

Affichez le code

# Calculer les statistiques descriptives pertinentes pour chaque désir
data_desirs_pas_du_tout <- donnees_pas_du_tout %>%
  select(age, Enfant, Sens, Harmonie, Inconnu,Instant) %>%
  pivot_longer(cols = -age, names_to = "Desir", values_to = "Valeur") %>%
  mutate(Desir = factor(Desir, levels = c("Enfant", "Sens", "Harmonie", "Inconnu","Instant"))) %>%
  group_by(Desir) %>%
  summarise(
    Moyenne = round(mean(Valeur), digits = 2),
    Mediane = round(median(Valeur), digits = 2),
    EcartType = round(sd(Valeur), digits = 2),
  )

# Créer l'histogramme 
graphique_pasdutout <- ggplot(data_desirs_pas_du_tout, aes(x = Desir, y = Moyenne, fill = "Pas du tout")) +
  geom_bar(stat = "identity") +
  geom_bar(data = data_desirs_moyenne_globale, aes(x = Desir, y = Moyenne, fill = "Global"), stat = "identity", position = "dodge") +
  theme_minimal() +
  guides(fill = guide_legend(title = "Données")) +
  scale_fill_manual(values = c("Pas du tout" = "#185640", "Global" = "lightgray")) +
  theme(legend.position = "bottom") +
  ylim(0, 6)

print(graphique_pasdutout)

Affichez le code

ggsave(filename = "Figures/graphique_pas_du_tout.png", plot = graphique_pasdutout)

Affichez le code

extraire_mots_images(donnees_pas_du_tout, "Données 'pas du tout' attachés")



Résultats pour  Données 'pas du tout' attachés :



Top 5 mots-images pour l'indicateur Enfant :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Enfant </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> souvenirs d’enfance </td>
   <td style="text-align:right;"> 12.55 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> chez moi. ailleurs </td>
   <td style="text-align:right;"> 11.01 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> cabane </td>
   <td style="text-align:right;"> 9.41 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> âme d’enfant </td>
   <td style="text-align:right;"> 3.20 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> île déserte </td>
   <td style="text-align:right;"> 1.06 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Sens :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Sens </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> saut dans le vide </td>
   <td style="text-align:right;"> 12.92 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> vertige existentiel </td>
   <td style="text-align:right;"> 12.00 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> ermitage </td>
   <td style="text-align:right;"> 11.31 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> cellule monacale </td>
   <td style="text-align:right;"> 10.50 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> dépouillement </td>
   <td style="text-align:right;"> 8.77 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Harmonie :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Harmonie </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> dépouillement </td>
   <td style="text-align:right;"> 3.51 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> contrées inhabitées </td>
   <td style="text-align:right;"> 2.20 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> atmosphère irréelle </td>
   <td style="text-align:right;"> 1.98 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> contemplation </td>
   <td style="text-align:right;"> 0.68 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> moment de poésie </td>
   <td style="text-align:right;"> 0.55 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Inconnu :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Inconnu </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> saut dans le vide </td>
   <td style="text-align:right;"> 19.38 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> à contre-courant </td>
   <td style="text-align:right;"> 11.84 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> chez moi. ailleurs </td>
   <td style="text-align:right;"> 11.01 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> contrées inhabitées </td>
   <td style="text-align:right;"> 6.60 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> bout du monde </td>
   <td style="text-align:right;"> 6.53 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Instant :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Instant </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> saut dans le vide </td>
   <td style="text-align:right;"> 12.92 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> chez moi. ailleurs </td>
   <td style="text-align:right;"> 6.61 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> à contre-courant </td>
   <td style="text-align:right;"> 5.07 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> ermitage </td>
   <td style="text-align:right;"> 4.85 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> île déserte </td>
   <td style="text-align:right;"> 2.12 </td>
  </tr>
</tbody>
</table>

Nous allons aussi identifier les individus détracteurs qui sont plus axés sur le sens et ceux qui sont plus attirés par l’inconnu.

Affichez le code

# Identifier les individus axés sur le sens
sens_donnees_pasdutout <- donnees_pas_du_tout %>%
  filter(Sens > Inconnu) 
nrow(sens_donnees_pasdutout)

[1] 5

Affichez le code

# Identifier les individus attirés par l'inconnu
inconnu_donnees_pasdutout <- donnees_pas_du_tout %>%
  filter(Inconnu > Sens) 
nrow(inconnu_donnees_pasdutout)

[1] 11

Affichez le code

# Afficher les mots-images pour chaque groupe
mots_images_sens <- creation_dataframe_mots(sens_donnees_pasdutout$imaginaryTags, metrique_xenia)
mots_images_inconnu <- creation_dataframe_mots(inconnu_donnees_pasdutout$imaginaryTags, metrique_xenia)

# Regroupement des mots-images similaires et calcul des indicateurs désirés
mots_images_sens <- mots_images_sens %>%
  group_by(mots_images) %>%
  summarise(poids_total = sum(poids),
            Sens = round(mean(met_sens) * poids_total, 2)) %>%
  select(mots_images, Sens) %>%
  arrange(desc(Sens)) %>%
  head(5)

mots_images_inconnu <- mots_images_inconnu %>%
  group_by(mots_images) %>%
  summarise(poids_total = sum(poids),
            Inconnu = round(mean(met_inconnu) * poids_total, 2)) %>%
  select(mots_images, Inconnu) %>%
  arrange(desc(Inconnu)) %>%
  head(5)

cat("Individus attirés par le sens :\n")

Individus attirés par le sens :

Affichez le code

print(
mots_images_sens %>%
      kable(booktabs = TRUE, format = "html") %>%
      kable_styling(full_width = FALSE, position = "center")
)

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Sens </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> vertige existentiel </td>
   <td style="text-align:right;"> 12.00 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> ermitage </td>
   <td style="text-align:right;"> 11.31 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> cellule monacale </td>
   <td style="text-align:right;"> 10.50 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> dépouillement </td>
   <td style="text-align:right;"> 4.86 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> retraite </td>
   <td style="text-align:right;"> 2.08 </td>
  </tr>
</tbody>
</table>

Affichez le code

cat("\nIndividus attirés par l'inconnu :\n")


Individus attirés par l'inconnu :

Affichez le code

print(
  mots_images_inconnu %>%
      kable(booktabs = TRUE, format = "html") %>%
      kable_styling(full_width = FALSE, position = "center")
)

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Inconnu </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> saut dans le vide </td>
   <td style="text-align:right;"> 18.69 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> à contre-courant </td>
   <td style="text-align:right;"> 11.03 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> chez moi. ailleurs </td>
   <td style="text-align:right;"> 11.01 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> contrées inhabitées </td>
   <td style="text-align:right;"> 6.60 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> bout du monde </td>
   <td style="text-align:right;"> 6.53 </td>
  </tr>
</tbody>
</table>

5.2 Focus sur les ambassadeurs « passionnément» & « à la folie »

Combien ? En proportion ?

Nous cherchons également à déterminer leur nombre total et leur proportion par rapport à l’ensemble de l’échantillon.

Affichez le code

donnees_tres_attache <- donnees_individu_population %>%
  filter(fleur=="Très attaché")

# Nombre d'individus qui sont « passionnément» & « à la folie » attachés
nombre_tres_attache <- nrow(donnees_tres_attache)

# Nombre total d'individus
nombre_total <- nrow(donnees_individu_population)

# Proportion d'individus qui sont « passionnément» & « à la folie » attachés par rapport au total
proportion_tres_attache <- nombre_tres_attache / nombre_total

# Affichage des résultats
cat("Nombre d'individus qui sont « très attachés» :", nombre_tres_attache, "\n")

Nombre d'individus qui sont « très attachés» : 119

Affichez le code

cat("Proportion d'individus qui sont « très attachés» :", round(proportion_tres_attache * 100,1), "%\n")

Proportion d'individus qui sont « très attachés» : 21.5 %

Y a-t-il des modalités significativement surreprésentées ?

Dans cette analyse, nous recherchons des modalités qui sont significativement surreprésentées parmi ces individus , comparativement à l’ensemble de l’échantillon.

Affichez le code

# Création des nouvelles modalités pour les données « passionnément » et « à la folie » attachés
donnees_tres_attache_nouveaux <- creation_modalites(donnees_tres_attache)

# Initialisation de la liste pour stocker les modalités significativement surreprésentées
liste_modalites_surrepresentees <- list()

# Boucle pour chaque variable socio-démographique
for (variable in variables_socio_demographiques) {
  
  # Filtrage des données "très attachés" selon la variable actuelle
  if (variable == "profession") {
    donnees_tres_attache_filtrees <- filtrer_donnees_initiales(donnees_tres_attache, variable)
  } else {
    donnees_tres_attache_filtrees <- filtrage_nouveaux_modalités(donnees_tres_attache_nouveaux, variable)
  }
  

  # Conversion des données en facteurs
  donnees_tres_attache_filtrees <- donnees_tres_attache_filtrees %>%
    mutate_all(as.character) %>%
    mutate_all(as.factor)
  
  # Filtrage des données générales selon la variable actuelle
  if (variable == "profession") {
    donnees_filtrees <- filtrer_donnees_initiales(donnees_individu_population, variable)
  } else {
    donnees_filtrees <- filtrage_nouveaux_modalités(donnees_individu_population_nouveaux, variable)
  }
  

  # Conversion des données filtrées en facteurs (si nécessaire)
  donnees_filtrees <- donnees_filtrees %>%
    mutate_all(as.character) %>%
    mutate_all(as.factor)
  
  # Identification des modalités surreprésentées
  modalities_tres_attaches <- identifier_modalites_surrepresentees(donnees_tres_attache_filtrees, donnees_filtrees)
  
  # Ajout des résultats dans la liste
  liste_modalites_surrepresentees[[variable]] <- modalities_tres_attaches
}

# Affichage des modalités significativement surreprésentées pour chaque variable
print("Modalités significativement surreprésentées parmi ceux qui sont très attachés à la Marne :")

[1] "Modalités significativement surreprésentées parmi ceux qui sont très attachés à la Marne :"

Affichez le code

for (variable in variables_socio_demographiques) {
  print(paste("Variable :", variable))
  print(liste_modalites_surrepresentees[[variable]])
}

[1] "Variable : age"
$age
# A tibble: 1 × 1
  age               
  <fct>             
1 Entre 41 et 65 ans

[1] "Variable : genre"
$genre
# A tibble: 1 × 1
  genre   
  <fct>   
1 Un homme

[1] "Variable : profession"
$profession
# A tibble: 1 × 1
  profession                                                   
  <fct>                                                        
1 Cadres, Chef d'entreprise, Profession libérale et Commerçants

[1] "Variable : duree_residence"
$duree_residence
# A tibble: 1 × 1
  duree_residence
  <fct>          
1 Natifs         

[1] "Variable : PTOT"
$PTOT
# A tibble: 2 × 1
  PTOT          
  <fct>         
1 Petites villes
2 Villages

Si certains désirs sont significativement plus forts pour ces individus, quels mots-images portent-ils le plus ?

Affichez le code

# Calculer les statistiques descriptives pertinentes pour chaque désir
desirs_data_tres_attache <- donnees_tres_attache %>%
  select(age, Enfant, Sens, Harmonie, Inconnu,Instant) %>%
  pivot_longer(cols = -age, names_to = "Desir", values_to = "Valeur") %>%
  mutate(Desir = factor(Desir, levels = c("Enfant", "Sens", "Harmonie", "Inconnu","Instant"))) %>%
  group_by(Desir) %>%
  summarise(
    Moyenne = round(mean(Valeur), digits = 2),
    Mediane = round(median(Valeur), digits = 2),
    EcartType = round(sd(Valeur), digits = 2),
  )

# Créer l'histogramme 
graphique_tresattaches <- ggplot(desirs_data_tres_attache, aes(x = Desir, y = Moyenne, fill = "Tres attaches")) +
  geom_bar(stat = "identity") +
  geom_bar(data = data_desirs_moyenne_globale, aes(x = Desir, y = Moyenne, fill = "Global"), stat = "identity", position = "dodge") +
  theme_minimal() +
  guides(fill = guide_legend(title = "Données")) +
  scale_fill_manual(values = c("Tres attaches" = "#185640", "Global" = "lightgray")) +
  theme(legend.position = "bottom") + 
  ylim(0,6)

print(graphique_tresattaches)

Affichez le code

ggsave(filename = "Figures/graphique_tres_attaches.png", plot = graphique_tresattaches)

Affichez le code

extraire_mots_images(donnees_tres_attache, "Données 'trés attachés'")



Résultats pour  Données 'trés attachés' :



Top 5 mots-images pour l'indicateur Enfant :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Enfant </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> souvenirs d’enfance </td>
   <td style="text-align:right;"> 81.66 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> grande maison joyeuse </td>
   <td style="text-align:right;"> 29.06 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> petit coin de paradis </td>
   <td style="text-align:right;"> 28.73 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> petit nid douillet </td>
   <td style="text-align:right;"> 27.52 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> chez moi. ailleurs </td>
   <td style="text-align:right;"> 24.74 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Sens :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Sens </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> au rythme de la nature </td>
   <td style="text-align:right;"> 29.75 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> retour à l’essentiel </td>
   <td style="text-align:right;"> 23.30 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> montagne sacrée </td>
   <td style="text-align:right;"> 19.84 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> retraite </td>
   <td style="text-align:right;"> 12.98 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> ressourcement </td>
   <td style="text-align:right;"> 12.75 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Harmonie :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Harmonie </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> petit coin de paradis </td>
   <td style="text-align:right;"> 43.09 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> respire l’élégance </td>
   <td style="text-align:right;"> 39.70 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> écrin de verdure </td>
   <td style="text-align:right;"> 31.79 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> au rythme de la nature </td>
   <td style="text-align:right;"> 19.83 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> joyau caché </td>
   <td style="text-align:right;"> 18.65 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Inconnu :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Inconnu </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> chez moi. ailleurs </td>
   <td style="text-align:right;"> 24.74 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> hasard des rencontres </td>
   <td style="text-align:right;"> 24.42 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> part de mystère </td>
   <td style="text-align:right;"> 21.79 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> voyage dans le temps </td>
   <td style="text-align:right;"> 19.10 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> exploration </td>
   <td style="text-align:right;"> 16.88 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Instant :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Instant </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> au rythme de la nature </td>
   <td style="text-align:right;"> 59.50 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> papilles émoustillées </td>
   <td style="text-align:right;"> 43.81 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> petit coin de paradis </td>
   <td style="text-align:right;"> 43.09 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> écrin de verdure </td>
   <td style="text-align:right;"> 39.74 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> temps libre pour respirer </td>
   <td style="text-align:right;"> 37.10 </td>
  </tr>
</tbody>
</table>

Nous allons aussi identifier les individus détracteurs qui sont plus axés sur l’harmonie et ceux qui sont plus attirés par l’instant.

Affichez le code

# Identifier les individus axés sur l'harmonie
harmonie_donnees_tresattaches <- donnees_tres_attache %>%
  filter(Harmonie > Instant) 
nrow(harmonie_donnees_tresattaches)

[1] 16

Affichez le code

# Identifier les individus attirés par l'instant
instant_donnees_tresattaches <- donnees_tres_attache %>%
  filter(Instant > Harmonie) 
nrow(instant_donnees_tresattaches)

[1] 103

Affichez le code

# Afficher les mots-images pour chaque groupe
mots_images_harmonie <- creation_dataframe_mots(harmonie_donnees_tresattaches$imaginaryTags, metrique_xenia)
mots_images_instant <- creation_dataframe_mots(instant_donnees_tresattaches$imaginaryTags, metrique_xenia)

# Regroupement des mots-images similaires et calcul des indicateurs désirés
mots_images_harmonie <- mots_images_harmonie %>%
  group_by(mots_images) %>%
  summarise(poids_total = sum(poids),
            Harmonie = round(mean(met_harmonie) * poids_total, 2)) %>%
  select(mots_images, Harmonie) %>%
  arrange(desc(Harmonie))  %>%
  head(5)

mots_images_instant <- mots_images_instant %>%
  group_by(mots_images) %>%
  summarise(poids_total = sum(poids),
            Instant = round(mean(met_instant) * poids_total, 2)) %>%
  select(mots_images, Instant) %>%
  arrange(desc(Instant))  %>%
  head(5)

cat("Individus attirés par l'harmonie :\n")

Individus attirés par l'harmonie :

Affichez le code

print(
  mots_images_harmonie %>%
      kable(booktabs = TRUE, format = "html") %>%
      kable_styling(full_width = FALSE, position = "center")
)

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Harmonie </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> étoiles plein les yeux </td>
   <td style="text-align:right;"> 11.64 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> respire l’élégance </td>
   <td style="text-align:right;"> 11.53 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> joyau caché </td>
   <td style="text-align:right;"> 8.59 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> beauté rayonnante </td>
   <td style="text-align:right;"> 7.25 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> moment de poésie </td>
   <td style="text-align:right;"> 6.21 </td>
  </tr>
</tbody>
</table>

Affichez le code

cat("\nIndividus attirés par l'isntant :\n")


Individus attirés par l'isntant :

Affichez le code

print(
  mots_images_instant %>%
      kable(booktabs = TRUE, format = "html") %>%
      kable_styling(full_width = FALSE, position = "center")
)

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Instant </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> au rythme de la nature </td>
   <td style="text-align:right;"> 55.77 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> papilles émoustillées </td>
   <td style="text-align:right;"> 42.97 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> petit coin de paradis </td>
   <td style="text-align:right;"> 41.71 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> temps libre pour respirer </td>
   <td style="text-align:right;"> 35.12 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> écrin de verdure </td>
   <td style="text-align:right;"> 34.72 </td>
  </tr>
</tbody>
</table>

6 Les 3 profils dominants

Taille les clusters (nb d’individus et proportion de l’échantillon)

Affichez le code

# Nombre d'individus dans le cluster 1
nb_individus_cluster1 <- nrow(individu_cluster1)
# Proportion de l'échantillon représentée par le cluster 1
prop_cluster1 <- nb_individus_cluster1 / nrow(donnees_individu_population)

# Nombre d'individus dans le cluster 2
nb_individus_cluster2 <- nrow(individu_cluster2)
# Proportion de l'échantillon représentée par le cluster 2
prop_cluster2 <- nb_individus_cluster2 / nrow(donnees_individu_population)

# Nombre d'individus dans le cluster 3
nb_individus_cluster3 <- nrow(individu_cluster3)
# Proportion de l'échantillon représentée par le cluster 3
prop_cluster3 <- nb_individus_cluster3 / nrow(donnees_individu_population)

# Calcul des proportions en pourcentage
prop_cluster1_percent <- round(prop_cluster1 * 100, 1)
prop_cluster2_percent <- round(prop_cluster2 * 100, 1)
prop_cluster3_percent <- round(prop_cluster3 * 100, 1)

# Affichage des résultats
cat("Cluster 1 : Nombre d'individus =", nb_individus_cluster1, ", Proportion de l'échantillon =", prop_cluster1_percent, "%\n")

Cluster 1 : Nombre d'individus = 188 , Proportion de l'échantillon = 33.9 %

Affichez le code

cat("Cluster 2 : Nombre d'individus =", nb_individus_cluster2, ", Proportion de l'échantillon =", prop_cluster2_percent, "%\n")

Cluster 2 : Nombre d'individus = 293 , Proportion de l'échantillon = 52.9 %

Affichez le code

cat("Cluster 3 : Nombre d'individus =", nb_individus_cluster3, ", Proportion de l'échantillon =", prop_cluster3_percent, "%\n")

Cluster 3 : Nombre d'individus = 73 , Proportion de l'échantillon = 13.2 %

Affichez le code

# Création des données pour la taille des clusters
cluster_sizes <- data.frame(Cluster = c("Cluster 1", "Cluster 2", "Cluster 3"),
                            Taille = c(nrow(individu_cluster1), nrow(individu_cluster2), nrow(individu_cluster3)))

# Calcul de la proportion de chaque cluster
total_population <- sum(cluster_sizes$Taille)
cluster_sizes$Proportion <- cluster_sizes$Taille / total_population * 100

# Histogramme pour la taille des clusters
histogram_cluster_size <- ggplot(cluster_sizes, aes(x = Cluster, y = Taille, fill = Cluster)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = Taille), vjust = -0.5, size = 4) +
  labs(title = "Nombre d'individus",
       x = "Cluster",
       y = "Nombre d'individus") +
  scale_fill_manual(values = c("Cluster 1" = "grey", "Cluster 2" = "skyblue", "Cluster 3" = "lightpink")) +
  theme_minimal()  +
    guides(fill = FALSE) 

# Diagramme circulaire pour la proportion des clusters
pie_chart_cluster_size <- ggplot(cluster_sizes, aes(x = "", y = Proportion, fill = Cluster)) +
  geom_bar(stat = "identity", width = 1) +
  geom_text(aes(label = paste(round(Proportion, 1), "%")), position = position_stack(vjust = 0.5), size = 4) +
  coord_polar("y", start = 0) +
  labs(title = "Proportion de l'échantillon") +
  theme_void() +
  scale_fill_manual(values = c("Cluster 1" = "grey", "Cluster 2" = "skyblue", "Cluster 3" = "lightpink")) +
  theme(legend.position = "right")

# Affichage des graphiques
print(histogram_cluster_size)

Affichez le code

print(pie_chart_cluster_size)

Histogramme des désirs des 3 profils et comparaison avec ceux de l’échantillon global

Affichez le code

# Fonction pour calculer les statistiques descriptives
calculate_desirs_stats <- function(cluster_data, type) {
  desirs_data <- cluster_data %>%
    select(Enfant, Sens, Harmonie, Inconnu, Instant) %>%
    pivot_longer(cols = everything(), names_to = "Desir", values_to = "Valeur") %>%
    mutate(Desir = factor(Desir, levels = c("Enfant", "Sens", "Harmonie", "Inconnu", "Instant")),
           Type = type) %>%
    group_by(Desir, Type) %>%
    summarise(
      Moyenne = round(mean(Valeur), digits = 2),
      Mediane = round(median(Valeur), digits = 2),
      EcartType = round(sd(Valeur), digits = 2)
    )
  return(desirs_data)
}

# Données pour chaque cluster
cluster1_data <- calculate_desirs_stats(individu_cluster1, "Cluster 1")
cluster2_data <- calculate_desirs_stats(individu_cluster2, "Cluster 2")
cluster3_data <- calculate_desirs_stats(individu_cluster3, "Cluster 3")

# Données globales
global_data <- donnees_individu_population %>%
  select(Enfant, Sens, Harmonie, Inconnu, Instant) %>%
  pivot_longer(cols = everything(), names_to = "Desir", values_to = "Valeur") %>%
  mutate(Desir = factor(Desir, levels = c("Enfant", "Sens", "Harmonie", "Inconnu", "Instant")),
         Type = "Global") %>%
  group_by(Desir, Type) %>%
  summarise(
    Moyenne = round(mean(Valeur), digits = 2),
    Mediane = round(median(Valeur), digits = 2),
    EcartType = round(sd(Valeur), digits = 2)
  )

# Fonction pour créer l'histogramme pour un cluster spécifique
create_desir_histogram <- function(cluster_data, global_data, cluster_name) {
  merged_data <- bind_rows(cluster_data, global_data)
  
  histogram <- ggplot(merged_data, aes(x = Desir, y = Moyenne, fill = Type)) +
    geom_bar(stat = "identity", position = position_dodge(width = 0.9)) +
    geom_text(aes(label = Moyenne), position = position_dodge(width = 0.9), vjust = -0.5, size = 3) +
    labs(title = paste("Histogramme des désirs -", cluster_name)) +
    theme_minimal() +
    theme(legend.position = "none") +
    scale_fill_manual(values = c("Cluster 1" = "black", "Cluster 2" = "skyblue", "Cluster 3" = "lightpink", "Global" = "grey")) +
    ylim(0,7)
  
  return(histogram)
}

# Création des histogrammes pour chaque cluster
histogram_cluster1 <- create_desir_histogram(cluster1_data, global_data, "Cluster 1")
histogram_cluster2 <- create_desir_histogram(cluster2_data, global_data, "Cluster 2")
histogram_cluster3 <- create_desir_histogram(cluster3_data, global_data, "Cluster 3")

# Affichage des histogrammes
grid.arrange(histogram_cluster1, histogram_cluster2, histogram_cluster3, nrow = 1)

Affichez le code

# Fonction pour calculer les statistiques descriptives pour chaque cluster
calculate_desirs_stats <- function(cluster_data) {
  desirs_data <- cluster_data %>%
    select(Enfant, Sens, Harmonie, Inconnu, Instant) %>%
    pivot_longer(cols = everything(), names_to = "Desir", values_to = "Valeur") %>%
    mutate(Desir = factor(Desir, levels = c("Enfant", "Sens", "Harmonie", "Inconnu", "Instant"))) %>%
    group_by(Desir) %>%
    summarise(
      Moyenne = round(mean(Valeur), digits = 2),
      Mediane = round(median(Valeur), digits = 2),
      EcartType = round(sd(Valeur), digits = 2)
    )
  return(desirs_data)
}

# Fonction pour créer un histogramme des désirs pour chaque profil avec comparaison à l'échantillon global
plot_desirs_comparison <- function(cluster1_data, cluster2_data, cluster3_data, global_data) {
  
  # Calcul des statistiques descriptives pour chaque cluster
  desirs_data_cluster1 <- calculate_desirs_stats(cluster1_data)
  desirs_data_cluster2 <- calculate_desirs_stats(cluster2_data)
  desirs_data_cluster3 <- calculate_desirs_stats(cluster3_data)
  desirs_data_global <- calculate_desirs_stats(global_data)
  
  # Création des histogrammes pour chaque cluster
  hist_cluster1 <- ggplot(desirs_data_cluster1, aes(x = Desir, y = Moyenne, fill = "Cluster 1")) +
    geom_bar(stat = "identity") +
    labs(title = "Histogramme des désirs - Cluster 1 (Enfant)") +
    geom_bar(data = desirs_data_global, aes(x = Desir, y = Moyenne, fill = "Global"), stat = "identity", position = "dodge") +
    theme_minimal() +
    guides(fill = guide_legend(title = "Données")) +
    scale_fill_manual(values = c("Cluster 1" = "black", "Global" = "lightgray")) +
    theme(legend.position = "bottom") +
    ylim(0,7)

  hist_cluster2 <- ggplot(desirs_data_cluster2, aes(x = Desir, y = Moyenne, fill = "Cluster 2")) +
    geom_bar(stat = "identity") +
    labs(title = "Histogramme des désirs - Cluster 2 (Instant/Harmonie)") +
    geom_bar(data = desirs_data_global, aes(x = Desir, y = Moyenne, fill = "Global"), stat = "identity", position = "dodge") +
    theme_minimal() +
    guides(fill = guide_legend(title = "Données")) +
    scale_fill_manual(values = c("Cluster 2" = "skyblue", "Global" = "lightgray")) +
    theme(legend.position = "bottom") +
    ylim(0,7)

  hist_cluster3 <- ggplot(desirs_data_cluster3, aes(x = Desir, y = Moyenne, fill = "Cluster 3")) +
    geom_bar(stat = "identity") +
    labs(title = "Histogramme des désirs - Cluster 3 (Sens/Inconnu)") +
    geom_bar(data = desirs_data_global, aes(x = Desir, y = Moyenne, fill = "Global"), stat = "identity", position = "dodge") +
    theme_minimal() +
    guides(fill = guide_legend(title = "Données")) +
    scale_fill_manual(values = c("Cluster 3" = "lightpink", "Global" = "lightgray")) +
    theme(legend.position = "bottom") +
    ylim(0,7)

  # Affichage des histogrammes
  grid.arrange(hist_cluster1, hist_cluster2, hist_cluster3, nrow = 1)
}

# Utilisation de la fonction avec vos données
plot_desirs_comparison(individu_cluster1, individu_cluster2, individu_cluster3, donnees_individu_population)

Histogramme des degrés d’attachement par profil et comparaison avec ceux de l’échantillon global

Affichez le code

# Fonction pour calculer les pourcentages par profil
calculate_attachment_percentages <- function(cluster_data, type) {
  attachment_data <- cluster_data %>%
    select(fleur)
  
  attachment_data <- table(attachment_data)
  attachment_data <- round(prop.table(attachment_data) * 100,1)
  attachment_data <- as.data.frame(attachment_data)
  colnames(attachment_data) <- c("Fleur", "Pourcentage")
  attachment_data$Type <- type 

  return(attachment_data)
}

# Fonction pour créer l'histogramme pour un cluster spécifique
create_attachment_histogram <- function(cluster_data, global_data, cluster_name) {
  merged_data <- bind_rows(cluster_data, global_data)
  
  histogram <- ggplot(merged_data, aes(x = Fleur, y = Pourcentage, fill = Type)) +
    geom_bar(stat = "identity", position = position_dodge(width = 0.9)) +
    geom_text(aes(label = round(Pourcentage, 2)), position = position_dodge(width = 0.9), vjust = -0.5, size = 3) +
    labs(title = paste("Histogramme des degrés d'attachement -", cluster_name)) +
    theme_minimal() +
    theme(legend.position = "none") +
    scale_fill_manual(values = c("Cluster 1" = "black", "Cluster 2" = "skyblue", "Cluster 3" = "lightpink", "Global" = "grey"))  +
    ylim(0,70)
  
  return(histogram)
}

# Calcul des pourcentages d'attachement pour chaque cluster
attachment_cluster1 <- calculate_attachment_percentages(individu_cluster1, "Cluster 1")
attachment_cluster2 <- calculate_attachment_percentages(individu_cluster2, "Cluster 2")
attachment_cluster3 <- calculate_attachment_percentages(individu_cluster3, "Cluster 3")

# Données globales
global_attachment_data <- donnees_individu_population %>%
  select(fleur)


  global_attachment_data <- table(global_attachment_data)
  global_attachment_data <- round(prop.table(global_attachment_data) * 100,1)
  global_attachment_data <- as.data.frame(global_attachment_data)
  colnames(global_attachment_data) <- c("Fleur", "Pourcentage")
  global_attachment_data$Type <- "Global"

# Création des histogrammes pour chaque cluster
histogram_cluster1_attachment <- create_attachment_histogram(attachment_cluster1, global_attachment_data, "Cluster 1")
histogram_cluster2_attachment <- create_attachment_histogram(attachment_cluster2, global_attachment_data, "Cluster 2")
histogram_cluster3_attachment <- create_attachment_histogram(attachment_cluster3, global_attachment_data, "Cluster 3")

# Affichage des histogrammes
grid.arrange(histogram_cluster1_attachment, histogram_cluster2_attachment, histogram_cluster3_attachment, nrow = 1)

Affichez le code

# Fonction pour calculer les pourcentages par profil pour les degrés d'attachement
calculate_attachment_percentages <- function(cluster_data, type) {
  attachment_data <- cluster_data %>%
    select(fleur)
  
  attachment_data <- table(attachment_data)
  attachment_data <- prop.table(attachment_data) * 100
  attachment_data <- as.data.frame(attachment_data)
  colnames(attachment_data) <- c("Fleur", "Pourcentage")
  attachment_data$Type <- type 

  return(attachment_data)
}

# Fonction pour créer un histogramme des degrés d'attachement pour chaque profil avec comparaison à l'échantillon global
plot_attachment_comparison <- function(cluster1_data, cluster2_data, cluster3_data, global_data) {
  
  # Calcul des pourcentages d'attachement pour chaque cluster
  attachment_cluster1 <- calculate_attachment_percentages(cluster1_data, "Cluster 1")
  attachment_cluster2 <- calculate_attachment_percentages(cluster2_data, "Cluster 2")
  attachment_cluster3 <- calculate_attachment_percentages(cluster3_data, "Cluster 3")
  attachment_global <- calculate_attachment_percentages(global_data, "Global")
  
  # Création des histogrammes pour chaque cluster
  hist_cluster1 <- ggplot() +
    geom_bar(data = attachment_cluster1, aes(x = Fleur, y = Pourcentage, fill = Type), stat = "identity", position = "dodge") +
    geom_bar(data = attachment_global, aes(x = Fleur, y = Pourcentage, fill = Type), stat = "identity", position = "dodge", alpha = 1) +
    labs(title = "Histogramme des degrés d'attachement - Cluster 1 (Enfant)") +
    scale_fill_manual(values = c("Cluster 1" = "black", "Global" = "lightgray"), guide = FALSE) +
    theme_minimal() +
    theme(legend.position = "bottom")  +
    ylim(0,70)
  
  hist_cluster2 <- ggplot() +
    geom_bar(data = attachment_cluster2, aes(x = Fleur, y = Pourcentage, fill = Type), stat = "identity", position = "dodge") +
    geom_bar(data = attachment_global, aes(x = Fleur, y = Pourcentage, fill = Type), stat = "identity", position = "dodge", alpha = 1) +
    labs(title = "Histogramme des degrés d'attachement - Cluster 2 (Instant/Harmonie)") +
    scale_fill_manual(values = c("Cluster 2" = "skyblue", "Global" = "lightgray"), guide = FALSE) +
    theme_minimal() +
    theme(legend.position = "bottom")  +
    ylim(0,70)
  
  hist_cluster3 <- ggplot() +
    geom_bar(data = attachment_cluster3, aes(x = Fleur, y = Pourcentage, fill = Type), stat = "identity", position = "dodge") +
    geom_bar(data = attachment_global, aes(x = Fleur, y = Pourcentage, fill = Type), stat = "identity", position = "dodge", alpha = 1) +
    labs(title = "Histogramme des degrés d'attachement - Cluster 3 (Sens/Inconnu)") +
    scale_fill_manual(values = c("Cluster 3" = "lightpink", "Global" = "lightgray"), guide = FALSE) +
    theme_minimal() +
    theme(legend.position = "bottom")  +
    ylim(0,70)
  
  # Affichage des histogrammes
  grid.arrange(hist_cluster1, hist_cluster2, hist_cluster3, nrow = 1)
}

# Utilisation de la fonction avec vos données
plot_attachment_comparison(individu_cluster1, individu_cluster2, individu_cluster3, donnees_individu_population)

Y a-t-il des modalités surreprésentées pour chaque profil ? Lesquelles?

Affichez le code

# Initialisation de la liste pour stocker les modalités significativement surreprésentées
liste_modalites_surrepresentees_cluster1 <- list()
liste_modalites_surrepresentees_cluster2 <- list()
liste_modalites_surrepresentees_cluster3 <- list()

# Utilisation de la fonction avec vos données pour chaque profil
for (variable in variables_socio_demographiques) {
  
  if (variable == "profession") {
  donnees_cluster1_filtrees <- filtrer_donnees_initiales(individu_cluster1, variable)
  donnees_cluster2_filtrees <- filtrer_donnees_initiales(individu_cluster2, variable)
  donnees_cluster3_filtrees <- filtrer_donnees_initiales(individu_cluster3, variable)
  } else {
    donnees_cluster1_filtrees <- filtrage_nouveaux_modalités(creation_modalites(individu_cluster1), variable)
    donnees_cluster2_filtrees <- filtrage_nouveaux_modalités(creation_modalites(individu_cluster2), variable)
    donnees_cluster3_filtrees <- filtrage_nouveaux_modalités(creation_modalites(individu_cluster3), variable)
  }

  
  
  # Conversion des données en facteurs
  donnees_cluster1_filtrees <- donnees_cluster1_filtrees %>%
    mutate_all(as.character) %>%
    mutate_all(as.factor)
  
  donnees_cluster2_filtrees <- donnees_cluster2_filtrees %>%
    mutate_all(as.character) %>%
    mutate_all(as.factor)
  
  donnees_cluster3_filtrees <- donnees_cluster3_filtrees %>%
    mutate_all(as.character) %>%
    mutate_all(as.factor)
  
  # Filtrage des données générales selon la variable actuelle
  if (variable == "profession") {
    donnees_filtrees <- filtrer_donnees_initiales(donnees_individu_population, variable)
  } else {
    donnees_filtrees <- filtrage_nouveaux_modalités(donnees_individu_population_nouveaux, variable)
  }
  

  # Conversion des données filtrées en facteurs (si nécessaire)
  donnees_filtrees <- donnees_filtrees %>%
    mutate_all(as.character) %>%
    mutate_all(as.factor)
  
  # Identification des modalités surreprésentées
  modalities_cluster1 <- identifier_modalites_surrepresentees(donnees_cluster1_filtrees, donnees_filtrees)
  modalities_cluster2 <- identifier_modalites_surrepresentees(donnees_cluster2_filtrees, donnees_filtrees)
  modalities_cluster3 <- identifier_modalites_surrepresentees(donnees_cluster3_filtrees, donnees_filtrees)
  
  # Ajout des résultats dans les listes respectives
  liste_modalites_surrepresentees_cluster1[[variable]] <- modalities_cluster1
  liste_modalites_surrepresentees_cluster2[[variable]] <- modalities_cluster2
  liste_modalites_surrepresentees_cluster3[[variable]] <- modalities_cluster3
}

Affichez le code

cat("Modalités surreprésentées dans le cluster 1 :\n")

Modalités surreprésentées dans le cluster 1 :

Affichez le code

for (variable in variables_socio_demographiques) {
  cat(paste("Variable :", variable, "\n"))
  print(liste_modalites_surrepresentees_cluster1[[variable]])
}

Variable : age 
$age
# A tibble: 1 × 1
  age               
  <fct>             
1 Entre 41 et 65 ans

Variable : genre 
$genre
# A tibble: 1 × 1
  genre    
  <fct>    
1 Une femme

Variable : profession 
$profession
# A tibble: 2 × 1
  profession                                  
  <fct>                                       
1 Profession intermédiaire, Employés, Ouvriers
2 Retraité                                    

Variable : duree_residence 
$duree_residence
# A tibble: 1 × 1
  duree_residence
  <fct>          
1 Natifs         

Variable : PTOT 
$PTOT
# A tibble: 1 × 1
  PTOT          
  <fct>         
1 Petites villes

Affichez le code

cat("Modalités surreprésentées dans le cluster 2 :\n")

Modalités surreprésentées dans le cluster 2 :

Affichez le code

for (variable in variables_socio_demographiques) {
  cat(paste("Variable :", variable, "\n"))
  print(liste_modalites_surrepresentees_cluster2[[variable]])
}

Variable : age 
$age
# A tibble: 1 × 1
  age           
  <fct>         
1 Plus de 66 ans

Variable : genre 
$genre
# A tibble: 0 × 1
# ℹ 1 variable: genre <fct>

Variable : profession 
$profession
# A tibble: 2 × 1
  profession                                                   
  <fct>                                                        
1 Agriculteurs, Artisans                                       
2 Cadres, Chef d'entreprise, Profession libérale et Commerçants

Variable : duree_residence 
$duree_residence
# A tibble: 2 × 1
  duree_residence   
  <fct>             
1 Entre 10 et 19 ans
2 Plus de 20 ans    

Variable : PTOT 
$PTOT
# A tibble: 2 × 1
  PTOT              
  <fct>             
1 Villages          
2 Villes importantes

Affichez le code

cat("Modalités surreprésentées dans le cluster 3 :\n")

Modalités surreprésentées dans le cluster 3 :

Affichez le code

for (variable in variables_socio_demographiques) {
  cat(paste("Variable :", variable, "\n"))
  print(liste_modalites_surrepresentees_cluster3[[variable]])
}

Variable : age 
$age
# A tibble: 1 × 1
  age            
  <fct>          
1 Moins de 40 ans

Variable : genre 
$genre
# A tibble: 1 × 1
  genre   
  <fct>   
1 Un homme

Variable : profession 
$profession
# A tibble: 2 × 1
  profession                                      
  <fct>                                           
1 Personnes sans activité professionnelle ou autre
2 Profession intermédiaire, Employés, Ouvriers    

Variable : duree_residence 
$duree_residence
# A tibble: 3 × 1
  duree_residence   
  <fct>             
1 Entre 10 et 19 ans
2 Moins de 10 ans   
3 Plus de 20 ans    

Variable : PTOT 
$PTOT
# A tibble: 2 × 1
  PTOT           
  <fct>          
1 Petites villes 
2 Villes moyennes

Mots-images les plus forts par (profil & souffle de désir), en distinguant ceux qui émanent des pas du tout attachés et des extrêmement attachés

Affichez le code

# Définition de la fonction pour générer les tableaux reactable
generer_tableau_react <- function(resultats, desir_type) {
  # Création du tableau pour le groupe "pas du tout" attaché
  tableau_pas_du_tout <- reactable(resultats$pas_du_tout,
                                   defaultPageSize = 5,
                                   columns = list(poids_pas_du_tout = colDef(align = "right")))
  
  # Création du tableau pour le groupe "très attaché"
  tableau_tres_attache <- reactable(resultats$tres,
                                    defaultPageSize = 5,
                                    columns = list(poids_tres_attache = colDef(align = "right")))
  
  # Affichage des tableaux côte à côte
  tagList(
    div(class = "row",
        div(class = "col-md-6", tableau_pas_du_tout),
        div(class = "col-md-6", tableau_tres_attache))
  )
}

# Appliquer la fonction pour chaque cluster
resultats_cluster1 <- extraire_mots_images_DegresFleur(individu_cluster1, "Enfant")
resultats_cluster2_instant <- extraire_mots_images_DegresFleur(individu_cluster2, "Instant")
resultats_cluster2_harmonie <- extraire_mots_images_DegresFleur(individu_cluster2, "Harmonie")
resultats_cluster3_inconnu <- extraire_mots_images_DegresFleur(individu_cluster3, "Inconnu")
resultats_cluster3_sens <- extraire_mots_images_DegresFleur(individu_cluster3, "Sens")

# Visualisation des résultats pour chaque cluster
print("Cluster 1:")

[1] "Cluster 1:"

Affichez le code

print(generer_tableau_react(resultats_cluster1, "Enfant"))

<div class="row">
  <div class="col-md-6">
    <div class="reactable html-widget html-fill-item" id="htmlwidget-aab3bd3b6ea7a8e9bd38" style="width:auto;height:auto;"></div>
    <script type="application/json" data-for="htmlwidget-aab3bd3b6ea7a8e9bd38">{"x":{"tag":{"name":"Reactable","attribs":{"data":{"mots_images":["cabane","chez moi. ailleurs","souvenirs d’enfance","âme d’enfant","tête dans les nuages"],"poids_pas_du_tout":[9,7.5,6.86,3.2,0.6]},"columns":[{"id":"mots_images","name":"mots_images","type":"character"},{"id":"poids_pas_du_tout","name":"poids_pas_du_tout","type":"numeric","align":"right"}],"defaultPageSize":5,"dataKey":"664522b23d6c96464c38de390e8d9eb6"},"children":[]},"class":"reactR_markup"},"evals":[],"jsHooks":[]}</script>
  </div>
  <div class="col-md-6">
    <div class="reactable html-widget html-fill-item" id="htmlwidget-637b911b6d8e654ee0be" style="width:auto;height:auto;"></div>
    <script type="application/json" data-for="htmlwidget-637b911b6d8e654ee0be">{"x":{"tag":{"name":"Reactable","attribs":{"data":{"mots_images":["souvenirs d’enfance","grande maison joyeuse","chez moi. ailleurs","âme d’enfant","petit nid douillet"],"poids_tres_attache":[58.6,17.76,17.63,16.97,12.73]},"columns":[{"id":"mots_images","name":"mots_images","type":"character"},{"id":"poids_tres_attache","name":"poids_tres_attache","type":"numeric","align":"right"}],"defaultPageSize":5,"dataKey":"5d0f1045cfac14993a4d5ef30c38f16f"},"children":[]},"class":"reactR_markup"},"evals":[],"jsHooks":[]}</script>
  </div>
</div>

Affichez le code

print("Cluster 2 - Instant:")

[1] "Cluster 2 - Instant:"

Affichez le code

print(generer_tableau_react(resultats_cluster2_instant, "Instant"))

<div class="row">
  <div class="col-md-6">
    <div class="reactable html-widget html-fill-item" id="htmlwidget-031d273518b2ad6f96a6" style="width:auto;height:auto;"></div>
    <script type="application/json" data-for="htmlwidget-031d273518b2ad6f96a6">{"x":{"tag":{"name":"Reactable","attribs":{"data":{"mots_images":["dans une bulle","au rythme de la nature","temps libre pour respirer","temps suspendu","contemplation"],"poids_pas_du_tout":[0.95,0.82,0.72,0.61,0.55]},"columns":[{"id":"mots_images","name":"mots_images","type":"character"},{"id":"poids_pas_du_tout","name":"poids_pas_du_tout","type":"numeric","align":"right"}],"defaultPageSize":5,"dataKey":"1e2b12ae5782c2d03d113e733f5f6715"},"children":[]},"class":"reactR_markup"},"evals":[],"jsHooks":[]}</script>
  </div>
  <div class="col-md-6">
    <div class="reactable html-widget html-fill-item" id="htmlwidget-dc2760c18646258247ae" style="width:auto;height:auto;"></div>
    <script type="application/json" data-for="htmlwidget-dc2760c18646258247ae">{"x":{"tag":{"name":"Reactable","attribs":{"data":{"mots_images":["au rythme de la nature","papilles émoustillées","écrin de verdure","petit coin de paradis","temps libre pour respirer"],"poids_tres_attache":[48.16,32.61,31.59,31.11,28.59]},"columns":[{"id":"mots_images","name":"mots_images","type":"character"},{"id":"poids_tres_attache","name":"poids_tres_attache","type":"numeric","align":"right"}],"defaultPageSize":5,"dataKey":"18bc11ebe076e307f3861c3b42d8af16"},"children":[]},"class":"reactR_markup"},"evals":[],"jsHooks":[]}</script>
  </div>
</div>

Affichez le code

print("Cluster 2 - Harmonie:")

[1] "Cluster 2 - Harmonie:"

Affichez le code

print(generer_tableau_react(resultats_cluster2_harmonie, "Harmonie"))

<div class="row">
  <div class="col-md-6">
    <div class="reactable html-widget html-fill-item" id="htmlwidget-ac9ebb2394297b23869a" style="width:auto;height:auto;"></div>
    <script type="application/json" data-for="htmlwidget-ac9ebb2394297b23869a">{"x":{"tag":{"name":"Reactable","attribs":{"data":{"mots_images":["contemplation","moment de poésie","temps suspendu","au rythme de la nature","dans une bulle"],"poids_pas_du_tout":[0.68,0.55,0.31,0.27,0.27]},"columns":[{"id":"mots_images","name":"mots_images","type":"character"},{"id":"poids_pas_du_tout","name":"poids_pas_du_tout","type":"numeric","align":"right"}],"defaultPageSize":5,"dataKey":"d74e55308e560fb97b0f50a3a3770dba"},"children":[]},"class":"reactR_markup"},"evals":[],"jsHooks":[]}</script>
  </div>
  <div class="col-md-6">
    <div class="reactable html-widget html-fill-item" id="htmlwidget-c81c836ed76cda7386f1" style="width:auto;height:auto;"></div>
    <script type="application/json" data-for="htmlwidget-c81c836ed76cda7386f1">{"x":{"tag":{"name":"Reactable","attribs":{"data":{"mots_images":["respire l’élégance","petit coin de paradis","écrin de verdure","joyau caché","au rythme de la nature"],"poids_tres_attache":[36.08,31.11,25.27,16.84,16.05]},"columns":[{"id":"mots_images","name":"mots_images","type":"character"},{"id":"poids_tres_attache","name":"poids_tres_attache","type":"numeric","align":"right"}],"defaultPageSize":5,"dataKey":"20f7a992302e661c73703c002318bc69"},"children":[]},"class":"reactR_markup"},"evals":[],"jsHooks":[]}</script>
  </div>
</div>

Affichez le code

print("Cluster 3 - Inconnu:")

[1] "Cluster 3 - Inconnu:"

Affichez le code

print(generer_tableau_react(resultats_cluster3_inconnu, "Inconnu"))

<div class="row">
  <div class="col-md-6">
    <div class="reactable html-widget html-fill-item" id="htmlwidget-b612f85e31165cf610bf" style="width:auto;height:auto;"></div>
    <script type="application/json" data-for="htmlwidget-b612f85e31165cf610bf">{"x":{"tag":{"name":"Reactable","attribs":{"data":{"mots_images":["saut dans le vide","contrées inhabitées","à contre-courant","île déserte","dépouillement"],"poids_pas_du_tout":[19.38,6.6,6.38,6.37,5.26]},"columns":[{"id":"mots_images","name":"mots_images","type":"character"},{"id":"poids_pas_du_tout","name":"poids_pas_du_tout","type":"numeric","align":"right"}],"defaultPageSize":5,"dataKey":"b1e85b8ec5a013d1ac8f7e79afc253cc"},"children":[]},"class":"reactR_markup"},"evals":[],"jsHooks":[]}</script>
  </div>
  <div class="col-md-6">
    <div class="reactable html-widget html-fill-item" id="htmlwidget-7387fa922444f5e5e32f" style="width:auto;height:auto;"></div>
    <script type="application/json" data-for="htmlwidget-7387fa922444f5e5e32f">{"x":{"tag":{"name":"Reactable","attribs":{"data":{"mots_images":["part de mystère","hasard des rencontres","montagne sacrée","terra incognita","rencontres magiques"],"poids_tres_attache":[12.27,6.9,4.78,4.55,3.54]},"columns":[{"id":"mots_images","name":"mots_images","type":"character"},{"id":"poids_tres_attache","name":"poids_tres_attache","type":"numeric","align":"right"}],"defaultPageSize":5,"dataKey":"2b26d70f1921a03fe2221d79e2a33be3"},"children":[]},"class":"reactR_markup"},"evals":[],"jsHooks":[]}</script>
  </div>
</div>

Affichez le code

print("Cluster 3 - Sens:")

[1] "Cluster 3 - Sens:"

Affichez le code

print(generer_tableau_react(resultats_cluster3_sens, "Sens"))

<div class="row">
  <div class="col-md-6">
    <div class="reactable html-widget html-fill-item" id="htmlwidget-359199f94699b5e308c9" style="width:auto;height:auto;"></div>
    <script type="application/json" data-for="htmlwidget-359199f94699b5e308c9">{"x":{"tag":{"name":"Reactable","attribs":{"data":{"mots_images":["saut dans le vide","vertige existentiel","ermitage","cellule monacale","dépouillement"],"poids_pas_du_tout":[12.92,12,11.31,10.5,8.77]},"columns":[{"id":"mots_images","name":"mots_images","type":"character"},{"id":"poids_pas_du_tout","name":"poids_pas_du_tout","type":"numeric","align":"right"}],"defaultPageSize":5,"dataKey":"161868f29948237cf8ef0a79fa394131"},"children":[]},"class":"reactR_markup"},"evals":[],"jsHooks":[]}</script>
  </div>
  <div class="col-md-6">
    <div class="reactable html-widget html-fill-item" id="htmlwidget-74ba0d0d05541d159a5d" style="width:auto;height:auto;"></div>
    <script type="application/json" data-for="htmlwidget-74ba0d0d05541d159a5d">{"x":{"tag":{"name":"Reactable","attribs":{"data":{"mots_images":["montagne sacrée","part de mystère","dépouillement","ermitage","retour à l’essentiel"],"poids_tres_attache":[11.15,6.14,5,4.55,3.5]},"columns":[{"id":"mots_images","name":"mots_images","type":"character"},{"id":"poids_tres_attache","name":"poids_tres_attache","type":"numeric","align":"right"}],"defaultPageSize":5,"dataKey":"86dbb0769315886e1b40db9d51976949"},"children":[]},"class":"reactR_markup"},"evals":[],"jsHooks":[]}</script>
  </div>
</div>

Les mots-images, ceux qui ont le plus de poids...pour l’ensemble du cluster comme pour le climat émotionnel global

Affichez le code

# Appliquer la fonction pour chaque cluster
extraire_mots_images(individu_cluster1, "Cluster 1")



Résultats pour  Cluster 1 :



Top 5 mots-images pour l'indicateur Enfant :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Enfant </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> souvenirs d’enfance </td>
   <td style="text-align:right;"> 359.05 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> chez moi. ailleurs </td>
   <td style="text-align:right;"> 93.70 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> petit nid douillet </td>
   <td style="text-align:right;"> 91.56 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> âme d’enfant </td>
   <td style="text-align:right;"> 67.98 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> grande maison joyeuse </td>
   <td style="text-align:right;"> 63.04 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Sens :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Sens </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> au rythme de la nature </td>
   <td style="text-align:right;"> 29.66 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> retour à l’essentiel </td>
   <td style="text-align:right;"> 29.60 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> retraite </td>
   <td style="text-align:right;"> 27.45 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> montagne sacrée </td>
   <td style="text-align:right;"> 17.80 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> qui se mérite </td>
   <td style="text-align:right;"> 15.70 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Harmonie :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Harmonie </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> écrin de verdure </td>
   <td style="text-align:right;"> 27.82 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> au rythme de la nature </td>
   <td style="text-align:right;"> 19.77 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> dans une bulle </td>
   <td style="text-align:right;"> 17.82 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> petit coin de paradis </td>
   <td style="text-align:right;"> 12.67 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> contemplation </td>
   <td style="text-align:right;"> 8.27 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Inconnu :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Inconnu </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> chez moi. ailleurs </td>
   <td style="text-align:right;"> 93.70 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> hasard des rencontres </td>
   <td style="text-align:right;"> 43.67 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> exploration </td>
   <td style="text-align:right;"> 29.62 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> voyage dans le temps </td>
   <td style="text-align:right;"> 27.71 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> marche sur les traces de </td>
   <td style="text-align:right;"> 24.80 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Instant :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Instant </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> petit plaisir </td>
   <td style="text-align:right;"> 82.64 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> à l'abri du tumulte du monde </td>
   <td style="text-align:right;"> 82.25 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> dans une bulle </td>
   <td style="text-align:right;"> 62.37 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> temps libre pour respirer </td>
   <td style="text-align:right;"> 59.45 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> au rythme de la nature </td>
   <td style="text-align:right;"> 59.32 </td>
  </tr>
</tbody>
</table>

Affichez le code

extraire_mots_images(individu_cluster2, "Cluster 2")



Résultats pour  Cluster 2 :



Top 5 mots-images pour l'indicateur Enfant :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Enfant </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> dans une bulle </td>
   <td style="text-align:right;"> 88.22 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> souvenirs d’enfance </td>
   <td style="text-align:right;"> 84.48 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> au rythme de la nature </td>
   <td style="text-align:right;"> 70.55 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> petit plaisir </td>
   <td style="text-align:right;"> 63.89 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> petit coin de paradis </td>
   <td style="text-align:right;"> 50.65 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Sens :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Sens </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> au rythme de la nature </td>
   <td style="text-align:right;"> 105.83 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> retour à l’essentiel </td>
   <td style="text-align:right;"> 57.33 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> ressourcement </td>
   <td style="text-align:right;"> 45.83 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> moment d’enchantement </td>
   <td style="text-align:right;"> 36.66 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> montagne sacrée </td>
   <td style="text-align:right;"> 31.30 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Harmonie :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Harmonie </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> écrin de verdure </td>
   <td style="text-align:right;"> 130.39 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> respire l’élégance </td>
   <td style="text-align:right;"> 122.34 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> petit coin de paradis </td>
   <td style="text-align:right;"> 75.97 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> au rythme de la nature </td>
   <td style="text-align:right;"> 70.55 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> joyau caché </td>
   <td style="text-align:right;"> 67.35 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Inconnu :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Inconnu </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> hasard des rencontres </td>
   <td style="text-align:right;"> 57.75 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> chez moi. ailleurs </td>
   <td style="text-align:right;"> 39.20 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> rencontres improbables </td>
   <td style="text-align:right;"> 34.52 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> exploration </td>
   <td style="text-align:right;"> 32.10 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> rencontres magiques </td>
   <td style="text-align:right;"> 31.99 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Instant :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Instant </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> au rythme de la nature </td>
   <td style="text-align:right;"> 211.66 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> écrin de verdure </td>
   <td style="text-align:right;"> 162.99 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> temps libre pour respirer </td>
   <td style="text-align:right;"> 137.66 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> dans une bulle </td>
   <td style="text-align:right;"> 123.51 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> papilles émoustillées </td>
   <td style="text-align:right;"> 110.96 </td>
  </tr>
</tbody>
</table>

Affichez le code

extraire_mots_images(individu_cluster3, "Cluster 3")



Résultats pour  Cluster 3 :



Top 5 mots-images pour l'indicateur Enfant :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Enfant </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> chez moi. ailleurs </td>
   <td style="text-align:right;"> 18.39 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> souvenirs d’enfance </td>
   <td style="text-align:right;"> 9.49 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> dans une bulle </td>
   <td style="text-align:right;"> 7.45 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> exploration </td>
   <td style="text-align:right;"> 5.92 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> au rythme de la nature </td>
   <td style="text-align:right;"> 5.68 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Sens :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Sens </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> dépouillement </td>
   <td style="text-align:right;"> 62.27 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> retraite </td>
   <td style="text-align:right;"> 34.75 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> dialogue direct avec le ciel </td>
   <td style="text-align:right;"> 28.20 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> perdu dans l’immensité </td>
   <td style="text-align:right;"> 24.51 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> ermitage </td>
   <td style="text-align:right;"> 23.58 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Harmonie :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Harmonie </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> dépouillement </td>
   <td style="text-align:right;"> 24.91 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> contrées inhabitées </td>
   <td style="text-align:right;"> 11.42 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> côtes indomptées </td>
   <td style="text-align:right;"> 5.91 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> au rythme de la nature </td>
   <td style="text-align:right;"> 5.68 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> terra incognita </td>
   <td style="text-align:right;"> 5.50 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Inconnu :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Inconnu </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> dépouillement </td>
   <td style="text-align:right;"> 37.36 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> contrées inhabitées </td>
   <td style="text-align:right;"> 34.27 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> saut dans le vide </td>
   <td style="text-align:right;"> 31.16 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> hasard des rencontres </td>
   <td style="text-align:right;"> 27.07 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> à contre-courant </td>
   <td style="text-align:right;"> 24.69 </td>
  </tr>
</tbody>
</table>

Top 5 mots-images pour l'indicateur Instant :

<table class="table" style="width: auto !important; margin-left: auto; margin-right: auto;">
 <thead>
  <tr>
   <th style="text-align:left;"> mots_images </th>
   <th style="text-align:right;"> Instant </th>
  </tr>
 </thead>
<tbody>
  <tr>
   <td style="text-align:left;"> retraite </td>
   <td style="text-align:right;"> 23.17 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> saut dans le vide </td>
   <td style="text-align:right;"> 20.77 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> hasard des rencontres </td>
   <td style="text-align:right;"> 18.04 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> au rythme de la nature </td>
   <td style="text-align:right;"> 17.05 </td>
  </tr>
  <tr>
   <td style="text-align:left;"> papilles émoustillées </td>
   <td style="text-align:right;"> 12.69 </td>
  </tr>
</tbody>
</table>