R可视乎 | 散点图系列(1)

1.前言

散点图(scatter graph、point graph、X-Y plot、scatter chart )是科研绘图中最常见的图表类型之一,通常用于显示和比较数值。散点图是使用一系列的散点在直角坐标系中展示变量的数值分布。在二维散点图中,可以通过观察两个变量的数据变化,发现两者的关系与相关性。

散点图可以提供三类关键信息:

(1)变量之间是否存在数量关联趋势;

(2)如果存在关联趋势,那么其是线性还是非线性的;

(3)观察是否有存在离群值,从而分析这些离群值对建模分析的影响。


本文可以看作是《R语言数据可视化之美》的学习笔记。该书第四章——数据关系型图表中展示的散点图系列包括以下四个方面:

  1. 趋势显示的二维散点图

  2. 分布显示的二维散点图

  3. 气泡图

  4. 三维散点图

本文主要对第一部分进行介绍,并加上小编自己的理解。下面几个部分也会在这星期陆续推出,敬请关注。

2.本文框架

[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(img-8GuztPWp-1606046103823)(https://imgkr2.cn-bj.ufileos.com/0dce4c7a-cf88-4cd7-a5fb-a387a81ca46a.png?UCloudPublicKey=TOKEN_8d8b72be-579a-4e83-bfd0-5f6ce1546f13&Signature=yw7%252BqqJH9pFaw0RcxoVcXlJTpc4%253D&Expires=1602321049)]

2.数据介绍

随机产生2列20行的数据,列名分别为x,y。x为序号,y由标准正态分布中产生。

library(ggplot2)
mydata = data.frame('x'= 1:20,'y'=sort(rnorm(20)))

[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(img-T1cAX7eT-1606046103840)(https://imgkr2.cn-bj.ufileos.com/9f16fcf9-5cdb-46dd-9775-80af5dcf7155.png?UCloudPublicKey=TOKEN_8d8b72be-579a-4e83-bfd0-5f6ce1546f13&Signature=KEp85uT0Ved420cec%252Bwz8LorRqQ%253D&Expires=1602314796)]

3. 不同类型拟合曲线的绘制

3.1 loess数据平滑曲线

局部加权回归(Locally Weighted Scatterplot Smoothing,LOESS)主要思想是取一定比例的局部数据,在这部分子集中拟合多项式回归曲线,这样就可以观察到数据在局部展现出来的规律和趋势。曲线的光滑程度与选取数据比例有关:比例越少,拟合越不光滑,反之越光滑。

ggplot2绘制时,使用geom_point绘制散点图,geom_smooth加入拟合曲线,method选择为loess,se=TRUE表示加入置信带,span控制loess平滑的平滑量,较小的数字产生波动线,较大的数字产生平滑线。其他参数对颜色,填充色以及透明度进行了修改。

ggplot(data = mydata, aes(x,y)) +
geom_point(fill="black",colour="black",size=3,shape=21) +
geom_smooth(method = 'loess',span=0.4,se=TRUE,
colour="#00A5FF",fill="#00A5FF",alpha=0.2)

[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(img-hcND9ALu-1606046103843)(https://imgkr2.cn-bj.ufileos.com/1b4a56bf-2749-440f-8985-e1fe0d86b38d.png?UCloudPublicKey=TOKEN_8d8b72be-579a-4e83-bfd0-5f6ce1546f13&Signature=jYHjgFOQNpOAj4mDspw81yz77T0%253D&Expires=1602315086)]

3.2 样条数据平滑曲线

这里使用了splines包中的样条函数,df=5,样条具有五个基函数,其他参数变化不大。具体非线性模型相关资料可参考:R语言里的非线性模型:多项式回归、局部样条、平滑样条、广义加性模型分析

ggplot(data = mydata, aes(x,y)) +
geom_point(fill="black",colour="black",size=3,shape=21) +
geom_smooth(method="lm",se=TRUE,
formula=y ~ splines::bs(x, 5),colour="red")

[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(img-VDzUJrhs-1606046103851)(https://imgkr2.cn-bj.ufileos.com/7b2f18c9-b024-4687-ad0e-63204370bc9b.png?UCloudPublicKey=TOKEN_8d8b72be-579a-4e83-bfd0-5f6ce1546f13&Signature=RE2bIQynHg%252FumBjeRG6Dhx%252FLr4U%253D&Expires=1602315172)]

3.3 GAM 数据平滑曲线

GAM 模型的拟合是通过一个迭代过程(向后拟合算法)对每个预测变量进行样条平滑的。其算法要在拟合误差和自由度之间进行权衡最终达到最优。

ggplot(data = mydata, aes(x,y)) +
geom_point(fill="black",colour="black",size=3,shape=21) +
geom_smooth(method = 'gam',formula=y ~s(x))

[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(img-fwYMyZjv-1606046103865)(https://imgkr2.cn-bj.ufileos.com/8415ac8b-1ba6-46b7-a109-501410c7e2c4.png?UCloudPublicKey=TOKEN_8d8b72be-579a-4e83-bfd0-5f6ce1546f13&Signature=uUk18ue5CAO6AsaZzbbHQ2O7e2o%253D&Expires=1602315183)]

4. 残差分析图

残差分析(residual analysis)就是通过残差所提供
的信息,分析出数据的可靠性、周期性或其他干扰。用于分析模型的假定正确与否的方法。所谓残
差是指观测值与预测值(拟合值)之间的差,即实际观察值与回归估计值的差。以下给出两种拟合方法的残差分析图。注意: 这里还是使用前面随机模拟产生的数据。

4.1 线性拟合

通过lm函数进行回归分析,公式为 y = a x + b y = ax+b y=ax+b。并将预测值 y ^ \hat{y} y^,残差 ε \varepsilon ε,残差的绝对值 ∣ ε ∣ |\varepsilon| ε进行存储,结果如下所示。

fit <- lm(y ~ x, data = mydata)
mydata$predicted <- predict(fit) # Save the predicted values
mydata$residuals <- residuals(fit) # Save the residual values
mydata$Abs_Residuals <- abs(mydata$residuals)
head(mydata)

[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(img-ur8SRbsD-1606046103874)(https://imgkr2.cn-bj.ufileos.com/fe824172-9f2b-418d-9db4-8ca09b093379.png?UCloudPublicKey=TOKEN_8d8b72be-579a-4e83-bfd0-5f6ce1546f13&Signature=jV8VhQ93O60VaSQlnDaGC3uhjb4%253D&Expires=1602315268)]

完整代码如下所示:

ggplot(mydata, aes(x = x, y = y)) +
  geom_point(aes(fill =Abs_Residuals, size = Abs_Residuals),shape=21,colour="black") + # size also mapped
  scale_fill_continuous(low = "black", high = "red") +
  geom_smooth(method = "lm", se = FALSE, color = "lightgrey") +
  geom_point(aes(y = predicted), shape = 1) +
  geom_segment(aes(xend = x, yend = predicted), alpha = .2) +
  guides(fill = guide_legend((title="Rresidual")),
         size = guide_legend((title="Rresidual")))+
  xlab("X-Axis")+
  ylab("Y-Axis")+
  theme(text=element_text(size=15,face="plain",color="black"),
        axis.title=element_text(size=10,face="plain",color="black"),
        axis.text = element_text(size=10,face="plain",color="black"),
        legend.position = "right",
        legend.title  = element_text(size=13,face="plain",color="black"),
        legend.text = element_text(size=10,face="plain",color="black"),
        legend.background = element_rect(fill=alpha("white",0)))
代码详解

绘制的方式比较简单,根据ggplot的思想不断叠加图层。我们对以下代码进行详细分析:

  1. 以x为横坐标,y为纵坐标,geom_point()绘制散点图,以Abs_Residuals的大小来填充点和尺寸,颜色为黑色。scale_fill_continuous()将填充色从"black"到"red"渐变。geom_smooth()给数据加入拟合曲线,这里使用lm()方法,置信带不展示,颜色为"lightgrey"。这时候的图形如下:

[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(img-SE3QBp3j-1606046103883)(https://imgkr2.cn-bj.ufileos.com/4c9a07c1-b7d0-41fa-ac8b-c3c92439c30f.png?UCloudPublicKey=TOKEN_8d8b72be-579a-4e83-bfd0-5f6ce1546f13&Signature=xoAbaDqw7uzKX3nZP%252FHpEus%252BjxI%253D&Expires=1602315306)]

  1. 将预测值的点进行绘制,geom_segment()可加入线段,其中xend = x, yend = predicted表示从x到x,y到predicted,所以就会产生下图中的竖直线了。

[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(img-cUBQwkf3-1606046103878)(https://imgkr2.cn-bj.ufileos.com/10d02b70-707a-4361-ac15-dfb1096e5757.png?UCloudPublicKey=TOKEN_8d8b72be-579a-4e83-bfd0-5f6ce1546f13&Signature=AGI6HCOJsJf6kxDDBHUpjpeh%252B6A%253D&Expires=1602318537)]

  1. 这时残差图基本完成,但是可以看到横纵坐标的标题有问题,右边的legend太累赘了以及字体颜色和大小还可以再做修改。最后图形如下所示:

在这里插入图片描述

4.2 非线性拟合

非线性拟合绘制残差图与线性拟合类似,唯一不同的点在:利用lm函数拟合不同的回归模型,以下使用了公式: y = a x + b x 2 + c y = ax+bx^2+c y=ax+bx2+c,后面的绘制与上面相同。

d<-mydata
fit <- lm(y ~ x+I(x^2), data = d)
d$predicted <- predict(fit) 
d$residuals0 <- residuals(fit)
d$Residuals<-abs(d$residuals0 )
ggplot(d, aes(x = x, y = y)) +
geom_smooth(method = "lm",formula = y ~ x+I(x^2), se = FALSE, color = "lightgrey") +
geom_segment(aes(xend = x, yend = predicted), alpha = .2) +
geom_point(aes(fill =Residuals, size = Residuals),shape=21,colour="black") + # size also mapped
scale_fill_continuous(low = "black", high = "red") +
geom_point(aes(y = predicted), shape = 1) +
xlab("X-Axis")+ ylab("Y-Axis")+
geom_point(aes(y = predicted), shape = 1) +
guides(fill = guide_legend((title="Rresidual")),
size = guide_legend((title="Rresidual")))+
theme(text=element_text(size=15,face="plain",color="black"),
axis.title=element_text(size=10,face="plain",color="black"),
axis.text = element_text(size=10,face="plain",color="black"),
legend.position = "right",
legend.title = element_text(size=13,face="plain",color="black"),
legend.text = element_text(size=10,face="plain",color="black"),
legend.background = element_rect(fill=alpha("white",0)))

[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(img-ZpwifDBs-1606046103890)(https://imgkr2.cn-bj.ufileos.com/d3e79b04-9a27-4a66-a74b-aab202d3c7a1.png?UCloudPublicKey=TOKEN_8d8b72be-579a-4e83-bfd0-5f6ce1546f13&Signature=saZCivKxsLR9RwKJSS1QIk5JhA0%253D&Expires=1602315430)]

这两个图采用黑色到红色渐变颜色和气泡面积大小两个视觉暗示对应残差的绝对值大小,用于实际数据点的表示;而拟合数据点则用小空心圆圈表示,并放置在灰色的拟合曲线上。用直线连接实际数据点和拟合数据点。残差的绝对值越大,颜色越红、气泡也越大,连接直线越长,这样可以很清晰地观察数据的拟合效果。

4.3 有趣的拓展

R 中的ggimage包提供了geom_image()函数可以将对应的圆形数据点使用图片替代展示。我们将其运用到上面的数据集中,就可以得到有趣的图了。

library(ggimage)
mydata$image = "https://www.r-project.org/logo/Rlogo.png"
ggplot(mydata, aes(x, y)) + geom_image(aes(image=image))+
  geom_smooth(method = 'lm')

[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(img-TlpTKR4b-1606046103892)(https://imgkr2.cn-bj.ufileos.com/6440b5bf-26b2-495e-af80-85c2a824f4fa.png?UCloudPublicKey=TOKEN_8d8b72be-579a-4e83-bfd0-5f6ce1546f13&Signature=s8lartmVfdgd8C7vjUss2RfXTO0%253D&Expires=1602320961)]

[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(img-Wz1arBip-1606046103897)(https://imgkr2.cn-bj.ufileos.com/a45d1534-ec3a-4c82-bbba-bf1b3c4fda31.png?UCloudPublicKey=TOKEN_8d8b72be-579a-4e83-bfd0-5f6ce1546f13&Signature=tqkveMZraZTuVRbVd%252F4hdYEXUgU%253D&Expires=1602320948)]

欢迎关注【庄闪闪的成长手册】,包含R可视化,数据分析,数据科学等前沿信息。微信扫码

  • 1
    点赞
  • 3
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值