ggplot2散点图进阶画法

本文主要介绍画散点图的以下几种类型：

目录

点数过多出现重叠现象 

 case 1

 case 2 

离散数据的回归拟合及置信区间问题 

 添加回归曲线

 修改置信区间的置信度

 隐藏置信区间

 给数据按类别分别拟合

 从已知模型中添加回归曲线

利用annotate()加注释 

绘制边缘地毯图 marginal rugs plot 

给散点图的点加上标签 

为所有数据加上标签

 选择性保留标签

气球图，更直观地看到数值的变化 

---

首先导入必要的包

library (ggplot2)
library(cowplot)#将图片组合在一起
library(gcookbook)#数据集
library(plyr)#后面用到ddply函数

点数过多出现重叠现象 

 case 1

#着重解决overplot
#基础绘图
p1 <- ggplot(diamonds,aes(x=carat,y=price))+
  geom_point(alpha=0.01)
p1

 可以看到这个数据集的散点图有很多的重叠的现象，这对我们进行数据分析并不利，因为我们并不知道这里究竟有多少数据重叠

 我们可以尝试二维密度图

二维密度图与散点图相似，但是当点过多，重叠程度较大，就需要用二维密度图反映其密集程度。

二维密度图显示了两个数值变量之间的关系，一个在x轴上表示，另一个在Y轴上表示，与散点图类似，然后计算二维空间中特定区域内的观测数，并用颜色梯度表示

#上面画的较慢，且表示并不清晰，我们可以尝试bin2d
p2.1 <- ggplot(diamonds,aes(x=carat,y=price))+
  stat_bin2d()
p2.2 <- ggplot(diamonds,aes(x=carat,y=price))+
  stat_bin2d(bins=50)
p2.3 <- ggplot(diamonds,aes(x=carat,y=price))+
  stat_bin2d(bins=50)+
  scale_fill_gradient(low = "skyblue",high = "red")
cowplot::plot_grid(p2.1,p2.2,p2.3,nrow = 1)  

 stat_bin2d()内置参数bins=50表示这个图由50x50个格子构成

scale_fill_gradient()内置参数low和high表示颜色随数量增加由浅蓝色逐步过渡到红色

 

 otherwise，将方格子换成正六边形

p3 <- ggplot(diamonds,aes(x=carat,y=price))+
  stat_binhex()+
  scale_fill_gradient(low = "skyblue",high = "red",
                      breaks=c(0,500,1000,2000,4000,6000))
p3

 case 2 

#另一种情况的重叠
head(ChickWeight)
p4 <- ggplot(ChickWeight,aes(x=Time,y=weight))+
  geom_point()+
  scale_x_continuous(breaks = seq(0,21,1))#设置x轴范围从0到21，每一个单位显示一个刻度
p4

 点聚集在一条线上不能直观的感受，我们可以利用jitter函数随机抖动一下

p5 <- ggplot(ChickWeight,aes(x=Time,y=weight))+
  geom_point(position = "jitter")+
  scale_x_continuous(breaks = seq(0,21,1))#设置x轴范围从0到21，每一个单位显示一个刻度
p5

 如果我们想要控制抖动的幅度

p6 <- ggplot(ChickWeight,aes(x=Time,y=weight))+
  geom_point(position = position_jitter(width = 0.5,height = 0))+
  scale_x_continuous(breaks=seq(0,22,1))#设置x轴范围从0到21，每一个单位显示一个刻度
p6

 或者我们用箱图来描绘这类数据

p7 <- ggplot(ChickWeight,aes(x=Time,y=weight))+
  geom_boxplot(aes(group=Time))#告诉ggplot怎么分类，不然会直接弄成一个箱图
p7

离散数据的回归拟合及置信区间问题 

 添加回归曲线

p8 <- ggplot(heightweight,aes(x=ageYear,y=heightIn))+
  geom_point()+
  geom_smooth(method = lm)#默认置信区间为95%，方法为线性拟合
p8

 修改置信区间的置信度

#添加99%的置信区间
p9 <- ggplot(heightweight,aes(x=ageYear,y=heightIn))+
  geom_point()+
  geom_smooth(method = lm,level=0.99)
p9

 隐藏置信区间

#不要置信区间
p10 <- ggplot(heightweight,aes(x=ageYear,y=heightIn))+
  geom_point()+
  geom_smooth(method = lm,se=F)#se=F隐藏置信区间
p10

 使用局部加权多项式拟合

#使用局部加权多项式拟合
p11 <- ggplot(heightweight,aes(x=ageYear,y=heightIn))+
  geom_point()+
  geom_smooth(method = loess)
p11

 给数据按类别分别拟合

p12 <- ggplot(heightweight,aes(x=ageYear,y=heightIn,colour = sex))+
  geom_point()+
  geom_smooth(method = loess)
p12

 从已知模型中添加回归曲线

#从已知模型中添加回归曲线
model <- lm(heightIn~ageYear+I(ageYear^2),heightweight)
model
predicted <- data.frame(ageYear=heightweight$ageYear)
predicted$heightIn <- predict(model,predicted)
predicted
p13 <- ggplot(heightweight,aes(x=ageYear,y=heightIn))+
  geom_point(colour = "grey")+
  geom_line(data=predicted,aes(x=ageYear,y=heightIn),size=1)
p13

利用annotate()加注释 

#annotate详细用法 8个例子
#annotate()通过第一个参数指定标注类型：
#"text"，"rect"，"segment"，"pointrange"，"curve"
p <- ggplot(mtcars, aes(x = wt, y = mpg)) + geom_point()
#在(4,25)处添加标签some text
an1 <- p + annotate("text", x = 4, y = 25, label = "Some text")+
  ggtitle("an1")
#在y=25直线上x从2到5每间隔一个单位添加标签some text
an2 <- p + annotate("text", x = 2:5, y = 25, label = "Some text")+
  ggtitle("an2")
#在这片区域作阴影，透明度为0.2
an3 <- p + annotate("rect", 
             xmin = 3, xmax = 4.2,#x范围
             ymin = 12, ymax = 21,#y范围
             alpha = .2)+
  ggtitle("an3")
#以(2.5,15)为起点，(4,25)为终点作直线
an4 <- p + annotate("segment", x = 2.5, xend = 4, y = 15, yend = 25,
             colour = "blue")+
  ggtitle("an4")
an5 <- p + annotate("pointrange", 
             x = 3.5, y = 20,#中心坐标
             ymin = 12, ymax = 28,
             colour = "red", size = .5)+
  ggtitle("an5")

an6 <- p + annotate("text", x = 2:3, y = 20:21, label = c("my label", "label 2"))+
  ggtitle("an6")
#数学公式
an7 <- p + annotate("text", x = 4, y = 25, label = "italic(R) ^ 2 == 0.75",
             parse = TRUE)+
  ggtitle("an7")
#添加有向箭头
an8 <- p + annotate("curve",
             x = 4, y = 22.5,xend = 3, yend = 15,#起始点
             curvature = .5,#弧度
             arrow = arrow(length = unit(3, "mm")))+#箭头3mm  
  ggtitle("an8")
cowplot::plot_grid(an1,an2,an3,an4,nrow = 2)
cowplot::plot_grid(an5,an6,an7,an8,nrow = 2)

 数学公式的写法参考这篇博文R语言作图：数学公式

绘制边缘地毯图 marginal rugs plot 

 边缘地毯图本质上是一种一维散点图，可以用来可视化数据在各个坐标轴上的分布。

下面以faithful数据集为例展示其画法

p15.1 <- ggplot(faithful,aes(x=eruptions,y=waiting))+geom_point()
p15.2 <- p15.1 + geom_rug()
cowplot::plot_grid(p15.1,p15.2,nrow = 1)

 

给散点图的点加上标签 

为所有数据加上标签

以countries数据集为例，为数据加上标签

df <- subset(countries,Year==2009&healthexp>2000)
p16.1 <- ggplot(df,aes(x=healthexp,y=infmortality))+
  geom_point()
p16.2 <- p16.1 + geom_text(aes(label=Name),
                           vjust = 0,#竖直方向位置参数
                           hjust = -.1,#水平方向位置参数
                           size = 3)#字体大小
p16.2

 

 选择性保留标签

#如果想要选择性保留
df
df$Name1 <- df$Name
idx <- df$Name1 %in% c("Canada","Switzerland","New Zealand","Slovenia")
#在利用逻辑向量索引时，R将查找逻辑值为TRUE元素的下标，并索引该下标元素的值，而不包括FALSE的值
df$Name1[!idx] <- NA
p17 <- ggplot(df,aes(x=healthexp,y=infmortality))+
  geom_point()+
  geom_text(aes(label=Name1),vjust=1 )
p17

 对于利用逻辑向量为索引筛选数据理解困难的小伙伴，参考R语言中的数据筛选索引

气球图，更直观地看到数值的变化 

 气球图,气球面积与数值成正比

df <- subset(countries,Year==2009&healthexp>2000)
p18 <- ggplot(df,aes(x=healthexp,y=infmortality,size=GDP))+
  geom_point(shape=21,colour="black",fill="cornsilk")+
  scale_size_area(max_size = 15)
p18