我一直在使用R/ggplot2成功地生成非常接近于公司所用商业工具生成的图形。但是有几个功能我无法在使用R生成的箱线图中实现。
- 在图形底部显示汇总“表格”，其中包括中位数、计数、异常值等项目。
- 以使重复标签被删除的方式显示条带文本。
R代码示例：
library(ggplot2)
library(data.table)
library(reshape2)
library(grid)
# create dataset
dt <- data.table(mpg)
# melt the data table
dtm <- data.table(
melt(data=dt,
id.vars=c("manufacturer","model","displ","year","cyl","trans","drv","fl","class"),
variable.name="mode", value.name="mpg"))
write.csv(dtm,file="dtm.csv",row.names=F)
# draw some plots
p <- ggplot(dtm, aes(x=mode,y=mpg)) +
geom_boxplot(aes(fill=mode), varwidth=F) +
facet_grid( ~ manufacturer + year ) +
theme_bw() +
theme(panel.margin=unit(0,"mm"), panel.grid=element_blank()) +
theme(axis.text.x=element_blank(), axis.title.x=element_blank()) +
theme(legend.position="bottom") +
coord_cartesian(ylim=c(0,50))
p
ggsave(plot=p, filename='ddtm_r.png', dpi=72, width=16, height=8)
R生成的输出在这里：
商业工具生成的相同箱线图在这里：
您可以看到图表中的数据是相同的（如预期），但商业版本中的条形标题更有组织性，而且我还可以在图底添加摘要表格。
R有没有类似的功能？
谢谢 & 祝好，
Derric
更新：2014年6月7日
在同事和在线帮助的建议下，我现在能够绘制包含附加到箱线图底部的摘要表格的图表。主要思路是从箱线图grob中提取面板信息，然后使用此信息生成文本表格，然后使用两个grob重新绘制图表。必须删除原始箱线图的图例才能获得正确的右侧对齐。
修改后的R代码如下：
# load the libraries
library(grid)
library(gridExtra)
library(data.table)
library(reshape2)
library(ggplot2)
library(gtable)
library(plyr)
# create dataset
dt <- data.table(mpg)
# melt the data table
dtm <- data.table(
melt(data=dt,
id.vars=c("manufacturer","model","displ","year","cyl","trans","drv","fl","class"),
variable.name="mode", value.name="mpg"))
#write.csv(dtm,file="dtm.csv",row.names=F)
# draw some plots
p1 <- ggplot(dtm, aes(x=factor(year),y=mpg)) +
geom_boxplot(aes(fill=factor(year)), varwidth=F) +
facet_grid( ~ manufacturer + mode ) +
theme_bw() +
theme(panel.margin=unit(0,"lines"),
panel.grid=element_blank(),
strip.text=element_text(angle=90),
axis.text.x=element_blank(),
axis.title.x=element_blank(),
axis.ticks.x=element_blank(),
plot.margin=unit(c(0,0,0,0),"lines"),
legend.position="right") +
coord_cartesian(ylim=c(0,50)) +
xlab(NULL)
# deconstruct the plot p1
pb <- ggplot_build(p1)
# pb has three groups; data, panel and plot
pb.data <- pb$data
# pb.data[[1]] is a data.frame
pb.data.df <- pb.data[[1]]
# melt the pb.data.df
pb.data.dt <- data.table(pb.data.df)
#pb.data.dt[,':='(outliers=NULL)]
pb.data.dtm <- melt(data=pb.data.dt,
#id.vars=c("x","PANEL"),
measure.vars=c("middle","lower","upper"),
variable.name="mode",
value.name="value")
p2 <- ggplot(pb.data.dtm, aes(x=factor(x),y=factor(mode),label=format(value,nsmall=1))) +
geom_text(size=3.0, angle=90, hjust=0.5) + facet_grid(~ PANEL) +
theme_bw() +
scale_y_discrete() +
theme(panel.margin=unit(0,"lines"),
panel.grid=element_blank(),
panel.border=element_rect(),
legend.position="right",
axis.text.x=element_blank(),
axis.text.y=element_text(angle=0),
axis.ticks=element_blank(),
strip.text=element_blank(),
strip.background=element_blank(),
plot.margin=unit(c(0,0,0,0),"lines")
) +
xlab(NULL) + ylab(NULL)
# a function to extract the legend from the grob
g_legend <- function(a.gplot) {
tmp <- ggplotGrob(a.gplot)
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
legend <- tmp$grobs[[leg]]
legend
}
legend1 <- g_legend(p1)
pa <- arrangeGrob((p1 + theme(legend.position='none')), legend1,
(p2 + theme(legend.position='none')),
ncol=2, nrow=2,
heights=c(50/60,10/60), widths=c(95/100,5/100))
ggsave(plot=pa, filename='dtm_r.png',dpi=72,height=10,width=18)
这个脚本现在给了我一个如下所示的图表：
谢谢。
