Add smooth line to R pyramid plots

Question

Please help me to add smooth lines(thick black lines shown in the figure) to a R pyramid plot as shown in the attached image. Appreciate your help.This plot shows the population distribution according to the age and gender.

xy.pop<-c(3.2,3.5,3.6,3.6,3.5,3.5,3.9,3.7,3.9,3.5,3.2,2.8,2.2,1.8,1.5,1.3,0.7,0.4)
xx.pop<-c(3.2,3.4,3.5,3.5,3.5,3.7,4,3.8,3.9,3.6,3.2,2.5,2,1.7,1.5,1.3,1,0.8)
agelabels<-c("0-4","5-9","10-14","15-19","20-24","25-29","30-34",
         "35-39","40-44","45-49","50-54","55-59","60-64","65-69","70-74",
         "75-79","80-44","85+")
mcol<-color.gradient(c(0,0,0.5,1),c(0,0,0.5,1),c(1,1,0.5,1),18)
fcol<-color.gradient(c(1,1,0.5,1),c(0.5,0.5,0.5,1),c(0.5,0.5,0.5,1),18)
par(mar=pyramid.plot(xy.pop,xx.pop,labels=agelabels,main="Australian population pyramid 2002",lxcol=mcol,rxcol=fcol,))

Images are not very useful to help people getting started. Can you post your sample data and code to generate the plot. Then we can take it from there. — Maurits Evers, Oct 26 '17 at 12:07
I am sorry for not posting the codes I used. I just posted code snippet. Thanks for your comment. — Lank, Oct 26 '17 at 12:20

Maurits Evers · Accepted Answer · 2018-09-02T23:10:23.587

How about the following (using ggplot rather than base R graphics).

# Your data
xy.pop<-c(3.2,3.5,3.6,3.6,3.5,3.5,3.9,3.7,3.9,3.5,3.2,2.8,2.2,1.8,1.5,1.3,0.7,0.4)
xx.pop<-c(3.2,3.4,3.5,3.5,3.5,3.7,4,3.8,3.9,3.6,3.2,2.5,2,1.7,1.5,1.3,1,0.8)
agelabels<-c("0-4","5-9","10-14","15-19","20-24","25-29","30-34",
            "35-39","40-44","45-49","50-54","55-59","60-64","65-69","70-74",
            "75-79","80-44","85+")

# Collect data in dataframe
df <- rbind.data.frame(
    cbind.data.frame(Percentage = -xy.pop, Group = agelabels, Gender = "male"),
    cbind.data.frame(Percentage = +xx.pop, Group = agelabels, Gender = "female"));

# Make sure agelabels have the right order
df$Group <- factor(df$Group, levels = agelabels);

# (gg)plot
gg <- ggplot(
    data = df, 
    aes(x = Group, y = Percentage, fill = Gender, group = Gender));
gg <- gg + geom_bar(data = subset(df, Gender == "female"), stat = "identity");
gg <- gg + geom_bar(data = subset(df, Gender == "male"), stat = "identity");
gg <- gg + coord_flip();
gg <- gg + geom_smooth(
    colour = "black", method = "loess", se = FALSE, show.legend = FALSE, size = 0.5);
gg <- gg + labs(
    x = "Age", 
    y = "Percentage", 
    title = "Australian population pyramid 2012");
gg <- gg + scale_y_continuous(
    breaks = seq(-4, 4, by = 2), 
    labels = c(rev(seq(0, 4, by = 2)), seq(2, 4, by = 2)));
print(gg);

I'm here fitting a LOESS curve separately to both the male and female pyramid halves (through the group aesthetic).

It's not quite the same plot as the one you show, but there is still room for improvement/tweaking. For example, you can change the fill aesthetic to achieve a percentage-dependent fill of the bars.

Credit where credit is due: This solution is based on this post on SO by @DidzisElferts.

Update (nearly a year later)

I've always wanted to review this answer to increase the aesthetic similarity of a ggplot2 solution with the plot generated from plotrix::pyramid.plot. Here is an update that gets pretty close.

# Define function to draw the left/right half of an age pyramid
ggpyramidhalf <- function(df, pos = "left", title) {
    gg <- ggplot(df, aes(Group, Percentage, group = Gender)) +
        geom_col(aes(fill = Group), colour = "black") +
        geom_smooth(
            colour = "black",
            method = "loess",
            se = F,
            show.legend = F, size = 0.5) +
        theme_minimal() +
        labs(y = "%", title = title) +
        coord_flip(expand = FALSE) +
        theme(
            axis.title.y = element_blank(),
            panel.grid.major = element_blank(),
            panel.grid.minor = element_blank())
    if (pos == "left") {
        gg <- gg +
            ylim(c(min(range(pretty(df$Percentage))), 0)) +
            scale_fill_manual(
                values = colorRampPalette(c("blue", "white"))(length(agelabels)),
                guide = F) +
            theme(
                plot.title = element_text(hjust = 1),
                axis.text.y = element_blank())
    } else {
        gg <- gg +
            ylim(c(0, max(range(pretty(df$Percentage))))) +
            scale_fill_manual(
                values = colorRampPalette(c("red", "white"))(length(agelabels)),
                guide = F) +
            theme(
                plot.title = element_text(hjust = 0),
                axis.title.y = element_blank(),
                axis.text.y = element_text(hjust = 0.5, margin = margin(r = 10)))
    }
    gg
}

# Draw left (male) half of age pyramid
gg1 <- df %>%
    filter(Gender == "male") %>%
    mutate(Group = factor(Group, agelabels)) %>%
    ggpyramidhalf(pos = "left", title = "Male")

# Draw right (female) half of age pyramid
gg2 <- df %>%
    filter(Gender == "female") %>%
    mutate(Group = factor(Group, agelabels)) %>%
    ggpyramidhalf(pos = "right", title = "Female")

# Use gridExtra to draw both halfs in one plot
library(gridExtra)
library(grid)
grid.arrange(
    gg1, gg2,
    ncol = 2,
    widths = c(1, 1.15),
    top = textGrob("Australian population period 2002", gp = gpar(font = 2)))

Thanks for your quick response. Your answer fits for my requirement at the moment. — Lank, Oct 26 '17 at 13:13

score 2 · Answer 2 · answered Oct 26 '17 at 13:24

Here is a solution using the pyramid.plot function of plotrix:

library(plotrix)

pyramid.plot(xy.pop,xx.pop,labels=agelabels,
             main="Australian population pyramid 2002",lxcol=mcol,rxcol=fcol)

male.smline <- loess.smooth(x=1:18, y=xy.pop, degree=2)
lines(-1-male.smline$y, male.smline$x, col="red", lwd=3)

female.smline <- loess.smooth(x=1:18, y=xx.pop, degree=2)
lines(1+female.smline$y, female.smline$x, col="black", lwd=3)

Add smooth line to R pyramid plots

2 Answers2

Update (nearly a year later)