R如何在ggplot2中为plot等金字塔添加刻面标签 [英] R how to add facet labels for pyramid like plot in ggplot2
本文介绍了R如何在ggplot2中为plot等金字塔添加刻面标签的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我创建了金字塔，就像情节一样，我想为情节的每一面添加标签（如facet标签）。
我的数据：
dt < - data.frame（答案= factor（x = rep（x = c（1：3），times = 2），
labels = c（Yes，No，Maybe）），
Gender =因子（x = rep（x = c（1：2），每个= 3），
labels = c（女性，男性）），
Prc = c（74.4,25.0，
label = c（74.4％，25.0％，0.6％，61.3％，35.5％，3.2％））
我的情节：
我的剧情生成代码：
pre $
xmi <-70
xma < - 80
library（ggplot2）
ggplot（data = dt，aes（ （=女性），aes（y = Prc））+
geom_text（subset = 。（Gender ==Female），aes（y = Prc，label = label），size = 4，hjust = -0.1）+ $ b $ （性别==男性），aes（y = Prc *（-1）））+
geom_text（subset =。（Gender ==Male ），aes（y = Prc *（-1），label = label），size = 4，hjust = 1）+
scale_y_continuous（limits = c（xmi，xma），breaks = seq（xmi，xma， 10），labels = abs（seq（xmi，xma，10）））+
theme（axis.text = element_text（color =black），
plot.title = element_text（lineheight =。 8））+
coord_flip（）+
annotate（text，x = 3.3，y = -50，label =Male，fontfacet =bold）+
annotate（ text，x = 3.3，y = 50，label =Female，fontfacet =bold）+
ylab（）+ xlab（）+ guides（fill = FALSE）
rm（xmi，xma）
以及facet标签标签示例：
现在的问题是：
1.如何将小平面标签添加到金字塔中，如plot;
或
2.也许有更好的方法制作像情节一样的金字塔。
解决方案
几种可能性。头两个从头开始构建一个条（即，小平面标签）。两者在定位条形横幅方面有所不同。第三个是一个金字塔图，类似于构建的一个
##方法2
＃构造条带
＃请注意视口;特别是它的位置和理由
library（gtable）
fontsize = 8.8
gp = gpar（fontsize = fontsize，col =grey10）
textGrobF = textGrob （女，x = .75，gp = gp）
textGrobM = textGrob（Male，x = .25，gp = gp）
strip = gTree（name = （bb），
vp = viewport（y = 1，just =bottom，height = unit（2.5，grobheight，textGrobF）），
children = gList（
rectGrob（gp = gpar（col = NA，fill =grey85）），
textGrobF，
textGrobM，
linesGrob（x = .5，gp = gpar（col =grey95））） ）
g = ggplotGrob（p）
＃使用gtable函数gtable_add_grob
定位strip将Strip放置在绘图面板
＃中由于strip的视口的理由，
＃strip被绘制在面板之外
＃首先，获取面板在布局中的位置
pos = g $ layout [grepl（ panel，g $ layout $ name），c（t，l）]
g = gtable_add_grob（g，strip，t = pos $ t，l = pos $ l，clip =off）
grid.newpage（）
grid.draw（g）
##方法3
＃金字塔图
库（ggplot2）
库（比例）
库（stringr）
图书馆（gtable）
图书馆（网格）
df = dt
＃常见主题
主题=主题（panel.grid.minor = element_blank（），
panel.grid.major = element_blank（），
axis.text.y = element_blank（），
axis.title.y = element_blank（），
plot.title = element_text（size = 10，hjust = 0.5））
#### 1.男性情节 - 出现在右边
ggM< - ggplot（data = subset（df，Gender =='Male'），aes（x = Answer））+
geom_bar（aes（y = .01 * Prc），stat =identity，fill = skyblue，width = .5） +
geom_text（data = subset（dt，Gender ==Male），aes（y = .01 * Prc，label = label），hjust = -.1，size = 4）+
scale_y_continuous（''，limits = c（0,1），expand = c（0,0），labels = percent）+
labs（x = NULL）+
ggtitle（Male）+
coord_flip（）+ theme +
theme（plot.margin = unit（c（1,1,0,0），lines））
＃get ggplot grob
gtM < - ggplotGrob（ggM）
#### 2.女性情节 - 出现在左侧 -
＃反转百分比'axis using trans =reverse
ggF < - ggplot（data = subset（df，Gender =='Female'），aes（x = Answer））+
geom_bar（aes（y = .01 * Prc），stat =identity，fill =salmon，width = .5）+
geom_text（data = subset（dt，Gender ==Female），aes（y = .01 *'，限制= c（1,0），反式=反向，展开= c（0,0）， labels = percent）+
labs（x = NULL）+
ggtitle（女性）+
coord_fli p（）+ theme +
theme（plot.margin = unit（c（1,0,0,1），lines））
＃get ggplot grob
gtF< - ggplotGrob（ggF）
##将勾号标记交换到绘图面板的右侧
＃获取布局中的左轴行数
rn< - 其中（gtF $ layout $ name ==axis-l）
＃提取轴（刻度标记和轴文本）
axis.grob< - gtF $ grobs [[rn]]
axisl< - axis.grob $ children [[2]]＃两个孩子 - 获得第二个
＃axisl＃注意：两个grobs - 文本和刻度标记
＃获得刻度线 - 注意：刻度线是第二个
yaxis = axisl $ grobs [[2]]
yaxis $ x = yaxis $ x - 单位（1，npc ）+ unit（2.75，pt）＃反转它们
＃将它们添加到面板的右侧
＃将一列添加到gtable
gtF< - gtable_add_cols（gtF，gtF $ widths [3]，length（gtF $ widths） - 1）
＃添加grob
pos = gtF $ layout [grepl（panel，gtF $ layout $ name） ，t]
gtF< - gtable_add_grob（gtF，yaxis，t = pos，length（g tF $ widths） - 1）
＃移除原来的左轴
gtF = gtF [， - c（2,3）]
＃ ### 3.回答标签 - 使用geom_text创建一个图 - 显示在中间
fontsize = 3
ggC< - ggplot（data = subset（df，Gender =='Male'）， aes（x = Answer））+
geom_bar（stat =identity，aes（y = 0））+
geom_text（aes（y = 0，label = Answer），size = fontsize）+
ggtitle（答案）+
coord_flip（）+ theme_bw（）+主题+
主题（panel.border = element_rect（color = NA））
＃get ggplot grob
gtC< - ggplotGrob（ggC）
＃获取标题
Title = gtC $ grobs [[which（gtC $ layout $ name ==title ]]]
＃获取绘图面板
gtC = gtC $ grobs [[which（gtC $ layout $ name ==panel）]]
#### 4.排列组件
##首先，结合女性和男性地块
gt = cbind（gtF，gtM，size =first）
##其次，在中间添加标签（gtC）
＃将列添加到gtable
maxlab = d f $ Answer [which（str_length（df $ Answer）== max（str_length（df $ Answer）））]
gt = gtable_add_cols（gt，sum（unit（1，grobwidth，textGrob（maxlab，gp = gpar（fontsize = fontsize * 72.27 / 25.4））），unit（5，mm）），
pos = length（gtF $ widths））
＃
gt = gtable_add_grob（gt，gtC，t = pos，l =长度（gtF $ widths）+ 1）
＃添加标题;即标签'答案'
gt = gtable_add_grob（gt，Title，t = 2，l =长度（gtF $宽度）+ 1）
### 5。绘制图
grid.newpage（）
grid.draw（gt）
I have created pyramid like plot and I want to add labels for each side of the plot (something like facet labels).
My data:
dt <- data.frame(Answer = factor(x = rep(x = c(1:3), times = 2),
labels = c("Yes", "No", "Maybe")),
Gender = factor(x = rep(x = c(1:2), each = 3),
labels = c("Female", "Male")),
Prc = c(74.4, 25.0, 0.6, 61.3, 35.5, 3.2),
label = c("74.4%", "25.0%", "0.6%", "61.3%", "35.5%", "3.2%"))
My plot:
My code for plot generation:
xmi <- -70
xma <- 80
library(ggplot2)
ggplot(data = dt, aes(x = Answer, fill = Gender)) +
geom_bar(stat = "identity", subset = .(Gender == "Female"), aes(y = Prc)) +
geom_text(subset = .(Gender == "Female"), aes(y = Prc, label = label), size = 4, hjust = -0.1) +
geom_bar(stat = "identity", subset = .(Gender == "Male"), aes(y=Prc * (-1)) ) +
geom_text(subset = .(Gender == "Male"), aes(y = Prc * (-1), label = label), size = 4, hjust = 1) +
scale_y_continuous(limits = c(xmi, xma), breaks=seq(xmi, xma,10),labels=abs(seq(xmi, xma,10))) +
theme(axis.text = element_text(colour = "black"),
plot.title = element_text(lineheight=.8) ) +
coord_flip() +
annotate("text", x = 3.3, y = -50, label = "Male", fontfacet = "bold") +
annotate("text", x = 3.3, y = 50, label = "Female", fontfacet = "bold") +
ylab("") + xlab("") + guides(fill=FALSE)
rm(xmi, xma)
And the facet labels labels example:
And the question is:
1. How to add facet labels to the pyramid like plot;
OR
2. Maybe there are the better way to make pyramid like plots.
解决方案
A few possibilities. The first two construct a strip (i.e., facet labels) from scratch. The two differ in the way they position the strip grob. The third is a pyramid plot, similar to the one constructed here, but with a little more tidying up.
library(ggplot2)
dt <- data.frame(Answer = factor(x = rep(x = c(1:3), times = 2),
labels = c("Yes", "No", "Maybe")),
Gender = factor(x = rep(x = c(1:2), each = 3),
labels = c("Female", "Male")),
Prc = c(74.4, 25.0, 0.6, 61.3, 35.5, 3.2),
label = c("74.4%", "25.0%", "0.6%", "61.3%", "35.5%", "3.2%"))
xmi <- -100
xma <- 100
p = ggplot(data = dt, aes(x = Answer, fill = Gender)) +
geom_bar(stat = "identity", data = subset(dt, Gender == "Female"), aes(y = Prc)) +
geom_text(data = subset(dt, Gender == "Female"), aes(y = Prc, label = label),
size = 4, hjust = -0.1) +
geom_bar(stat = "identity", data = subset(dt, Gender == "Male"), aes(y=Prc * (-1)) ) +
geom_text(data = subset(dt, Gender == "Male"), aes(y = Prc * (-1), label = label),
size = 4, hjust = 1.1) +
scale_y_continuous(limits = c(xmi, xma), breaks = seq(xmi, xma, 10), labels = abs(seq(xmi, xma, 10))) +
theme(axis.text = element_text(colour = "black")) +
coord_flip() +
ylab("") + xlab("") + guides(fill = FALSE) +
theme(plot.margin = unit(c(2, 1, 1, 1), "lines"))
## Method 1
# Construct the strip
library(grid)
strip = gTree(name = "Strip",
children = gList(
rectGrob(gp = gpar(col = NA, fill = "grey85")),
textGrob("Female", x = .75, gp = gpar(fontsize = 8.8, col = "grey10")),
textGrob("Male", x = .25, gp = gpar(fontsize = 8.8, col = "grey10")),
linesGrob(x = .5, gp = gpar(col = "grey95"))))
# Position strip using annotation_custom
p1 = p + annotation_custom(strip, xmin = Inf, xmax = 3.75, ymax = Inf, ymin = -Inf)
g = ggplotGrob(p1)
# The strip is positioned outside the panel,
# therefore turn off clipping to the panel.
g$layout[g$layout$name=='panel', "clip"] = "off"
# Draw it
grid.newpage()
grid.draw(g)
## Method 2
# Construct the strip
# Note the viewport; in particular its position and justification
library(gtable)
fontsize = 8.8
gp = gpar(fontsize = fontsize, col = "grey10")
textGrobF = textGrob("Female", x = .75, gp = gp)
textGrobM = textGrob("Male", x = .25, gp = gp)
strip = gTree(name = "Strip",
vp = viewport(y = 1, just = "bottom", height = unit(2.5, "grobheight", textGrobF)),
children = gList(
rectGrob(gp = gpar(col = NA, fill = "grey85")),
textGrobF,
textGrobM,
linesGrob(x = .5, gp = gpar(col = "grey95"))))
g = ggplotGrob(p)
# Position strip using the gtable function, gtable_add_grob
# Strip is positioned in the plot panel,
# but because of the justification of strip's viewport,
# the strip is drawn outside the panel
# First, get the panel's position in the layout
pos = g$layout[grepl("panel", g$layout$name), c("t","l")]
g = gtable_add_grob(g, strip, t = pos$t, l = pos$l, clip = "off")
grid.newpage()
grid.draw(g)
## Method 3
# Pyramid plot
library(ggplot2)
library(scales)
library(stringr)
library(gtable)
library(grid)
df = dt
# Common theme
theme = theme(panel.grid.minor = element_blank(),
panel.grid.major = element_blank(),
axis.text.y = element_blank(),
axis.title.y = element_blank(),
plot.title = element_text(size = 10, hjust=0.5))
#### 1. "male" plot - to appear on the right
ggM <- ggplot(data = subset(df, Gender == 'Male'), aes(x = Answer)) +
geom_bar(aes(y = .01*Prc), stat = "identity", fill = "skyblue", width = .5) +
geom_text(data = subset(dt, Gender == "Male"), aes(y = .01*Prc, label = label), hjust = -.1, size = 4) +
scale_y_continuous('', limits = c(0, 1), expand = c(0, 0), labels = percent) +
labs(x = NULL) +
ggtitle("Male") +
coord_flip() + theme +
theme(plot.margin= unit(c(1, 1, 0, 0), "lines"))
# get ggplot grob
gtM <- ggplotGrob(ggM)
#### 2. "female" plot - to appear on the left -
# reverse the 'Percent' axis using trans = "reverse"
ggF <- ggplot(data = subset(df, Gender == 'Female'), aes(x = Answer)) +
geom_bar(aes(y = .01*Prc), stat = "identity", fill = "salmon", width = .5) +
geom_text(data = subset(dt, Gender == "Female"), aes(y = .01*Prc, label = label), hjust = 1.1, size = 4) +
scale_y_continuous('', limits = c(1, 0), trans = "reverse", expand = c(0, 0), labels = percent) +
labs(x = NULL) +
ggtitle("Female") +
coord_flip() + theme +
theme(plot.margin= unit(c(1, 0, 0, 1), "lines"))
# get ggplot grob
gtF <- ggplotGrob(ggF)
## Swap the tick marks to the right side of the plot panel
# Get the row number of the left axis in the layout
rn <- which(gtF$layout$name == "axis-l")
# Extract the axis (tick marks and axis text)
axis.grob <- gtF$grobs[[rn]]
axisl <- axis.grob$children[[2]] # Two children - get the second
# axisl # Note: two grobs - text and tick marks
# Get the tick marks - NOTE: tick marks are second
yaxis = axisl$grobs[[2]]
yaxis$x = yaxis$x - unit(1, "npc") + unit(2.75, "pt") # Reverse them
# Add them to the right side of the panel
# Add a column to the gtable
gtF <- gtable_add_cols(gtF, gtF$widths[3], length(gtF$widths) - 1)
# Add the grob
pos = gtF$layout[grepl("panel", gtF$layout$name), "t"]
gtF <- gtable_add_grob(gtF, yaxis, t = pos, length(gtF$widths) - 1)
# Remove original left axis
gtF = gtF[,-c(2,3)]
#### 3. Answer labels - create a plot using geom_text - to appear down the middle
fontsize = 3
ggC <- ggplot(data = subset(df, Gender == 'Male'), aes(x=Answer)) +
geom_bar(stat = "identity", aes(y = 0)) +
geom_text(aes(y = 0, label = Answer), size = fontsize) +
ggtitle("Answer") +
coord_flip() + theme_bw() + theme +
theme(panel.border = element_rect(colour = NA))
# get ggplot grob
gtC <- ggplotGrob(ggC)
# Get the title
Title = gtC$grobs[[which(gtC$layout$name == "title")]]
# Get the plot panel
gtC = gtC$grobs[[which(gtC$layout$name == "panel")]]
#### 4. Arrange the components
## First, combine "female" and "male" plots
gt = cbind(gtF, gtM, size = "first")
## Second, add the labels (gtC) down the middle
# Add column to gtable
maxlab = df$Answer[which(str_length(df$Answer) == max(str_length(df$Answer)))]
gt = gtable_add_cols(gt, sum(unit(1, "grobwidth", textGrob(maxlab, gp = gpar(fontsize = fontsize*72.27/25.4))), unit(5, "mm")),
pos = length(gtF$widths))
# Add the Answer grob
gt = gtable_add_grob(gt, gtC, t = pos, l = length(gtF$widths) + 1)
# Add the title; ie the label 'Answer'
gt = gtable_add_grob(gt, Title, t = 2, l = length(gtF$widths) + 1)
### 5. Draw the plot
grid.newpage()
grid.draw(gt)
这篇关于R如何在ggplot2中为plot等金字塔添加刻面标签的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
