r - 向 R 金字塔图添加平滑线

请帮我将平滑线(图中所示的粗黑线)添加到 R 金字塔图中，如附图所示。感谢您的帮助。 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,))

最佳答案

下面怎么样(使用 ggplot 而不是基本的 R 图形)。

# 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);

我在这里分别将 LOESS 曲线拟合到男性和女性金字塔的两半(通过 group 美学)。

它与您展示的情节并不完全相同，但仍有改进/调整的空间。例如，您可以更改 fill 美学以实现条形的百分比填充。

信用到期:此解决方案基于@DidzisElferts 在 SO 上的 this post。

更新(近一年后)

我一直想查看这个答案，以增加 ggplot2 解决方案与从 plotrix::pyramid.plot 生成的图的审美相似性。这是一个非常接近的更新。

# 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)))

关于r - 向 R 金字塔图添加平滑线，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/46953735/