R语言数据分析案例42-结婚意愿问卷数据统计分析

statistican_ABin

于 2024-07-14 09:00:00 发布

阅读量598

点赞数 32

分类专栏： R语言数据分析案例文章标签： r语言数据分析开发语言

本文链接：https://blog.csdn.net/m0_62638421/article/details/140397949

版权

R语言数据分析案例专栏收录该内容

42 篇文章 5 订阅

订阅专栏

1. 调查背景和意义

随着社会的不断发展和进步，年轻人的生活方式和价值观也在不断变化。尤其是近年来亚文化的迅速崛起，已经成为许多年轻人日常生活中不可或缺的一部分。。。。本研究旨在通过分析不同亚文化圈层（如偶像文化圈、宠物文化圈、二次元文化圈、新舞音文化圈、新艺术文化圈和新竞技文化圈）的参与度，探讨其对青年群体婚育意愿的影响，从而为相关政策制定和社会干预提供科学依据。

2. 调查问题描述

本次调查的主要问题是：青年群体在不同亚文化圈层中的参与度如何影响其婚育意愿？

3. 数据收集过程

为了保证调查结果的代表性和科学性，我们采用了随机抽样的方法。通过线上问卷和线下调研相结合的方式，我们在全国范围内收集了132份有效问卷。问卷内容包括性别、年龄、学历、对不同亚文化圈层的参与度和婚育意愿等信息。。。。

数据和代码

报告代码数据

4. 统计方法的选择

为了深入分析亚文化圈层参与度对青年群体婚育意愿的影响，我们选择了描述统计和假设检验相结合的统计方法。

4.1 描述统计

描述统计主要用于概述数据的基本特征，包括性别、年龄、学历的分布情况，以及不同亚文化圈层参与度的总体情况。通过绘制条形图和箱线图，我们可以直观地展示这些基本特征。

4.2 假设检验

假设检验主要用于分析不同亚文化圈层参与度对婚育意愿的影响。

5. 统计结果的分析

5.1 描述统计结果

结果如下：

library(readxl)
library(ggplot2)

data <- read_excel("结婚意愿.xlsx")
head(data,5)
# 描述统计
summary(data)

从图片中的描述统计结果可以看出，样本数据在性别、年龄、学历以及各个亚文化圈层参与度和婚育意愿方面的分布情况。具体来说，性别分布均衡，男女比例较为接近（男：1.000，女：2.000）。年龄方面，样本主要集中在21-27岁和28-35岁两个年龄段（1st Qu.: 2.000, Median: 3.000）。。。。

接下来查看性别分布情况：

gender_distribution <- table(data$性别)
barplot(gender_distribution, main="性别分布", col=c("blue", "pink"), names.arg=c("Male", "Female"), ylab="Count")

从性别分布图来看，样本中女性的比例明显高于男性。具体数据显示，女性参与者的数量约为80人，而男性参与者的数量约为50人。这样的分布可能反映了在参与此次调查的过程中，女性对调查主题表现出了更高的兴趣和参与意愿。。。。

接下来查看年龄分布：

# 年龄分布
age_distribution <- table(data$年龄)
barplot(age_distribution, main="年龄分布", col="green", names.arg=c("<20", "21-27", "28-35", ">36"), ylab="Count")

从年龄分布图来看，样本中21-27岁的青年群体占据了绝对的主体地位，约有100人，而其他年龄段的参与者相对较少，尤其是28-35岁和36岁以上的参与者，数量几乎可以忽略不计。。。。接下来查看学历分布图：

# 绘制学历分布图
education_distribution <- table(data$学历)
barplot(education_distribution, main="学历分布", col="purple", names.arg=education_labels, ylab="数量")

从学历分布图来看，样本中的本科生占比最高，约有80人，其次是研究生，约有40人，而大专及以下学历的参与者数量非常少。这一分布特点可能反映了高学历青年群体对亚文化圈层的参与度较高，也可能是因为高学历群体更愿意参与学术研究相关的调查。

5.2 假设检验分析

假设检验是统计分析中的重要工具，用于确定数据中是否存在显著差异。在本研究中，我们主要使用独立样本t检验来分析不同亚文化圈层参与度对婚育意愿的影响。。。

偶像文化圈参与度与婚育意愿，结果如下

perform_t_test <- function(data, cultural_column) {
  t_test_result <- t.test(data[[cultural_column]] ~ data$婚育意愿)
  return(t_test_result)
}

# 生成图表函数
plot_boxplot <- function(data, cultural_column, title) {
  ggplot(data, aes(x=婚育意愿, y=!!sym(cultural_column), fill=婚育意愿)) +
    geom_boxplot() +
    scale_fill_manual(values=c("1"="lightblue", "0"="lightgreen")) + # 自定义颜色
    labs(title=title, x="婚育意愿", y=cultural_column) +
    theme(plot.title = element_text(hjust = 0.5))
}
# 偶像文化圈参与度与婚育意愿的假设检验
t_test_idol <- perform_t_test(data, "偶像文化圈参与度")
print(t_test_idol)
# 偶像文化圈参与度与婚育意愿的箱线图
plot_boxplot(data, "偶像文化圈参与度", "偶像文化圈参与度与婚育意愿的关系")

从Welch双样本t检验的结果可以看出，偶像文化圈参与度在高婚育意愿组和低婚育意愿组之间的差异不显著（t = -0.62558, p = 0.533）。p值大于0.05，表明两组之间的均值差异在统计上不显著。

偶像文化圈参与度与婚育意愿的箱线图可视化一下

这些图形结果与t检验的统计结果一致，进一步支持了偶像文化圈参与度对婚育意愿没有显著影响的结论。因此，可以认为，偶像文化圈的参与度并不是决定青年群体婚育意愿的主要因素。

接下来分析宠物文化圈参与度与婚育意愿的假设检验，结果如下：

这些图形结果与t检验的统计结果一致，进一步支持了二次元文化圈参与度对婚育意愿没有显著影响的结论。。。

接下来是新舞音文化圈参与度与婚育意愿的假设检验

从箱线图中可以直观地看到，新舞音文化圈参与度在高婚育意愿组（婚育意愿值为1）和低婚育意愿组（婚育意愿值为0）之间的分布情况。。。。

接下来分析新艺术文化圈参与度与婚育意愿的假设检验

t_test_sport <- perform_t_test(data, "新竞技文化圈参与度")
print(t_test_sport)
# 新竞技文化圈参与度与婚育意愿的箱线图
plot_boxplot(data, "新竞技文化圈参与度", "新竞技文化圈参与度与婚育意愿的关系")

从Welch双样本t检验的结果可以看出，新艺术文化圈参与度在高婚育意愿组和低婚育意愿组之间的差异不显著（t = -0.99785, p = 0.3209）。p值大于0.05，表明两组之间的均值差异在统计上不显著。

6. 结论和展望

6.1 研究结论

性别、年龄和学历分布方面，样本中的男性和女性比例相对均衡，21-27岁和28-35岁年龄段的青年人占比最高，本科学历占比最高。样本具有较好的代表性。亚文化圈层参与度的总体情况方面，在偶像文化圈、宠物文化圈、二次元文化圈、新舞音文化圈、新艺术文化圈和新竞技文化圈等亚文化圈层中，青年群体的参与度存在一定差异。。。。