R语言数据探索和分析23-公共物品问卷分析

第一次实利用用最基本的公共物品游戏，不外加其他的treatment。班里的学生4人一组，一共44/4=11组。一共玩20个回合的公共物品游戏。每回合给15秒做决定的时间。第十回合后，给大家放一个几分钟的“爱心”视频（链接如下），然后继续完成剩下的10回合。
修改列名
把“来源”，“来源详情”，“来自IP” 这几个无关变量删除。重新命名前面几个变量，新变量对应名称为：'序号','提交答卷时间','所用时间','性别'。把代表组号的那一个变量的名字重新命名为“team_num”。把后面所有回合的变量名重新命名为“round1”, round2,....round20。以及最后两个测算风险偏好和模糊偏好的变量分别重新命名为risk_atti 和 ambiguity_atti。
数据和完备代码

1. # 读取数据
2. data <- read.csv("datar.csv", header = TRUE, stringsAsFactors = FALSE, fileEncoding = "GBK")
3. data
5. head(data,5)
7. # 删除无关变量
8. data <- data[, !names(data) %in% c("来源", "来源详情", "来自IP")]
10. # 重新命名变量
11. colnames(data) <- c("序号", "提交答卷时间", "所用时间", "性别", "team_num",
12.                     paste0("round", 1:20), "risk_atti", "ambiguity_atti")
14. names(data)
15. head(data,5)

复制代码

变量赋值

1. data$gender <- ifelse(data$性别 == "男", 1, 0)
2. head(data,5)

复制代码

看“爱心”视频前，大家前10回合的平均贡献值是多少？看“爱心”视频后，大家后10回合的平均贡献值是多少？

1. # 提取前10回合和后10回合的数据
2. before_video <- data[, 7:16]
3. after_video <- data[, 17:26]
5. # 计算平均贡献值
6. avg_contribution_before <- rowMeans(before_video, na.rm = TRUE)
7. avg_contribution_after <- rowMeans(after_video, na.rm = TRUE)
9. # 输出结果
10. avg_contribution_before <- mean(avg_contribution_before, na.rm = TRUE)
11. avg_contribution_after <- mean(avg_contribution_after, na.rm = TRUE)
13. cat("看“爱心”视频前，大家前10回合的平均贡献值是:", avg_contribution_before, "\n")
14. cat("看“爱心”视频后，大家后10回合的平均贡献值是:", avg_contribution_after, "\n")
15. # 导入绘图库
16. library(ggplot2)
18. # 创建数据框
19. contribution <- data.frame(
20.   Time_Period = c("Before Video", "After Video"),
21.   Average_Contribution = c(avg_contribution_before, avg_contribution_after)
22. )
24. # 绘制柱状图，并标上数据值
25. ggplot(contribution, aes(x = Time_Period, y = Average_Contribution, fill = Time_Period)) +
26.   geom_bar(stat = "identity") +
27.   geom_text(aes(label = round(Average_Contribution, 2)), vjust = -0.5) +  # 标上数据值
28.   labs(title = "Average Contribution Before and After Watching 'Love' Video",
29.        x = "Time Period",
30.        y = "Average Contribution") +
31.   theme_minimal() +
32.   theme(legend.position = "none")

复制代码

从结果和可视化都可以看出，看“爱心”视频前，大家前10回合的平均贡献值是7.138889，看“爱心”视频后，大家后10回合的平均贡献值是7.2
异常值检测

1. # 找出所用时间超过800秒的同学
2. outliers_800 <- data[data$'所用时间' == '808秒', ]
3. outliers_800
4. # 找出所用时间为314秒的同学
5. outliers_314 <- data[data$'所用时间' == '314秒', ]
6. # 找出所用时间为74秒的同学
7. outliers_74 <- data[data$'所用时间' == '74秒', ]
8. # 将outliers合并
9. outliers <- rbind(outliers_800, outliers_314, outliers_74)
10. outliers
11. # 从数据中删除outliers
12. data <- data[!(rownames(data) %in% rownames(outliers)), ]
14. # 重新计算Part 1
15. before_video <- data[, 7:16]
16. after_video <- data[, 17:26]
18. avg_contribution_before <- rowMeans(before_video, na.rm = TRUE)
19. avg_contribution_after <- rowMeans(after_video, na.rm = TRUE)
21. avg_contribution_before <- mean(avg_contribution_before, na.rm = TRUE)
22. avg_contribution_after <- mean(avg_contribution_after, na.rm = TRUE)

复制代码

删除了异常值之后，看“爱心”视频前，大家前10回合的平均贡献值是6.751515，看“爱心”视频后，大家后10回合的平均贡献值是7.490909
女同学的前十和后十回合的平均贡献值是多少？男生呢？

1. # 按性别分组
2. female_data <- subset(data, 性别 == "女")
3. male_data <- subset(data, 性别 == "男")
5. # 提取前十回合和后十回合的数据
6. before_video_female <- female_data[, 7:16]
7. before_video_female
8. after_video_female <- female_data[, 17:26]
9. before_video_male <- male_data[, 7:16]
10. after_video_male <- male_data[, 17:26]
12. # 计算平均贡献值
13. avg_contribution_before_female <- rowMeans(before_video_female, na.rm = TRUE)
14. avg_contribution_after_female <- rowMeans(after_video_female, na.rm = TRUE)
15. avg_contribution_before_male <- rowMeans(before_video_male, na.rm = TRUE)
16. avg_contribution_after_male <- rowMeans(after_video_male, na.rm = TRUE)
18. # 计算平均贡献值的平均值
19. avg_contribution_before_female <- mean(avg_contribution_before_female, na.rm = TRUE)
20. avg_contribution_after_female <- mean(avg_contribution_after_female, na.rm = TRUE)
21. avg_contribution_before_male <- mean(avg_contribution_before_male, na.rm = TRUE)
22. avg_contribution_after_male <- mean(avg_contribution_after_male, na.rm = TRUE)

复制代码

女同学的前十回合的平均贡献值是5.266667，女同学的后十回合的平均贡献值是6.3，男同学的前十回合的平均贡献值是7.308333，男同学的后十回合的平均贡献值是7.9375
为了探索差别风险偏好的同学在观看“爱心”视频前后的平均贡献值，我们可以按照之前的步骤举行数据处理和分析。起首，我们需要将风险偏好转换为风险偏好等级，然后按照这些等级将数据分组，分别计算他们在观看视频前后的平均贡献值。        

1. # 根据映射关系将风险偏好转换为相应的风险偏好等级
2. risk_attitude_levels <- c("highly risk loving", "very risk loving", "risk loving",
3.                           "risk neutral", "slightly risk averse", "risk averse",
4.                           "very risk averse", "highly risk averse", "stay in bed", "stay in bed")
6. data$risk_attitude_level <- risk_attitude_levels[data$risk_atti]
8. # 按风险偏好等级分组
9. risk_attitude_groups <- split(data, data$risk_attitude_level)
11. # 计算每个组在观看视频前后的平均贡献值
12. avg_contribution_before <- sapply(risk_attitude_groups, function(group) {
13.   avg_before <- mean(rowMeans(group[, 7:16], na.rm = TRUE), na.rm = TRUE)
14.   return(avg_before)
15. })
17. avg_contribution_after <- sapply(risk_attitude_groups, function(group) {
18.   avg_after <- mean(rowMeans(group[, 17:26], na.rm = TRUE), na.rm = TRUE)
19.   return(avg_after)
20. })
22. # 合并结果为数据框
23. avg_contribution <- data.frame(Risk_Attitude = names(avg_contribution_before),
24.                                Avg_Contribution_Before = avg_contribution_before,
25.                                Avg_Contribution_After = avg_contribution_after)
27. # 输出结果
28. print(avg_contribution)

复制代码

高风险偏好者（highly risk loving）在观看视频前的平均贡献值较高，但在观看视频后低落到较低水平，这可能表明他们更倾向于冒险和自我长处，并且对于公共物品的贡献程度受到外部因素影响较大。风险厌恶者（risk averse）在观看视频前后的平均贡献值有所增加，这可能表明他们更加稳健和审慎，但在观看视频后表现出更多的乐意到场公共物品的贡献。风险中性者（risk neutral）在观看视频前后的平均贡献值保持相对稳固，这可能表明他们的决策相对稳固，不受外部因素的影响较大。风险略微厌恶者（slightly risk averse）和非常风险厌恶者（very risk averse）在观看视频前后的平均贡献值厘革较小，这可能表明他们的行为相对稳固，不受外部因素的影响较大。保持在床上者（stay in bed）在观看视频前后的平均贡献值有所增加，这可能表明他们对于外部因素的反应较弱，但在观看视频后表现出更多的乐意到场公共物品的贡献。
综上所述，差别风险偏好等级的同学在观看视频前后的行为表现有所差别，这可能受到个体风险态度和外部环境的影响。针对这些差别特点，我们可以制定更具针对性的鼓励措施，以促进更多人为公共物品做出贡献。
创作不易，希望大家多点赞关注批评！！！

免责声明：如果侵犯了您的权益，请联系站长，我们会及时删除侵权内容，谢谢合作！更多信息从访问主页：qidao123.com:ToB企服之家，中国第一个企服评测及商务社交产业平台。