ggplot你不知道的细节

 

例一 Michaelis-Menten动力学方程

这个例子中采用出自文献中的一组有关于浮萍氮摄取的数据，共2两个变量8个观测值，其中底物浓度与浮萍的氮取速率之间可以通过M-M动力学方程来进行描述。在这个例子中首先通过nls()根据M-M动力学方程进行模型拟合，然后用预测值进行了ggplot2绘图，主要采用了R里面的数学表示方法plotmath在图中展示了公式，并通过ggplot2种的theme对图像进行了修饰。需要注意的在geom_text()并不能直接使用expression，需要开启parse = TURE，且用字符串表示。

conc <- c(2.856829, 5.005303, 7.519473, 22.101664, 27.769976, 39.198025, 45.483269, 203.784238)
rate <- c(14.58342, 24.74123, 31.34551, 72.96985, 77.50099, 96.08794, 96.96624, 108.88374)
L.minor <- data.frame(conc, rate)
L.minor.m1 <- nls(rate ~ Vm * conc/(K + conc), data = L.minor, #采用M-M动力学方程
                  start = list(K = 20, Vm = 120), #初始值设置为K=20，Vm=120
                  trace = TRUE) #占线拟合过程
#确定x轴范围并构建数据集
min <- range(L.minor$conc)[1]
max <- range(L.minor$conc)[2]
line.data <- data.frame(conc = seq(min, max, length.out = 1000))
#用模型预测数据构建数据集
line.data$p.predict <- predict(L.minor.m1, newdata = line.data)
 
require(ggplot2)
M_Mfunction <- ggplot() +
  geom_point(aes(x = conc, y = rate), data = L.minor,
             alpha = 0.5, size = 5, color = "red") +
  geom_line(aes(x = conc, y = p.predict), data = line.data,
            size = 1, color = "blue") +
  scale_x_continuous(
    name = expression(Substrate ~~ concentration(mmol ~~ m^3)),#采用expression来表示数学公式
    breaks = seq(0, 200, by = 25)) +
  scale_y_continuous(
    name = "Uptake rate (weight/h)",
    breaks = seq(0, 120, by = 10)) +
  geom_text(aes(x = 100, y = 60),
            label = "bolditalic(f(list(x, (list(K, V[m])))) == frac(V[m]%.%x, K+x))",
            #注意 geom_text中如果用expression()来进行表达，必须开启parse = TRUE
            #同时以字符串""的形式表示，不能使用expression
            parse = TRUE, 
            size = 5, family = "times"
            ) +
  theme_bw() +
  theme(
        axis.title.x=element_text(size=16),
        axis.title.y=element_text(size=16),
        axis.text.x=element_text(size=12),
        axis.text.y=element_text(size=12))

 

 

例二 热图

热图是一种极好的数据可视化方式，能够清楚的显示出多维数据之间的关联性和差异性，糗世界已经为我们展现了R里面所常用的heatmap，ggplot2和lattice3种热图绘制方式，当然随着R的不断进步，已经有多种包提供了更丰富和更简单的热图绘制方式，例如gplots中的heatmap.2，pheatmap，heatmap.plus等等。ggplot2进行热图的绘制也十分方便，热图的关键是聚类，两个可行的方案是对聚类结果进行排序和将聚类结果因子化后固定，通过结合plyr包，可以很方便的实现。这里采用一组来源于WHO国家数据来对热图的绘制进行，首先数据标准化和正态化后按Index的D（为各国的人口数据）进行排序，再将其因子化后固定，用geom_tile()进行热图的绘制，在ggplot2种已能通过scale_fill_gradient2在三种基本色进行渐变。

数据下载

WHO<-read.csv("WHO.csv", header = TRUE)
require(plyr)
#按总人口数排列数据
WHO<-arrange(WHO, desc(D))
#将数据的名字转换为因子，并固定已拍好的country，
#同理可以按照聚类的结果进行排列
WHO<- transform(WHO, Country = factor(Country, levels = unique(Country)))
 
require(reshape2)
require(ggplot2)
require(scales)
require(grid)
#melt数据
m.WHO <- melt(WHO)
#标准化，每排数据映射到按最小值和最大值映射到(0,1)区间
m.WHO <- ddply(m.WHO, .(variable), transform, rescale = rescale(value))
#标准化并正态化数据
s.WHO <- ddply(m.WHO, .(variable), transform, rescale = scale(value))
require(ggplot2)
p<-ggplot(s.WHO, aes(variable, Country)) +
  #用tile来进行绘热力图
  geom_tile(aes(fill=rescale)) +
  scale_fill_gradient2(mid="black", high="red", low="green", name = "Intensity") +
  labs(x="Country", y="Index", face = "bold") +
  theme_bw() +
  theme(
    axis.title.x=element_text(size=16),
    axis.title.y=element_text(size=16),
    axis.text.x=element_text(size=12, colour="grey50"),
    axis.text.y=element_text(size=12, colour="grey50"),
    legend.title=element_text(size=14),
    legend.text=element_text(size=12),
    legend.key.size = unit(0.8, "cm"))#需要载入grid包来调整legend的大小

 

 

例三 动态图

相信很多人都被Hans Rosling在TED和BCC展现的动态散点图所惊艳到，这是一种多维数据展现方式，并成功的加入了时间这一维度，各路牛人都用不同的手段进行了实现，精彩的作品例如d3.js,和基于google charts API的googlevis。统计之都的魔王大人也用ggplot2结合animation包和ffmpeg进行了绘制。但ggplot2生成动态图比较简陋，主要的原理是一次输出多张按年份排列的图片，再将这些图片按顺序结合生成视频或动态图。在dataguru的课程上我使用循环并结合paste循环输出了如下的动态图，详细的代码请移步

 

 

例四 火山图

火山图是散点图的一种，能够快速的辨别出大型数据集重复变量之间的差异，具体的介绍可以参考wiki和Colin Gillespie的博客，下面的代码和图是使用ggplot2的实现方式。

数据下载

require(ggplot2)
##change theme##
old_theme <- theme_update(
  axis.ticks=element_line(colour="black"),
  panel.grid.major=element_blank(),
  panel.grid.minor=element_blank(),
  panel.background=element_blank(),
  axis.line=element_line(size=0.5)
)
##Highlight genes that have an absolute fold change > 2 and a p-value < Bonferroni cut-off
a <- read.table("flu.txt",header=TRUE,sep="	",)
P.Value <- c(a$P.Value)
FC <- c(a$FC)
df <- data.frame(P.Value, FC)
df.G <- subset(df, log2(FC) < -1& P.Value < 0.05) #define Green
df.G <- cbind(df.G, rep(1, nrow(df.G)))
colnames(df.G)[3] <- "Color"
df.B <- subset(df, (log2(FC) >= -1 & log2(FC) <= 1) | P.Value >= 0.05) #define Black
df.B <- cbind(df.B, rep(2, nrow(df.B)))
colnames(df.B)[3] <- "Color"
df.R <- subset(df, log2(FC) > 1 & P.Value < 0.05) #define Red
df.R <- cbind(df.R, rep(3, nrow(df.R)))
colnames(df.R)[3] <- "Color"
df.t <- rbind(df.G, df.B, df.R)
df.t$Color <- as.factor(df.t$Color)
##Construct the plot object
ggplot(data = df.t, aes(x = log2(FC), y = -log10(P.Value), color= Color )) +
  geom_point(alpha = 0.5, size = 1.75) +
  theme( legend.position = "none") +
  xlim(c(-5, 5)) + ylim(c(0, 20)) +
  scale_color_manual(values = c("green", "black", "red")) +
  labs(x=expression(log[2](FC)), y=expression( -log[10](P.Value))) +
  theme(axis.title.x=element_text(size=20),
        axis.text.x=element_text(size=15)) +
  theme(axis.title.y=element_text(size=20),
        axis.text.y=element_text(size=15))

　　

 

 

 

再说高质量图片输出

绘图完成后最后一步便是图片输出，高质量的图片输出让人赏心悦目，而不正确的输出方式或者直接采用截图的方式从图形设备中截取，得到的图片往往是低劣的。一幅高质量的图片应当控制图片尺寸和字体大小，并对矢量图进行高质量渲染，即所谓的抗锯齿。R语言通过支持Cairo矢量图形处理的类库，可以创建高质量的矢量图形(PDF，PostScript，SVG) 和 位图(PNG，JPEG， TIFF)，同时支持在后台程序中高质量渲染。在ggplot2我比较推荐的图片输出格式为经过Cairo包处理的PDF，因为PDF格式体积小，同时可以储存为其他任何格式，随后再将PDF储存为eps格式并在Photoshop中打开做最终的调整，例如调整比例、色彩空间和dpi（一般杂志和出版社要求dpi=300以上）等。额外需要注意的是ggplot2中的字体大小问题，在cookbook-r一书中指出，在ggplot2中绝大多数情况下，size的大小以mm记，详细的讨论也可以参考stackover的讨论，而在theme()中对element_text()里的size进行调整，此时的size是以磅值（points, pts）来进行表示。
下面以3种ggplot2种常用的图片输出方式，输出一幅主标题为20pts，横纵坐标标题为15pts，长为80mm(3.15in)，宽为60mm(2.36in)的图为例。

require(ggplot2)
require(Cairo)
ggplot() +
  geom_text(aes(x = 16, y = 16), label = "ABC", size = 11.28) + #尺寸为11.28mm，即为32磅
  geom_text(aes(x = 16, y = 14.5), label = "ABC", size = 32) + #尺寸为32mm
  labs( x = "x axis", y = "y axis") +
  ylim( c(14, 16.5)) +
  xlim( c(15.75, 16.25)) +
  theme(
    axis.title.x = element_text(size = 32),#尺寸为32磅
    axis.title.y = element_text(size = 32))#尺寸为32磅
 
x <- seq(-4,4, length.out = 1000)
y <-dnorm(x)
data <- data.frame(x, y)
 
#用Cairo包输出
require(Cairo)
CairoPDF("plot1.pdf", 3.15, 3.15) #单位为英寸
ggplot(data, aes(x = x, y = y)) + geom_line(size = 1) +
  theme_bw()
dev.off() #关闭图像设备，同时储存图片
 
plot2 <- ggplot(data, aes(x = x, y = y)) + geom_line(size = 1) +
  theme_bw()
#用ggsave输出，默认即以用Cairo包进行抗锯齿处理
ggsave("plot2.pdf", plot2, width = 3.15, height = 3.15)
 
#RStudio输出 

 

 

 

更改字体

更改默认字体或者采用中文输出图片是十分恼人的一件事情，好在我们还有各种拓展包和功能强大的Rstudio来实现。

用extrafont输出英文字体

extrafont包能够直接调用字体文件，再通过Ghostscript(需要安装）将写入的字体插入生成的PDF中，具体代码可参考了作者说明

好玩的showtext

邱怡轩大神写了一个好玩的showtext，确实好好玩~

简单易用的RStudio输出

最简单实用的输出方法还是使用RStudio输出，直接调用系统字体(我的是win7，mac和linux下还没有试过）并输出即可

#showtext
require(showtext)
require(ggplot2)
require(Cairo)
font.add("BlackoakStd", "C://Windows//Fonts//BlackoakStd.otf")
font.add("BrushScriptStd", "C://Windows//Fonts//BrushScriptStd.otf")
font.add("times", "C://Windows//Fonts//times.ttf")
font.add("STHUPO", "C://Windows//Fonts//STHUPO.ttf")
CairoPDF("showtext_output", 8, 8)
showtext.begin()
ggplot() +
  geom_text(aes(x = 16, y = 16.25), label = "Blackoak Std", size = 8,
            family = "BlackoakStd") +
  geom_text(aes(x = 16, y = 16), label ="Brush Script Std", size = 16,
            family = "BrushScriptStd") +
  geom_text(aes(x = 16, y = 15.75), label = "Times New Roman", size = 16,
            family = "times") +
  geom_text(aes(x = 16, y = 15.50), label = "华文琥珀", size = 16,
            family = "STHUPO") +
  ylim(c(15.25, 16.50)) +
  labs(x = "", y = "") +
  theme_bw() #在用RStudio输出

 

gridExtra包

在绘图时，有时候会遇到这样一种情景，客户想把多个代表不同KPI的图形分布到同一个画布(Page)上，而且每一个图形都是单独绘制的。对于这种需求，可以使用gridExtra包来实现，gridExtra包能把图形逐个地添加到画布中，并按照业务的需求，把图形摆放到合适的位置上去。在布局完成之后，把图形绘制出来。也就是说，gridExtra用于把几张图拼成一组图，可以把ggplot2绘制的多张图形组合到一个大图中。通常情况下，gridExtra包常用于控制图形的复杂布局和绘制文本表，本文简单介绍gridExtra包的布局功能。

一，友好函数

gridExtra提供用于布局的友好函数：

arrangeGrob(..., grobs = list(...), layout_matrix, vp = NULL,
name = "arrange", as.table = TRUE, respect = FALSE, clip = "off",
nrow = NULL, ncol = NULL, widths = NULL, heights = NULL, top = NULL,
bottom = NULL, left = NULL, right = NULL, padding = unit(0.5, "line"))

grid.arrange(..., newpage = TRUE)

这两个函数的区别是：arrangeGrob()返回未绘制的grob，而grid.arrange()函数在当前的设备上绘图图形。

参数注释：

• ...：grobs、ggplot、lattice等grob（图形对象）
• grobs：对象对象的list
• layout_matrix：表示布局的矩阵

gridExtra是grid包的友好版本，在grid包中，grob是一个可编辑的绘图对象，grob是graphical object两个单词的前两个字符的组合。常用于表示ggplot对象，lattice等高级图形系统创建图形对象。

二，gridExtra布局的基本用法

grid.arrange()函数，不仅能够控制个数已知的图形布局，还能对控制未知个数的图形布局，功能十分强大。

1，控制多个grob的布局

把ggplot2和lattice绘制的图形对象，分两列，并排显示：

library(gridExtra)
library(ggplot2)
library(lattice)

p <- qplot(1,1)
p2 <- xyplot(1~1)   ##lattice包

grid.arrange(p,p2,ncol = 2)

2，控制grob列表的布局

把绘图对象添加到列表中，并把该列表传递给grid.arrange()函数的grobs参数：

library(gridExtra)
library(ggplot2)
library(lattice)

gs <- list(NULL)
gs[[1]] <- qplot(1,1)
gs[[2]] <- xyplot(1~1)   ##lattice包

grid.arrange(grobs=gs,ncol = 2)

3，使用矩阵设置复杂布局

各个图形对象排放的位置，可以通过布局矩阵（layout_matrix）来控制：

lay <- rbind(c(1,1,1,2,3),
             c(1,1,1,4,5),
             c(6,7,8,9,9))

grid.arrange(grobs = gs,layout_matrix = lay)

　

三，在图形内部绘图

ggplot2包中有一个用于创建grob对象的函数，参数x是一个ggplot对象：

ggplotGrob(x)

我们可以通过添加注释（annotate）的方式，向一个图形内部添加一个图形：

annotation_custom(grob, xmin = -Inf, xmax = Inf, ymin = -Inf,  ymax = Inf)

例如：向大图形中添加一个小图形：

library(gridExtra)
library(ggplot2)

g <- ggplotGrob(qplot(1, 1) +
      theme(plot.background = element_rect(colour = "black")))
qplot(1:10, 1:10) +
  annotation_custom(
    grob = g,
    xmin = 1, xmax = 5, ymin = 5, ymax = 10
  ) 

　

ggrepel包画图标记不重叠标签

• 当我们在图形中添加标签时，标签之间很容易相互重叠，包ggrepel就专门用来解决这个问题！ 首先我们来看看通过geom_text()添加标签时的情形：

library(ggplot2)
#使用数据集mtcars演示
ggplot(mtcars)+ geom_point(aes(wt, mpg), color="red")+
geom_text(aes(wt, mpg, label=rownames(mtcars)))+
theme_classic(base_size = 16)

• 可以看到可视化效果不是很好。接下来看看包ggrepel的效果。

#geom_text_repel()

geom_text_repel()是基于geom_text()

library(ggrepel)
set.seed(42)
ggplot(mtcars)+ geom_point(aes(wt, mpg), color="red")+
geom_text_repel(aes(wt, mpg, label=rownames(mtcars)))+
theme_classic(base_size = 16)

geom_label_repel()

geom_label_repel()是基于geom_label(),它将标签置于一个小方框中

set.seed(42)
ggplot(mtcars)+ geom_point(aes(wt, mpg), color="grey", size=5)+
geom_label_repel(aes(wt, mpg, fill=factor(cyl),
label=rownames(mtcars)), fontface="bold", color="white",
box.padding=unit(0.35, "lines"), point.padding=unit(0.5, "lines"),
segment.colour = "grey50")+ theme_classic(base_size = 16)

参数

大部分geom_text()的参数都适用于geom_text_repel(),除了以下几个：

• hjust
• vjust
• position
• check_overlap

ggrepel包为geom_text_repel()与geom_label_repel()提供了特有的参数设置：

• segment.color:连接点与标签的线段的颜色
• segment.size:线段的粗细
• segment.alpha:线段的透明度
• box.padding:文本框周边填充
• point.padding:点周围填充
• arrow:grid:arrow提供的箭头
• force:强制性将重叠文本散开
• max.oter:最大迭代次数
• nudge_x/y:标签开始位置在坐标轴的移动距离
• direction:允许标签的方向，x、y or both

下面举个栗子来详细了解这些参数的图形效果

set.seed(42)
ggplot(mtcars)+ geom_point(aes(wt, mpg, color=factor(cyl)), size=3)+
geom_text_repel(aes(wt, mpg, color=factor(cyl),
label=rownames(mtcars), angle=ifelse(mtcars$cyl==4, 90, 0)),
size=4, family="Times", fontface="bold",
box.padding=unit(0.5, "lines"), point.padding=unit(1.6, "lines"),
segment.color = "#cccccc", segment.size = 0.5,
arrow = arrow(length=unit(0.01, "npc")),force = 1, max.iter = 3e3,
nudge_x = ifelse(mtcars$cyl==6, 2, 0), nudge_y = ifelse(mtcars$cyl==6, 9, 0))+
scale_color_discrete(name="cyl")+
scale_x_continuous(expand = c(0.5, 0))+
scale_y_continuous(expand = c(0.25, 0))+
theme_classic(base_size = 16)

　

也可以通过设置参数point.padding=NA不对点进行repel

set.seed(42)
mtcars$label <- rownames(mtcars)
ggplot(mtcars, aes(wt, mpg, label=label))+
geom_point(color="red")+ geom_text_repel(point.padding = NA)+
theme_classic(base_size = 16)

通过赋值某些label空字符“”来隐藏。

set.seed(42)
mtcars$label <- rownames(mtcars)
mtcars$label[1:15] <- ""
ggplot(mtcars, aes(wt, mpg))+ geom_point(aes(color=factor(cyl)), size=2)+
geom_text_repel(aes(color=factor(cyl), size=hp, label=label),
point.padding = unit(0.25, "lines"), box.padding = unit(0.25, "lines"),
nudge_y = 0.1)+ theme_classic(base_size = 16)

将标签控制在特定区域
通过设置参数xlim和ylim来限制label的位置

set.seed(42)
data <- mtcars
mu <- mean(data$wt)
left <- data[data$wt <mu, ]
right <- data[data$wt>=mu, ]
ggplot()+ geom_vline(xintercept = mu)+
geom_point(aes(wt, mpg), data=data)+
geom_text_repel(data=left, aes(wt, mpg, label=rownames(left),
color="Left half"), xlim=c(NA, mu))+
geom_text_repel(data=right, aes(wt, mpg, label=rownames(right),
color="Rigth half"), xlim=c(mu, NA))+ theme_classic(base_size = 16)

通过控制参数direction来决定label是左右移动还是上下移动， 默认是both

set.seed(42)
#direction="x" 左右移动
ggplot(mtcars)+
 geom_point(aes(wt, mpg), color="red")+
 geom_text_repel(aes(wt, mpg, label=rownames(mtcars)), direction="x")+
 theme_classic(base_size = 16)+xlim(1, 6)

 

#direction="x" 上下移动
ggplot(mtcars)+
 geom_point(aes(wt, mpg), color="red")+
 geom_text_repel(aes(wt, mpg, label=rownames(mtcars)), direction="y")+
 theme_classic(base_size = 16)+xlim(1, 6)

线图

set.seed(42)
ggplot(Orange, aes(age, circumference, color=Tree))+
 geom_line()+
 coord_cartesian(xlim=c(min(Orange$age), max(Orange$age)+90))+
 geom_text_repel(data=subset(Orange, age==max(age)),
                 aes(label=paste("Tree", Tree)),size=6, nudge_x = 45, segment.color = NA)+
 theme_classic(base_size = 16)+
 theme(legend.position = "none")+
 labs(title="Orange Trees", x="Age(days)", y="Circumference(mm)")