堆叠 geom_bar() 每个 x 值有 2 个柱
Stacked geom_bar() with 2 bars per x value
请原谅，这是被询问和回答的问题，但到目前为止，我还没有找到满足我的用例的解决方案。如果你知道一个，请给我指明正确的方向。
这是我的代码的一个小示例：
library(tidyverse)
source <- c("D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P")
subject <- c("M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R")
grade <- c(1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, 2)
domain <- c("Alg", "Alg", "Alg", "Alg", "Alg", "Alg", "Geo", "Geo", "Geo", "Geo", "Geo", "Geo", "Comp", "Comp", "Comp", "Comp", "Comp", "Comp", "Voc", "Voc", "Voc", "Voc", "Voc", "Voc", "Alg", "Alg", "Alg", "Alg", "Alg", "Geo", "Geo", "Geo", "Geo", "Geo", "Comp", "Comp", "Comp", "Comp", "Comp", "Voc", "Voc", "Voc", "Voc", "Voc", "Voc")
placement <- c("A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A")
qty <- c(425, 389, 96, 460, 293, 163, 518, 291, 101, 366, 349, 201, 889, 661, 150, 680, 617, 465, 445, 293, 112, 381, 292, 208, 223, 232, 131, 270, 72, 27, 45, 9, 99, 40, 79, 194, 72, 126, 133, 123, 456, 98, 234, 432, 65)
test <- data.frame(source, subject, grade, domain, placement, qty)
plot4 <- test %>%
ggplot(aes(x = grade, y = qty, fill = placement)) +
geom_bar(stat = "identity", position = "fill") +
stat_count(aes(label = paste(sprintf("%1.2f", ..count../sum(..count..)*100), "%\n", ..count..), y = 0.5*..count..),
geom = "text",
colour = "black",
size = 2.5,
position = position_fill(vjust = 0.5)) +
scale_x_discrete("Grade", limits = c(1, 2),
labels = c("1st", "2nd"),
guide = guide_axis(angle = 90)) +
scale_y_continuous("Prop place") +
scale_fill_manual("Placement",
values = rev(c("#de7e7e", "#ebeb4d", "#70e65e")),
labels = rev(c("C",
"B",
"A"))
) +
theme(axis.title.y = element_blank(),
axis.text.y = element_blank()) +
facet_wrap(vars(subject, domain), scales = "free_x")
plot4
产生以下情节：
每个年级（在本例中为 1 年级和 2 年级）我需要的是有两个堆叠条，数据在堆叠的每个区域居中。每个来源（“D”和“P”）应该有一个与每个年级相关联的栏。
我不知道如何将第二个变量添加到 x 轴以从每个等级的每个来源创建条形图。我可以做成绩，也可以做来源，但不能两者都做。
*帮助我找出 stat_count 行的奖励积分。我需要每个堆栈的 n() 和 % 相对于每个 source/grade/placement 值的总数。这些数字甚至都不接近，但这段代码在不太复杂的情节上对我有用。
这可能就是您想要的
my_labels <- test %>%
group_by(grade, source,domain, subject) %>%
summarise(n = qty,p = qty/sum(qty)) %>%
mutate(lab = paste(n,"\n",sprintf("%1.2f",p*100),"%"),
x = interaction (grade,source)) # get the labels calculated and add at the end
interaction() 函数有助于获取等级和来源的组合以进行绘图
test %>%
ggplot(aes(x = interaction (grade,source),
y = qty, fill = placement)) +
geom_bar(stat = "identity", position ="fill") +
scale_x_discrete("Grade",
labels = c("1st D","2nd D","1st P","2nd P"), # add new X labels
guide = guide_axis(angle = 90)) +
scale_fill_manual("Placement",
values = rev(c("#de7e7e", "#ebeb4d", "#70e65e")),
labels = rev(c("C","B","A"))) +
scale_y_continuous("Prop place") +
facet_wrap(vars(subject, domain), scales = "free_x") +
geom_text(data = my_labels, aes(label = lab,y = p),position = position_stack(vjust = 0.2)) # adjust position to get labels where you want.
此处的一些评论可能会有所帮助
谢谢@e.matt。通过您的回答（和一些调整），我能够完全按照我想要的方式得到它。我使用 mutate() 添加了一个 pcnt 列，使 geom_text() 层更易于使用。 interaction() 函数完美地为我提供了每个类别（在本例中为等级）的两个堆叠和闪避条形图。以下是我能够解决的修改后的解决方案代码：
source <- c("D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P")
subject <- c("M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R")
grade <- c(1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, 2)
domain <- c("Alg", "Alg", "Alg", "Alg", "Alg", "Alg", "Geo", "Geo", "Geo", "Geo", "Geo", "Geo", "Comp", "Comp", "Comp", "Comp", "Comp", "Comp", "Voc", "Voc", "Voc", "Voc", "Voc", "Voc", "Alg", "Alg", "Alg", "Alg", "Alg", "Geo", "Geo", "Geo", "Geo", "Geo", "Comp", "Comp", "Comp", "Comp", "Comp", "Voc", "Voc", "Voc", "Voc", "Voc", "Voc")
placement <- c("A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A")
qty <- c(425, 389, 96, 460, 293, 163, 518, 291, 101, 366, 349, 201, 889, 661, 150, 680, 617, 465, 445, 293, 112, 381, 292, 208, 223, 232, 131, 270, 72, 27, 45, 9, 99, 40, 79, 194, 72, 126, 133, 123, 456, 98, 234, 432, 65)
#pcnt was added to the dataframe using mutate() as shown below
pcnt <- pcnt <- c(46.7, 41.16, 11.31, 50.22, 30.08, 16.77, 56.92, 38.39, 12.38, 39.96, 32.92, 20.85, 56.04, 30.97, 16.74, 45.52, 32.07, 19.21, 52.75, 35.9, 16.38, 43.67, 19.5, 13.5, 52.29, 44.33, 10.37, 38.59, 41.58, 37.74, 47.29, 38.26, 10.65, 57.43, 22.92, 19.21, 53.41, 44.51, 9.94, 37.68, 33.44, 22.72, 48, 34.29, 7.8, 72.64, 29.01, 5.38, 52.35, 37.28, 14.27, 43.25, 40.39, 31.37, 38.05, 36.65, 27.7, 73.17, 50, 33.33, 29.41, 6.08, 60, 15.27, 10.7, 58.68, 7.22, 21.83, 16.94, 29.65, 51.99, 22.14, 50.34, 44.29, 22.9, 49.49, 21.75, 41.04, 39.82, 21.24, 78.06, 22.12, 12.5, 17.2, 15.56, 77.62, 10.13, 15.18, 37.73, 32.9, 17.36, 100)
test <- data.frame(source, subject, grade, domain, placement, qty)
test <- test %>%
group_by(subject, grade, domain, placement) %>%
mutate(pcnt = round(qty / sum(qty) * 100, 2)) %>%
arrange(domain, desc(qty))
plot <- test %>%
ggplot(aes(x = interaction(source, grade),
y = qty,
fill = placement)) +
geom_bar(stat = "identity", position = "fill") +
scale_x_discrete("Grade",
labels = c("1.D", "1.P","2.D", "2.P"),
guide = guide_axis(angle = 90)) +
scale_y_continuous("Prop place") +
scale_fill_manual("Relative Placement",
values = rev(c("#de7e7e", "#ebeb4d", "#70e65e")),
labels = rev(c("C", "B", "A"))
) +
facet_wrap(vars(domain), scales = "free_x") +
geom_text(size = 2.5, aes(label = paste(sprintf("%1.2f", pcnt), "%\n", qty), y = 0.5 * qty),
position = position_fill(vjust=0.5))
plot
请原谅，这是被询问和回答的问题，但到目前为止，我还没有找到满足我的用例的解决方案。如果你知道一个，请给我指明正确的方向。
这是我的代码的一个小示例：
library(tidyverse)
source <- c("D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P")
subject <- c("M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R")
grade <- c(1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, 2)
domain <- c("Alg", "Alg", "Alg", "Alg", "Alg", "Alg", "Geo", "Geo", "Geo", "Geo", "Geo", "Geo", "Comp", "Comp", "Comp", "Comp", "Comp", "Comp", "Voc", "Voc", "Voc", "Voc", "Voc", "Voc", "Alg", "Alg", "Alg", "Alg", "Alg", "Geo", "Geo", "Geo", "Geo", "Geo", "Comp", "Comp", "Comp", "Comp", "Comp", "Voc", "Voc", "Voc", "Voc", "Voc", "Voc")
placement <- c("A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A")
qty <- c(425, 389, 96, 460, 293, 163, 518, 291, 101, 366, 349, 201, 889, 661, 150, 680, 617, 465, 445, 293, 112, 381, 292, 208, 223, 232, 131, 270, 72, 27, 45, 9, 99, 40, 79, 194, 72, 126, 133, 123, 456, 98, 234, 432, 65)
test <- data.frame(source, subject, grade, domain, placement, qty)
plot4 <- test %>%
ggplot(aes(x = grade, y = qty, fill = placement)) +
geom_bar(stat = "identity", position = "fill") +
stat_count(aes(label = paste(sprintf("%1.2f", ..count../sum(..count..)*100), "%\n", ..count..), y = 0.5*..count..),
geom = "text",
colour = "black",
size = 2.5,
position = position_fill(vjust = 0.5)) +
scale_x_discrete("Grade", limits = c(1, 2),
labels = c("1st", "2nd"),
guide = guide_axis(angle = 90)) +
scale_y_continuous("Prop place") +
scale_fill_manual("Placement",
values = rev(c("#de7e7e", "#ebeb4d", "#70e65e")),
labels = rev(c("C",
"B",
"A"))
) +
theme(axis.title.y = element_blank(),
axis.text.y = element_blank()) +
facet_wrap(vars(subject, domain), scales = "free_x")
plot4
产生以下情节：
每个年级（在本例中为 1 年级和 2 年级）我需要的是有两个堆叠条，数据在堆叠的每个区域居中。每个来源（“D”和“P”）应该有一个与每个年级相关联的栏。
我不知道如何将第二个变量添加到 x 轴以从每个等级的每个来源创建条形图。我可以做成绩，也可以做来源，但不能两者都做。
*帮助我找出 stat_count 行的奖励积分。我需要每个堆栈的 n() 和 % 相对于每个 source/grade/placement 值的总数。这些数字甚至都不接近，但这段代码在不太复杂的情节上对我有用。
这可能就是您想要的
my_labels <- test %>%
group_by(grade, source,domain, subject) %>%
summarise(n = qty,p = qty/sum(qty)) %>%
mutate(lab = paste(n,"\n",sprintf("%1.2f",p*100),"%"),
x = interaction (grade,source)) # get the labels calculated and add at the end
interaction() 函数有助于获取等级和来源的组合以进行绘图
test %>%
ggplot(aes(x = interaction (grade,source),
y = qty, fill = placement)) +
geom_bar(stat = "identity", position ="fill") +
scale_x_discrete("Grade",
labels = c("1st D","2nd D","1st P","2nd P"), # add new X labels
guide = guide_axis(angle = 90)) +
scale_fill_manual("Placement",
values = rev(c("#de7e7e", "#ebeb4d", "#70e65e")),
labels = rev(c("C","B","A"))) +
scale_y_continuous("Prop place") +
facet_wrap(vars(subject, domain), scales = "free_x") +
geom_text(data = my_labels, aes(label = lab,y = p),position = position_stack(vjust = 0.2)) # adjust position to get labels where you want.
此处的一些评论可能会有所帮助
谢谢@e.matt。通过您的回答（和一些调整），我能够完全按照我想要的方式得到它。我使用 mutate() 添加了一个 pcnt 列，使 geom_text() 层更易于使用。 interaction() 函数完美地为我提供了每个类别（在本例中为等级）的两个堆叠和闪避条形图。以下是我能够解决的修改后的解决方案代码：
source <- c("D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "D", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P", "P")
subject <- c("M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "M", "M", "M", "M", "M", "M", "M", "M", "M", "M", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R")
grade <- c(1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, 1, 1, 1, 2, 2, 2)
domain <- c("Alg", "Alg", "Alg", "Alg", "Alg", "Alg", "Geo", "Geo", "Geo", "Geo", "Geo", "Geo", "Comp", "Comp", "Comp", "Comp", "Comp", "Comp", "Voc", "Voc", "Voc", "Voc", "Voc", "Voc", "Alg", "Alg", "Alg", "Alg", "Alg", "Geo", "Geo", "Geo", "Geo", "Geo", "Comp", "Comp", "Comp", "Comp", "Comp", "Voc", "Voc", "Voc", "Voc", "Voc", "Voc")
placement <- c("A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A", "B", "A", "C", "B", "A", "C", "B", "A", "C", "B", "A")
qty <- c(425, 389, 96, 460, 293, 163, 518, 291, 101, 366, 349, 201, 889, 661, 150, 680, 617, 465, 445, 293, 112, 381, 292, 208, 223, 232, 131, 270, 72, 27, 45, 9, 99, 40, 79, 194, 72, 126, 133, 123, 456, 98, 234, 432, 65)
#pcnt was added to the dataframe using mutate() as shown below
pcnt <- pcnt <- c(46.7, 41.16, 11.31, 50.22, 30.08, 16.77, 56.92, 38.39, 12.38, 39.96, 32.92, 20.85, 56.04, 30.97, 16.74, 45.52, 32.07, 19.21, 52.75, 35.9, 16.38, 43.67, 19.5, 13.5, 52.29, 44.33, 10.37, 38.59, 41.58, 37.74, 47.29, 38.26, 10.65, 57.43, 22.92, 19.21, 53.41, 44.51, 9.94, 37.68, 33.44, 22.72, 48, 34.29, 7.8, 72.64, 29.01, 5.38, 52.35, 37.28, 14.27, 43.25, 40.39, 31.37, 38.05, 36.65, 27.7, 73.17, 50, 33.33, 29.41, 6.08, 60, 15.27, 10.7, 58.68, 7.22, 21.83, 16.94, 29.65, 51.99, 22.14, 50.34, 44.29, 22.9, 49.49, 21.75, 41.04, 39.82, 21.24, 78.06, 22.12, 12.5, 17.2, 15.56, 77.62, 10.13, 15.18, 37.73, 32.9, 17.36, 100)
test <- data.frame(source, subject, grade, domain, placement, qty)
test <- test %>%
group_by(subject, grade, domain, placement) %>%
mutate(pcnt = round(qty / sum(qty) * 100, 2)) %>%
arrange(domain, desc(qty))
plot <- test %>%
ggplot(aes(x = interaction(source, grade),
y = qty,
fill = placement)) +
geom_bar(stat = "identity", position = "fill") +
scale_x_discrete("Grade",
labels = c("1.D", "1.P","2.D", "2.P"),
guide = guide_axis(angle = 90)) +
scale_y_continuous("Prop place") +
scale_fill_manual("Relative Placement",
values = rev(c("#de7e7e", "#ebeb4d", "#70e65e")),
labels = rev(c("C", "B", "A"))
) +
facet_wrap(vars(domain), scales = "free_x") +
geom_text(size = 2.5, aes(label = paste(sprintf("%1.2f", pcnt), "%\n", qty), y = 0.5 * qty),
position = position_fill(vjust=0.5))
plot