data <- read.csv ("C:/Users/ADMIN/Desktop/PTDL DINH TINH/Students Social Media Addiction.csv", header = T)
str(data)
## 'data.frame': 705 obs. of 13 variables:
## $ Student_ID : int 1 2 3 4 5 6 7 8 9 10 ...
## $ Age : int 19 22 20 18 21 19 23 20 18 21 ...
## $ Gender : chr "Female" "Male" "Female" "Male" ...
## $ Academic_Level : chr "Undergraduate" "Graduate" "Undergraduate" "High School" ...
## $ Country : chr "Bangladesh" "India" "USA" "UK" ...
## $ Avg_Daily_Usage_Hours : num 5.2 2.1 6 3 4.5 7.2 1.5 5.8 4 3.3 ...
## $ Most_Used_Platform : chr "Instagram" "Twitter" "TikTok" "YouTube" ...
## $ Affects_Academic_Performance: chr "Yes" "No" "Yes" "No" ...
## $ Sleep_Hours_Per_Night : num 6.5 7.5 5 7 6 4.5 8 6 6.5 7 ...
## $ Mental_Health_Score : int 6 8 5 7 6 4 9 6 7 7 ...
## $ Relationship_Status : chr "In Relationship" "Single" "Complicated" "Single" ...
## $ Conflicts_Over_Social_Media : int 3 0 4 1 2 5 0 2 1 1 ...
## $ Addicted_Score : int 8 3 9 4 7 9 2 8 5 4 ...
Giải thích:
# Chọn các biến định tính
dldt <- c("Age", "Gender", "Academic_Level", "Country", "Most_Used_Platform", "Affects_Academic_Performance", "Relationship_Status")
# Tạo bộ dữ liệu mới chỉ chứa định tính
dat <- data[, dldt]
Bộ dữ liệu Social Media Addiction này gồm 705 quan sát tương ứng với từng học sinh, sinh viên bao gồm thông tin cá nhân, tần suất sử dụng mạng xã hội, chi tiết các nền tảng mạng xã hội, các thông tin liên quan đến sức khoẻ, tình trạng hôn nhân, mức độ nghiện mạng xã hội.
Bộ dữ liệu Social Media Addiction vs Relationships cung cấp thông tin từ 705 sinh viên về hành vi sử dụng mạng xã hội, đặc điểm nhân khẩu học, sức khỏe tâm thần và tình trạng các mối quan hệ cá nhân. Bộ dữ liệu này có thể được sử dụng để phân tích mối liên hệ giữa mức độ nghiện mạng xã hội và các yếu tố như chất lượng mối quan hệ, giấc ngủ, kết quả học tập và sức khỏe tâm lý. Ngoài ra, nó còn cho phép so sánh hành vi sử dụng mạng xã hội giữa các nhóm theo giới tính, độ tuổi, quốc gia hoặc trình độ học vấn. Với dữ liệu định lượng và định tính phong phú, bộ dữ liệu này rất phù hợp cho các nghiên cứu trong lĩnh vực tâm lý học, xã hội học, giáo dục hoặc y tế công cộng, đồng thời có thể hỗ trợ trong việc xây dựng các mô hình dự đoán nguy cơ nghiện mạng xã hội và đề xuất các biện pháp can thiệp nhằm cải thiện chất lượng cuộc sống và mối quan hệ cá nhân của giới trẻ.
Cấu trúc bộ dữ liệu Supermarket Transactions
Nhưng với yêu cầu chỉ sử dụng các biến định tính để phân tính nên chúng ta chỉ quan tâm đến các biến như sau :
Giải thích:
sapply(dat, …): áp dụng hàm cho từng cột trong dữ liệu dat.
sum(is.na(x)): đếm số lượng NA trong từng cột.
# Kiểm tra số lượng NA trong mỗi cột định tính
na_counts <- sapply(dat, function(x) sum(is.na(x)))
na_counts
## Age Gender
## 0 0
## Academic_Level Country
## 0 0
## Most_Used_Platform Affects_Academic_Performance
## 0 0
## Relationship_Status
## 0
Nhận xét - Kết quả thu được cho thấy rằng tất cả các cột định tính đều không có giá trị thiếu (NA) vì số lượng NA trong các cột đều hiển thị là 0
# Chuyển các biến định tính sang factor
dat$Gender <- as.factor(dat$Gender)
dat$Academic_Level <- as.factor(dat$Academic_Level)
dat$Country <- as.factor(dat$Country)
dat$Most_Used_Platform <- as.factor(dat$Most_Used_Platform)
dat$Affects_Academic_Performance <- as.factor(dat$Affects_Academic_Performance)
dat$Relationship_Status <- as.factor(dat$Relationship_Status)
Kiểm tra lại sau khi chuyển đổi
Giải thích:
sapply(dat, class): Áp dụng hàm class() cho từng cột để kiểm tra kiểu dữ liệu. Kết quả trả về là một vector hiển thị tên cột và loại dữ liệu tương ứng.
Nếu kết quả là “factor” cho tất cả các cột → chuyển đổi thành công.
sapply(dat, class)
## Age Gender
## "integer" "factor"
## Academic_Level Country
## "factor" "factor"
## Most_Used_Platform Affects_Academic_Performance
## "factor" "factor"
## Relationship_Status
## "factor"
Nhận xét : Kết quả thu được toàn bộ các biến đã được chuyển đổi thành dạng factor.
install.packages("ggplot2", repos = "https://cloud.r-project.org")
## Installing package into 'C:/Users/ADMIN/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
##
## There is a binary version available but the source version is later:
## binary source needs_compilation
## ggplot2 3.5.1 3.5.2 FALSE
## installing the source package 'ggplot2'
library(ggplot2)
tab_age <- table(dat$Age)
tab_age
##
## 18 19 20 21 22 23 24
## 14 163 165 156 147 34 26
table(dat$Age)/sum(nrow(dat))
##
## 18 19 20 21 22 23 24
## 0.01985816 0.23120567 0.23404255 0.22127660 0.20851064 0.04822695 0.03687943
ggplot(dat, aes(x = Age)) +
geom_bar(fill = "steelblue") +
theme_minimal() +
labs(title = "Tần suất theo độ tuổi", x = "Độ tuổi", y = "Số lượng")
Độ tuổi của người tham gia khảo sát chủ yếu tập trung vào khoảng từ 19 đến 22 tuổi, chiếm khoảng 89.5% tổng số mẫu. Cụ thể:
Các nhóm tuổi 23 và 24 có tỷ lệ thấp hơn đáng kể (chỉ khoảng 8.5% tổng số mẫu), có thể là nhóm sinh viên năm cuối, học cao học hoặc đã tốt nghiệp.
Tuổi 18 chiếm một phần rất nhỏ (1.99%), cho thấy người tham gia khảo sát có độ tuổi bắt đầu từ giai đoạn mới vào đại học hoặc cuối trung học phổ thông.
Phân bố độ tuổi khá tập trung và lệch trái nhẹ, cho thấy đối tượng khảo sát tương đối đồng nhất về mặt độ tuổi – chủ yếu là thanh niên, sinh viên.
Điều này phù hợp với mục tiêu nghiên cứu liên quan đến nghiện mạng xã hội và các mối quan hệ, vì đây là nhóm tuổi sử dụng mạng xã hội thường xuyên và dễ bị ảnh hưởng nhất.
Biến Age trong bộ dữ liệu thể hiện rõ rằng đối tượng nghiên cứu chủ yếu là sinh viên trong độ tuổi từ 19 đến 22, với độ tuổi 20 là phổ biến nhất. Đây là nhóm tuổi quan trọng để nghiên cứu các vấn đề liên quan đến hành vi sử dụng mạng xã hội, sức khỏe tâm thần và chất lượng các mối quan hệ, do họ đang trong giai đoạn phát triển mạnh về mặt xã hội và tâm lý.
install.packages("dplyr", repos = "https://cloud.r-project.org")
## Installing package into 'C:/Users/ADMIN/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
## package 'dplyr' successfully unpacked and MD5 sums checked
## Warning: cannot remove prior installation of package 'dplyr'
## Warning in file.copy(savedcopy, lib, recursive = TRUE): problem copying
## C:\Users\ADMIN\AppData\Local\R\win-library\4.3\00LOCK\dplyr\libs\x64\dplyr.dll
## to C:\Users\ADMIN\AppData\Local\R\win-library\4.3\dplyr\libs\x64\dplyr.dll:
## Permission denied
## Warning: restored 'dplyr'
##
## The downloaded binary packages are in
## C:\Users\ADMIN\AppData\Local\Temp\RtmpqQTDwM\downloaded_packages
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.3.3
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
tab_gender <- table(dat$Gender)
tab_gender
##
## Female Male
## 353 352
table(dat$Gender)/sum(nrow(dat))
##
## Female Male
## 0.5007092 0.4992908
# Tạo dataframe từ bảng tần số
gender_freq <- as.data.frame(tab_gender)
colnames(gender_freq) <- c("Gender", "Frequency")
# Tính phần trăm
gender_freq$Percentage <- gender_freq$Frequency / sum(gender_freq$Frequency) * 100
# Tạo nhãn chỉ gồm phần trăm
gender_freq$Label <- paste0(round(gender_freq$Percentage, 1), "%")
# Vẽ biểu đồ tròn với nhãn chỉ phần trăm
ggplot(gender_freq, aes(x = "", y = Percentage, fill = Gender)) +
geom_col(width = 1, color = "white") +
coord_polar(theta = "y") +
theme_void() +
geom_text(aes(label = Label), position = position_stack(vjust = 0.5), size = 5) +
labs(title = "Phân bố giới tính người tham gia khảo sát") +
scale_fill_brewer(palette = "Pastel1")
Giải thích code
tab_gender là bảng tần số kiểu table đếm số lượng từng nhóm trong biến Gender.
as.data.frame(tab_gender) chuyển bảng tần số thành dạng data frame để dễ xử lý.
Đổi tên cột thành “Gender” (nhóm giới tính) và “Frequency” (số lượng).
Đổi tên cột thành “Gender” (nhóm giới tính) và “Frequency” (số lượng).
tab_gender là bảng tần số kiểu table đếm số lượng từng nhóm trong biến Gender.
as.data.frame(tab_gender) chuyển bảng tần số thành dạng data frame để dễ xử lý.
Tạo cột Label để dùng làm nhãn trên biểu đồ.
Dùng round() làm tròn số phần trăm đến 1 chữ số thập phân.
Kết hợp phần trăm với ký hiệu % thành chuỗi ký tự.
ggplot(gender_freq, aes(x = ““, y = Percentage, fill = Gender)):
geom_col(width = 1, color = “white”):
coord_polar(theta = “y”):
theme_void():
geom_text(aes(label = Label), position = position_stack(vjust = 0.5), size = 5):
labs(title = “Phân bố giới tính người tham gia khảo sát”):
scale_fill_brewer(palette = “Pastel1”):
tab_academic <- table(dat$Academic_Level)
tab_academic
##
## Graduate High School Undergraduate
## 325 27 353
table(dat$Academic_Level)/sum(nrow(dat))
##
## Graduate High School Undergraduate
## 0.46099291 0.03829787 0.50070922
# Tạo bảng tần số
tab_academic <- table(dat$Academic_Level)
# Chuyển sang data frame
academic_freq <- as.data.frame(tab_academic)
colnames(academic_freq) <- c("Academic_Level", "Frequency")
# Tính phần trăm
academic_freq$Percentage <- academic_freq$Frequency / sum(academic_freq$Frequency) * 100
# Tạo nhãn chỉ gồm phần trăm
academic_freq$Label <- paste0(round(academic_freq$Percentage, 1), "%")
ggplot(academic_freq, aes(x = "", y = Percentage, fill = Academic_Level)) +
geom_col(width = 1, color = "white") +
coord_polar(theta = "y") +
theme_void() +
geom_text(aes(label = Label),
position = position_stack(vjust = 0.5), size = 4) +
labs(title = "Phân bố trình độ học vấn của người tham gia") +
scale_fill_brewer(palette = "Set3")
tab_platform <- table(dat$Most_Used_Platform)
tab_platform
##
## Facebook Instagram KakaoTalk LINE LinkedIn Snapchat TikTok Twitter
## 123 249 12 12 21 13 154 30
## VKontakte WeChat WhatsApp YouTube
## 12 15 54 10
table(dat$Most_Used_Platform)/sum(nrow(dat))
##
## Facebook Instagram KakaoTalk LINE LinkedIn Snapchat TikTok
## 0.17446809 0.35319149 0.01702128 0.01702128 0.02978723 0.01843972 0.21843972
## Twitter VKontakte WeChat WhatsApp YouTube
## 0.04255319 0.01702128 0.02127660 0.07659574 0.01418440
# Chuyển sang data frame
platform_freq <- as.data.frame(tab_platform)
colnames(platform_freq) <- c("Platform", "Frequency")
# Vẽ biểu đồ
ggplot(platform_freq, aes(x = reorder(Platform, -Frequency), y = Frequency, fill = Platform)) +
geom_bar(stat = "identity", width = 0.7) +
labs(title = "Nền tảng mạng xã hội được sử dụng nhiều nhất",
x = "Nền tảng",
y = "Số lượng người dùng") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Giải thích code
🔹 ggplot(…): hàm khởi tạo biểu đồ từ gói ggplot2.
🔹 platform_freq: là data frame chứa hai cột: Platform (tên nền tảng) và Frequency (tần số người dùng).
🔹 aes(…): khai báo “thẩm mỹ” – nghĩa là bạn chỉ định các biến nào dùng cho trục và màu:
🔹 geom_bar(): hàm vẽ biểu đồ cột.
🔹 stat = “identity”: báo rằng bạn đã cung cấp sẵn giá trị tần số, không cần ggplot tự đếm lại.
🔹 width = 0.7: độ rộng của các cột (0.7 là vừa đẹp).
🔹 Instagram là nền tảng phổ biến nhất:
Được sử dụng bởi hơn 35% người tham gia khảo sát. Điều này phù hợp với thực tế khi Instagram là mạng xã hội phổ biến nhất trong giới trẻ, đặc biệt là sinh viên – nhóm chiếm tỷ lệ lớn trong bộ dữ liệu. 🔹 TikTok và Facebook giữ vị trí tiếp theo:
TikTok: 21.84% – một tỷ lệ cao, phản ánh xu hướng tiêu thụ nội dung ngắn, nhanh và giải trí. Facebook: tuy là nền tảng lâu đời hơn nhưng vẫn được 17.45% người dùng chọn là nền tảng chính. 🔹 Các nền tảng còn lại có tỷ lệ rất thấp:
WhatsApp, Twitter, LinkedIn, WeChat, Snapchat, LINE, KakaoTalk, VKontakte,… đều dưới 10%. Điều này cho thấy nhóm khảo sát tập trung sử dụng mạng xã hội để xem nội dung, giải trí, hơn là nhắn tin chuyên nghiệp hay mạng lưới nghề nghiệp.
tab_affect <- table(dat$Affects_Academic_Performance)
tab_affect
##
## No Yes
## 252 453
table(dat$Affects_Academic_Performance)/sum(nrow(dat))
##
## No Yes
## 0.3574468 0.6425532
# Chuyển sang data frame
affect_freq <- as.data.frame(tab_affect)
colnames(affect_freq) <- c("Response", "Frequency")
# Tính phần trăm
affect_freq$Percentage <- affect_freq$Frequency / sum(affect_freq$Frequency) * 100
# Tạo nhãn hiển thị phần trăm
affect_freq$Label <- paste0(round(affect_freq$Percentage, 1), "%")
# Biểu đồ
ggplot(affect_freq, aes(x = "", y = Percentage, fill = Response)) +
geom_col(width = 1, color = "white") +
coord_polar(theta = "y") +
theme_void() +
geom_text(aes(label = Label),
position = position_stack(vjust = 0.5), size = 5) +
labs(title = "Mạng xã hội ảnh hưởng đến kết quả học tập") +
scale_fill_manual(values = c("#66c2a5", "#fc8d62")) # Chọn màu tùy
tab_relationship <- table(dat$Relationship_Status)
tab_relationship
##
## Complicated In Relationship Single
## 32 289 384
table(dat$Relationship_Status)/sum(nrow(dat))
##
## Complicated In Relationship Single
## 0.04539007 0.40992908 0.54468085
# Chuyển thành data frame
relationship_freq <- as.data.frame(tab_relationship)
colnames(relationship_freq) <- c("Status", "Frequency")
# Tính phần trăm
relationship_freq$Percentage <- relationship_freq$Frequency / sum(relationship_freq$Frequency) * 100
# Tạo nhãn phần trăm
relationship_freq$Label <- paste0(round(relationship_freq$Percentage, 1), "%")
# Biểu đồ
ggplot(relationship_freq, aes(x = "", y = Percentage, fill = Status)) +
geom_col(width = 1, color = "white") +
coord_polar(theta = "y") +
theme_void() +
geom_text(aes(label = Label),
position = position_stack(vjust = 0.5), size = 5) +
labs(title = "Tình trạng mối quan hệ của người tham gia khảo sát") +
scale_fill_brewer(palette = "Set1")
prop.test(x = sum(dat$Gender == "Male"),
n = nrow(dat),
p = 0.5, # Giả thuyết H0: p = 0.5
conf.level = 0.95)
##
## 1-sample proportions test with continuity correction
##
## data: sum(dat$Gender == "Male") out of nrow(dat), null probability 0.5
## X-squared = 0, df = 1, p-value = 1
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
## 0.4617813 0.5368081
## sample estimates:
## p
## 0.4992908
Giả thuyết:
Nhận xét
Giá trị p-value = 1 > 0.05 cho thấy không có bất kỳ bằng chứng thống kê nào để cho rằng tỷ lệ nam khác 50%.
Kết luận.
prop.test(x = sum(dat$Most_Used_Platform == "TikTok"),
n = nrow(dat),
p = 0.8, # Giả thuyết: 80% dùng TikTok
conf.level = 0.95)
##
## 1-sample proportions test with continuity correction
##
## data: sum(dat$Most_Used_Platform == "TikTok") out of nrow(dat), null probability 0.8
## X-squared = 1486.6, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.8
## 95 percent confidence interval:
## 0.1888401 0.2511618
## sample estimates:
## p
## 0.2184397
Giả thuyết kiểm định:
Nhận xét
Tỷ lệ người chọn TikTok là 21.8%, rất thấp so với giả thuyết ban đầu là 80%.
Khoảng tin cậy 95% nằm trong khoảng [18.9%, 25.1%], không bao gồm 80%.
p-value cực kỳ nhỏ (< 2.2e-16), cho thấy sự khác biệt là có ý nghĩa thống kê rất cao.
Kết luận
prop.test(
x = sum(dat$Academic_Level == "High School"),
n = nrow(dat),
p = 0.05,
alternative = "greater", # Một phía: kiểm định p > 0.05
conf.level = 0.95
)
##
## 1-sample proportions test with continuity correction
##
## data: sum(dat$Academic_Level == "High School") out of nrow(dat), null probability 0.05
## X-squared = 1.7936, df = 1, p-value = 0.9098
## alternative hypothesis: true p is greater than 0.05
## 95 percent confidence interval:
## 0.02746425 1.00000000
## sample estimates:
## p
## 0.03829787
Giả thuyết kiểm định:
Kết quả kiểm định:
Giá trị thống kê X-squared = 1.7936
p-value = 0.9098
Tỷ lệ mẫu (p̂) = 0.0383 (khoảng 3.8%)
Khoảng tin cậy 95% (một phía) là từ 2.75% đến 100% (được hiển thị như vậy do kiểm định 1 phía)
Nhận xét
p-value = 0.9098 > 0.05, do đó không có đủ bằng chứng để bác bỏ giả thuyết H₀.
Tỷ lệ học sinh THPT trong mẫu khảo sát là khoảng 3.8%, thấp hơn 5% giả định trong H₀.
Khoảng tin cậy thấp hơn 5%, chứng tỏ tỷ lệ thực sự có thể thấp hơn hoặc bằng 5%.
Như vậy, không có bằng chứng thống kê để kết luận rằng tỷ lệ học sinh THPT trong mẫu lớn hơn 5%.
Kết luận
Mục tiêu:
So sánh tỷ lệ người bị ảnh hưởng học tập do dùng mạng xã hội giữa 2 nhóm:
Tỷ lệ Undergraduate bị ảnh hưởng học tập có nhỏ hơn Graduate không?
# Tạo bảng 2 chiều giữa Academic_Level và Affects_Academic_Performance
tab_academic <- table(dat$Academic_Level, dat$Affects_Academic_Performance)
# Chỉ giữ lại Undergraduate và Graduate
tab_ug_g <- tab_academic[c("Undergraduate", "Graduate"), ]
prop.test(
x = c(tab_ug_g["Undergraduate", "Yes"], tab_ug_g["Graduate", "Yes"]),
n = c(sum(tab_ug_g["Undergraduate", ]), sum(tab_ug_g["Graduate", ])),
alternative = "less", # kiểm định 1 phía
conf.level = 0.95
)
##
## 2-sample test for equality of proportions with continuity correction
##
## data: c(tab_ug_g["Undergraduate", "Yes"], tab_ug_g["Graduate", "Yes"]) out of c(sum(tab_ug_g["Undergraduate", ]), sum(tab_ug_g["Graduate", ]))
## X-squared = 0.814, df = 1, p-value = 0.8165
## alternative hypothesis: less
## 95 percent confidence interval:
## -1.0000000 0.1003869
## sample estimates:
## prop 1 prop 2
## 0.6487252 0.6123077
H₀: p₁ - p₂ = 0 (tỷ lệ Undergraduate bằng Graduate)
H₁: p₁ - p₂ < 0 (tỷ lệ Undergraduate nhỏ hơn Graduate)
Nhận xét kết quả kiểm định
Kết luận
# Đếm số người "Single" bị ảnh hưởng học tập (Yes)
x <- sum(dat$Relationship_Status == "Single" & dat$Affects_Academic_Performance == "Yes")
# Tổng số người "Single"
n <- sum(dat$Relationship_Status == "Single")
# Ước lượng khoảng tin cậy 95% cho tỷ lệ dùng mạng xã hội ảnh hưởng học tập
prop.test(x = x, n = n, conf.level = 0.95)
##
## 1-sample proportions test with continuity correction
##
## data: x out of n, null probability 0.5
## X-squared = 67.503, df = 1, p-value < 2.2e-16
## alternative hypothesis: true p is not equal to 0.5
## 95 percent confidence interval:
## 0.6623351 0.7552421
## sample estimates:
## p
## 0.7109375
Giả thuyết kiểm định:
Kết quả thống kê:
Diễn giải kết quả
Tỷ lệ người độc thân bị ảnh hưởng bởi mạng xã hội là khoảng 71.1%, và khoảng tin cậy 95% nằm từ 66.2% đến 75.5%.
Khoảng tin cậy này không chứa 0.5, nghĩa là chúng ta loại bỏ H₀ (không có bằng chứng rằng tỷ lệ là 50%).
p-value < 0.001, cực kỳ nhỏ → nghĩa là xác suất để quan sát được tỷ lệ này nếu p = 0.5 là rất thấp, nên ta bác bỏ H₀.
# Tạo bảng tần số chéo
cross_gp <- table(dat$Gender, dat$Most_Used_Platform)
# Chuyển sang bảng tần suất theo phần trăm
cross_percent_gp <- prop.table(cross_gp) * 100
# Làm tròn và hiển thị
print(round(cross_percent_gp, 2))
##
## Facebook Instagram KakaoTalk LINE LinkedIn Snapchat TikTok Twitter
## Female 3.40 24.40 1.70 1.70 1.13 1.13 12.20 2.27
## Male 14.04 10.92 0.00 0.00 1.84 0.71 9.65 1.99
##
## VKontakte WeChat WhatsApp YouTube
## Female 0.00 0.57 1.56 0.00
## Male 1.70 1.56 6.10 1.42
# Chuyển sang data frame
cross_dfgp <- as.data.frame(cross_gp)
colnames(cross_dfgp) <- c("Gender", "Platform", "Percentage")
# Biểu đồ
ggplot(cross_dfgp, aes(x = Platform, y = Percentage, fill = Gender)) +
geom_col(position = "dodge") +
labs(title = "Tỷ lệ sử dụng mạng xã hội theo giới tính",
x = "Nền tảng mạng xã hội",
y = "Tỷ lệ (%)") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
scale_fill_brewer(palette = "Set2")
🔹 1. Instagram vượt trội ở nữ giới
🔹 2. Facebook ngược lại – phổ biến hơn ở nam giới
🔹 3. TikTok phổ biến ở cả hai giới
🔹 4. Một số nền tảng có tính giới tính hóa cao
🔹 5. WhatsApp, WeChat, LinkedIn, Twitter…: được cả 2 giới dùng nhưng nam thường chiếm tỷ lệ cao hơn.
# Tạo bảng tần số chéo
cross_gp <- table(dat$Gender, dat$Most_Used_Platform)
# Kiểm định
chisq.test(cross_gp, simulate.p.value = TRUE, B = 10000)
##
## Pearson's Chi-squared test with simulated p-value (based on 10000
## replicates)
##
## data: cross_gp
## X-squared = 154.33, df = NA, p-value = 9.999e-05
Các giả thuyết
Phương pháp
Kết quả
Nhận xét
Với mức ý nghĩa α = 0.05, giá trị p-value rất nhỏ (p-value ≈ 0.0001 < 0.05) nên bác bỏ giả thuyết không H₀.
Điều này cho thấy có bằng chứng thống kê mạnh mẽ để kết luận rằng:
Nghĩa là, sở thích sử dụng các nền tảng mạng xã hội khác nhau phụ thuộc vào giới tính, không phải ngẫu nhiên.
# Tạo bảng tần số chéo
cross_lp <- table(dat$Academic_Level, dat$Affects_Academic_Performance)
# Chuyển sang bảng tần suất theo phần trăm
cross_percent_lp <- prop.table(cross_lp) * 100
# Làm tròn và hiển thị
print(round(cross_percent_lp, 2))
##
## No Yes
## Graduate 17.87 28.23
## High School 0.28 3.55
## Undergraduate 17.59 32.48
# Chuyển sang data frame để vẽ
cross_dflp <- as.data.frame(cross_percent_lp)
colnames(cross_dflp) <- c("Academic_Level", "Affects", "Percentage")
# Biểu đồ
ggplot(cross_dflp, aes(x = Academic_Level, y = Percentage, fill = Affects)) +
geom_col(position = "dodge") +
labs(title = "Ảnh hưởng của mạng xã hội đến kết quả học tập theo trình độ học vấn",
x = "Trình độ học vấn",
y = "Tỷ lệ (%)") +
scale_fill_brewer(palette = "Set1", name = "Ảnh hưởng") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 30, hjust = 1))
🔹 1. Người học đại học (Undergraduate) bị ảnh hưởng nhiều nhất
🔹 2. Người học sau đại học (Graduate) cũng bị ảnh hưởng đáng kể
🔹 3. Học sinh phổ thông (High School) chiếm tỷ lệ rất nhỏ
# Tạo bảng tần số chéo
cross_lp <- table(dat$Academic_Level, dat$Affects_Academic_Performance)
# Kiểm định
chisq.test(cross_lp)
##
## Pearson's Chi-squared test
##
## data: cross_lp
## X-squared = 10.793, df = 2, p-value = 0.004533
Các giả thuyết:
Phương pháp: - Sử dụng kiểm định Chi bình phương độc lập dựa trên bảng tần số chéo giữa Academic_Level và Affects_Academic_Performance.
Kết quả: - Giá trị thống kê chi bình phương: X-squared = 10.793 - Bậc tự do: df = 2 - Giá trị p-value: p-value = 0.004533
Nhận xét: - Với mức ý nghĩa α = 0.05, p-value = 0.004533 < 0.05, nên bác bỏ giả thuyết không H₀. - Điều này cho thấy có bằng chứng thống kê để kết luận rằng: - Trình độ học vấn có ảnh hưởng đến việc mạng xã hội có làm ảnh hưởng đến hiệu quả học tập hay không. - Nói cách khác, mức độ ảnh hưởng của mạng xã hội đến học tập khác nhau ở các nhóm trình độ học vấn khác nhau.
# Tạo bảng tần số chéo
cross_sp <- table(dat$Relationship_Status, dat$Most_Used_Platform)
# Chuyển sang bảng tần suất theo phần trăm
cross_percent_sp <- prop.table(cross_sp) * 100
# Làm tròn và hiển thị
print(round(cross_percent_sp, 2))
##
## Facebook Instagram KakaoTalk LINE LinkedIn Snapchat TikTok
## Complicated 0.14 1.42 0.00 0.00 0.71 0.57 1.13
## In Relationship 10.07 13.33 0.85 0.00 1.13 0.57 6.38
## Single 7.23 20.57 0.85 1.70 1.13 0.71 14.33
##
## Twitter VKontakte WeChat WhatsApp YouTube
## Complicated 0.00 0.00 0.00 0.00 0.57
## In Relationship 1.99 0.85 2.13 3.55 0.14
## Single 2.27 0.85 0.00 4.11 0.71
# Chuyển sang data frame để vẽ
df_cross_sp <- as.data.frame(cross_percent_sp)
colnames(df_cross_sp) <- c("Relationship_Status", "Platform", "Percentage")
# Biểu đồ
ggplot(df_cross_sp, aes(x = Platform, y = Percentage, fill = Relationship_Status)) +
geom_col(position = "dodge") +
labs(title = "Nền tảng mạng xã hội phổ biến theo tình trạng quan hệ",
x = "Nền tảng mạng xã hội",
y = "Tỷ lệ (%)") +
theme_minimal() +
scale_fill_brewer(palette = "Set2") +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
🔹 1. Instagram và TikTok – phổ biến nhất ở người độc thân
Instagram: Người độc thân dùng nhiều nhất (20.57%), gần gấp đôi so với người đang yêu (13.33%).
TikTok: Cũng được ưa chuộng bởi người độc thân (14.33%), vượt trội so với người đang trong mối quan hệ (6.38%).
→ Cho thấy người độc thân có xu hướng dùng nền tảng giải trí, chia sẻ hình ảnh nhiều hơn – có thể để kết nối xã hội, thể hiện bản thân, hoặc giải tỏa cảm xúc.
🔹 2. Facebook – được dùng nhiều hơn ở người đang yêu
Người đang yêu có tỷ lệ dùng Facebook cao nhất (10.07%), có thể do họ thích chia sẻ khoảnh khắc với người yêu hoặc theo dõi các mối quan hệ.
Người độc thân dùng ít hơn (7.23%), còn nhóm “complicated” gần như không dùng (0.14%).
🔹 3. Nền tảng nhắn tin (WhatsApp, WeChat, LINE):
WhatsApp: Thịnh hành ở cả 2 nhóm chính, nhưng cao hơn ở người độc thân (4.11%) và người đang yêu (3.55%).
WeChat: Chủ yếu xuất hiện ở người đang yêu (2.13%), cho thấy một nhóm người dùng có thể đến từ khu vực như Trung Quốc, Đài Loan.
LINE: Chỉ xuất hiện đáng kể ở người độc thân (1.70%) – có thể do đặc điểm vùng văn hóa hoặc dân số mẫu khảo sát.
🔹 4. Nhóm “Complicated” có tần suất sử dụng mạng xã hội khá thấp
Tất cả các nền tảng đều có tỷ lệ rất thấp ở nhóm này.
Có thể do số lượng người thuộc nhóm này trong khảo sát ít, hoặc họ có xu hướng thu mình, ít hoạt động mạng xã hội khi tình cảm không rõ ràng.
# Tạo bảng tần số chéo
cross_sp <- table(dat$Relationship_Status, dat$Most_Used_Platform)
# Kiểm định
chisq.test(cross_sp, simulate.p.value = TRUE, B = 10000)
##
## Pearson's Chi-squared test with simulated p-value (based on 10000
## replicates)
##
## data: cross_sp
## X-squared = 132.96, df = NA, p-value = 9.999e-05
Các giả thuyết
Phương pháp
Kết quả
Nhận xét
install.packages("epitools", repos = "https://cloud.r-project.org")
## Installing package into 'C:/Users/ADMIN/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
## package 'epitools' successfully unpacked and MD5 sums checked
##
## The downloaded binary packages are in
## C:\Users\ADMIN\AppData\Local\Temp\RtmpqQTDwM\downloaded_packages
library(epitools)
# Tạo bảng 2x2
tab1 <- table(dat$Gender, dat$Affects_Academic_Performance)
print(tab1)
##
## No Yes
## Female 122 231
## Male 130 222
riskratio(tab1)
## $data
##
## No Yes Total
## Female 122 231 353
## Male 130 222 352
## Total 252 453 705
##
## $measure
## risk ratio with 95% C.I.
## estimate lower upper
## Female 1.0000000 NA NA
## Male 0.9637692 0.8632283 1.07602
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Female NA NA NA
## Male 0.5126596 0.530117 0.511323
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"
Cặp biến
Diễn giải
Kết luận
# Các nền tảng có ảnh hưởng đến học tập của người dùng hay không?
tab_tiktok <- table(dat$Most_Used_Platform, dat$Affects_Academic_Performance)
addmargins(tab_tiktok)
##
## No Yes Sum
## Facebook 86 37 123
## Instagram 77 172 249
## KakaoTalk 0 12 12
## LINE 12 0 12
## LinkedIn 21 0 21
## Snapchat 1 12 13
## TikTok 10 144 154
## Twitter 19 11 30
## VKontakte 12 0 12
## WeChat 7 8 15
## WhatsApp 0 54 54
## YouTube 7 3 10
## Sum 252 453 705
# Tạo ma trận 2×2
matrix_tiktok <- matrix(c(144, 309, 10, 242), nrow = 2, byrow = FALSE)
colnames(matrix_tiktok) <- c("Yes", "No")
rownames(matrix_tiktok) <- c("TikTok", "Others")
# Tính RR
riskratio(matrix_tiktok)
## $data
## Yes No Total
## TikTok 144 10 154
## Others 309 242 551
## Total 453 252 705
##
## $measure
## NA
## risk ratio with 95% C.I. estimate lower upper
## TikTok 1.000000 NA NA
## Others 6.763702 3.687155 12.40731
##
## $p.value
## NA
## two-sided midp.exact fisher.exact chi.square
## TikTok NA NA NA
## Others 0 7.412727e-21 1.0561e-17
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"
Kết quả Relative Risk (RR)
Diển giải kết quả
Kết luận
# Đối tượng là sinh viên tốt nghiệp dùng mạng xã hội có bị ảnh hưởng đến học tập hay không?
tab_graduate <- table(dat$Academic_Level, dat$Affects_Academic_Performance)
addmargins(tab_graduate)
##
## No Yes Sum
## Graduate 126 199 325
## High School 2 25 27
## Undergraduate 124 229 353
## Sum 252 453 705
# Tạo ma trận 2×2
matrix_graduate <- matrix(c(199, 254, 126, 126), nrow = 2, byrow = FALSE)
colnames(matrix_graduate) <- c("Yes", "No")
rownames(matrix_graduate) <- c("Graduate", "Others")
# Tính RR
riskratio(matrix_graduate)
## $data
## Yes No Total
## Graduate 199 126 325
## Others 254 126 380
## Total 453 252 705
##
## $measure
## NA
## risk ratio with 95% C.I. estimate lower upper
## Graduate 1.0000000 NA NA
## Others 0.8552632 0.7019114 1.042119
##
## $p.value
## NA
## two-sided midp.exact fisher.exact chi.square
## Graduate NA NA NA
## Others 0.1224822 0.1342683 0.1212158
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "Unconditional MLE & normal approximation (Wald) CI"
Kết quả Relative Risk (RR)
Diễn giải kết quả
Kết luận
# Bảng chéo giữa Gender và Affects Academic Performance
tab1 <- table(dat$Gender, dat$Affects_Academic_Performance)
# Tính Odds Ratio
oddsratio(tab1)
## $data
##
## No Yes Total
## Female 122 231 353
## Male 130 222 352
## Total 252 453 705
##
## $measure
## odds ratio with 95% C.I.
## estimate lower upper
## Female 1.0000000 NA NA
## Male 0.9021089 0.6623095 1.228053
##
## $p.value
## two-sided
## midp.exact fisher.exact chi.square
## Female NA NA NA
## Male 0.5126596 0.530117 0.511323
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"
Kết quả Odds Ratio (OR)
Diễn giải kết quả
Kết luận
# Các nền tảng có ảnh hưởng đến học tập của người dùng hay không?
tab_tiktok <- table(dat$Most_Used_Platform, dat$Affects_Academic_Performance)
# Tạo ma trận 2×2
matrix_tiktok <- matrix(c(144, 309, 10, 242), nrow = 2, byrow = FALSE)
colnames(matrix_tiktok) <- c("Yes", "No")
rownames(matrix_tiktok) <- c("TikTok", "Others")
# Tính Odds Ratio
oddsratio(matrix_tiktok)
## $data
## Yes No Total
## TikTok 144 10 154
## Others 309 242 551
## Total 453 252 705
##
## $measure
## NA
## odds ratio with 95% C.I. estimate lower upper
## TikTok 1.00000 NA NA
## Others 11.09053 5.998239 23.02663
##
## $p.value
## NA
## two-sided midp.exact fisher.exact chi.square
## TikTok NA NA NA
## Others 0 7.412727e-21 1.0561e-17
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"
Kết quả Odds Ratio (OR)
Diễn giải kết quả
Kết luận
# Đối tượng là sinh viên tốt nghiệp dùng mạng xã hội có bị ảnh hưởng đến học tập hay không?
tab_graduate <- table(dat$Academic_Level, dat$Affects_Academic_Performance)
# Tạo ma trận 2×2
matrix_graduate <- matrix(c(199, 254, 126, 126), nrow = 2, byrow = FALSE)
colnames(matrix_graduate) <- c("Yes", "No")
rownames(matrix_graduate) <- c("Graduate", "Others")
# Tính RR
oddsratio(matrix_graduate)
## $data
## Yes No Total
## Graduate 199 126 325
## Others 254 126 380
## Total 453 252 705
##
## $measure
## NA
## odds ratio with 95% C.I. estimate lower upper
## Graduate 1.0000000 NA NA
## Others 0.7837873 0.5750241 1.067746
##
## $p.value
## NA
## two-sided midp.exact fisher.exact chi.square
## Graduate NA NA NA
## Others 0.1224822 0.1342683 0.1212158
##
## $correction
## [1] FALSE
##
## attr(,"method")
## [1] "median-unbiased estimate & mid-p exact CI"
Kết quả Odds Ratio (OR)
Diễn giải kết quả
Kết luận