Question

我需要绘制一个金字塔图，就像附图一样。

alt text

我发现了一个使用来自here的R（但不是ggplot）的例子，任何人都可以使用ggplot给我一些提示吗？谢谢！

Answer 1

这实际上是一个背对背的条形图，就像在优秀的学习者博客中使用ggplot2生成的那样：http://learnr.wordpress.com/2009/09/24/ggplot2-back-to-back-bar-charts/

您可以将coord_flip与其中一个图表一起使用，但我不知道如何让它在两个图表之间共享y轴标签，就像您上面所做的那样。下面的代码应该让你足够接近原始代码：

首先创建一个数据样本数据框，将Age列转换为具有所需断点的因子：

require(ggplot2)
df <- data.frame(Type = sample(c('Male', 'Female', 'Female'), 1000, replace=TRUE),
                 Age = sample(18:60, 1000, replace=TRUE))

AgesFactor <- ordered( cut(df$Age, breaks = c(18,seq(20,60,5)), 
                           include.lowest = TRUE))

df$Age <- AgesFactor

现在开始构建情节：使用相应的数据子集创建男性和女性情节，抑制传说等。

gg <- ggplot(data = df, aes(x=Age))

gg.male <- gg + 
  geom_bar( subset = .(Type == 'Male'), 
            aes( y = ..count../sum(..count..), fill = Age)) +
  scale_y_continuous('', formatter = 'percent') + 
  opts(legend.position = 'none') +
  opts(axis.text.y = theme_blank(), axis.title.y = theme_blank()) + 
  opts(title = 'Male', plot.title = theme_text( size = 10) ) +  
  coord_flip()

对于女性情节，使用trans = "reverse" ...

反转'百分比'轴

gg.female <- gg + 
  geom_bar( subset = .(Type == 'Female'), 
            aes( y = ..count../sum(..count..), fill = Age)) +
  scale_y_continuous('', formatter = 'percent', trans = 'reverse') + 
  opts(legend.position = 'none') +
  opts(axis.text.y = theme_blank(), 
       axis.title.y = theme_blank(), 
       title = 'Female') +
  opts( plot.title = theme_text( size = 10) ) +
  coord_flip()

现在创建一个绘图只是为了使用geom_text显示年龄括号，但也使用虚拟geom_bar来确保此绘图中“年龄”轴的缩放与男女情节：

gg.ages <- gg + 
  geom_bar( subset = .(Type == 'Male'), aes( y = 0, fill = alpha('white',0))) +
  geom_text( aes( y = 0,  label = as.character(Age)), size = 3) +
  coord_flip() +
  opts(title = 'Ages',
       legend.position = 'none' ,
       axis.text.y = theme_blank(),
       axis.title.y = theme_blank(),
       axis.text.x = theme_blank(),
       axis.ticks = theme_blank(),          
       plot.title = theme_text( size = 10))

最后，使用Hadley Wickham的书中的方法将图块排列在网格上：

grid.newpage()

pushViewport( viewport( layout = grid.layout(1,3, widths = c(.4,.2,.4))))

vplayout <- function(x, y) viewport(layout.pos.row = x, layout.pos.col = y)

print(gg.female, vp = vplayout(1,1))
print(gg.ages,   vp = vplayout(1,2))
print(gg.male,   vp = vplayout(1,3))

alt text

Answer 2

我做了一些解决方法 - 而不是使用geom_bar，我使用了geom_linerange和geom_label。

library(magrittr)
library(dplyr)
library(ggplot2)

population <- read.csv("https://raw.githubusercontent.com/andriy-gazin/datasets/master/ageSexDistribution.csv")

population %<>% 
  tidyr::gather(sex, number, -year, - ageGroup) %>% 
  mutate(ageGroup = gsub("100 і старше", "≥100", ageGroup), 
     ageGroup = factor(ageGroup,
                        ordered = TRUE,
                        levels = 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-84",
                                   "85-89", "90-94", "95-99", "≥100")),
     number = ifelse(sex == "male", number*-1/10^6, number/10^6)) %>% 
  filter(year %in% c(1990, 1995, 2000, 2005, 2010, 2015))

png(filename = "~/R/pyramid.png", width = 900, height = 1000, type = "cairo")

ggplot(population, aes(x = ageGroup, color = sex))+
  geom_linerange(data = population[population$sex=="male",], 
                 aes(ymin = -0.3, ymax = -0.3+number), size = 3.5, alpha = 0.8)+
  geom_linerange(data = population[population$sex=="female",], 
                 aes(ymin = 0.3, ymax = 0.3+number), size = 3.5, alpha = 0.8)+
  geom_label(aes(x = ageGroup, y = 0, label = ageGroup, family = "Ubuntu Condensed"), 
         inherit.aes = F,
         size = 3.5, label.padding = unit(0.0, "lines"), label.size = 0,
         label.r = unit(0.0, "lines"), fill = "#EFF2F4", alpha = 0.9, color = "#5D646F")+
  scale_y_continuous(breaks = c(c(-2, -1.5, -1, -0.5, 0) + -0.3, c(0, 0.5, 1, 1.5, 2)+0.3),
                 labels = c("2", "1.5", "1", "0.5", "0", "0", "0.5", "1", "1.5", "2"))+
  facet_wrap(~year, ncol = 2)+
  coord_flip()+
labs(title = "Піраміда населення України",
   subtitle = "Статево-вікові групи у 1990-2015 роках, млн осіб",
   caption = "Дані: Держкомстат України")+
  scale_color_manual(name = "", values = c(male = "#3E606F", female = "#8C3F4D"),
                 labels = c("жінки", "чоловіки"))+
  theme_minimal(base_family = "Ubuntu Condensed")+
theme(text = element_text(color = "#3A3F4A"),
    panel.grid.major.y = element_blank(),
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_line(linetype = "dotted", size = 0.3, color = "#3A3F4A"),
    axis.title = element_blank(),
    plot.title = element_text(face = "bold", size = 36, margin = margin(b = 10), hjust = 0.030),
    plot.subtitle = element_text(size = 16, margin = margin(b = 20), hjust = 0.030),
    plot.caption = element_text(size = 14, margin = margin(b = 10, t = 50), color = "#5D646F"),
    axis.text.x = element_text(size = 12, color = "#5D646F"),
    axis.text.y = element_blank(),
    strip.text = element_text(color = "#5D646F", size = 18, face = "bold", hjust = 0.030),
    plot.background = element_rect(fill = "#EFF2F4"),
    plot.margin = unit(c(2, 2, 2, 2), "cm"),
    legend.position = "top",
    legend.margin  = unit(0.1, "lines"),
    legend.text  = element_text(family = "Ubuntu Condensed", size = 14),
    legend.text.align = 0)

dev.off()

以及由此产生的情节：

and here's the resulting plot

Answer 3

略微调整：

library(ggplot2)
library(plyr)
library(gridExtra)

## The Data
df <- data.frame(Type = sample(c('Male', 'Female', 'Female'), 1000, replace=TRUE),
    Age = sample(18:60, 1000, replace=TRUE))

AgesFactor <- ordered(cut(df$Age, breaks = c(18,seq(20,60,5)), 
     include.lowest = TRUE))

df$Age <- AgesFactor

## Plotting
gg <- ggplot(data = df, aes(x=Age))

gg.male <- gg + 
    geom_bar( data=subset(df,Type == 'Male'), 
        aes( y = ..count../sum(..count..), fill = Age)) +
    scale_y_continuous('', labels = scales::percent) + 
    theme(legend.position = 'none',
        axis.title.y = element_blank(),
        plot.title = element_text(size = 11.5),
        plot.margin=unit(c(0.1,0.2,0.1,-.1),"cm"),
        axis.ticks.y = element_blank(), 
        axis.text.y = theme_bw()$axis.text.y) + 
    ggtitle("Male") + 
    coord_flip()    

gg.female <-  gg + 
    geom_bar( data=subset(df,Type == 'Female'), 
        aes( y = ..count../sum(..count..), fill = Age)) +
    scale_y_continuous('', labels = scales::percent, 
                   trans = 'reverse') + 
    theme(legend.position = 'none',
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank(), 
        plot.title = element_text(size = 11.5),
        plot.margin=unit(c(0.1,0,0.1,0.05),"cm")) + 
    ggtitle("Female") + 
    coord_flip() + 
    ylab("Age")

## Plutting it together
grid.arrange(gg.female,
    gg.male,
    widths=c(0.4,0.6),
    ncol=2
)

enter image description here

我仍然希望更多地使用边距（也许panel.margin也可以帮助theme调用。

Answer 4

我已经使用facet_share()得到的面板表来获得相当多的镜像轴 - 我认为结果非常适合人口金字塔。您可以查看代码here。

然后，使用library(magrittr) library(ggpol) population <- read.csv("https://raw.githubusercontent.com/andriy-gazin/datasets/master/ageSexDistribution.csv", encoding = "UTF-8") population %<>% mutate(ageGroup = factor(ageGroup, levels = ageGroup[seq(length(levels(ageGroup)))])) %>% filter(year == 2015) %>% mutate(male = male * -1) %>% gather(gender, count, -year, -ageGroup) %>% mutate(gender = factor(gender, levels = c("male", "female"))) %>% filter(ageGroup != "100 і старше") ggplot(population, aes(x = ageGroup, y = count, fill = gender)) + geom_bar(stat = "identity") + facet_share(~gender, dir = "h", scales = "free", reverse_num = TRUE) + coord_flip() + theme_minimal()函数：

{{1}}

Answer 5

我喜欢@andriy的情节足以制作一个简化的自定义功能：

数据应如下所示，ageGroup是有序因素。

head(population)
#   ageGroup  sex   number
# 1      0-4 male 1.896459
# 2      5-9 male 1.914255
# 3    10-14 male 1.832594
# 4    15-19 male 1.849453
# 5    20-24 male 1.658733
# 6    25-29 male 1.918060

然后提供数据和休息时间：

pyramid(population,c(0, 0.5, 1, 1.5, 2))

如果需要，可以使用我从this blog获取的函数age_cat来创建年龄组。见下面的代码。我略微编辑了原始名称和默认参数。

例如：

age_column <- sample(0:110,10000,TRUE)
table(age_cat(age_column))
# 0-9 10-19 20-29 30-39 40-49 50-59 60-69 70-79 80-89 90-99  100+ 
# 885   836   885   927   942   953   886   882   935   872   997

<强>功能

pyramid <- function(data,.breaks){
ggplot(data, aes(x = ageGroup, color = sex))+
  geom_linerange(data = data[data$sex=="male",],
                 aes(ymin = -tail(.breaks,1)/7, ymax = -tail(.breaks,1)/7-number), size = 3.5, alpha = 0.8)+
  geom_linerange(data = data[data$sex=="female",],
                 aes(ymin = tail(.breaks,1)/7, ymax = tail(.breaks,1)/7+number), size = 3.5, alpha = 0.8)+
  geom_label(aes(x = ageGroup, y = 0, label = ageGroup),
             inherit.aes = F,
             size = 3.5, label.padding = unit(0.0, "lines"), label.size = NA, 
             label.r = unit(0.0, "lines"), fill = "white", alpha = 0.9, color = "#5D646F")+
  scale_y_continuous(breaks = c(-rev(.breaks) -tail(.breaks,1)/7, .breaks+tail(.breaks,1)/7),
                     labels = c(rev(.breaks),.breaks))+
  coord_flip()+
  scale_color_manual(name = "", values = c(male = "#3E606F", female = "#8C3F4D"))+
  theme_minimal()+
  theme(text = element_text(color = "#3A3F4A"),
        panel.grid.major.y = element_blank(),
        panel.grid.minor = element_blank(),
        panel.grid.major.x = element_line(linetype = "dotted", size = 0.3, color = "#3A3F4A"),
        axis.title = element_blank(),
        axis.text.x = element_text(size = 12, color = "#5D646F"),
        axis.text.y = element_blank(),
        strip.text = element_text(color = "#5D646F", size = 18, face = "bold", hjust = 0.030),
        legend.position = "none")
}

age_cat <- function(x, lower = 0, upper = 100, by = 5,
                    sep = "-", above.char = "+") {

  labs <- c(paste(seq(lower, upper - by, by = by),
                  seq(lower + by - 1, upper - 1, by = by),
                  sep = sep),
            paste(upper, above.char, sep = ""))

  cut(floor(x), breaks = c(seq(lower, upper, by = by), Inf),
      right = FALSE, labels = labs)
}

数据

library(dplyr) library(ggplot2) population <- read.csv("https://raw.githubusercontent.com/andriy-gazin/datasets/master/ageSexDistribution.csv") population <- population %>% tidyr::gather(sex, number, -year, - ageGroup) %>% mutate(ageGroup = factor(ageGroup, ordered = TRUE, levels = 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-84", "85-89", "90-94", "95-99", "100+")), ageGroup = `[<-`(ageGroup,is.na(ageGroup),value="100+"), number = number/10^6) %>% dplyr::filter(year == 1990) %>% select(-year)

使用R和ggplot2绘制金字塔图

5 个答案: