学生社交媒体使用与幸福感分析

R
EDA
社交媒体
心理健康
可视化
分析学生的社交媒体使用习惯与成瘾模式，探究行为与学业相关洞察。
作者

Pinn Xu

发布于

2026年2月23日

18 min read · 390 EN words · 4762 中文字
环境与版本 
R==4.5.2
plotly==4.12.0
sampling==2.11
tidyverse==2.0.0

1 简介

1.1 环境与包版本

本项目在 R v4.5.2 环境下完成，使用了 plotly（v4.12.0）和 sampling 包，以及包含 stringr（v1.6.0）、tibble（v3.3.1）和 dplyr（v1.1.4）等包的集合 tidyverse（v2.0.0）。

代码 
# 查看版本
getRversion()                # [1] '4.5.2'
packageVersion("plotly")     # [1] '4.12.0'
packageVersion("sampling")   # [1] '2.11'
packageVersion("tidyverse")  # [1] '2.0.0'
packageVersion("stringr")    # [1] '1.6.0'
packageVersion("tibble")     # [1] '3.3.1'
packageVersion("dplyr")      # [1] '1.1.4'

1.2 数据集概览

本分析使用来自 Kaggle 的数据集 Student Social Media & Relationships，包含来自不同国家、不同教育背景、年龄在 16-25 岁之间的学生匿名横截面调查数据，涵盖社交媒体使用强度、平台偏好和人际关系等关键维度，可供研究者探究数字行为与个人及学业成果之间的关联。每条观测代表一名学生的问卷回答，数据集样本量充足（N = 705），适合统计分析。

在变量方面，包含一个标识变量 Student_ID，为每条观测分配唯一 ID。其他类别变量包括 Gender、Country、Most_Used_Platform、Relationship_Status（非有序类别），以及 Academic_Level、Affects_Academic_Performance（布尔型，有序类别）。数值变量包括 Age、Avg_Daily_Usage_Hours、Sleep_Hours_Per_Night、Mental_Health_Score、Conflicts_Over_Social_Media 和 Addicted_Score，其中心理健康评分和成瘾评分均为 1 到 10 的自评量表。

1.3 分析目标

本项目旨在探究学生社交媒体使用模式（如平均使用时长、平台偏好）、背景与人口统计因素（如学业水平、国家、年龄、性别）与学生幸福感及学业表现（如平均睡眠时长、心理健康、成瘾程度）之间的复杂相关关系。

选用该数据集的原因在于其较大的样本量（N = 705）和多维度的变量结构，提供了足够的统计效力以获取可靠的学生行为洞察。

分析阶段分为三个主要步骤：首先，进行描述性分析，建立对样本人口统计特征和社交媒体使用模式的基本认知；其次，深入分析学生数字习惯与幸福感指标之间的相关关系，并通过中心极限定理（CLT）验证统计推断的可靠性；最后，比较评估三种抽样方法的效率与精度：简单随机抽样、系统抽样和分层抽样。

在可视化方面，项目主要使用 tidyverse 包中的数据处理方法（包括管道运算符 |> 以及 dplyr 包中的 group_by() 和 summarize() 等函数）对数据进行处理，再使用 plotly 包中的工具进行绘图。

此外，为提升视觉叙事的可及性，本项目采用了由 David Nichols 开发的在线工具生成的色觉友好配色方案。

2 数据准备

2.1 导入数据集

数据集从 Kaggle 下载并保存至本地目录，随后使用内置函数 read.csv() 以相对路径导入 R，存储为 df0。输出 1 展示了 df0 的结构。

输出 1: 数据框结构
代码 
# 导入数据集
df0 <- read.csv("../../../src/data/student-social-media-addiction.csv")
str(df0) # 查看数据框结构
'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 ...

2.2 数据预处理

为便于后续分析与可视化，提前进行了若干处理步骤。

首先，加载相关包，将原始数据集 df0 转换为 tibble 并存储为 df，保持原始数据集不变。随后，将后续分析中使用的类别变量名称和数值变量名称分别指定并存储在向量 names_catvar 和 names_numvar 中。

代码 
# 加载包
library(tidyverse)
library(plotly)
library(sampling)

# 创建 tibble
df <- tibble(df0) # 将 tibble 存入 df，保留 df0 不变

# 存储后续使用的类别变量名称
names_catvar <- c(
  "Gender", "Country", "Most_Used_Platform", "Relationship_Status",
  "Academic_Level", "Affects_Academic_Performance"
)

# 存储后续使用的数值变量名称
names_numvar <- c(
  "Age", "Avg_Daily_Usage_Hours", "Sleep_Hours_Per_Night",
  "Mental_Health_Score", "Conflicts_Over_Social_Media", "Addicted_Score"
)

2.3 缺失值

使用 sum(is.na(df)) 对缺失值进行初步检查，数据集中未发现显式缺失值（输出 2）。

输出 2: 缺失值数量
代码 
# 检查缺失值数量
sum(is.na(df))
[1] 0

2.4 类别数据

对于类别变量，首先检查各变量的类别数量（见 输出 3）及每个类别的观测计数（见 输出 4）。结果显示，大多数类别变量包含适中数量的类别，而国家和最常用平台变量的类别数相对较多，因此需要进一步处理。

输出 3: 类别变量中唯一值的数量
代码 
## 所有类别变量

# 检查每个类别变量的类别数量
for (name in names_catvar) {
  print(paste(name, length(unique(df[[name]]))))
}
[1] "Gender 2"
[1] "Country 110"
[1] "Most_Used_Platform 12"
[1] "Relationship_Status 3"
[1] "Academic_Level 3"
[1] "Affects_Academic_Performance 2"
输出 4: 类别变量各取值的观测数量
代码 
## 除国家和平台外的所有类别变量

# 检查每个类别的观测数量
# （不包括国家和最常用平台变量）
for (name in setdiff(names_catvar, c("Country", "Most_Used_Platform"))) {
  print(table(df[name]))
  cat("\n")
}
Gender
Female   Male 
   353    352 

Relationship_Status
    Complicated In Relationship          Single 
             32             289             384 

Academic_Level
     Graduate   High School Undergraduate 
          325            27           353 

Affects_Academic_Performance
 No Yes 
252 453

因此，分别筛选出观测数最多的前五个国家和平台，并将其名称存储在向量 top5_countries 和 top5_platforms 中，结果见 输出 5。

输出 5: 各国家和平台的观测数量
代码 
## 国家与平台

# 检查前五个国家的观测数量
head(sort(table(df["Country"]), decreasing = TRUE), 5)

cat("\n")

# 检查前五个平台的观测数量
head(sort(table(df["Most_Used_Platform"]), decreasing = TRUE), 5)
Country
  India     USA  Canada Denmark  France 
     53      40      34      27      27 

Most_Used_Platform
Instagram    TikTok  Facebook  WhatsApp   Twitter 
      249       154       123        54        30
代码 
## 国家与平台

# 存储前五个国家
top5_countries <- names(
  head(sort(table(df$Country), decreasing = TRUE), 5)
)

# 存储前五个平台
top5_platforms <- names(
  head(sort(table(df$Most_Used_Platform), decreasing = TRUE), 5)
)

此外，Affects_Academic_Performance 变量由字符型转换为逻辑型（“Yes” = TRUE，“No” = FALSE），见 输出 6。

输出 6: 布尔变量
代码 
## 布尔变量

# 将变量由字符型转换为逻辑型
df$Affects_Academic_Performance <- df$Affects_Academic_Performance == "Yes"

  # 由于该变量仅包含 "Yes" 和 "No" 回答，
  # 因此无需进一步清理。

# 检查转换后的变量
str(df$Affects_Academic_Performance)
 logi [1:705] TRUE FALSE TRUE FALSE TRUE TRUE ...

2.5 数值数据

使用 summary() 函数获取数值变量的描述性统计（输出 7）。结果表明各变量均在合理范围内，无明显极端或异常值，因此在此阶段无需进一步预处理。

输出 7: 数值变量的描述性统计
代码 
## 所有数值变量

# 查看数值变量的描述性统计
for (name in names_numvar) {
  print(summary(df[name]))
  cat("\n")
}
      Age       
 Min.   :18.00  
 1st Qu.:19.00  
 Median :21.00  
 Mean   :20.66  
 3rd Qu.:22.00  
 Max.   :24.00  

 Avg_Daily_Usage_Hours
 Min.   :1.500        
 1st Qu.:4.100        
 Median :4.800        
 Mean   :4.919        
 3rd Qu.:5.800        
 Max.   :8.500        

 Sleep_Hours_Per_Night
 Min.   :3.800        
 1st Qu.:6.000        
 Median :6.900        
 Mean   :6.869        
 3rd Qu.:7.700        
 Max.   :9.600        

 Mental_Health_Score
 Min.   :4.000      
 1st Qu.:5.000      
 Median :6.000      
 Mean   :6.227      
 3rd Qu.:7.000      
 Max.   :9.000      

 Conflicts_Over_Social_Media
 Min.   :0.00               
 1st Qu.:2.00               
 Median :3.00               
 Mean   :2.85               
 3rd Qu.:4.00               
 Max.   :5.00               

 Addicted_Score 
 Min.   :2.000  
 1st Qu.:5.000  
 Median :7.000  
 Mean   :6.437  
 3rd Qu.:8.000  
 Max.   :9.000

此外，由于 Age 变量的范围较窄且变异有限，将其分组为三个年龄段。如 输出 8 所示，将 Age 视为连续变量在如此狭窄的区间（18-24）内离散程度极低（仅有 7 个唯一值），而将各年龄值作为单独类别则可能导致若干小而不均的子组。因此，分组为三个区间能提供更适合后续分析的结构。

为此，首先使用直方图查看年龄分布并确定合适的分组断点，然后将分组信息存入新变量 Age_Group（见 输出 9）。

输出 8: 年龄范围及唯一年龄值数量
代码 
## 年龄

# 检查取值范围
range(df$Age)

# 检查 Age 中唯一值的数量
length(unique(df$Age))
[1] 18 24
[1] 7
输出 9: 年龄分组
代码 
## 年龄

## 存储直方图数据

# 存储包含 3 个分箱的直方图数据
hist_data <- hist(
  df$Age,
  breaks = 4,
  xlab = "年龄",
  col = "#FFD794",
  main = "年龄分布",
  plot = FALSE  # 不显示图形
)

# 存储分组断点
breaks <- hist_data$breaks


## 向 df 添加新变量 Age_Group

# 将分组信息存入新变量 Age_Group
df <- df |>
  mutate(
    Age_Group = case_when(
      (breaks[1] <= Age) & (Age <= breaks[2]) ~
      sprintf("%d-%d", breaks[1], breaks[2]),
      (breaks[2] <= Age) & (Age <= breaks[3]) ~
      sprintf("%d-%d", breaks[2], breaks[3]),
      (breaks[3] <= Age) & (Age <= breaks[4]) ~
      sprintf("%d-%d", breaks[3], breaks[4]),
    )
  )

# 查看新变量
table(df["Age_Group"])
Age_Group
18-20 20-22 22-24 
  342   303    60

3 描述性分析

本节展示了样本的若干核心背景特征与行为模式。

3.1 人口统计特征

3.1.1 性别

图 1 展示了数据集（N = 705）中高度均衡的性别分布。样本中女性占 50.1%，男性占 49.9%，比例近乎完美对等，为后续基于性别的行为模式比较提供了相对无偏的基础。

代码 
## 性别

# 饼图
plot_ly(
  as.data.frame(table(Gender = recode(df$Gender, Female = "女性", Male = "男性"))),
  labels = ~Gender,
  values = ~Freq,
  type = "pie",                # 饼图
  textinfo = "label+percent",  # 在扇区上显示标签和百分比

  # 饼图绘图区
  domain = list(
    x = c(0, 1),    # 水平方向：占满宽度
    y = c(0, 0.85)  # 垂直方向：顶部留出 15% 边距
  ),

  # 美学设置
  marker = list(
    colors = c("女性" = "#FFB697", "男性" = "#8fc4de"), # 填充颜色
    line = list(color = "#222", width = 1.5)             # 轮廓线
  )
) |>

  layout(
    showlegend = FALSE,           # 移除图例
    margin = list(l = 1, r = 1),  # 左右边距
    title = list(
      y = 0.95,                   # 标题的 y 位置
      text = "样本性别分布"
    )
  )
图 1: 样本性别分布

3.1.2 国家

图 2 及其后的 输出 10 展示了样本前五个国家的分布情况及各国占总样本的百分比。印度以 7.5% 领先，其次是美国（5.7%）和加拿大（4.8%）。丹麦和法国各占 3.8%，体现了参与者地理来源的多样性，主要集中在南亚和北美地区。

代码 
## 国家

# 提取前五国家数据
top5_countries_data <- df |>
  filter(Country %in% top5_countries) |>
  mutate(
    Country_CN = recode(
      Country,
      India = "印度",
      USA = "美国",
      Canada = "加拿大",
      Denmark = "丹麦",
      France = "法国"
    )
  )

# 柱状图
plot_ly(
  as.data.frame(
    sort(table(top5_countries_data["Country_CN"]), decreasing = TRUE) # 排序
  ),
  x = ~Country_CN,
  y = ~Freq,
  type = "bar",  # 柱状图

  # 美学设置
  marker = list(
    color = "#add4a0",                        # 填充颜色
    line = list(color = "#222", width = 1.5)  # 轮廓线颜色与宽度
  )
) |>

  layout(
    margin = list(t = 50),  # 顶部边距
    title = list(
      y = 0.95,             # 标题的 y 位置
      text = "样本国家分布（前 5）"
    ),
    xaxis = list(
      title = "国家",
      range = c(-0.8, 4.8)  # 扩展 x 轴范围（0 = 第一个类别）
    ),
    yaxis = list(
      title = "频数",
      range = c(0, 60)      # 使 y 轴覆盖全部取值
    )
  )
图 2: 样本国家分布（前 5）
输出 10: 前五国家占总体的百分比
代码 
## 国家

# 查看前五国家观测值占总体的百分比
sort(table(top5_countries_data$Country_CN), decreasing = TRUE) / nrow(df) * 100

    印度     美国   加拿大     丹麦     法国 
7.517730 5.673759 4.822695 3.829787 3.829787

3.1.3 年龄分组

如 图 3 所示，年龄分布偏向年轻参与者，18-20 和 20-22 岁组占比最大。22-24 岁组频率显著较低，表明样本主要由大学低年级学生构成。

代码 
## 年龄分组

# 柱状图
plot_ly(
  as.data.frame(
    sort(table(df["Age_Group"]), decreasing = TRUE) # 排序
  ),
  x = ~Age_Group,
  y = ~Freq,
  type = "bar",  # 柱状图

  # 美学设置
  marker = list(
    color = "#FFD794",                        # 填充颜色
    line = list(color = "#222", width = 1.5)  # 轮廓线颜色与宽度
  )
) |>

  layout(
    margin = list(t = 50),  # 顶部边距
    title = list(
      y = 0.95,             # 标题的 y 位置
      text = "样本年龄分组分布"
    ),
    xaxis = list(
      title = "年龄分组",
      range = c(-0.8, 2.8)  # 扩展 x 轴范围（0 = 第一个类别）
    ),
    yaxis = list(
      title = "频数",
      range = c(0, 400)     # 使 y 轴覆盖全部取值
    )
  )
图 3: 样本年龄分组分布

3.2 平台偏好

图 4 展示了五大最受欢迎社交平台的频率分布。Instagram（249 人）为样本中最受欢迎的平台，其次是 TikTok（154 人）和 Facebook（123 人），而 WhatsApp（54 人）和 Twitter（30 人）使用频率明显较低。

代码 
## 平台

# 提取前五平台数据
top5_platforms_data <- df |>
  filter(Most_Used_Platform %in% top5_platforms)

# 柱状图
plot_ly(
  as.data.frame(
    sort(table(top5_platforms_data["Most_Used_Platform"]), decreasing = TRUE)
  ),
  x = ~Most_Used_Platform,
  y = ~Freq,
  type = "bar",  # 柱状图

  # 美学设置
  marker = list(
    color = "#c3a4cf",                        # 填充颜色
    line = list(color = "#222", width = 1.5)  # 轮廓线颜色与宽度
  )
) |>

  layout(
    margin = list(t = 50),  # 顶部边距
    title = list(
      y = 0.95,             # 标题的 y 位置
      text = "前 5 大热门平台"
    ),
    xaxis = list(
      title = "平台",
      range = c(-0.8, 4.8)  # 扩展 x 轴范围（0 = 第一个类别）
    ),
    yaxis = list(title = "频数")
  )
图 4: 前 5 大热门平台

值得注意的是，按性别分组后（图 5），各平台使用存在明显的性别差异。Instagram 和 TikTok 在女性中更受欢迎，其中 Instagram 的性别差距更大；而 Facebook 和 WhatsApp 则呈现出男性主导的趋势；Twitter 的性别差异最小。总体来看，女性似乎更偏爱视觉型平台，而男性则更倾向于通讯型平台。

代码 
## 平台 ~ 性别

# 获取数据
platform_gender_data <- top5_platforms_data |>
  mutate(Gender_CN = recode(Gender, Female = "女性", Male = "男性")) |>
  group_by(Most_Used_Platform, Gender_CN) |>
  summarize(Count = n(), .groups = 'drop') |>
  arrange(desc(Count))

# 柱状图
plot_ly(
  platform_gender_data,
  x = ~factor(Most_Used_Platform, top5_platforms),  # 排序
  y = ~Count,
  type = "bar",        # 柱状图
  color = ~Gender_CN,  # 将性别映射到条形颜色
  colors = c("女性" = "#FFB697", "男性" = "#8fc4de"),

  # 美学设置
  marker = list(
    line = list(color = "#222", width = 1.5)  # 轮廓线颜色与宽度
  )
) |>

  layout(
    barmode = "group",                     # 并排显示条形组
    legend = list(
      orientation = "h",                   # 水平排列图例标签
      xanchor = "right", yanchor = "top",  # 图例锚点
      x = 1, y = 1                         # 图例位置
    ),
    margin = list(t = 50),                 # 顶部边距
    title = list(
      y = 0.95,                            # 标题的 y 位置
      text = "按性别分组的前 5 大热门平台"
    ),
    xaxis = list(
      title = "平台",
      range = c(-0.6, 4.6)  # 扩展 x 轴范围（0 = 第一个类别）
    ),
    yaxis = list(title = "频数")
  )
图 5: 按性别分组的前 5 大热门平台

3.3 使用时长

平均社交媒体使用时长的直方图（图 6）呈对称分布，峰值在 4.5 到 5 小时之间，表明受访学生的数字生活方式整体高度投入且较为一致。

代码 
## 使用时长

# 直方图
plot_ly(
  df,
  x = ~Avg_Daily_Usage_Hours,
  type = "histogram",

  # 美学设置
  marker = list(
    color = "#55D2C6",                        # 填充颜色
    line = list(color = "#222", width = 1.5)  # 轮廓线
  )
) |>

  layout(
    margin = list(t = 50),  # 顶部边距
    title = list(
      y = 0.95,             # 标题的 y 位置
      text = "日均使用时长分布"
    ),
    xaxis = list(
      title = "日均使用时长",
      range = c(0.8, 9.4),  # 使 x 轴覆盖全部取值
      dtick = 1             # 刻度间距
    ),
    yaxis = list(title = "频数")
  )
图 6: 日均使用时长分布

箱线图（图 7）展示了前五国家的日均使用时长分布。美国和印度的使用投入度最高，中位使用时长显著高于其他国家。相比之下，加拿大、法国和丹麦的总体使用时长较低，其中丹麦的中位数最为保守。此外，印度组中存在一个明显的离群值，代表一名日均使用时长远低于该国整体趋势的用户。

代码 
## 使用时长 ~ 前五国家

## 排序

# 计算每个国家的使用时长中位数
countries_by_usage <- top5_countries_data |>
  group_by(Country_CN) |>

  # 创建新变量以存储中位数
  summarize(
    Median_Usage_Hour = median(Avg_Daily_Usage_Hours, na.rm = TRUE),
    .groups = "drop"  # 删除分组信息
  ) |>

  # 按中位数降序排序
  arrange(desc(Median_Usage_Hour)) |>

  # 提取 Country_CN 变量向量
  # （按使用时长中位数降序排列的国家名称）
  pull(Country_CN)


## 绘图

# 箱线图
plot_ly(
  top5_countries_data,

  # 按使用时长中位数降序排列的国家名称
  # 将 Country_CN 变量设为因子
  x = ~factor(Country_CN, countries_by_usage),
  y = ~Avg_Daily_Usage_Hours,
  type = "box",  # 箱线图

  # 美学设置：箱体边界
  fillcolor = "#55D2C6",
  line = list(color = "#222", width = 1.5),

  # 美学设置：离群值
  marker = list(
    color = "#55D2C6",                        # 填充颜色
    line = list(color = "#222", width = 1.5)  # 轮廓线
  )
) |>

  layout(
    margin = list(t = 50),  # 顶部边距
    title = list(
      y = 0.95,             # 标题的 y 位置
      text = "前 5 国家日均使用时长箱线图"
    ),
    xaxis = list(
      title = "前 5 国家",
      range = c(-0.6, 4.6)  # 扩展 x 轴范围（0 = 第一个类别）
    ),
    yaxis = list(
      title = "日均使用时长",
      range = c(1, 10),     # 使 y 轴覆盖全部取值
      dtick = 1             # 刻度间距
    )
  )
图 7: 前 5 国家日均使用时长箱线图

3.4 睡眠时长

同时，本项目也对睡眠时长的分布进行了分析。图 8 显示，睡眠时长分布大致对称，峰值约在每晚 7 到 7.5 小时。大多数学生的睡眠时长在 6 到 8 小时的较健康范围内，但分布较为分散，部分学生每晚仅睡约 4 小时，也有学生接近 10 小时，反映出学生群体中睡眠习惯的多样性。

代码 
## 睡眠时长

# 直方图
plot_ly(
  df,
  x = ~Sleep_Hours_Per_Night,
  type = "histogram",

  # 美学设置
  marker = list(
    color = "#FFABB6",                        # 填充颜色
    line = list(color = "#222", width = 1.5)  # 轮廓线
  )
) |>

  layout(
    margin = list(t = 50),  # 顶部边距
    title = list(
      y = 0.95,             # 标题的 y 位置
      text = "平均睡眠时长分布"
    ),
    xaxis = list(
      title = "平均睡眠时长",
      range = c(2.8, 11),   # 使 x 轴覆盖全部取值
      dtick = 1             # 刻度间距
    ),
    yaxis = list(
      title = "频数",
      range = c(0, 60)      # 使 y 轴覆盖全部取值
    )
  )
图 8: 平均睡眠时长分布

进一步按前五国家分析平均睡眠时长分布，图 9 与前述使用时长分布（图 7）呈现出显著的反向趋势。社交媒体使用投入度最高的美国和印度，其睡眠时长中位数最低，均不足 6 小时；而使用模式最为保守的丹麦和法国，睡眠时长中位数最高，其中丹麦约为 8.2 小时。此外，印度组存在大量上方离群值，表明部分学生即使在整体趋势下仍保持了较高的睡眠水平。这些地理差异暗示数字使用与睡眠之间存在负相关关系，为后续行为模式相关分析提供了重要基线。

代码 
## 睡眠时长 ~ 前五国家

## 排序

# 计算每个国家的睡眠时长中位数
countries_by_sleep <- top5_countries_data |>
  group_by(Country_CN) |>

  # 创建新变量以存储中位数
  summarize(
    Median_Sleep_Hour = median(Sleep_Hours_Per_Night, na.rm = TRUE),
    .groups = "drop"  # 删除分组信息
  ) |>

  # 按中位数升序排序
  arrange(Median_Sleep_Hour) |>

  # 提取 Country_CN 变量向量
  # （按睡眠时长中位数升序排列的国家名称）
  pull(Country_CN)


## 绘图

# 箱线图
plot_ly(
  top5_countries_data,

  # 按睡眠时长中位数升序排列的国家名称
  # 将 Country_CN 变量设为因子
  x = ~factor(Country_CN, countries_by_sleep),
  y = ~Sleep_Hours_Per_Night,
  type = "box",  # 箱线图

  # 美学设置：箱体边界
  fillcolor = "#FFABB6",
  line = list(color = "#222", width = 1.5),

  # 美学设置：离群值
  marker = list(
    color = "#FFABB6",                        # 填充颜色
    line = list(color = "#222", width = 1.5)  # 轮廓线
  )
) |>

  layout(
    margin = list(t = 50),  # 顶部边距
    title = list(
      y = 0.95,             # 标题的 y 位置
      text = "前 5 国家平均睡眠时长箱线图"
    ),
    xaxis = list(
      title = "前 5 国家",
      range = c(-0.6, 4.6)  # 扩展 x 轴范围（0 = 第一个类别）
    ),
    yaxis = list(
      title = "平均睡眠时长",
      range = c(3, 10),     # 使 y 轴覆盖全部取值
      dtick = 1             # 刻度间距
    )
  )
图 9: 前 5 国家平均睡眠时长箱线图

4 相关性分析

4.1 睡眠时长与使用时长

散点图（图 10）展示了日均社交媒体使用时长与睡眠时长之间的强负相关关系。随着使用时长从 2 小时增至 8 小时，睡眠时长大约每增加 1 小时使用便减少 1 小时。大多数数据点沿这一下降趋势聚集，尽管部分重度用户（6 小时以上）仍报告约 7 小时的睡眠，中度用户（4-6 小时）的睡眠则降至 6-8 小时。

代码 
## 睡眠时长 ~ 使用时长

# 散点图
plot_ly(
  df,
  x = ~Avg_Daily_Usage_Hours
) |>

  # 添加散点
  add_markers(
    y = ~Sleep_Hours_Per_Night,
    marker = list(color = "#3B9FE4", opacity = 0.6)
  ) |>

  layout(
    margin = list(t = 50),  # 顶部边距
    title = list(
      y = 0.95,             # 标题的 y 位置
      text = "使用时长与睡眠时长的关系"
    ),
    xaxis = list(
      title = "日均使用时长",
      range = c(0.8, 9.2),  # 使 x 轴覆盖全部取值
      dtick = 1             # 刻度间距
    ),
    yaxis = list(
      title = "平均睡眠时长",
      range = c(3, 10)      # 使 y 轴覆盖全部取值
    )
  )
图 10: 使用时长与睡眠时长的关系

为验证上述趋势，进行了 Pearson 相关性检验。如 输出 11 所示，相关系数约为 -0.79（p < .001），表明学生日均社交媒体使用时长与睡眠时长之间存在高度潜在的负相关关系。

输出 11: Pearson 相关性检验结果
代码 
## 睡眠时长 ~ 使用时长

# 相关性检验
cor.test(x = df$Avg_Daily_Usage_Hours, y = df$Sleep_Hours_Per_Night)

    Pearson's product-moment correlation

data:  df$Avg_Daily_Usage_Hours and df$Sleep_Hours_Per_Night
t = -34.231, df = 703, p-value < 2.2e-16
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 -0.8167435 -0.7611776
sample estimates:
       cor 
-0.7905825

图 11 通过对两变量拟合线性模型，进一步呈现了这一负相关关系。

代码 
## 睡眠时长 ~ 使用时长

# 线性模型
fit <- lm(Sleep_Hours_Per_Night ~ Avg_Daily_Usage_Hours, data = df)

# 散点图
plot_ly(
  df,
  x = ~Avg_Daily_Usage_Hours
) |>

  # 添加散点
  add_markers(
    y = ~Sleep_Hours_Per_Night,
    name = "数据点",
    marker = list(color = "#3B9FE4", opacity = 0.6)
  ) |>

  # 添加线性拟合
  add_lines(
    y = ~fitted(fit),
    name = "线性拟合",
    line = list(color = '#D53132', width = 1.5)
  ) |>

  layout(
    legend = list(
      orientation = "h",                  # 图例标签排列方式
      xanchor = "right", yanchor = "top", # 图例锚点
      x = 1, y = 1                        # 图例位置
    ),
    margin = list(t = 50),                # 顶部边距
    title = list(
      y = 0.95,                           # 标题的 y 位置
      text = "使用时长与睡眠时长的线性关系"
    ),
    xaxis = list(
      title = "日均使用时长",
      range = c(0.8, 9.2),                # 使 x 轴覆盖全部取值
      dtick = 1                           # 刻度间距
    ),
    yaxis = list(
      title = "平均睡眠时长",
      range = c(3, 10)                    # 使 y 轴覆盖全部取值
    )
  )
图 11: 使用时长与睡眠时长的线性关系

4.2 其他指标

此外，心理健康评分与成瘾评分等其他指标之间的关系同样值得探究（指标名称见 输出 12）。为此，使用 5×5 的分面散点图矩阵展示所有指标之间的关系趋势（见 图 12）。

输出 12: 待比较指标的名称
代码 
## 各指标之间的关系

# 从 names_numvar 中移除 Age
(names_numvar <- setdiff(names_numvar, "Age"))
[1] "Avg_Daily_Usage_Hours"       "Sleep_Hours_Per_Night"      
[3] "Mental_Health_Score"         "Conflicts_Over_Social_Media"
[5] "Addicted_Score"
代码 
## 各指标之间的关系

# 提取数值变量数据
num_data <- df[, names_numvar]

# 成对散点图
plot_ly(
  num_data,
  type = "splom",  # 散点图矩阵

  # 待比较指标
  dimensions = list(
    list(label = "使用时长", values = ~Avg_Daily_Usage_Hours),
    list(label = "睡眠时长", values = ~Sleep_Hours_Per_Night),
    list(label = "心理健康", values = ~Mental_Health_Score),
    list(label = "社交媒体冲突", values = ~Conflicts_Over_Social_Media),
    list(label = "成瘾评分", values = ~Addicted_Score)
  ),

  # 美学设置
  marker = list(
    color = "#3B9FE4",
    opacity = 0.5,
    size = 4
  )
) |>

  layout(
    margin = list(t = 60),  # 顶部边距
    title = list(
      y = 0.95,             # 标题的 y 位置
      text = "各指标之间的关系"
    )
  )
图 12: 各指标之间的关系

散点图矩阵（图 12）揭示了行为与心理指标之间复杂的相关网络，核心在于过度社交媒体使用的负面影响。输出 13 展示了所有五项指标的相关系数矩阵，提供了对行为趋势的有效洞见。

结果显示，使用时长与睡眠之间存在显著的负相关——屏幕时间增加持续对应睡眠减少。这一趋势进一步体现在使用时长与成瘾程度的正相关关系上，成瘾程度的上升又带来更多的生活冲突。相反，更好的心理健康结果与较低的成瘾评分、较少的使用时长和更长的睡眠时长相关。总体而言，数据揭示了一个负反馈循环：高度的设备依赖损害了睡眠与社会和谐，共同导致心理健康状况的恶化。

输出 13: 各指标相关系数矩阵
代码 
## 各指标之间的关系

# 查看相关系数矩阵（Pearson 相关系数）
(cor_matrix <- round(cor(num_data), 2))
                            Avg_Daily_Usage_Hours Sleep_Hours_Per_Night
Avg_Daily_Usage_Hours                        1.00                 -0.79
Sleep_Hours_Per_Night                       -0.79                  1.00
Mental_Health_Score                         -0.80                  0.71
Conflicts_Over_Social_Media                  0.80                 -0.68
Addicted_Score                               0.83                 -0.76
                            Mental_Health_Score Conflicts_Over_Social_Media
Avg_Daily_Usage_Hours                     -0.80                        0.80
Sleep_Hours_Per_Night                      0.71                       -0.68
Mental_Health_Score                        1.00                       -0.89
Conflicts_Over_Social_Media               -0.89                        1.00
Addicted_Score                            -0.95                        0.93
                            Addicted_Score
Avg_Daily_Usage_Hours                 0.83
Sleep_Hours_Per_Night                -0.76
Mental_Health_Score                  -0.95
Conflicts_Over_Social_Media           0.93
Addicted_Score                        1.00

值得注意的是，成瘾评分与心理健康之间的相关系数（r = -.95），以及成瘾评分与社交媒体冲突次数之间的相关系数（r = .93）最为显著，两者 |r| > .9（见 输出 14），表明随着成瘾行为的加深，心理健康状况几乎同步崩溃，人际摩擦也随之上升。

综上，成瘾评分是本数据集中预测负面生活结果最有力的指标。

输出 14: 相关性最强的指标对（|r| > .9）
代码 
## 各指标之间的关系

# 查找 |r| > 0.9 的变量对位置
loc <- which(
  abs(cor_matrix) > 0.9 & cor_matrix != 1,
  arr.ind = TRUE  # 返回行列索引矩阵
)

# 打印结果
for(i in 1:nrow(loc)) {
  row <- loc[i, 1]
  col <- loc[i, 2]
  cat(
    rownames(cor_matrix)[row], "~", colnames(cor_matrix)[col], "\n",
    "r =", cor_matrix[row, col], "\n")
}
Addicted_Score ~ Mental_Health_Score 
 r = -0.95 
Addicted_Score ~ Conflicts_Over_Social_Media 
 r = 0.93 
Mental_Health_Score ~ Addicted_Score 
 r = -0.95 
Conflicts_Over_Social_Media ~ Addicted_Score 
 r = 0.93

5 中心极限定理的应用

本节对总体数据集（df）以不同样本量（n = 10、30、50、100）反复随机抽样（重复 1000 次），并观察样本均值分布的规律，以验证中心极限定理（CLT）的适用性。

中心极限定理指出，随着样本量的增加，样本均值的抽样分布趋近于正态分布，无论总体的原始分布形状如何。

同时，样本均值的标准差（观测标准误）与总体标准差 σ 和样本量 n 相关，标准误的计算公式为 \(SE = \frac{\sigma}{\sqrt n}\)。该公式在后续分析中用于计算理论标准误。

为探究 CLT 的适用性，首先定义了一个函数，以指定的样本量、抽样次数、抽样变量及其他相关参数进行随机抽样。

代码 
## 中心极限定理

## 定义绘图函数

# 存储不同样本量
sizes <- c(10, 30, 50, 100)

# 定义函数：按指定样本量从 df 随机抽样，
# 并按指定参数绘制样本均值直方图

make_hist <- function(
    n, col, time = 1000, ymax = 1,
    binwidth = 0.2, bincolor = "#FFA472", xdtick = 1
  ) {

  ## n：样本量
  ## col：从 df 中选择的列
  ## time：重复抽样次数
  ## ymax：直方图 y 轴最大值
  ## binwidth：直方图分箱宽度
  ## bincolor：分箱颜色
  ## xdtick：x 轴刻度间距

  # 从 df 随机抽样并计算样本均值
  sample_means <- replicate(
    time,   # 重复次数，默认 1000
    mean(
      sample(df[[col]], size = n, replace = TRUE),
      na.rm = TRUE
    )
  )

  # 计算总体均值和标准差
  pop_mean <- mean(df[[col]], na.rm = TRUE)
  pop_sd <- sd(df[[col]], na.rm = TRUE)

  # 计算固定的 x 轴范围
  xmin <- pop_mean - (2 * pop_sd)
  xmax <- pop_mean + (2 * pop_sd)

  # 绘制样本均值概率分布直方图
  plot_ly(
    x = sample_means,
    type = "histogram",
    histnorm = "probability",  # 概率分布
    name = paste("n =", n),
    xbins = list(
      start = xmin,
      end = xmax,
      size = binwidth          # 指定分箱宽度，默认值为 0.4
    ),

    # 美学设置
    marker = list(
      color = bincolor,        # 指定分箱颜色，默认值为 "#FFA472"
      line = list(color = "#222", width = 1.5)
    )
  ) |>

    layout(
      margin = list(t = 60),   # 顶部边距

      # 添加样本量注释
      annotations = list(
        list(
          text = paste("样本量：", n),
          x = 0.5,             # 注释的 x 位置
          y = -0.25,           # 注释的 y 位置
          xanchor = "center",  # 注释的 x 锚点
          yanchor = "bottom",  # 注释的 y 锚点
          xref = "paper",      # 相对当前子图定位
          yref = "paper",
          showarrow = FALSE    # 移除注释箭头
        )
      ),

      # 坐标轴范围
      xaxis = list(
        range = c(xmin, xmax),          # x 轴范围
        dtick = xdtick                  # 指定刻度间距，默认值为 1
      ),
      yaxis = list(range = c(0, ymax))  # 指定 y 轴最大值，默认值为 1
    )
}

5.1 使用时长

对于日均使用时长变量，绘制了 2×2 的直方图矩阵（图 13），在相同坐标轴范围下展示不同样本量（n = 10、30、50、100）的样本均值分布，以观察分布形态的变化趋势。与此同时，输出 15 展示了关于使用时长的总体与样本统计量。

结果显示，随着样本量增加，样本均值分布显著趋于集中，标准差减小；所有四种样本量的样本均值均值均接近总体均值，成功预测了总体；观测标准误（样本均值的标准差）也近似于由总体标准差推导出的理论标准误。

代码 
## 中心极限定理 - 使用时长

## 抽取随机样本并绘图

# 设置随机种子以保证可复现
set.seed(32)

# 获取绘图信息
# （遍历 sizes，将取值作为 n 传入函数）
plots <- lapply(
  sizes, function(n) make_hist(
    n, "Avg_Daily_Usage_Hours", bincolor = "#55D2C6", ymax = 0.6
  )
)

# 以 2*2 矩阵显示子图
subplot(
  plots,
  nrows = 2,     # 子图矩阵的行数
  margin = 0.08  # 子图之间的间距
) |>

  layout(
    showlegend = FALSE,  # 移除图例
    margin = list(
      t = 80,            # 顶部边距
      b = 60             # 底部边距
    ),
    title = list(
      y = 0.95,
      text = "使用时长样本均值概率分布"
    )
  )
图 13: 使用时长样本均值概率分布
输出 15: 使用时长相关统计量对比
代码 
## 中心极限定理 - 使用时长

## 存储样本均值

# 创建列表，存储不同样本量下的使用时长样本均值
sample_means_usage <- lapply(
  sizes,         # 遍历样本量
  function(n) {  # n：由 sizes 传入的样本量
    replicate(
      1000,      # 重复次数
      mean(
        sample(df[["Avg_Daily_Usage_Hours"]], size = n, replace = TRUE),
        na.rm = TRUE)
      )
  }
)


## 存储样本均值的均值和标准差

# 初始化空向量
mean_sample_means_usage <- numeric(length(sizes))

# 计算使用时长样本均值的均值
for (i in seq_along(sizes)) {
  mean_sample_means_usage[i] <- round(
    mean(sample_means_usage[[i]], na.rm = TRUE),
    digits = 2  # 保留 2 位小数
  )
}

# 初始化空向量
sd_sample_means_usage <- numeric(length(sizes))

# 计算使用时长样本均值的标准差
for (i in seq_along(sizes)) {
  sd_sample_means_usage[i] <- round(
    sd(sample_means_usage[[i]], na.rm = TRUE),
    digits = 2  # 保留 2 位小数
  )
}


## 总体均值和标准差

pop_mean_usage <- mean(df$Avg_Daily_Usage_Hours, na.rm = TRUE)
pop_sd_usage <- sd(df$Avg_Daily_Usage_Hours, na.rm = TRUE)


## 打印结果

clt_results_usage <- data.frame(
  Sample_Size = sizes,
  Predicted_Mean = mean_sample_means_usage,
  Observed_SE = sd_sample_means_usage,
  Theoretical_SE = round(pop_sd_usage / sqrt(sizes), 2)
)

print(clt_results_usage)

cat("\n总体均值：", round(pop_mean_usage, 2),
    "\n总体标准差：", round(pop_sd_usage, 2), "\n"
)
  Sample_Size Predicted_Mean Observed_SE Theoretical_SE
1          10           4.92        0.40           0.40
2          30           4.92        0.23           0.23
3          50           4.93        0.18           0.18
4         100           4.92        0.12           0.13

总体均值： 4.92 
总体标准差： 1.26

此外，图 14 展示了其中一种样本均值分布（n = 100，重复 1000 次）及叠加其上的理想正态曲线（n = 100，由 dnorm() 函数计算）。结果显示样本均值直方图与正态曲线高度吻合，与中心极限定理一致。

代码 
## 中心极限定理 - 使用时长

## 理想正态分布数据

x_values <- seq(
  min(tail(sample_means_usage, 1)[[1]]),  # 最后一组均值，n = 100
  max(tail(sample_means_usage, 1)[[1]]),
  length.out = 100                        # 序列长度为 100
)

y_values <- dnorm(
  x_values,
  mean = mean(tail(sample_means_usage, 1)[[1]]),
  sd = sd(tail(sample_means_usage, 1)[[1]])
)


## 样本均值分布与正态曲线

plot_ly() |>

  # 直方图
  add_histogram(
    x = tail(sample_means_usage, 1)[[1]],
    type = "histogram",
    histnorm = "probability",
    xbins = list(size = 0.05),  # 分箱宽度
    name = "样本均值",          # 直方图标签

    # 美学设置
    marker = list(
      color = "#55D2C6",                         # 填充颜色
      line = list(color = "#222", width = 1.5),  # 轮廓线
      opacity = 0.6
    )
  ) |>

  # 正态曲线
  add_lines(
    x = x_values,
    y = y_values * 0.05,
    name = "正态曲线",        # 线条标签
    line = list(color = '#D53132', width = 2)
  ) |>

  layout(
    legend = list(
      orientation = "h",                   # 图例标签排列方式
      xanchor = "left", yanchor = "top",   # 图例锚点
      x = 0, y = 1.1                       # 图例位置
    ),
    margin = list(t = 90),    # 顶部边距
    title = list(
      y = 0.95,               # 标题的 y 位置
      text = "使用时长样本均值概率分布（含正态曲线）"
    ),
    xaxis = list(
      title = "日均使用时长样本均值（n = 100）",
      range = c(4.38, 5.4)
    ),
    yaxis = list(
      title = "概率",
      range = c(0, 0.18)
    )
  )
图 14: 使用时长样本均值概率分布（含正态曲线）

5.2 睡眠时长

类似地，对睡眠时长变量采用相同方法进行分析。图 15、输出 15 及 输出 16 所呈现的结果规律与使用时长高度相似，再次验证了中心极限定理的适用性。

代码 
## 中心极限定理 - 睡眠时长

# 设置随机种子以保证可复现
set.seed(32)

# 获取绘图信息
# （遍历 sizes，将取值作为 n 传入函数）
plots <- lapply(
  sizes, function(n) make_hist(
    n, "Sleep_Hours_Per_Night", bincolor = "#FFABB6", ymax = 0.6
  )
)

# 以 2*2 矩阵显示子图
subplot(
  plots,
  nrows = 2,
  margin = 0.08
) |>

  layout(
    showlegend = FALSE,  # 移除图例
    margin = list(
      t = 80,            # 顶部边距
      b = 60             # 底部边距
    ),
    title = list(
      y = 0.95,
      text = "睡眠时长样本均值概率分布"
    )
  )
图 15: 睡眠时长样本均值概率分布
输出 16: 睡眠时长相关统计量对比
代码 
## 中心极限定理 - 睡眠时长

## 存储样本均值

# 创建列表，存储不同样本量下的睡眠时长样本均值
sample_means_sleep <- lapply(
  sizes,         # 遍历样本量
  function(n) {  # n：由 sizes 传入的样本量
    replicate(
      1000,      # 重复次数
      mean(
        sample(df[["Sleep_Hours_Per_Night"]], size = n, replace = TRUE),
        na.rm = TRUE)
      )
  }
)


## 存储样本均值的均值和标准差

# 初始化空向量
mean_sample_means_sleep <- numeric(length(sizes))

# 计算睡眠时长样本均值的均值
for (i in seq_along(sizes)) {
  mean_sample_means_sleep[i] <- round(
    mean(sample_means_sleep[[i]], na.rm = TRUE),
    digits = 2  # 保留 2 位小数
  )
}

# 初始化空向量
sd_sample_means_sleep <- numeric(length(sizes))

# 计算睡眠时长样本均值的标准差
for (i in seq_along(sizes)) {
  sd_sample_means_sleep[i] <- round(
    sd(sample_means_sleep[[i]], na.rm = TRUE),
    digits = 2  # 保留 2 位小数
  )
}


## 总体均值和标准差

pop_mean_sleep <- mean(df$Sleep_Hours_Per_Night, na.rm = TRUE)
pop_sd_sleep <- sd(df$Sleep_Hours_Per_Night, na.rm = TRUE)


## 打印结果

clt_results_sleep <- data.frame(
  Sample_Size = sizes,
  Predicted_Mean = mean_sample_means_sleep,
  Observed_SE = sd_sample_means_sleep,
  Theoretical_SE = round(pop_sd_sleep / sqrt(sizes), 2)
)

print(clt_results_sleep)

cat("\n总体均值：", round(pop_mean_sleep, 2),
    "\n总体标准差：", round(pop_sd_sleep, 2), "\n"
)
  Sample_Size Predicted_Mean Observed_SE Theoretical_SE
1          10           6.87        0.36           0.36
2          30           6.87        0.21           0.21
3          50           6.86        0.16           0.16
4         100           6.87        0.11           0.11

总体均值： 6.87 
总体标准差： 1.13
代码 
## 中心极限定理 - 睡眠时长

## 理想正态分布数据

x_values <- seq(
  min(tail(sample_means_sleep, 1)[[1]]),
  max(tail(sample_means_sleep, 1)[[1]]),
  length.out = 100  # 选择 100 个数
)

y_values <- dnorm(
  x_values,
  mean = mean(tail(sample_means_sleep, 1)[[1]]),
  sd = sd(tail(sample_means_sleep, 1)[[1]])
)


## 样本均值分布与正态曲线

plot_ly() |>

  # 直方图
  add_histogram(
    x = tail(sample_means_sleep, 1)[[1]],
    type = "histogram",
    histnorm = "probability",
    xbins = list(size = 0.05),  # 分箱宽度
    name = "样本均值",          # 直方图标签

    # 美学设置
    marker = list(
      color = "#FFABB6",                         # 填充颜色
      line = list(color = "#222", width = 1.5),  # 轮廓线
      opacity = 0.6
    )
  ) |>

  # 正态曲线
  add_lines(
    x = x_values,
    y = y_values * 0.05,
    name = "正态曲线",        # 线条标签
    line = list(color = '#D53132', width = 2)
  ) |>

  layout(
    legend = list(
      orientation = "h",                   # 图例标签排列方式
      xanchor = "left", yanchor = "top",   # 图例锚点
      x = 0, y = 1.1                       # 图例位置
    ),
    margin = list(t = 90),    # 顶部边距
    title = list(
      y = 0.95,               # 标题的 y 位置
      text = "睡眠时长样本均值概率分布（含正态曲线）"
    ),
    xaxis = list(title = "睡眠时长样本均值（n = 100）"),
    yaxis = list(title = "概率")
  )
图 16: 睡眠时长样本均值概率分布（含正态曲线）

6 抽样方法

本节以前五平台数据作为总体数据集，使用三种抽样方法各抽取一个样本：有放回的简单随机抽样、不等概率系统抽样和无放回的分层抽样，并对这三种方法的总体预测能力进行比较分析。

输出 17、输出 18 和 输出 19 展示了不同样本的结果，包括各平台的比例分布以及日均使用时长的均值和标准差。

6.1 简单随机抽样

使用 srswr() 函数进行有放回的简单随机抽样，样本存储于 sample1。

输出 17: 有放回简单随机抽样结果
代码 
## 有放回简单随机抽样

## 抽样

# 样本量与随机种子
n <- 100
set.seed(32)

# 简单随机抽样
s <- srswr(n, nrow(top5_platforms_data))

# 查找被抽中观测所在的行
rows <- (1:nrow(top5_platforms_data))[s!=0]
rows <- rep(rows, s[s!=0])

# 提取样本数据
sample1 <- top5_platforms_data[rows, ]


## 计算

# 定义计算百分比的函数
calc_perc <- function(sample_data, n = 100) {

  ## sample_data：通过不同方法抽取的样本数据
  ## n：样本量

  # 频数
  f <- table(
    factor(
      sample_data$Most_Used_Platform,
      levels = top5_platforms  # 确保平台顺序一致
    )
  )

  # 百分比
  return(f / n)  # n：样本量
}

# 平台百分比
perc1 <- calc_perc(sample1)

# 使用时长的样本均值和标准差
mean1 <- mean(sample1$Avg_Daily_Usage_Hours, na.rm = TRUE)
sd1 <- sd(sample1$Avg_Daily_Usage_Hours, na.rm = TRUE)

# 打印结果
cat("平台百分比（%）：\n"); perc1 * 100; cat("\n")
cat("使用时长样本均值：", mean1, "\n")
cat("使用时长样本标准差：", round(sd1, 3), "\n")
平台百分比（%）：

Instagram    TikTok  Facebook  WhatsApp   Twitter 
       44        27        13        11         5 

使用时长样本均值： 5.035 
使用时长样本标准差： 1.262

6.2 系统抽样

对于系统抽样，首先使用 inclusionprobabilities() 函数根据使用时长计算纳入概率并存储于 pik，再使用 UPsystematic(pik) 抽取样本，存储于 sample2。

输出 18: 不等概率系统抽样结果
代码 
## 不等概率系统抽样

## 抽样

# 随机种子
set.seed(32)

# 根据使用时长计算纳入概率
pik <- inclusionprobabilities(top5_platforms_data$Avg_Daily_Usage_Hours, n)

# 不等概率系统抽样
s <- UPsystematic(pik)

# 提取样本数据
sample2 <- top5_platforms_data[s!= 0, ]


## 计算

# 平台百分比
perc2 <- calc_perc(sample2)

# 使用时长的样本均值和标准差
mean2 <- mean(sample2$Avg_Daily_Usage_Hours, na.rm = TRUE)
sd2 <- sd(sample2$Avg_Daily_Usage_Hours, na.rm = TRUE)

# 打印结果
cat("平台百分比（%）：\n"); perc2 * 100; cat("\n")
cat("使用时长样本均值：", mean2, "\n")
cat("使用时长样本标准差：", round(sd2, 3), "\n")
平台百分比（%）：

Instagram    TikTok  Facebook  WhatsApp   Twitter 
       41        28        18         9         4 

使用时长样本均值： 5.332 
使用时长样本标准差： 1.267

6.3 分层抽样

对于分层抽样，首先使用 order() 函数按平台对总体数据进行排序，再使用 strata() 函数抽取样本，存储于 sample3，各层样本量按平台比例计算。

输出 19: 无放回分层抽样结果
代码 
## 无放回分层抽样

## 排序数据

# 按平台对数据排序
order_index <- order(top5_platforms_data$Most_Used_Platform)
data <- top5_platforms_data[order_index, ]  # 使用排序后的数据

# 计算比例
prop_table <- table(data$Most_Used_Platform) / nrow(data)

# 计算各层样本量
sizes <- round(prop_table * n)

# 检查样本量总和是否等于 n
# sum(sizes)  # [1] 100


## 分层抽样

# 随机种子
set.seed(32)

# 查找分层
st <- sampling::strata(
  data,
  stratanames = "Most_Used_Platform",
  size = sizes,
  method = "srswor"  # 无放回简单随机抽样
)

# 提取样本数据
sample3 <- sampling::getdata(data, st)


## 计算

# 平台百分比
perc3 <- calc_perc(sample3)

# 使用时长的样本均值和标准差
mean3 <- mean(sample3$Avg_Daily_Usage_Hours, na.rm = TRUE)
sd3 <- sd(sample3$Avg_Daily_Usage_Hours, na.rm = TRUE)

# 打印结果
cat("平台百分比（%）：\n"); perc3 * 100; cat("\n")
cat("使用时长样本均值：", mean3, "\n")
cat("使用时长样本标准差：", round(sd3, 3), "\n")
平台百分比（%）：

Instagram    TikTok  Facebook  WhatsApp   Twitter 
       41        25        20         9         5 

使用时长样本均值： 4.948 
使用时长样本标准差： 1.134

6.4 抽样方法比较

6.4.1 平台比例

输出 20 展示了总体（前五平台数据）和三种样本中各平台的比例。为便于分析，计算了各样本值与对应总体值之差的均值，见 输出 21。此外，图 17 对 输出 21 的结果进行了可视化。

输出 20: 不同平台的总体与样本比例
代码 
## 抽样方法比较

## 平台百分比

# 存储样本百分比
sample_percs <- list(srswr = perc1, ups = perc2, stwor = perc3)

# 计算总体百分比
pop_perc <- table(
  factor(
    top5_platforms_data$Most_Used_Platform,
    levels = top5_platforms
  )
) / nrow(top5_platforms_data)


# 显示百分比结果
cat("总体百分比：\n")
round(pop_perc, 2); cat("\n\n")
cat("样本百分比：\n\n")
sample_percs
总体百分比：

Instagram    TikTok  Facebook  WhatsApp   Twitter 
     0.41      0.25      0.20      0.09      0.05 


样本百分比：

$srswr

Instagram    TikTok  Facebook  WhatsApp   Twitter 
     0.44      0.27      0.13      0.11      0.05 

$ups

Instagram    TikTok  Facebook  WhatsApp   Twitter 
     0.41      0.28      0.18      0.09      0.04 

$stwor

Instagram    TikTok  Facebook  WhatsApp   Twitter 
     0.41      0.25      0.20      0.09      0.05

如 输出 21 和 图 17 所示，无放回分层抽样与总体值的差异最小（0.002），预测平台比例的能力最强。相比之下，有放回简单随机抽样的预测能力最弱（均值差异为 0.029）。分层抽样表现最佳，可能是因为它在抽样前按平台类别划定层次，保留了总体中平台分布的内在结构，从而降低了抽样变异性；而简单随机抽样更为随机，平台比例的预测较不稳定。

输出 21: 各抽样方法与总体比例之差
代码 
## 抽样方法比较

## 平台百分比

# 计算样本百分比与总体百分比之间
# 差异的均值
mean_diffs <- sample_percs |>

  # 计算差异
  lapply(\(percs) abs(percs - pop_perc)) |>
    # lapply：列表应用，返回一个列表
    # 其中 \() 是匿名函数，等同于 function(percs)
    # 它将 sample_percs 中的取值作为 percs 传入并应用函数，
    # 然后返回一个列表

  # 计算差异均值
  sapply(mean, na.rm = TRUE)
    # sapply：简化版 apply，返回值数据类型更灵活。
    # 此处返回一个命名向量

# 显示结果
cat("与总体百分比的差异：\n")
sort(round(mean_diffs, 3)); cat("\n")
与总体百分比的差异：
stwor   ups srswr 
0.002 0.012 0.029
代码 
## 抽样方法比较

## 平台百分比

# 绘制与总体百分比差异的柱状图
method_labels <- c(
  srswr = "简单随机",
  ups = "系统抽样",
  stwor = "分层抽样"
)

plot_ly(
  x = unname(method_labels[names(mean_diffs)]),  # 抽样方法名称
  y = unname(mean_diffs),
  type = "bar",  # 柱状图

  # 美学设置
  marker = list(
    color = "#c3a4cf",                        # 填充颜色
    line = list(color = "#222", width = 1.5)  # 轮廓线颜色与宽度
  )
) |>

  layout(
    margin = list(t = 50),  # 顶部边距
    title = list(
      y = 0.95,             # 标题的 y 位置
      text = "各抽样方法与总体比例之差"
    ),
    xaxis = list(
      title = "抽样方法",
      type = "category",        # 使用分类x轴
      categoryorder = "array",  # 使用自定义类顺序
      categoryarray = unname(method_labels[names(sort(mean_diffs))]), # 类顺序
      range = c(-0.5, 2.5)
    ),
    yaxis = list(title = "差异")
  )
图 17: 各抽样方法与总体比例之差

6.4.2 使用时长统计量

除预测类别比例外，还对三种抽样方法预测均值和标准差的能力进行了测试。输出 22 展示了均值和标准差的结果，图 18 提供了更直观的可视化呈现。

输出 22: 社交媒体使用时长的总体与样本统计量
代码 
## 抽样方法比较

## 使用时长的均值和标准差

# 存储样本均值和标准差
sample_means <- c(srswr = mean1, ups = mean2, stwor = mean3)
sample_sds <- c(srswr = sd1, ups = sd2, stwor = sd3)

# 显示均值结果
cat("总体均值：", round(pop_mean_usage, 3), "\n")
cat("样本均值：\n"); sample_means; cat("\n")

# 显示标准差结果
cat("总体标准差：", round(pop_sd_usage, 3), "\n")
cat("样本标准差：\n"); round(sample_sds, 3)
总体均值： 4.919 
样本均值：
srswr   ups stwor 
5.035 5.332 4.948 

总体标准差： 1.257 
样本标准差：
srswr   ups stwor 
1.262 1.267 1.134

在 图 18 中，棒中间的点代表样本均值，黑色误差棒表示距样本均值一个样本标准差的范围，虚线及标注文字标记了总体均值和总体标准差。

综合 输出 22 和 图 18，就数值变量均值而言，无放回分层抽样预测结果最接近总体，预测能力最强；不等概率系统抽样的预测能力最弱。

然而在标准差方面，有放回简单随机抽样的预测最为准确，而无放回分层抽样的预测精度最低。

这些预测能力上的差异很可能源于各抽样方法的内在设计。无放回分层抽样通过确保所有子组按比例代表，在估计均值上表现出色，并通过消除重复数据点来减少方差；而不等概率系统抽样若抽样间隔与数据中的隐藏模式相吻合，可能引入偏差。

相反，有放回简单随机抽样对标准差的估计更为准确，可能是因为有放回机制允许样本更好地反映总体的真实变异性与噪声，而分层的结构化特性则倾向于压缩内部方差，导致对总体分散程度的低估。

代码 
## 抽样方法比较

## 使用时长的均值和标准差

# 将方法、样本均值和标准差存入数据框
plot_data <- data.frame(
  Method = method_labels[names(sample_means)],  # 抽样方法名称
  Mean   = sample_means,
  SD     = sample_sds
)

# 棒状图
plot_ly(
  plot_data,
  x = ~Method,
  y = ~Mean
) |>

  # 添加误差棒
  add_markers(
    name = "样本均值",  # 棒状图标签

    # 误差棒（样本标准差）
    error_y = list(
      type = "data",    # 使用 array 中指定的数据作为误差棒长度
      array = ~SD,      # 用作误差棒长度的数据
      color = '#222'  # 误差棒颜色
    ),

    # 标记点（样本均值）的美学设置
    marker = list(size = 12, color = '#55D2C6')
  ) |>

  layout(
    margin = list(t = 60, b = 60),  # 顶部和底部边距
    title = list(
      y = 0.95,                     # 标题的 y 位置
      text = "各抽样方法均值与标准差比较"
    ),
    yaxis = list(
      title = "使用时长",
      range = c(              # y 轴范围
        pop_mean_usage - 1.5*pop_sd_usage,
        pop_mean_usage + 1.5*pop_sd_usage
      )
    ),
    xaxis = list(
      title = "抽样方法",
      range = c(-0.5, 3),                  # x 轴范围
      type = "category",                   # 类别轴
      categoryorder = "array",             # 使用指定顺序
      categoryarray = plot_data$Method     # 指定类别顺序
    ),

    # 添加总体统计量参考线
    shapes = list(

      # 总体均值
      list(
        type = "line",        # 添加线条
        xref = "x",           # x 值相对于 x 轴（0,1,2）
        x0 = -0.4, x1 = 2.4,  # 线条的 x 范围
        y0 = pop_mean_usage,  # 线条的 y 值
        y1 = pop_mean_usage,
        line = list(
          color = "#D53132",
          dash = "dash",      # 线型
          width = 2
        )
      ),

      # 总体均值 + 总体标准差
      list(
        type = "line",
        xref = "x",
        x0 = -0.4, x1 = 2.4,
        y0 = pop_mean_usage + pop_sd_usage,
        y1 = pop_mean_usage + pop_sd_usage,
        line = list(color = "#FFA472", dash = "dot", width = 2)
      ),

      # 总体均值 - 总体标准差
      list(
        type = "line",
        xref = "x",
        x0 = -0.4, x1 = 2.4,
        y0 = pop_mean_usage - pop_sd_usage,
        y1 = pop_mean_usage - pop_sd_usage,
        line = list(color = "#FFA472", dash = "dot", width = 2)
      )
    ),

    # 参考线注释
    annotations = list(

      # 总体均值
      list(
        text = "总体均值\n(4.919)",
        x = 2.5,
        y = pop_mean_usage,
        xanchor = "left",
        showarrow = FALSE
      ),

      # 总体均值 + 总体标准差
      list(
        text = "+1 总体标准差\n(+1.257)",
        x = 2.5,
        y = pop_mean_usage + pop_sd_usage,
        xanchor = "left",
        showarrow = FALSE
      ),

      list(
        text = "-1 总体标准差\n(-1.257)",
        x = 2.5,
        y = pop_mean_usage - pop_sd_usage,
        xanchor = "left",
        showarrow = FALSE
      )
    )
  )
图 18: 各抽样方法均值与标准差比较
回到顶部