java金字塔的流程图,R中的金字塔图

Plotrix可能更容易，但可以反汇编ggplot图表，并将它们排列为金字塔图 . 使用@ eipi10的数据(谢谢)，并调整drawing-pyramid-plot-using-r-and-ggplot2中的代码，我为"males"，"females"和"country"标签绘制了单独的图 . 此外，我从其中一个地块中获取了一个传奇 . 诀窍是让左侧图表的刻度线出现在图表的右侧 - 我改编了mirroring-axis-ticks-in-ggplot2的代码 . 四个位("female"图，国家标签，"male plot"和图例)使用gtable函数放在一起 .

Minor edit: Updating to ggplot2 2.2.1

# Packages

library(plyr)

library(ggplot2)

library(scales)

library(gtable)

library(stringr)

library(grid)

# Data

mov

41.5,31.3,60.7,50.4)

fov

12.3,10,0.8)

fob

25.5,25.3,31.7,28.4)

mob

12.3,10,0.8)

labs

"iceland","portugal","austria","switzerland","australia",

"new zealand","dubai","south africa",

"finland","italy","morocco")

df = data.frame(labs=rep(labs,4), values=c(mov, mob, fov, fob),

sex=rep(c("Male", "Female"), each=2*length(fov)),

bmi = rep(rep(c("Overweight", "Obese"), each=length(fov)),2))

# Order countries by overall percent overweight/obese

labs.order = ddply(df, .(labs), summarise, sum=sum(values))

labs.order = labs.order$labs[order(labs.order$sum)]

df$labs = factor(df$labs, levels=labs.order)

# 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

geom_bar(aes(y = values/100, fill = bmi), stat = "identity") +

scale_y_continuous('', labels = percent, limits = c(0, 1), expand = c(0,0)) +

labs(x = NULL) +

ggtitle("Male") +

coord_flip() + theme +

theme(plot.margin= unit(c(1, 0, 0, 0), "lines"))

# get ggplot grob

gtM

#### 4. Get the legend

leg = gtM$grobs[[which(gtM$layout$name == "guide-box")]]

#### 1. back to "male" plot - to appear on the right

# remove legend

legPos = gtM$layout$l[grepl("guide", gtM$layout$name)] # legend's position

gtM = gtM[, -c(legPos-1,legPos)]

#### 2. "female" plot - to appear on the left -

# reverse the 'Percent' axis using trans = "reverse"

ggF

geom_bar(aes(y = values/100, fill = bmi), stat = "identity") +

scale_y_continuous('', labels = percent, trans = 'reverse',

limits = c(1, 0), expand = c(0,0)) +

labs(x = NULL) +

ggtitle("Female") +

coord_flip() + theme +

theme(plot.margin= unit(c(1, 0, 0, 1), "lines"))

# get ggplot grob

gtF

# remove legend

gtF = gtF[, -c(legPos-1,legPos)]

## Swap the tick marks to the right side of the plot panel

# Get the row number of the left axis in the layout

rn

# Extract the axis (tick marks and axis text)

axis.grob

axisl

# 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

panelPos = gtF$layout[grepl("panel", gtF$layout$name), c('t','l')]

gtF

# Add the grob

gtF

# Remove original left axis

gtF = gtF[, -c(2,3)]

#### 3. country labels - create a plot using geom_text - to appear down the middle

fontsize = 3

ggC

geom_bar(stat = "identity", aes(y = 0)) +

geom_text(aes(y = 0, label = labs), size = fontsize) +

ggtitle("Country") +

coord_flip() + theme_bw() + theme +

theme(panel.border = element_rect(colour = NA))

# get ggplot grob

gtC

# Get the title

Title = gtC$grobs[[which(gtC$layout$name == "title")]]

# Get the plot panel

gtC = gtC$grobs[[which(gtC$layout$name == "panel")]]

#### 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 = labs[which(str_length(labs) == max(str_length(labs)))]

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 grob

gt = gtable_add_grob(gt, gtC, t = panelPos$t, l = length(gtF$widths) + 1)

# add the title; ie the label 'country'

titlePos = gtF$layout$l[which(gtF$layout$name == "title")]

gt = gtable_add_grob(gt, Title, t = titlePos, l = length(gtF$widths) + 1)

## Third, add the legend to the right

gt = gtable_add_cols(gt, sum(leg$width), -1)

gt = gtable_add_grob(gt, leg, t = panelPos$t, l = length(gt$widths))

# draw the plot

grid.newpage()

grid.draw(gt)