Cet audit analytique supplémentaire documente les principales étapes de préparation des données, l’évaluation de la fidélité du codage, les transformations de variables, les procédures de diagnostic ainsi que les décisions de modélisation statistique qui sous-tendent les analyses présentées dans le manuscrit principal. Ce document est fourni afin de favoriser la transparence, la reproductibilité et l’interprétabilité des résultats.

Ce document complète, sans toutefois s’y substituer, la section « Méthodologie » du manuscrit principal. Toutes les informations méthodologiques essentielles sont rapportées dans l’article lui-même. Le présent fichier fournit le suivi analytique détaillé, incluant les vérifications intermédiaires, les tests de diagnostic et les sorties statistiques supplémentaires.

Note sur la transparence des données et la reproductibilité
Le jeu de données Clean_BD_TikTok_F.csv mis à disposition ici constitue la base de travail ayant servi aux modélisations statistiques. Il regroupe les indicateurs d’engagement et les scores issus du codage de la valence pour les \(n=118\) vidéos de l’échantillon.

Conformément aux pratiques de recherche en sources ouvertes (OSINT), les données proviennent exclusivement de l’espace public numérique. Pour les besoins de l’analyse statistique, les données textuelles qualitatives (commentaires bruts) ont été transformées en variables catégorielles et numériques. Les identifiants originaux des vidéos sont conservés pour permettre la vérifiabilité des sources, garantissant ainsi une transparence totale du processus de recherche.

Télécharger la base de données codée (CSV) (20.4 Ko)

Fiabilité du codage

Objectif : Vérifier que le codage est suffisamment cohérent entre évaluateurs avant les analyses principales.

Procédure : La fidélité intercodeurs a été estimée séparément pour les vidéos et les commentaires à partir d’un codage en double aveugle.

Règle de décision : Les analyses subséquentes ont été poursuivies si la concordance observée était jugée élevée et substantiellement cohérente avec la structure des désaccords.

knitr::kable(
  data.frame(
    Base = c("Vidéos", "Commentaires"),
    Type = c("Kappa simple", "Kappa pondéré quadratique"),
    N = c(nrow(Kappa_Video), nrow(Kappa_Commentaire)),
    Kappa = c(
      round(kappa_video$value, 3),
      round(kappa_commentaire$value, 3)
    ),
    z = c(
      round(kappa_video$statistic, 3),
      round(kappa_commentaire$statistic, 3)
    ),
    p = c(
    ifelse(kappa_video$p.value < .001, "< .001", signif(kappa_video$p.value, 3)),
    ifelse(kappa_commentaire$p.value < .001, "< .001", signif(kappa_commentaire$p.value, 3))
    )
  ),
  caption = "Fidélité intercodeurs pour le codage des vidéos et des commentaires."
)
Fidélité intercodeurs pour le codage des vidéos et des commentaires.
Base Type N Kappa z p
Vidéos Kappa simple 118 0.838 16.423 < .001
Commentaires Kappa pondéré quadratique 1357 0.880 32.415 < .001

Note : Le codage repose sur 118 vidéos et 1 357 commentaires de premier niveau, codés en double aveugle. Les désaccords ont été résolus par discussion entre les codeurs et, lorsque nécessaire, par l’intervention d’un troisième évaluateur.

Matrices de contingence

knitr::kable(tab_video, caption = "Matrice de contingence du codage des vidéos.")
Matrice de contingence du codage des vidéos.
1 2 3 4 5
44 0 2 0 0
0 15 1 0 0
3 4 23 0 0
1 0 0 7 1
1 0 1 0 15 
knitr::kable(tab_commentaire, caption = "Matrice de contingence du codage des commentaires.")
Matrice de contingence du codage des commentaires.
1 2 3 4
290 30 1 0
29 679 37 2
1 28 144 24
0 4 30 58

Note : Les commentaires analysés en double aveugle représentent 10 % de l’échantillon total. La concentration des observations sur la diagonale suggère une forte concordance. Pour les commentaires, les désaccords se concentrent surtout entre catégories adjacentes, ce qui appuie l’usage d’un kappa pondéré quadratique.

Vérifications de l’intégrité des données

Objectif : Vérifier que la base analytique finale est complète, cohérente et adéquatement structurée avant de procéder aux analyses descriptives et inférentielles.

Procédure : La base de données finale a été inspectée afin de confirmer le nombre d’observations et de variables, le type de chaque variable, ainsi que l’absence de valeurs manquantes pour les variables retenues dans les analyses. Une vérification de cohérence générale de la structure de la base a également été réalisée à partir d’une inspection tabulaire.

Règle de décision : Les analyses ont été poursuivies lorsque la base ne présentait pas de problème majeur d’intégrité, notamment en ce qui concerne les valeurs manquantes, la structure des variables et la cohérence générale du fichier analytique.

glimpse(BD_TikTok)
## Rows: 118
## Columns: 20
## $ id_video         <dbl> 74627374, 74635192, 74653101, 74657027, 74683437, 747…
## $ date             <date> 2025-01-22, 2025-01-24, 2025-01-29, 2025-01-30, 2025…
## $ Video_category_3 <dbl> 1, 1, 2, 2, 1, 2, 1, 2, 2, 1, 2, 1, 2, 3, 2, 1, 1, 1,…
## $ views            <dbl> 388100, 1300000, 844600, 820000, 1100000, 557600, 140…
## $ like_rate        <dbl> 0.05256377, 0.04761539, 0.03705896, 0.05621951, 0.062…
## $ likes            <dbl> 20400, 61900, 31300, 46100, 68400, 18900, 61200, 2640…
## $ share_rate       <dbl> 0.007851069, 0.005186154, 0.007209330, 0.002379268, 0…
## $ shares           <dbl> 3047, 6742, 6089, 1951, 5635, 1014, 16600, 1576, 1024…
## $ comment_rate     <dbl> 0.001378511, 0.001687692, 0.001075065, 0.001556098, 0…
## $ total_comments   <dbl> 535, 2194, 908, 1276, 1417, 384, 1858, 647, 560, 805,…
## $ comments_lvl1    <dbl> 327, 484, 350, 417, 294, 245, 470, 158, 399, 140, 342…
## $ n_comments_lvl1  <dbl> 177, 215, 184, 201, 167, 150, 212, 113, 196, 103, 182…
## $ n_pos            <dbl> 49, 69, 56, 24, 51, 38, 44, 83, 29, 35, 57, 24, 7, 34…
## $ n_neu            <dbl> 85, 90, 104, 76, 106, 64, 119, 19, 115, 49, 89, 93, 1…
## $ n_neg            <dbl> 27, 35, 20, 58, 10, 28, 40, 4, 43, 17, 33, 11, 2, 44,…
## $ n_host           <dbl> 16, 21, 4, 43, 0, 20, 9, 7, 9, 2, 3, 7, 2, 38, 3, 2, …
## $ top_pos          <dbl> 0, 0, 434, 0, 735, 190, 0, 2358, 1336, 1242, 0, 602, …
## $ top_neu          <dbl> 1141, 2041, 2058, 927, 676, 183, 0, 0, 506, 0, 272, 0…
## $ top_neg          <dbl> 3756, 7184, 0, 4345, 0, 0, 7448, 0, 0, 1001, 2691, 76…
## $ top_hos          <dbl> 0, 0, 0, 0, 0, 482, 0, 0, 0, 0, 0, 0, 0, 674, 0, 0, 0…

Note : La base de données finale comprend 118 observations et 20 variables.

Vérification des NA

library(dplyr)
library(tidyr)
library(knitr)

na_table <- BD_TikTok %>%
  summarise(across(everything(), ~ sum(is.na(.)))) %>%
  pivot_longer(
    cols = everything(),
    names_to = "Variable",
    values_to = "NA"
  ) %>%
  filter(NA > 0)

if (nrow(na_table) == 0) {
  na_table <- data.frame(
    Vérification = "Valeurs manquantes",
    Résultat = "Aucune valeur manquante détectée"
  )
}

knitr::kable(
  na_table,
  caption = "Vérification des valeurs manquantes"
)
Vérification des valeurs manquantes
Vérification Résultat
Valeurs manquantes Aucune valeur manquante détectée

Note : Aucune valeur manquante (NA) n’a été observée dans la base de données pour les variables retenues dans les analyses.

Vérification des doublons et de la cohérence

check_duplicates <- sum(duplicated(BD_TikTok$id_video))
check_valence    <- sum(abs((BD_TikTok$n_pos + BD_TikTok$n_neu + BD_TikTok$n_neg + BD_TikTok$n_host) - BD_TikTok$n_comments_lvl1), na.rm = TRUE)

resultats_integrite <- data.frame(
  Indicateur = c("Nombre de doublons (id_video)", "Somme des écarts de valence (Cohérence totale)"),
  Valeur = c(check_duplicates, check_valence)
)

knitr::kable(resultats_integrite, 
             caption = "Résultats des tests d'intégrité des données",
             align = "lc")
Résultats des tests d’intégrité des données
Indicateur Valeur
Nombre de doublons (id_video) 0
Somme des écarts de valence (Cohérence totale) 0

Note : Le premier indicateur vérifie l’absence de doublons dans l’identifiant unique des vidéos (id_video). Le second évalue la cohérence interne des variables de valence en comparant, pour chaque vidéo, la somme des commentaires positifs, neutres, négatifs et hostiles au nombre total de commentaires de premier niveau codés (n_comments_lvl1). Une valeur de 0 indique une cohérence parfaite sur l’ensemble de la base.

Dictionnaire des variables

data_dict <- data.frame(
  Variable = c(
    "Video_category_3", "views", "like_rate", "share_rate", "comment_rate", 
    "n_pos", "n_neg", "n_host"
  ),
  Description = c(
    "Catégorie de la vidéo (3 niveaux)", 
    "Nombre total de vues", 
    "Ratio de mentions j'aime par vue", 
    "Ratio de partages par vue",
    "Ratio de commentaires par vue",
    "Nombre de commentaires positifs", 
    "Nombre de commentaires négatifs", 
    "Nombre de commentaires hostiles"
  ),
  Type = c(
    "Factor", "Numeric", "Numeric", "Numeric", "Numeric", 
    "Numeric", "Numeric", "Numeric"
  ),
  Scale = c(
    "Nominale", "Ratio", "Proportion", "Proportion", "Proportion", 
    "Ratio", "Ratio", "Ratio"
  ),
  Used_in = c(
    "VI (Tous les modèles)", "VD (Engagement)", "VD (Engagement)", "VD (Engagement)", "VD (Engagement)", 
    "VD (Valence)", "VD (Valence)", "VD (Valence)"
  ),
  Transformation = c(
    "Aucune", "ln(x)", "ln(x)", "ln(x)", "ln(x)", 
    "ln(x)", "ln(x+1)", "ln(x+1)"
  )
)

knitr::kable(data_dict, 
             caption = "Dictionnaire des données et spécifications des variables",
             col.names = c("Variable", "Description", "Type", "Échelle", "Utilisée dans", "Transformation"))
Dictionnaire des données et spécifications des variables
Variable Description Type Échelle Utilisée dans Transformation
Video_category_3 Catégorie de la vidéo (3 niveaux) Factor Nominale VI (Tous les modèles) Aucune
views Nombre total de vues Numeric Ratio VD (Engagement) ln(x)
like_rate Ratio de mentions j’aime par vue Numeric Proportion VD (Engagement) ln(x)
share_rate Ratio de partages par vue Numeric Proportion VD (Engagement) ln(x)
comment_rate Ratio de commentaires par vue Numeric Proportion VD (Engagement) ln(x)
n_pos Nombre de commentaires positifs Numeric Ratio VD (Valence) ln(x)
n_neg Nombre de commentaires négatifs Numeric Ratio VD (Valence) ln(x+1)
n_host Nombre de commentaires hostiles Numeric Ratio VD (Valence) ln(x+1)

Note : Ce tableau présente les principales variables retenues dans les analyses inférentielles, leur définition, leur niveau de mesure, leur rôle analytique et, le cas échéant, la transformation appliquée avant modélisation. Les transformations logarithmiques ont été utilisées afin de réduire l’asymétrie de certaines distributions. Pour les variables pouvant prendre la valeur 0, une constante de 1 a été ajoutée avant transformation.

Description des données

Objectif : Décrire les principales variables retenues dans les analyses et documenter leur distribution générale.

Procédure : Les variables numériques ont été résumées à l’aide de statistiques descriptives, puis représentées graphiquement afin de documenter leur amplitude et leur distribution. Une attention particulière a été portée aux indicateurs d’engagement, aux variables de valence et aux mesures d’approbation secondaire saillante.

Règle de décision : Les distributions observées ont servi à orienter les étapes ultérieures de transformation et de sélection des variables pour les analyses inférentielles.

library(dplyr)
library(janitor)
## 
## Attaching package: 'janitor'
## The following objects are masked from 'package:stats':
## 
##     chisq.test, fisher.test
library(knitr)

repartition_categories <- BD_TikTok %>%
  mutate(
    categorie_video = factor(
      Video_category_3,
      levels = c(1, 2, 3),
      labels = c("Information", "Prévention/sensibilisation", "Image work")
    )
  ) %>%
  tabyl(categorie_video) %>%
  adorn_pct_formatting(digits = 1) %>%
  adorn_totals("row")

knitr::kable(
  repartition_categories,
  caption = "Répartition des vidéos selon les trois catégories analytiques"
)
Répartition des vidéos selon les trois catégories analytiques
categorie_video n percent
Information 47 39.8%
Prévention/sensibilisation 47 39.8%
Image work 24 20.3%
Total 118 -

Note : Ce tableau présente la répartition des 118 vidéos selon les trois catégories analytiques retenues pour les analyses comparatives, soit les contenus informationnels, les contenus de prévention/sensibilisation et les contenus d’image work. Les pourcentages sont calculés sur l’ensemble des vidéos codées.

Les variables de type rate (p. ex., like_rate, share_rate, comment_rate) correspondent à des ratios calculés à partir du nombre total de vues, afin de standardiser les indicateurs d’engagement. Les variables top_* (p. ex., top_pos, top_neu, top_neg, top_hos) représentent une mesure d’approbation secondaire saillante, définie comme la somme des mentions « j’aime » des trois commentaires les plus appréciés pour chaque vidéo, selon leur valence.

library(dplyr)
library(tidyr)
library(knitr)

vars_desc <- c(
  "views", "like_rate", "likes", "share_rate", "shares",
  "comment_rate", "total_comments", "comments_lvl1",
  "n_comments_lvl1", "n_pos", "n_neu", "n_neg", "n_host",
  "top_pos", "top_neu", "top_neg", "top_hos"
)

desc_num <- BD_TikTok %>%
  select(all_of(vars_desc)) %>%
  summarise(
    across(
      everything(),
      list(
        moyenne = ~ mean(., na.rm = TRUE),
        ecart_type = ~ sd(., na.rm = TRUE),
        mediane = ~ median(., na.rm = TRUE),
        min = ~ min(., na.rm = TRUE),
        max = ~ max(., na.rm = TRUE)
      ),
      .names = "{.col}___{.fn}"
    )
  ) %>%
  pivot_longer(
    cols = everything(),
    names_to = c("Variable", ".value"),
    names_sep = "___"
  ) %>%
   mutate(across(where(is.numeric), ~ format(round(., 4), scientific = FALSE, trim = TRUE)))
knitr::kable(
  desc_num,
  caption = "Statistiques descriptives des variables numériques."
)
Statistiques descriptives des variables numériques.
Variable moyenne ecart_type mediane min max
views 358755.0847 373204.0267 266350.0000 26800.0000 2300000.0000
like_rate 0.0494 0.0138 0.0482 0.0178 0.0817
likes 18187.0932 19236.8436 12900.0000 901.0000 114000.0000
share_rate 0.0031 0.0041 0.0017 0.0002 0.0296
shares 1593.2627 3969.3474 427.0000 12.0000 35500.0000
comment_rate 0.0013 0.0006 0.0012 0.0003 0.0042
total_comments 493.8898 561.4202 330.5000 20.0000 3617.0000
comments_lvl1 208.4153 195.9603 153.0000 13.0000 1389.0000
n_comments_lvl1 115.0593 69.6619 110.5000 13.0000 302.0000
n_pos 30.2034 25.4123 24.0000 2.0000 133.0000
n_neu 58.8305 37.6405 56.0000 0.0000 165.0000
n_neg 20.3644 21.3264 14.0000 0.0000 108.0000
n_host 5.6610 7.7175 3.0000 0.0000 43.0000
top_pos 296.6695 767.2979 0.0000 0.0000 5677.0000
top_neu 759.8136 2793.1756 138.0000 0.0000 28814.0000
top_neg 777.2203 2497.8889 6.0000 0.0000 22187.0000
top_hos 15.5000 79.7001 0.0000 0.0000 674.0000 
library(dplyr)

data_num <- BD_TikTok %>%
  select(where(is.numeric)) %>%
  select(-id_video)

library(tidyr)

data_long <- data_num %>%
  pivot_longer(cols = everything(),
               names_to = "variable",
               values_to = "value")

library(ggplot2)

ggplot(data_long, aes(x = value)) +
  geom_histogram(bins = 30) +
  facet_wrap(~variable, scales = "free")

Note : Les histogrammes présentent la distribution des variables numériques retenues pour les analyses. Les échelles de l’axe des x sont libres afin de respecter l’amplitude propre à chaque variable.

Différence entre valence et approbation secondaire saillante

library(dplyr)
library(ggplot2)
library(scales)
## 
## Attaching package: 'scales'
## The following object is masked from 'package:readr':
## 
##     col_factor
library(tibble)

comment_counts <- c(
  Positif = sum(BD_TikTok$n_pos, na.rm = TRUE),
  Neutre  = sum(BD_TikTok$n_neu, na.rm = TRUE),
  Négatif = sum(BD_TikTok$n_neg, na.rm = TRUE),
  Hostile = sum(BD_TikTok$n_host, na.rm = TRUE)
)

approval_counts <- c(
  Positif = sum(BD_TikTok$top_pos, na.rm = TRUE),
  Neutre  = sum(BD_TikTok$top_neu, na.rm = TRUE),
  Négatif = sum(BD_TikTok$top_neg, na.rm = TRUE),
  Hostile = sum(BD_TikTok$top_hos, na.rm = TRUE)
)

plot_data <- bind_rows(
  tibble(
    valence = names(comment_counts),
    mesure = "Commentaires",
    n = as.numeric(comment_counts)
  ),
  tibble(
    valence = names(approval_counts),
    mesure = "Approbation secondaire saillante",
    n = as.numeric(approval_counts)
  )
) %>%
  group_by(mesure) %>%
  mutate(pct = n / sum(n)) %>%
  ungroup() %>%
  mutate(
    valence = factor(valence, levels = c("Positif", "Neutre", "Négatif", "Hostile")),
    mesure = factor(
      mesure,
      levels = c("Commentaires", "Approbation secondaire saillante")
    ),
    label = paste0(
      percent(pct, accuracy = 0.1),
      "\n(n = ", format(n, big.mark = " ", scientific = FALSE), ")"
    )
  )

p <- ggplot(plot_data, aes(x = valence, y = pct, fill = mesure)) +
  geom_col(
    position = position_dodge(width = 0.72),
    width = 0.65
  ) +
  geom_text(
    aes(label = label),
    position = position_dodge(width = 0.72),
    vjust = -0.3,
    size = 4.0,
    lineheight = 0.9
  ) +
  scale_y_continuous(
    labels = percent_format(accuracy = 1),
    limits = c(0, 0.62),
    expand = expansion(mult = c(0, 0.05))
  ) +
  scale_fill_manual(
    values = c(
      "Commentaires" = "grey30",
      "Approbation secondaire saillante" = "grey70"
    )
  ) +
  labs(
    x = "Valence",
    y = "Proportion",
    fill = NULL
  ) +
  theme_minimal(base_size = 14) +
  theme(
    legend.position = "top",
    legend.justification = "left",
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_blank(),
    axis.title.x = element_text(size = 14, margin = margin(t = 10)),
    axis.title.y = element_text(size = 14, margin = margin(r = 10)),
    axis.text = element_text(size = 12),
    legend.text = element_text(size = 12),
    legend.title = element_text(size = 13)
  )
print(p)

Note : Cette figure présente une comparaison agrégée à l’échelle de l’ensemble des vidéos publiées par la Sûreté du Québec en 2025. Les proportions de la série « Commentaires » sont calculées à partir de l’ensemble des commentaires de premier niveau codés, tous vidéos confondues. Les proportions de la série « Approbation secondaire saillante » sont calculées à partir de la somme des mentions « j’aime » associées aux trois commentaires les plus appréciés pour chaque vidéo, agrégées selon la valence de ces commentaires. Il s’agit donc d’une comparaison globale de la structure des réactions exprimées et de la structure des réactions les plus valorisées dans l’espace interactionnel.

Préparation des variables

Objectif : Préparer les variables pour des analyses comparatives plus stables sur le plan distributionnel.

Procédure : Des transformations logarithmiques ont été appliquées aux variables les plus asymétriques, avec ajout d’une constante de 1 lorsque des valeurs nulles étaient possibles.

Règle de décision : Les variables ont été conservées pour l’inférence lorsqu’elles demeuraient interprétables après transformation et que leur structure restait compatible avec une modélisation prudente.

library(dplyr)

BD_TikTok <- BD_TikTok %>%
  mutate(
    log_views        = log(views),
    log_like         = log(likes),
    log_like_rate    = log(like_rate),
    log_comment      = log(total_comments),
    log_share       = log(shares),   
    log_share_rate   = log(share_rate),
    log_comment_rate = log(comment_rate),
    log_n_pos        = log(n_pos),
    log_n_neg        = log(n_neg + 1),
    log_n_host       = log(n_host + 1),
    log_top_pos      = log(top_pos + 1),
    log_top_neg      = log(top_neg + 1),
    log_top_hos      = log(top_hos + 1)
  )

Distribution des variables d’engagement

Les distributions transformées des variables d’engagement ont été examinées visuellement afin d’évaluer la persistance éventuelle d’asymétries ou de valeurs extrêmes.

library(tidyr)
library(ggplot2)
library(scales)

engagement_vars <- BD_TikTok %>%
  select(log_views, log_like, log_like_rate, log_share, log_share_rate, log_comment, log_comment_rate) %>%
  pivot_longer(cols = everything(), names_to = "variable", values_to = "value") %>%
  mutate(
    variable = case_when(
      variable == "log_views" ~ "Vues",
      variable == "log_like" ~ "Mentions « j’aime »",
      variable == "log_like_rate" ~ "Taux de mentions « j’aime »",
      variable == "log_share" ~ "Partages",
      variable == "log_share_rate" ~ "Taux de partage",
      variable == "log_comment" ~ "Commentaires totaux",
      variable == "log_comment_rate" ~ "Taux de commentaires",
      TRUE ~ variable
    )
  )

ggplot(engagement_vars, aes(x = value)) +
  geom_histogram(bins = 30, fill = "grey40", color = "white") +
  facet_wrap(~variable, scales = "free") +
  scale_x_continuous(labels = comma) +
  labs(
    x = "Valeur",
    y = "Fréquence"
  ) +
  theme_minimal(base_size = 14) +
  theme(
    strip.text = element_text(size = 12),
    panel.grid.minor = element_blank()
  )

Note : Histogrammes des variables d’engagement après transformation logarithmique.

log_vars <- BD_TikTok %>%
  select(log_views, log_like, log_like_rate, log_share, log_share_rate, log_comment, log_comment_rate) %>%
  pivot_longer(cols = everything(), names_to = "variable", values_to = "value")

ggplot(log_vars, aes(y = value)) +
  geom_boxplot() +
  facet_wrap(~variable, scales = "free") +
  theme_minimal()

Note : Malgré l’application de transformations logarithmiques, certaines valeurs extrêmes persistent dans les distributions. Ces observations ne sont pas considérées comme des erreurs, mais reflètent la nature fortement asymétrique des données issues des plateformes sociales (effets de viralité). Elles ont été conservées dans les analyses afin de préserver la validité écologique des résultats.

Distribution des variables de valence

Les distributions des variables de valence ont été examinées séparément afin de vérifier si leur forme demeurait compatible avec les analyses comparatives envisagées.

valence_vars <- BD_TikTok %>%
  select(log_n_pos, log_n_neg, log_n_host) %>%
  pivot_longer(cols = everything(), names_to = "variable", values_to = "value") %>%
  mutate(
    variable = case_when(
      variable == "log_n_pos" ~ "Commentaires positifs",
      variable == "log_n_neg" ~ "Commentaires négatifs",
      variable == "log_n_host" ~ "Commentaires hostiles",
      TRUE ~ variable
   )
  )

ggplot(valence_vars, aes(x = value)) +
  geom_histogram(bins = 30, fill = "grey40", color = "white") +
  facet_wrap(~variable, scales = "free") +
  scale_x_continuous(labels = comma) +
  labs(
    x = "Valeur",
    y = "Fréquence"
  ) +
  theme_minimal(base_size = 14) +
  theme(
    strip.text = element_text(size = 12),
    panel.grid.minor = element_blank()
  )

Note : Les variables de valence représentent le nombre de commentaires de premier niveau positifs, négatifs ou hostiles observés pour chaque vidéo.

log_vars <- BD_TikTok %>%
  select(log_n_pos, log_n_neg, log_n_host) %>%
  pivot_longer(cols = everything(), names_to = "variable", values_to = "value")

ggplot(log_vars, aes(y = value)) +
  geom_boxplot() +
  facet_wrap(~variable, scales = "free") +
  theme_minimal()

Distribution des variables d’approbation secondaire saillante

Les variables d’approbation secondaire saillante ont été examinées séparément afin d’évaluer si leur structure permettait leur inclusion dans les modèles inférentiels.

valence_vars <- BD_TikTok %>%
  select(log_top_pos, log_top_neg, log_top_hos) %>%
  pivot_longer(cols = everything(), names_to = "variable", values_to = "value") %>%
  mutate(
    variable = case_when(
      variable == "log_top_pos" ~ "Approbation secondaire positifs",
      variable == "log_top_neg" ~ "Approbation secondaire négatifs",
      variable == "log_top_hos" ~ "Approbation secondaire hostiles",
      TRUE ~ variable
    )
  )

ggplot(valence_vars, aes(x = value)) +
  geom_histogram(bins = 30, fill = "grey40", color = "white") +
  facet_wrap(~variable, scales = "free") +
  scale_x_continuous(labels = comma) +
  labs(
    x = "Valeur",
    y = "Fréquence"
  ) +
  theme_minimal(base_size = 14) +
  theme(
    strip.text = element_text(size = 12),
    panel.grid.minor = element_blank()
  )

log_vars <- BD_TikTok %>%
  select(log_top_pos, log_top_neg, log_top_hos) %>%
  pivot_longer(cols = everything(), names_to = "variable", values_to = "value")

ggplot(log_vars, aes(y = value)) +
  geom_boxplot() +
  facet_wrap(~variable, scales = "free") +
  theme_minimal()

Note : Les variables top_*, représentant une mesure d’approbation secondaire saillante, présentent une distribution fortement asymétrique avec une inflation de zéros, persistant après transformation logarithmique. Compte tenu de cette structure, leur inclusion dans des modèles linéaires aurait compromis la robustesse des estimations et la validité des comparaisons. Ces variables ont donc été exclues des analyses inférentielles.

Modèles principaux

Objectif : Examiner si les indicateurs d’engagement et de valence diffèrent selon les catégories de vidéos.

Procédure : Des modèles de régression linéaire distincts ont été estimés pour chaque variable dépendante retenue, avec Video_category_3 traitée comme facteur catégoriel.

Règle de décision : Les modèles ont été interprétés comme des outils de comparaison entre groupes, sans inférence causale ni finalité prédictive.

BD_TikTok <- BD_TikTok %>%
  mutate(Video_category_3 = factor(Video_category_3))

mod_views         <- lm(log_views ~ Video_category_3, data = BD_TikTok)

mod_like          <- lm(log_like ~ Video_category_3, data = BD_TikTok)
mod_like_rate     <- lm(log_like_rate ~ Video_category_3, data = BD_TikTok)
mod_comment       <- lm(log_comment ~ Video_category_3, data = BD_TikTok)

mod_comment_rate  <- lm(log_comment_rate ~ Video_category_3, data = BD_TikTok)
mod_share         <- lm(log_share ~ Video_category_3, data = BD_TikTok)
mod_share_rate    <- lm(log_share_rate ~ Video_category_3, data = BD_TikTok)

mod_n_pos         <- lm(log_n_pos ~ Video_category_3, data = BD_TikTok)
mod_n_neg         <- lm(log_n_neg ~ Video_category_3, data = BD_TikTok)
mod_n_host        <- lm(log_n_host ~ Video_category_3, data = BD_TikTok)

models <- list(
  views = mod_views,
  like = mod_like,
  like_rate = mod_like_rate,
  comment = mod_comment,
  comment_rate = mod_comment_rate,
  share = mod_share,
  share_rate = mod_share_rate,
  pos_comm     = mod_n_pos,
  neg_comm     = mod_n_neg,
  host_comm    = mod_n_host
)

Vérification des postulats

Objectif :
Vérifier si les modèles retenus satisfont suffisamment les hypothèses nécessaires à une interprétation prudente.

Procédure : Des tests formels d’hétéroscédasticité et de normalité ont été combinés à une inspection visuelle des graphiques diagnostiques et à un examen des observations influentes.

Règle de décision : En présence d’hétéroscédasticité, des erreurs-types robustes ont été privilégiées. Les observations influentes ont été conservées lorsqu’elles semblaient refléter la variabilité réelle des données plutôt qu’une erreur manifeste.

library(lmtest) 
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
diagnostic_results <- lapply(names(models), function(name) {
  m <- models[[name]]
  
  bp_test <- bptest(m)
  sw_test <- shapiro.test(residuals(m))
  
  data.frame(
    Variable = name,
    BP_p_value = round(bp_test$p.value, 4),
    SW_p_value = round(sw_test$p.value, 4),
    stringsAsFactors = FALSE
  )
})

diagnostic_table <- bind_rows(diagnostic_results)
knitr::kable(diagnostic_table, caption = "Tests de diagnostic des modèles")
Tests de diagnostic des modèles
Variable BP_p_value SW_p_value
BP…1 views 0.0180 0.5593
BP…2 like 0.0068 0.7692
BP…3 like_rate 0.0420 0.2762
BP…4 comment 0.0002 0.1835
BP…5 comment_rate 0.0012 0.5716
BP…6 share 0.1155 0.2638
BP…7 share_rate 0.4655 0.0581
BP…8 pos_comm 0.0032 0.0246
BP…9 neg_comm 0.0033 0.5015
BP…10 host_comm 0.5028 0.0027

Note : Les tests de Breusch-Pagan et de Shapiro-Wilk sont rapportés à titre diagnostique. Les résultats ont été interprétés conjointement avec l’inspection visuelle des résidus.

for (name in names(models)) {
  m <- models[[name]]
  
  par(mfrow = c(2,2))
  plot(m)
  mtext(paste("Modèle :", name), outer = TRUE, line = -2, cex = 1.2)
}

library(dplyr)
library(purrr)
## 
## Attaching package: 'purrr'
## The following object is masked from 'package:scales':
## 
##     discard
cooks_table <- map_dfr(names(models), function(name) {
  m <- models[[name]]
  cooks_d <- cooks.distance(m)
  threshold <- 4 / nobs(m)
  
  tibble(
    Variable = name,
    Max_Cook_D = max(cooks_d, na.rm = TRUE),
    Mean_Cook_D = mean(cooks_d, na.rm = TRUE),
    Threshold = threshold,
    Nb_Outliers = sum(cooks_d > threshold)
  )
}) %>%
  mutate(
    across(where(is.numeric), ~ round(., 4))
  )

knitr::kable(
  cooks_table,
  caption = "Diagnostic des observations influentes (distance de Cook)"
)
Diagnostic des observations influentes (distance de Cook)
Variable Max_Cook_D Mean_Cook_D Threshold Nb_Outliers
views 0.1193 0.0091 0.0339 5
like 0.1048 0.0093 0.0339 6
like_rate 0.0721 0.0093 0.0339 9
comment 0.1071 0.0096 0.0339 6
comment_rate 0.1116 0.0098 0.0339 7
share 0.1512 0.0091 0.0339 6
share_rate 0.1536 0.0091 0.0339 7
pos_comm 0.0607 0.0089 0.0339 3
neg_comm 0.0942 0.0094 0.0339 7
host_comm 0.0978 0.0090 0.0339 5

Note : Les observations dépassant le seuil conventionnel de 4/n ont été recensées mais conservées, car elles reflètent vraisemblablement la variabilité réelle des données issues des plateformes sociales.

Comparaisons post-hoc

Objectif : Identifier quelles catégories de vidéos diffèrent entre elles pour les variables analysées.

Procédure : Des comparaisons pairwise ont été réalisées à partir des modèles linéaires estimés au moyen de emmeans, avec une matrice de variance-covariance robuste HC3 et un ajustement de Tukey.

Règle de décision : Les contrastes ont été interprétés à partir des p-values ajustées et de leur ampleur relative, exprimée en ratios exponentiés et en pourcentages de variation.

library(emmeans)
## Welcome to emmeans.
## Caution: You lose important information if you filter this package's results.
## See '? untidy'
library(sandwich)
library(dplyr)
library(purrr)
library(knitr)

pairwise_results <- imap(models, function(mod, nom_modele) {

  emm <- emmeans(
    mod,
    specs = ~ Video_category_3,
    vcov. = vcovHC(mod, type = "HC3")
  )

  pairs_emm <- pairs(emm, adjust = "tukey")

  as.data.frame(summary(pairs_emm)) %>%
    mutate(
      modele = nom_modele,
      ratio = exp(estimate),
      pct_change = (exp(estimate) - 1) * 100,
      .before = 1
    )
})

pairwise_table <- bind_rows(pairwise_results)

pairwise_formatted <- pairwise_table %>%
  mutate(
    across(c(estimate, SE, df, t.ratio, ratio, pct_change), ~ round(., 4)),
    p.value = ifelse(p.value < .001, "< .001", as.character(round(p.value, 4)))
  ) %>%
  select(modele, contrast, estimate, SE, df, t.ratio, p.value, ratio, pct_change)

knitr::kable(
  pairwise_formatted,
  caption = "Comparaisons post-hoc (Tukey) avec erreurs-types robustes (HC3)"
)
Comparaisons post-hoc (Tukey) avec erreurs-types robustes (HC3)
modele contrast estimate SE df t.ratio p.value ratio pct_change
views Video_category_31 - Video_category_32 0.5935 0.1809 115 3.2800 0.0039 1.8102 81.0230
views Video_category_31 - Video_category_33 0.7647 0.2299 115 3.3268 0.0034 2.1483 114.8299
views Video_category_32 - Video_category_33 0.1712 0.2583 115 0.6630 0.7854 1.1868 18.6755
like Video_category_31 - Video_category_32 0.7524 0.1992 115 3.7767 < .001 2.1221 112.2064
like Video_category_31 - Video_category_33 0.7621 0.2646 115 2.8802 0.0131 2.1428 114.2830
like Video_category_32 - Video_category_33 0.0097 0.2958 115 0.0329 0.9994 1.0098 0.9786
like_rate Video_category_31 - Video_category_32 0.1589 0.0561 115 2.8347 0.0149 1.1723 17.2262
like_rate Video_category_31 - Video_category_33 -0.0025 0.0767 115 -0.0332 0.9994 0.9975 -0.2546
like_rate Video_category_32 - Video_category_33 -0.1615 0.0833 115 -1.9387 0.1325 0.8509 -14.9120
comment Video_category_31 - Video_category_32 0.7546 0.2161 115 3.4914 0.002 2.1267 112.6716
comment Video_category_31 - Video_category_33 0.8895 0.3190 115 2.7886 0.0169 2.4340 143.3985
comment Video_category_32 - Video_category_33 0.1350 0.3488 115 0.3869 0.9209 1.1445 14.4480
comment_rate Video_category_31 - Video_category_32 0.1611 0.0922 115 1.7467 0.1924 1.1748 17.4832
comment_rate Video_category_31 - Video_category_33 0.1249 0.1437 115 0.8688 0.661 1.1330 13.2982
comment_rate Video_category_32 - Video_category_33 -0.0363 0.1539 115 -0.2357 0.9699 0.9644 -3.5622
share Video_category_31 - Video_category_32 0.3326 0.3055 115 1.0887 0.523 1.3946 39.4562
share Video_category_31 - Video_category_33 0.7463 0.4014 115 1.8591 0.1554 2.1092 110.9250
share Video_category_32 - Video_category_33 0.4138 0.4359 115 0.9493 0.6103 1.5125 51.2481
share_rate Video_category_31 - Video_category_32 -0.2609 0.1780 115 -1.4659 0.3111 0.7704 -22.9621
share_rate Video_category_31 - Video_category_33 -0.0183 0.2328 115 -0.0788 0.9966 0.9818 -1.8177
share_rate Video_category_32 - Video_category_33 0.2425 0.2453 115 0.9886 0.5856 1.2745 27.4468
pos_comm Video_category_31 - Video_category_32 0.6568 0.2017 115 3.2567 0.0042 1.9287 92.8673
pos_comm Video_category_31 - Video_category_33 0.4031 0.2439 115 1.6524 0.2281 1.4965 49.6454
pos_comm Video_category_32 - Video_category_33 -0.2537 0.2733 115 -0.9285 0.6235 0.7759 -22.4102
neg_comm Video_category_31 - Video_category_32 0.5815 0.2092 115 2.7803 0.0173 1.7887 78.8713
neg_comm Video_category_31 - Video_category_33 0.9229 0.2897 115 3.1858 0.0052 2.5166 151.6607
neg_comm Video_category_32 - Video_category_33 0.3414 0.3188 115 1.0710 0.5339 1.4069 40.6937
host_comm Video_category_31 - Video_category_32 0.5532 0.2066 115 2.6774 0.023 1.7388 73.8751
host_comm Video_category_31 - Video_category_33 0.6146 0.2652 115 2.3174 0.0574 1.8490 84.8972
host_comm Video_category_32 - Video_category_33 0.0615 0.2755 115 0.2231 0.9729 1.0634 6.3391