1. Giới thiệu

1.1. Bối cảnh

Trong thời đại số, nền tảng TikTok đã trở thành một trong những kênh mạng xã hội phổ biến nhất trên toàn cầu, đặc biệt là trong lĩnh vực giải trí và marketing. Việc phân tích dữ liệu từ các video TikTok giúp chúng ta hiểu rõ hơn về hành vi người dùng, xu hướng nội dung, cũng như các yếu tố ảnh hưởng đến mức độ lan truyền của video

Tập dữ liệu tiktok_dataset.csv được sử dụng trong phân tích này bao gồm các cột:

Nguồn: ở đây

1.2. Mục tiêu

Phân tích khám phá dữ liệu (EDA) và trực quan hóa dữ liệu. Xem xét cấu trúc và dọn dẹp dữ liệu, cũng như bất kỳ trực quan hóa một số biến trong dữ liệu. Kiểm tra các giá trị ngoại lệ của các biến quan trọng nhất (như video_duration_sec, video_like_count, video_comment_count và video_view_count,v.v).

Xác định và tiến hành các giả thuyết thống kê và phân tích thống kê cần thiết cho dự án phân loại TikTok.

Thực hiện hồi quy logistic bằng cách sử dụng trạng thái đã xác minh (verified_status) làm biến kết quả. Kết quả có thể được sử dụng để cung cấp thông tin cho mô hình cuối cùng liên quan đến việc dự đoán xem video có phải là khiếu nại (claim) hay ý kiến (opinion) hay không.

2. Khám phá dữ liệu

Trước hết ta cần chuẩn bị một số gói lệnh cần thiết trong R. Cũng như đọc dữ liệu.

if (!require("pacman")) install.packages("pacman")
pacman::p_load("readr", "lubridate", "dplyr", "ggplot2", 
               "plotly", "corrplot", "skimr", "car", "caret")
options(repr.plot.width = 16, repr.plot.height = 8) 

df <- read_csv("tiktok_dataset.csv")
head(df)

## # A tibble: 6 × 12
##     `#` claim_status   video_id video_duration_sec video_transcription_text     
##   <dbl> <chr>             <dbl>              <dbl> <chr>                        
## 1     1 claim        7017666017                 59 someone shared with me that …
## 2     2 claim        4014381136                 32 someone shared with me that …
## 3     3 claim        9859838091                 31 someone shared with me that …
## 4     4 claim        1866847991                 25 someone shared with me that …
## 5     5 claim        7105231098                 19 someone shared with me that …
## 6     6 claim        8972200955                 35 someone shared with me that …
## # ℹ 7 more variables: verified_status <chr>, author_ban_status <chr>,
## #   video_view_count <chr>, video_like_count <chr>, video_share_count <chr>,
## #   video_download_count <chr>, video_comment_count <chr>

Các cột

• #, video_id thay vì ở định dạng character thì lại ở dạng double.

• video_view_count, video_like_count, video_share_count, video_download_count, video_comment_count thay vì ở định dạng double thì lại ở dạng character. Do đó ta sẽ điều chình nó bằng các

col <- c("#", "video_id", "video_view_count","video_like_count", 
         "video_share_count", "video_download_count",
         "video_comment_count")

for (i in 1:7){
  if (is.character(df[[col[i]]])){
    df[[col[i]]] <- as.double(df[[col[i]]])
  }
  else {
    df[[col[i]]] <- as.character(df[[col[i]]])
  }
}

2.1. Thông tin tổng quan

skim_without_charts(df)

Variable type: character

Variable type: numeric

Dữ liệu chứa 298 giá trị thiếu ở biến claim và ở các biến cũng có số lượng giá trị thiếu tương tự, như vậy có thể các giá trị thiếu đều xảy ra ở cùng một quan sát giống nhau.

Tỷ lệ giá trị thiếu \(\dfrac{298}{19382} = 1.54\%\) quá nhỏ nên không có ảnh hưởng lớn đến tổng thể dữ liệu.

df <- na.omit(df)
sum(is.na(df)) == 0

## [1] TRUE

2.2. Xây dựng trực quan

video_duration_sec

Tạo biểu đồ hộp để tìm các giá trị ngoại lệ (outliers)

fig <- df %>% 
  ggplot(aes(, video_duration_sec)) + 
  geom_boxplot(colour = 'blue', outlier.shape = 1)
ggplotly(fig)

Tạo biểu đồ histogram để xác định phân phối

bins = max(df$video_duration_sec) - min(df$video_duration_sec) + 1
fig <- df %>% 
  ggplot(aes(video_duration_sec, fill = verified_status)) + 
  geom_histogram(bins = bins) 
ggplotly(fig)

Nhận xét:

• Biến không có các giá trị ngoại lệ.
• Các video có độ dài từ 5 đến 60 giây có phân phối đều.

video_view_count

fig <- df %>% 
  ggplot(aes(, video_view_count)) + 
  geom_boxplot(colour = 'blue', outlier.shape = 1)
ggplotly(fig)

bins = round(max(df$video_view_count, na.rm = TRUE)/50000) + 1
fig <- df %>% 
  ggplot(aes(video_view_count, fill = verified_status)) + 
  geom_histogram(bins = bins) 
ggplotly(fig)

Nhận xét:

• Biến không có các giá trị ngoại lệ.
• Biến có phân phôi không đều, các video có lược xem khoảng 100,000 chiếm phần lớn, các nhóm video còn lại có phân phối đều.

video_like_count

fig <- df %>% 
  ggplot(aes(, video_like_count)) + 
  geom_boxplot(colour = 'blue', outlier.shape = 1)
ggplotly(fig)

bins = round(max(df$video_like_count, na.rm = TRUE)/50000) + 1
fig <- df %>% 
  ggplot(aes(video_like_count, fill = verified_status)) + 
  geom_histogram(bins = bins) 
ggplotly(fig)

Nhận xét:

• Biến chứa rất nhiều giá trị ngoại lệ.
• Phân phối của biến không đều, số lượng video có lược like dưới 100,000 chiếm phần lớn, các nhóm còn lại có xu hướng giảm dần.

video_comment_count

fig <- df %>% 
  ggplot(aes(, video_comment_count)) + 
  geom_boxplot(colour = 'blue', outlier.shape = 1)
ggplotly(fig)

bins = round(max(df$video_comment_count, na.rm = TRUE)/1000) + 1
fig <- df %>% 
  ggplot(aes(video_comment_count, fill = verified_status)) + 
  geom_histogram(bins = bins) 
ggplotly(fig)

Nhận xét:

• Cũng như biến video_like_count có rất nhiều giá trị ngoại lệ.
• Phân phối của biến không đều, số lượng video có lược like dưới 1,000 chiếm phần lớn, các nhóm còn lại có xu hướng giảm dần.

video_share_count

fig <- df %>% 
  ggplot(aes(, video_share_count)) + 
  geom_boxplot(colour = 'blue', outlier.shape = 1)
ggplotly(fig)

bins = round(max(df$video_share_count, na.rm = TRUE)/25000) + 1
fig <- df %>% 
  ggplot(aes(video_share_count, fill = verified_status)) + 
  geom_histogram(bins = bins) 
ggplotly(fig)

Nhận xét:

• Tương tự biến video_like_count có rất nhiều giá trị ngoại lệ.
• Phân phối của biến không đều, số lượng video có lược like dưới 25,000 chiếm phần lớn, các nhóm còn lại có xu hướng giảm dần.

video_download_count

fig <- df %>% 
  ggplot(aes(,video_download_count)) + 
  geom_boxplot(colour = 'blue', outlier.shape = 1)
ggplotly(fig)

bins = round(max(df$video_download_count, na.rm = TRUE)/1000) + 1
fig <- df %>% 
  ggplot(aes(video_download_count, fill = verified_status)) + 
  geom_histogram(bins = bins) 
ggplotly(fig)

Nhận xét:

• Tương tự biến video_like_count có rất nhiều giá trị ngoại lệ.
• Phân phối của biến không đều, số lượng video có lược like dưới 1500 chiếm phần lớn, các nhóm còn lại có xu hướng giảm dần.

len_text

df$len_text <- as.numeric(lapply(df$video_transcription_text, nchar))
bins = round((max(df$len_text) - min(df$len_text))/2) + 1
fig <- df %>% 
  ggplot(aes(len_text, fill = verified_status)) + 
  geom_histogram(bins = bins) 
ggplotly(fig)

Nhận xét: phân phối của tổng sô ký tự trong mô tả video có phân phối xấp xỉ chuẩn

2.3. Biểu đồ liên quan đến claim_status

df %>% group_by(claim_status) %>% 
  summarise(count = n()) %>% 
  ggplot(aes(x = 2, y = count, fill = claim_status)) +
  geom_bar(stat = "identity", width = 1, color = "white") +
  coord_polar("y") +
  xlim(0.5, 3.5) +
  theme_void() + 
  labs(title = "Ratio of claim_status") +
  geom_text(aes(label = paste0(round(count/sum(count)*100,2), "%")),
            position = position_stack(vjust = 0.5)) +
  scale_fill_manual(values = c("#0072b2", "#e69f00"))

df %>% group_by(claim_status) %>% 
  summarise(sum_view = sum(video_view_count)) %>% 
  ggplot(aes(x = 2, y = sum_view, fill = claim_status)) +
  geom_bar(stat = "identity", width = 1, color = "white") +
  coord_polar("y") +
  xlim(0.5, 3.5) +
  theme_void() + 
  labs(title = "Ratio of Total views by claim_status") +
  geom_text(aes(label = paste0(round(sum_view/sum(sum_view)*100,2), "%")),
            position = position_stack(vjust = 0.5))+
  scale_fill_manual(values = c("#0072b2", "#e69f00"))

df %>% ggplot(aes(claim_status, fill = claim_status)) + 
  geom_bar(stat = "count") + 
  facet_wrap(~ verified_status) +
  geom_text(stat = "count", aes(label = ..count..), vjust = "bottom") + 
  labs(title = "Count Verfied status by Claim status") +
  theme(legend.position = "none") +
  scale_fill_manual(values = c("#0072b2", "#e69f00"))

df %>% ggplot(aes(claim_status, fill = claim_status)) + 
  geom_bar(stat = "count") + 
  facet_wrap(~ author_ban_status) +
  geom_text(stat = "count", aes(label = ..count..), vjust = "bottom") + 
  labs(title = "Count Author ban status by Claim status") +
  theme(legend.position = "none") +
  scale_fill_manual(values = c("#0072b2", "#e69f00"))

Đối với cả claim (khiếu nại) và opinion (ý kiến), có nhiều tác giả active (tích cực) hơn so với tác giả banded (bị cấm) hoặc tác giả under review (đang được xem xét); tuy nhiên, tỷ lệ tác giả tích cực đối với video ý kiến lớn hơn nhiều so với video khiếu nại. Một lần nữa, có vẻ như các tác giả đăng video khiếu nại có nhiều khả năng bị xem xét và/hoặc bị cấm hơn.

2.4. Xác định các giá trị ngoại lệ

col <- c("video_view_count","video_like_count", 
         "video_share_count", "video_download_count",
         "video_comment_count")

for (i in 1:5){
  q1 = quantile(as.double(df[[col[i]]]), 0.25, na.rm = TRUE)
  q3 = quantile(as.double(df[[col[i]]]), 0.75, na.rm = TRUE)
  iqr = as.double(q3) - as.double(q1)
  median = median(as.double(df[[col[i]]]))
  outlier_threshold = median + 1.5*iqr
  
  outlier_count = sum(as.double(df[[col[i]]]) > outlier_threshold, na.rm = TRUE)
  print(paste("Tổng số ngoại lệ của", paste0(col[i], ":"), outlier_count))
}

## [1] "Tổng số ngoại lệ của video_view_count: 2343"
## [1] "Tổng số ngoại lệ của video_like_count: 3468"
## [1] "Tổng số ngoại lệ của video_share_count: 3732"
## [1] "Tổng số ngoại lệ của video_download_count: 3733"
## [1] "Tổng số ngoại lệ của video_comment_count: 3882"

df %>% ggplot(aes(x = video_view_count, y = video_like_count)) + 
  geom_point(aes(colour = factor(claim_status))) + 
  labs(color = "claim_status") +
  scale_colour_manual(values = c("#0072b2", "#e69f00"))

3. Kiểm tra giả thuyết

3.1. Trung bình lược xem

• \(H_0\): Không có sự khác biệt về trung bình lược xem của cả hai nhóm verified và not verified.
• \(H_a\): Có sự khác biệt về trung bình lược xem của cả hai nhóm verified và not verified.

t.test(video_view_count ~ verified_status, data = df, var.equal = FALSE)

## 
##  Welch Two Sample t-test
## 
## data:  video_view_count by verified_status
## t = 25.499, df = 1571.2, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group not verified and group verified is not equal to 0
## 95 percent confidence interval:
##  160822.9 187626.4
## sample estimates:
## mean in group not verified     mean in group verified 
##                  265663.79                   91439.16

Với giá trị p-value < 2.2e-16 \(\approx\) 0 có đủ bằng chứng để bác bỏ giả thuyết \(H_0\), chấp nhận \(H_a\). Do đó có sự khác biệt về trung bình lược xem của các video.

3.2. Tính độc lập

verified_status và claim_status

• \(H_0\): Hai biến verified_status và claim_status có tính độc lập.
• \(H_a\): Hai biến verified_status và claim_status không có tính độc lập.

chisq.test(table(df$verified_status, df$claim_status))

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  table(df$verified_status, df$claim_status)
## X-squared = 554.02, df = 1, p-value < 2.2e-16

Với giá trị p-value < 2.2e-16 \(\approx\) 0 có đủ bằng chứng để bác bỏ giả thuyết \(H_0\), chấp nhận \(H_a\). Tức là hai biến không có tính độc lập, nghĩa là hai biên có mối liên hệ

verified_status và author_ban_status

• \(H_0\): Hai biến verified_status và author_ban_status có tính độc lập.
• \(H_a\): Hai biến verified_status và author_ban_status không có tính độc lập.

chisq.test(table(df$verified_status, df$author_ban_status))

## 
##  Pearson's Chi-squared test
## 
## data:  table(df$verified_status, df$author_ban_status)
## X-squared = 71.205, df = 2, p-value = 3.451e-16

Với giá trị p-value < 3.451e-16 \(\approx\) 0 có đủ bằng chứng để bác bỏ giả thuyết \(H_0\), chấp nhận \(H_a\). Tức là hai biến không có tính độc lập, nghĩa là hai biến có mối liên hệ

4. Xây dựng mô hình phân loại cho biếnverified_status

4.1. Xác định tính tương quan của các biến

cordf <- df %>% 
  select("video_duration_sec", "video_view_count", 
         "video_like_count", "video_share_count",
         "video_download_count", "video_comment_count", 
         "len_text")
corr <- cor(cordf)
corr <- `colnames<-`(corr, c("duration", "view", "like", "share",
                             "download", "comment", "len_text"))
corr <- `rownames<-`(corr, c("duration", "view", "like", "share",
                             "download", "comment", "len_text"))
corrplot.mixed(corr, upper = "square", tl.pos = 'lt',
               order = 'AOE', lower.col = "#000000")

Nhận xét:

• Biến video_like_count có tương quan mạnh với với biến video_share_count, video_view_count và video_download_count.
• Biến video_download_count và biến video_comment_count có tương quan mạnh.

Do dó có hiện tượng đa cộng tuyến giữa các biến. Điều này là không thể tránh khỏi vì các video trên bất kỳ nên tản nào thì các hình thức tương tác đều có mối liên hệ với nhau.

4.2. Tạo biến phân loại và biến giả

md_df <- df %>% 
  select("video_duration_sec", "video_view_count", 
         "video_like_count", "video_share_count",
         "video_download_count", "video_comment_count", 
         "len_text")

md_df$verified <- ifelse(df$verified_status == "verified", 1, 0)
md_df$claim <- ifelse(df$claim_status == "claim", 1, 0)
md_df$author_ban_active = ifelse(df$author_ban_status == "active", 1,0)
md_df$author_ban_banned = ifelse(df$author_ban_status == "banned", 1,0)
skim_without_charts(md_df)

Variable type: numeric

row <- nrow(md_df)
df_test <- md_df[(round(0.75*row):row),]

verified_test <- df_test$verified

df_test$verified_status <- NULL
df_test$video_view_count <- NULL
df_test$video_view_count <- NULL

md <- glm(verified ~ video_duration_sec + video_view_count +
            video_like_count + video_share_count + 
            video_download_count + len_text + claim +
            author_ban_active + author_ban_banned,
          md_df, family = "binomial")
car::vif(md)

##   video_duration_sec     video_view_count     video_like_count 
##             1.000764             5.975007             9.401172 
##    video_share_count video_download_count             len_text 
##             4.466353             3.304519             1.062962 
##                claim    author_ban_active    author_ban_banned 
##             3.510806             1.592432             1.542392

Theo Hair et al. (2014) gợi ý: < 5 là chấp nhận được, 5–10 cần đánh giá và > 10 cần can thiệp. Do đó ta loại 2 biến có VIF > 5 ra khỏi mô hình là các biến video_like_count và video_view_count

md <- glm(verified ~ video_duration_sec + video_share_count + 
            video_download_count + len_text + claim +
            author_ban_active + author_ban_banned,
          md_df, family = "binomial")
vif(md)

##   video_duration_sec    video_share_count video_download_count 
##             1.000773             2.370360             2.344616 
##             len_text                claim    author_ban_active 
##             1.062956             1.917576             1.592355 
##    author_ban_banned 
##             1.542066

Hệ số VIF đều nhỏ hơn 5 cho thấy việc loại bỏ biến có tác động tích cực đến mô hình.

prob <- predict(md, newdata = df_test, type = "response")
pred <- ifelse(prob > 0.5, 1, 0)
confusionMatrix(factor(pred), factor(verified_test), positive = "1")

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction    0    1
##          0 4289  483
##          1    0    0
##                                           
##                Accuracy : 0.8988          
##                  95% CI : (0.8899, 0.9072)
##     No Information Rate : 0.8988          
##     P-Value [Acc > NIR] : 0.5121          
##                                           
##                   Kappa : 0               
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.0000          
##             Specificity : 1.0000          
##          Pos Pred Value :    NaN          
##          Neg Pred Value : 0.8988          
##              Prevalence : 0.1012          
##          Detection Rate : 0.0000          
##    Detection Prevalence : 0.0000          
##       Balanced Accuracy : 0.5000          
##                                           
##        'Positive' Class : 1               
## 

Mặc dù độ chính xác tổng thể (accuracy) đạt 89.88%, mô hình logistic không nhận diện được bất kỳ trường hợp dương tính nào (Sensitivity hay Recall = 0). Mcnemar’s test p-value < 2e-16 nghĩa là có chênh lệch giữa 2 loại lỗi có ý nghĩa thống kê — mô hình lệch. Prevalence = 10.12% có nhãn là 1 (tức là verified) dữ liệu dữ liệu mất cân bằng rõ rệt

Kết quả dự báo đều nhận được kết quả là not verified là do tỷ lệ của dữ liệu không đều.

table(df$verified_status) # Toàn bộ dữ liệu

## 
## not verified     verified 
##        17884         1200

table(verified_test) # Tập test

## verified_test
##    0    1 
## 4289  483

Hệ số hồi quy

summary(md)

## 
## Call:
## glm(formula = verified ~ video_duration_sec + video_share_count + 
##     video_download_count + len_text + claim + author_ban_active + 
##     author_ban_banned, family = "binomial", data = md_df)
## 
## Coefficients:
##                        Estimate Std. Error z value Pr(>|z|)    
## (Intercept)          -2.069e+00  1.860e-01 -11.124   <2e-16 ***
## video_duration_sec   -2.589e-03  1.862e-03  -1.390   0.1645    
## video_share_count     4.208e-06  2.011e-06   2.092   0.0364 *  
## video_download_count -5.468e-05  3.654e-05  -1.496   0.1345    
## len_text             -1.193e-03  1.544e-03  -0.772   0.4399    
## claim                -1.644e+00  1.075e-01 -15.302   <2e-16 ***
## author_ban_active     1.117e-01  1.244e-01   0.898   0.3694    
## author_ban_banned    -6.764e-02  1.935e-01  -0.350   0.7266    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 8962.6  on 19083  degrees of freedom
## Residual deviance: 8354.4  on 19076  degrees of freedom
## AIC: 8370.4
## 
## Number of Fisher Scoring iterations: 6

Các giá trị ước lượng (cột Estimate) của hệ số hồi quy đều có ý nghĩa thống kế với các mức ý nghĩa khác nhau theo cột Pr(>|z|).