关于如何使用 R 和 ggplot2 绘制背靠背图的问题
Question on how to draw back-to-back plot using R and ggplot2
我打算画一个金字塔图,就像附件中的那样。
我找到了几个使用 ggplot 的示例,但我仍在努力将我的示例应用于我的数据(或我想要绘制的数据)。
structure(list(serial = c(40051004, 16160610, 16090310), DMSex = structure(c(2,
2, 2), label = "Gender from household grid", labels = c(`No answer/refused` = -9,
`Don't know` = -8, `Interview not achieved` = -7, `Schedule not applicable` = -2,
`Item not applicable` = -1, Male = 1, Female = 2), class = "haven_labelled"),
dtotac = structure(c(-9, -9, -8), label = "DV: Total actual hours in all jobs and businesses", labels = c(`No answer/refused` = -9,
`Don't know` = -8, `Interview not achieved` = -7, `Item not applicable` = -1
), class = "haven_labelled")), row.names = c(NA, -3L), class = c("tbl_df",
"tbl", "data.frame"))
如何转换我的数据并绘制背靠背图?或者如何在不进行子集化的情况下定义 Gender 和 dtotac 变量?
我正在使用的代码
library(ggplot2)
library(plyr)
library(gridExtra)
SerialGenderWorkN <- data.frame(Type = sample(c('Male', 'Female', 'Female'),
11421, replace=TRUE),
dtotac = sample (0:60, 11421, replace=TRUE))
WrkFactor <- ordered(cut(SerialGenderWork$dtotac,
breaks = c(0, seq(20, 60, 10)),
include.lowest = TRUE))
SerialGenderWorkN$dtotac <- WrkFactor
ggplotWrk <- ggplot(data =SerialGenderWorkN, aes(x=dtotac))
ggplotWrk.female <- ggplotWrk +
geom_bar(data=subset(SerialGenderWorkN, Type == 'Female'),
aes( y = ..count../sum(..count..), fill = dtotac)) +
scale_y_continuous('', labels = scales::percent) +
theme(legend.position = 'none',
axis.title.y = element_blank(),
plot.title = element_text(size = 11.5),
plot.margin=unit(c(0.1,0.2,0.1,-.1),"cm"),
axis.ticks.y = element_blank(),
axis.text.y = theme_bw()$axis.text.y) +
ggtitle("Female") +
theme(plot.title = element_text(hjust = 0.5)) +
coord_flip()
ggplotWrk.male <- ggplotWrk +
geom_bar(data=subset(SerialGenderWorkN,Type == 'Male'),
aes( y = ..count../sum(..count..), fill = dtotac)) +
scale_y_continuous('', labels = scales::percent,
trans = 'reverse') +
theme(legend.position = 'none',
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
plot.title = element_text(size = 11.5),
plot.margin=unit(c(0.1,0.2,0.1,-.1),"cm")) +
ggtitle("Male") +
theme(plot.title = element_text(hjust = 0.5)) +
coord_flip() +
xlab("Work Hours")
## Plutting it together
grid.arrange(ggplotWrk.male, ggplotWrk.female,
widths=c(0.4, 0.4), ncol=2)
这是输出
如何移动 "Work hours" 以显示在 "Male" 和 "Female" 绘图之间?
您可以使用 top
参数并使用 vjust
降低它。
grid.arrange(ggplotWrk.male, ggplotWrk.female,
widths=c(0.4, 0.4), ncol=2,
top = textGrob("Work Hours",gp=gpar(fontsize=11,font=1), vjust=2))
我觉得这个问题很有趣,我认为没有完美的解决方案。就我个人而言,我希望一切看起来都整齐且对齐,所以 gridExtra::grid.arrange
的 top
(或轴标签的 bottom
)参数并不真正令我满意。
另一种解决方案是使用构面并使用包 gtable
和 grid
编辑绘图。这也不是完美的,因为我没有找到单独调整刻面比例的解决方案。唯一的选择是通过在小平面上添加 scales = "free_x"
来设置天平。如果双方的最大百分比彼此接近,则效果很好。如果不是,也许不是。
首先,我编写了一个用于删除 grob 中的列的函数。我们将使用它将轴标签移动到中心。
library(tidyverse)
library(grid)
library(gtable)
delete_col <- function(x, pattern) {
t <- x$layout %>%
filter(str_detect(name, pattern)) %>%
pull(l)
x <- gtable_filter(x, pattern, invert = TRUE)
x$widths[t] <- unit(0, "cm")
x
}
然后我们将创建数据和基本图。需要两个主题选项才能将轴文本设置在构面的正中间。
test_data <- rnorm(500, 50, 15) %>%
crossing(sex = c("M", "F")) %>%
transmute(sex, value = cut(., c(min(.), 20, 40, 60, max(.)), include.lowest = TRUE))
test_data <- test_data %>%
count(sex, value) %>%
group_by(sex) %>%
mutate(p = n/sum(n)) %>%
ungroup() %>%
mutate(p = if_else(sex == "F", -p, p)) # negative values for the left-hand side.
p1 <- test_data %>%
ggplot(aes(value, p)) +
facet_wrap(~ sex, scales = "free_x") +
geom_col() +
coord_flip() +
theme(axis.text.y = element_text(hjust = 0.5, margin = margin(0, 0, 0, 0)),
axis.ticks.length = unit(0, "pt")) +
scale_y_continuous(labels = function(x) paste0(abs(x) * 100, "%")) +
labs(x = NULL)
现在变得有点复杂了。首先,我们将从 ggplot 对象创建一个 grob 对象。
p1_g <- ggplotGrob(p1)
然后我们将加宽 space 面之间的 space ,方法是采用轴文本所采用的现有 space 并添加一些白色 space。我查看了 grob 对象,通过使用 gtable_show_layout(p1_g)
.
查看哪些列是哪些列
p1_g$widths[7] <- p1_g$widths[4] + unit(0.5, "cm")
接下来我们将轴文本分离到它自己的对象以供以后使用。
p1g_axis <- gtable_filter(p1_g, "axis-l-1-1")
最后我们将把它们加在一起。我现在通过查看布局知道将所有内容放在哪里。 l
用于左侧范围,t
用于顶部范围。
p1_g %>%
gtable_add_grob(p1g_axis, l = 7, t = 8, name = "middle_axis") %>% # add the axis to the middle
delete_col("axis-l-1-1") %>% # delete the original axis
gtable_add_grob(textGrob("Label", gp = gpar(fontsize = 11)), l = 7, t = 7) %>% # add the top label
grid.draw() # draw the result
我打算画一个金字塔图,就像附件中的那样。
我找到了几个使用 ggplot 的示例,但我仍在努力将我的示例应用于我的数据(或我想要绘制的数据)。
structure(list(serial = c(40051004, 16160610, 16090310), DMSex = structure(c(2,
2, 2), label = "Gender from household grid", labels = c(`No answer/refused` = -9,
`Don't know` = -8, `Interview not achieved` = -7, `Schedule not applicable` = -2,
`Item not applicable` = -1, Male = 1, Female = 2), class = "haven_labelled"),
dtotac = structure(c(-9, -9, -8), label = "DV: Total actual hours in all jobs and businesses", labels = c(`No answer/refused` = -9,
`Don't know` = -8, `Interview not achieved` = -7, `Item not applicable` = -1
), class = "haven_labelled")), row.names = c(NA, -3L), class = c("tbl_df",
"tbl", "data.frame"))
如何转换我的数据并绘制背靠背图?或者如何在不进行子集化的情况下定义 Gender 和 dtotac 变量?
我正在使用的代码
library(ggplot2)
library(plyr)
library(gridExtra)
SerialGenderWorkN <- data.frame(Type = sample(c('Male', 'Female', 'Female'),
11421, replace=TRUE),
dtotac = sample (0:60, 11421, replace=TRUE))
WrkFactor <- ordered(cut(SerialGenderWork$dtotac,
breaks = c(0, seq(20, 60, 10)),
include.lowest = TRUE))
SerialGenderWorkN$dtotac <- WrkFactor
ggplotWrk <- ggplot(data =SerialGenderWorkN, aes(x=dtotac))
ggplotWrk.female <- ggplotWrk +
geom_bar(data=subset(SerialGenderWorkN, Type == 'Female'),
aes( y = ..count../sum(..count..), fill = dtotac)) +
scale_y_continuous('', labels = scales::percent) +
theme(legend.position = 'none',
axis.title.y = element_blank(),
plot.title = element_text(size = 11.5),
plot.margin=unit(c(0.1,0.2,0.1,-.1),"cm"),
axis.ticks.y = element_blank(),
axis.text.y = theme_bw()$axis.text.y) +
ggtitle("Female") +
theme(plot.title = element_text(hjust = 0.5)) +
coord_flip()
ggplotWrk.male <- ggplotWrk +
geom_bar(data=subset(SerialGenderWorkN,Type == 'Male'),
aes( y = ..count../sum(..count..), fill = dtotac)) +
scale_y_continuous('', labels = scales::percent,
trans = 'reverse') +
theme(legend.position = 'none',
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
plot.title = element_text(size = 11.5),
plot.margin=unit(c(0.1,0.2,0.1,-.1),"cm")) +
ggtitle("Male") +
theme(plot.title = element_text(hjust = 0.5)) +
coord_flip() +
xlab("Work Hours")
## Plutting it together
grid.arrange(ggplotWrk.male, ggplotWrk.female,
widths=c(0.4, 0.4), ncol=2)
这是输出
如何移动 "Work hours" 以显示在 "Male" 和 "Female" 绘图之间?
您可以使用 top
参数并使用 vjust
降低它。
grid.arrange(ggplotWrk.male, ggplotWrk.female,
widths=c(0.4, 0.4), ncol=2,
top = textGrob("Work Hours",gp=gpar(fontsize=11,font=1), vjust=2))
我觉得这个问题很有趣,我认为没有完美的解决方案。就我个人而言,我希望一切看起来都整齐且对齐,所以 gridExtra::grid.arrange
的 top
(或轴标签的 bottom
)参数并不真正令我满意。
另一种解决方案是使用构面并使用包 gtable
和 grid
编辑绘图。这也不是完美的,因为我没有找到单独调整刻面比例的解决方案。唯一的选择是通过在小平面上添加 scales = "free_x"
来设置天平。如果双方的最大百分比彼此接近,则效果很好。如果不是,也许不是。
首先,我编写了一个用于删除 grob 中的列的函数。我们将使用它将轴标签移动到中心。
library(tidyverse)
library(grid)
library(gtable)
delete_col <- function(x, pattern) {
t <- x$layout %>%
filter(str_detect(name, pattern)) %>%
pull(l)
x <- gtable_filter(x, pattern, invert = TRUE)
x$widths[t] <- unit(0, "cm")
x
}
然后我们将创建数据和基本图。需要两个主题选项才能将轴文本设置在构面的正中间。
test_data <- rnorm(500, 50, 15) %>%
crossing(sex = c("M", "F")) %>%
transmute(sex, value = cut(., c(min(.), 20, 40, 60, max(.)), include.lowest = TRUE))
test_data <- test_data %>%
count(sex, value) %>%
group_by(sex) %>%
mutate(p = n/sum(n)) %>%
ungroup() %>%
mutate(p = if_else(sex == "F", -p, p)) # negative values for the left-hand side.
p1 <- test_data %>%
ggplot(aes(value, p)) +
facet_wrap(~ sex, scales = "free_x") +
geom_col() +
coord_flip() +
theme(axis.text.y = element_text(hjust = 0.5, margin = margin(0, 0, 0, 0)),
axis.ticks.length = unit(0, "pt")) +
scale_y_continuous(labels = function(x) paste0(abs(x) * 100, "%")) +
labs(x = NULL)
现在变得有点复杂了。首先,我们将从 ggplot 对象创建一个 grob 对象。
p1_g <- ggplotGrob(p1)
然后我们将加宽 space 面之间的 space ,方法是采用轴文本所采用的现有 space 并添加一些白色 space。我查看了 grob 对象,通过使用 gtable_show_layout(p1_g)
.
p1_g$widths[7] <- p1_g$widths[4] + unit(0.5, "cm")
接下来我们将轴文本分离到它自己的对象以供以后使用。
p1g_axis <- gtable_filter(p1_g, "axis-l-1-1")
最后我们将把它们加在一起。我现在通过查看布局知道将所有内容放在哪里。 l
用于左侧范围,t
用于顶部范围。
p1_g %>%
gtable_add_grob(p1g_axis, l = 7, t = 8, name = "middle_axis") %>% # add the axis to the middle
delete_col("axis-l-1-1") %>% # delete the original axis
gtable_add_grob(textGrob("Label", gp = gpar(fontsize = 11)), l = 7, t = 7) %>% # add the top label
grid.draw() # draw the result