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)
