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 = 3, l = length(gtF$widths) + 1)
### 5. Draw the plot
grid.newpage()
grid.draw(gt)