感知概率与感知数量

感知概率与感知数量

这篇文章学习自zonination/perceptions。原作者模仿绘制了谢尔曼-肯特关于感知概率和感知数量的研究图表。在本文中我对zonination的绘制代码进行了细微的改进。

首先准备绘制图表需要的数据:

numberly.csv
probly.csv

准备R包和读入数据集:

1
2
3
4
5
6
setwd("~/Desktop")
probly <- read.csv("probly.csv", stringsAsFactors = F)
numberly <- read.csv("numberly.csv", stringsAsFactors = F)
library(tidyverse)
library(ggridges)
library(scales)

这两个数据集都是宽面板,下面把这两个数据集转变为长面板:

1
2
3
4
5
numberly <- gather(numberly, "variable", "value", 1:10)
numberly$variable <- gsub("[.]", " ", numberly$variable)
probly <- gather(probly, "variable", "value", 1:17)
probly$variable <- gsub("[.]", " ", probly$variable)
probly$value <- probly$value/100 # 转换成百分数

中文化:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
probly$variable[which(probly$variable == "Almost Certainly")] <- "几乎确定"
probly$variable[which(probly$variable == "Almost Certainly")] <- "几乎确定"
probly$variable[which(probly$variable == "Chances Are Slight")] <- "机会渺茫"
probly$variable[which(probly$variable == "Highly Unlikely")] <- "很不可能"
probly$variable[which(probly$variable == "Almost No Chance")] <- "毫无机会"
probly$variable[which(probly$variable == "Little Chance")] <- "机会不大"
probly$variable[which(probly$variable == "Probably Not")] <- "不太确定"
probly$variable[which(probly$variable == "Unlikely")] <- "不可能"
probly$variable[which(probly$variable == "Improbable")] <- "不太可能"
probly$variable[which(probly$variable == "We Doubt")] <- "值得怀疑"
probly$variable[which(probly$variable == "About Even")] <- "一半一半"
probly$variable[which(probly$variable == "Better Than Even")] <- "有点可能"
probly$variable[which(probly$variable == "Probably")] <- "可能"
probly$variable[which(probly$variable == "We Believe")] <- "值得确定"
probly$variable[which(probly$variable == "Likely")] <- "很可能"
probly$variable[which(probly$variable == "Probable")] <- "大概率的可能"
probly$variable[which(probly$variable == "Very Good Chance")] <- "非常有机会"
probly$variable[which(probly$variable == "Highly Likely")] <- "极有可能"

numberly$variable[which(numberly$variable == "Hundreds of")] <- "成百上千"
numberly$variable[which(numberly$variable == "Scores of")] <- "许多"
numberly$variable[which(numberly$variable == "Dozens")] <- "几打"
numberly$variable[which(numberly$variable == "Many")] <- "很多"
numberly$variable[which(numberly$variable == "A lot")] <- "大量"
numberly$variable[which(numberly$variable == "Several")] <- "几个"
numberly$variable[which(numberly$variable == "Some")] <- "一些"
numberly$variable[which(numberly$variable == "A few")] <- "很少"
numberly$variable[which(numberly$variable == "A couple")] <- "一对"
numberly$variable[which(numberly$variable == "Fractions of")] <- "几分之一"

因子化与排序:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
probly$variable <- factor(probly$variable,
c(
"机会渺茫",
"很不可能",
"毫无机会",
"机会不大",
"不太确定",
"不可能",
"不太可能",
"值得怀疑",
"一半一半",
"有点可能",
"可能",
"值得确定",
"很可能",
"大概率的可能",
"非常有机会",
"极有可能",
"几乎确定"
))

numberly$variable <- factor(numberly$variable,
c(
"成百上千",
"许多",
"几打",
"很多",
"大量",
"几个",
"一些",
"很少",
"一对",
"几分之一"
))

下面就可以开始绘图了,首先 绘制概率感知的箱线图。

1
2
3
4
5
6
7
8
9
10
library(ggpomological)
(p <- ggplot(probly, aes(variable, value)) +
geom_boxplot(aes(fill = variable), alpha = 0.5) +
geom_jitter(aes(color = variable), size = 3, alpha = 0.2) +
scale_y_continuous(breaks = seq(0, 1, 0.1), labels = scales::percent_format()) +
guides(fill = F, color = F) +
labs(title = "概率感知", x = "可能性术语", y = "感知概率值分配") +
coord_flip() +
theme_pomological(base_size = 20, base_family = "MLingWaiMedium-SC")) +
theme(plot.title = element_text(hjust = 0.5, size = 30))

然后绘制数量感知分布:

1
2
3
4
5
6
7
8
9
(q <- ggplot(numberly, aes(variable, value)) +
geom_boxplot(aes(fill = variable), alpha = 0.5) +
geom_jitter(aes(color = variable), size = 2, alpha = 0.2) +
scale_y_log10(labels = trans_format("log10", math_format(10^.x)), breaks = 10^(-2:6)) +
guides(fill = F, color = F) +
labs(title = "数量感知", x = "数量描述术语", y = "感知数量值分配") +
coord_flip() +
theme_pomological(base_size = 20, base_family = "MLingWaiMedium-SC") +
theme(plot.title = element_text(hjust = 0.5, size = 30)))

绘制概率感知的山岭图:

1
2
3
4
5
6
7
ggplot(probly, aes(y = variable, x = value)) +
geom_density_ridges(scale = 4, aes(fill = variable), alpha = 3/4) +
scale_x_continuous(breaks = seq(0, 1, 0.1), labels = scales::percent_format()) +
guides(fill = F, color = F) +
labs(title = "概率感知分布", x = "概率值分配", y = "") +
theme_pomological(base_size = 20, base_family = "MLingWaiMedium-SC") +
theme(plot.title = element_text(hjust = 0.5, size = 30))

绘制数量感知山岭图:

1
2
3
4
5
6
7
ggplot(numberly, aes(y = variable, x = value)) +
geom_density_ridges(aes(fill = variable, alpha = 3/4)) +
scale_x_log10(labels = trans_format("log10", math_format(10^.x)), breaks = 10^(-2:6)) +
labs(title = "数量感知分布", x = "数量值分配", y = "") +
guides(fill = F, color = F) +
theme_pomological(base_size = 20, base_family = "MLingWaiMedium-SC") +
theme(plot.title = element_text(hjust = 0.5, size = 30), legend.position = "none")

# R

评论

Your browser is out-of-date!

Update your browser to view this website correctly. Update my browser now

×