第五章：散点图
1.基本散点图
attach(heightweight)
heightweight[,c("ageYear","heightIn")]
ggplot(heightweight,aes(x=ageYear,y=heightIn))+geom_point()
ggplot(heightweight,aes(x=ageYear,y=heightIn))+geom_point(shape=21)#shape参数修改点的形状
ggplot(heightweight,aes(x=ageYear,y=heightIn))+geom_point(size=1.5)#2、使用点形和颜色属性，并基于某变量对数据进行【分组】
`heightweight[,c("sex","ageYear","heightIn")]
ggplot(heightweight,aes(x=ageYear,y=heightIn,shape=sex))+geom_point()
ggplot(heightweight,aes(x=ageYear,y=heightIn,colour=sex))+geom_point()PS:分类因子变量必须是因子
ggplot(heightweight,aes(x=ageYear,y=heightIn,shape=sex,colour=sex))+geom_point()#将一变量同时映射给shape和colour分组后颜色和形状都不同
ggplot(heightweight,aes(x=ageYear,y=heightIn,shape=sex,colour=sex))+
geom_point()+scale_shape_manual(values=c(1,2))+
scale_colour_brewer(palette="Set1")#根据分组变量将分属不同组的数据点设置为不同点形和颜色3、使用不同于默认设置的点形
ggplot(heightweight,aes(x=ageYear,y=heightIn,shape=sex))+
geom_point(size=3)+scale_shape_manual(values=c(1,4))#利用scale_shape_manual调整,自定义点形
#点是否实点，边框颜色都可以设置
hw=heightweight#副本
hw$weightGroup=cut(hw$weightLb,breaks=c(-Inf,100,Inf),labels=c("<100",">=100"))#大于100磅的一组
#可以按2个变量对数据进行分组，一个是因子sex，一个是连续型变量（做了分类处理）——刻画了两个变量
ggplot(hw,aes(x=ageYear,y=heightIn,shape=sex,fill=weightGroup))+
geom_point(size=2.5)+
scale_shape_manual(values=c(21,24))
#上面的代码运行后没有虚点，和标示不同
ggplot(hw,aes(x=ageYear,y=heightIn,shape=sex,fill=weightGroup))+
geom_point(size=2.5)+
scale_shape_manual(values=c(21,24))+
scale_fill_manual(values=c(NA,"black"),guide=guide_legend(override.ase=list(shape=21)))4、将连续型变量映射到点的颜色或大小属性上
###如何来刻画第三个连续型变量——必须将第三个变量映射到其他的图形属性（颜色、大小）——必须放在aes中
heightweight[,c("sex","ageYear","heightIn","weightLb")]
ggplot(heightweight,aes(x=ageYear,y=heightIn,colour=weightLb))+geom_point()#该图点的颜色越深weightLb越小
ggplot(heightweight,aes(x=ageYear,y=heightIn,size=weightLb))+geom_point()#该图点越大weightLb越大
#此时对第三个变量解释精度较低，适用于不需要高精度解释的变量，点的大小差不代表值的大小差
ggplot(heightweight,aes(x=ageYear,y=heightIn,fill=weightLb))+
geom_point(shape=21,size=2.5)+scale_fill_gradient(low="black",high="white")#scale_fill_gradient
#将色阶设置为黑白,黑白渐变，增大数据点大小
ggplot(heightweight,aes(x=ageYear,y=heightIn,fill=weightLb))+
geom_point(shape=21,size=2.5)+scale_fill_gradient(low="black",high="white",breaks=seq(70,170,by=20),
guide=guide_legend())
#scale_fill_gradient()中breaks设置断点，会以离散点的图例代替色阶（渐变色）
ggplot(heightweight,aes(x=ageYear,y=heightIn,size=weightLb,colour=sex))+
geom_point(alpha=0.5)+scale_size_area()+
scale_colour_brewer(palette="Set1")#scale_fill_gradient
#alpha=0.5指定点为半透明，scale_size_area()设置点面积正比于变量值，scale_colour_gradient()修改调色板
#PS:将某变量映射给size时，避免将其他变量映射给shape属性。【不同点形的大小不好比较】5、处理图像重叠
###数据量大时，如何避免互相重叠？——重叠度低的时候可以用不同的点形或虚实区别
#（1）用半透明的点处理
sp=ggplot(diamonds,aes(x=carat,y=price))
sp+geom_point()#5万多数据，很难区分不同区域数据点的相对密度
sp+geom_point(alpha=0.1)#设置点透明度为90%，重叠后颜色越重表示该区域点越密集
sp+geom_point(alpha=0.01)#设置点透明度为99%，重叠后颜色越重表示该区域点越密集
#（2）将数据点分箱，并以矩阵来表示，将数据点的密度映射为矩阵的填充色
sp+stat_bin2d()#stat_bin2d()分别在横纵轴方向将数据分隔20组，总计900个箱子
#数据点默认颜色区分不大（黑蓝）
sp+stat_bin2d(bins=50)+ #将箱数设置为50
scale_fill_gradient(low="lightblue",high="red")
sp+stat_bin2d(bins=50)+ #将箱数设置为50
scale_fill_gradient(low="lightblue",high="red",limits=c(0,6000))
#scale_fill_gradient重新设定数据点颜色，最小色阶为浅蓝，最大色阶为红色，默认图例不含最小值，颜色标度范围不是从0开始
#limits手动设定范围为0,6000
install.packages("hexbin")
library(hexbin)
sp+stat_binhex()+
scale_fill_gradient(low="lightblue",high="red",limits=c(0,8000))
#stat_binhex()对分箱形状改为六边形
sp+stat_binhex()+
scale_fill_gradient(low="lightblue",high="red",breaks=c(0,250,500,1000,2000,4000,6000),
limits=c(0,6000))
#stat_binhex()对分箱形状改为六边形,落在分箱范围外面的格子显示灰色
#（3）当某一数据轴或两个数据轴都是离散型数据时，很容易出现重叠——增加随机扰动
fix(ChickWeight)
spl=ggplot(ChickWeight,aes(x=Time,y=weight))
spl+geom_point()#重合状况
spl+geom_point(position="jitter")
#spl+geom_jitter()同上#所谓扰动就是原本取值0的点在0附近随机波动，把原本重叠的点横向平铺一点
spl+geom_point(position=position_jitter(width=0.5,height=0))#height=0表示只在水平方向增加扰动
spl+geom_point(position=position_jitter(width=1,height=0))#水平方向扰动太大，点很容易混淆
#当数据集一个离散一个连续时，使用箱线图（缺点：难以显示每个位置的数据点数量）
###由于某些变量time本质是离散，但被保存成连续，需告诉如何分组aes(group=)
spl+geom_boxplot(aes(group=Time))#设定分组
spl+geom_boxplot()#不设分组6、添加回归模型拟合线
###在散点图中添加回归模型拟合线——stat_smooth()
library(gcookbook)#为了数据
sp=ggplot(heightweight,aes(x=ageYear,y=heightIn))#先定义基本绘图对象sp
sp+geom_point()+stat_smooth()#不设置method默认拟合loess曲线（局部加权多项式）,不是直线
sp+geom_point()+stat_smooth(method="lm")
sp+geom_point()+stat_smooth(method="lm",level=0.99)#99%置信区间
# method可以取lm, glm, gam, loess, rlm
sp+geom_point()+stat_smooth(method="lm",se=FALSE)#不画置信域
sp+geom_point(colour="grey60")+
stat_smooth(method="lm",se=FALSE,colour="blue")#修改线和点的颜色
sp+geom_point(colour="grey60")+stat_smooth(method="loess")
sp+geom_point(colour="grey60")+stat_smooth(method="glm")
#logistic回归
library(MASS)#需要该包里面的数据,用来logistic回归
b=biopsy;head(b)#副本数据,有699条观测
b$classn[b$class=="benign"]=0#把类别class转化为0-1变量
b$classn[b$class=="malignant"]=1
head(b)
ggplot(b,aes(x=V1,y=classn))+geom_point()#基本的散点图看出大量的点重合，需要设置透明度和扰动
ggplot(b,aes(x=V1,y=classn))+
geom_point(position=position_jitter(width=0.3,height=0.06),alpha=0.4,shape=21,size=1.5)+
stat_smooth(fill="red",method="glm",family=binomial)
#########glm拟合，fill设置置信带颜色
sps=ggplot(heightweight,aes(x=ageYear,y=heightIn,colour=sex))+
geom_point()+
scale_colour_brewer(palette="Set1")
sps#以sex分类，映射到颜色
sps+geom_smooth()#分类添加loess线
##可知蓝色的拟合线没有到达图形的右边界（1.由于预测范围为数据的范围 2.即使外推，也只能根据整组数据对应的x轴范围进行预测）
#####loessn不能外推，lm可以
sps+geom_smooth(method="lm",se=FALSE,fullrange=TRUE)#fullrange是T指示需要外推
##需不需要外推，要用loess还是lm要考虑变量的意义，这里体重身高不会随年龄一直增加，显然lm不适合。loess更适合7、根据【已有】模型向散点图添加拟合线
##方法仍然是调用stat_smooth()
library(gcookbook)
model=lm(heightIn~ageYear+I(ageYear^2),heightweight)
model
xmin=min(heightweight$ageYear);xmax=max(heightweight$ageYear)#找到范围，进行插值
predicted=data.frame(ageYear=seq(xmin,xmax,length.out=100))#xmin到xmax之间的100个数作为横坐标的值
predicted$heightIn=predict(model,predicted)#把用模型预测的值放入数据框
predicted
##将这些点与原本数据点绘制到一起
sp=ggplot(heightweight,aes(x=ageYear,y=heightIn))+
geom_point(colour="grey50")
sp+geom_line(data=predicted,size=1)#用插值的点绘制曲线，size是线的粗细
sp+stat_smooth(colour="blue",se=FALSE,size=1)+stat_smooth(method="lm",colour="red",se=FALSE,size=1)##定义函数predictvals()简化向散点图添加模型拟合线的过程【对上面代码的简化】
predictvals=function(model,xvar,yvar,xrange=NULL,samples=100,...)
{ #if先判断是否给了x的范围xrange
if (is.null(xrange))
{ #如果是空，也就是没给范围，x的范围从模型对象中提取
if (any(class(model) %in% c("lm","glm")))
xrange=range(model$model[[xvar]])#如果是线性模型lm和glm用该语句提取范围
else if (any(class(model) %in% "loess"))
xrange=range(model$x) #用局部加权多项式loess拟合时提取
}
newdata=data.frame(x=seq(xrange[1],xrange[2],length.out=samples))#在该范围内打samples数量的点作为自变量
names(newdata)=xvar#把上面的数据点命名
newdata[[yvar]]=predict(model,newdata=newdata,...)#利用predict按model对上面的数据点预测，并放入数据框
newdata#输出数据框
}
modlinear=lm(heightIn~ageYear,heightweight)#线性回归模型
##对该模型调用上面的函数predictvals
lm_predicted=predictvals(modlinear,"ageYear","heightIn")
modloess=loess(heightIn~ageYear,heightweight)#loess拟合模型
loess_predicted=predictvals(modloess,"ageYear","heightIn")
sp+geom_line(data=lm_predicted,colour="red",size=0.8)+
geom_line(data=loess_predicted,colour="blue",size=0.8)#绘图结果和7最开始的结果相同
#注意：在用非线性glm函数拟合时，需要设定参数type。下面是应用
library(MASS)
b=biopsy
b$classn[b$class=="bengin"]=0#b中加一列classn作为类别的标示
b$classn[b$class=="malignant"]=1
fitlogistic=glm(classn ~ V1, b, family=binomial)#用glm拟合
glm_predicted=predictvals(fitlogistic, "V1", "classn", type="response")#用定义的函数预测并生成新的数据
####此处需要加参数type用来对glm进行predict。
ggplot(b, aes(x=V1, y=classn)) +
geom_point(position=position_jitter(width=0.3, height=0.08),alpha=0.4,shape=21,size=1.5)+
geom_line(data=glm_predicted, colour="#1177FF", size=1)
##position增加扰动避免重复，geom_line用data绘制曲线，颜色"#1177FF"是RGB颜色--蓝色
#8、添加来自多个模型的拟合线
##自定义函数predictvals()、dlply()、ldply()
#由数据集自定义函数，可以对原数据集的子集分别建立模型
make_model=function(data)
{ lm(heightIn ~ ageYear, data) }
library(gcookbook)#数据集所在包
library(plyr)#dlply()和ldply()的包，这两个函数的作用是切分数据，对各个部分执行某一函数，并对执行结果进行重组
models=dlply(heightweight,"sex",.fun=make_model)#dlply对数据集按sex分类，并对数据集分别应用上面的函数建立模型
models
predvals=ldply(models,.fun=predictvals,xvar="ageYear",yvar="heightIn")#ldply可以用上面得到的模型预测得到新的数据集
predvals#该数据集按照性别分别建立数据集
ggplot(heightweight,aes(x=ageYear,y=heightIn,colour=sex))+
geom_point()+geom_line(data=predvals)##绘制原来的散点和预测值绘成的曲线
predvals=ldply(models, .fun=predictvals, xvar="ageYear", yvar="heightIn",xrange=range(heightweight$ageYear))
ggplot(heightweight,aes(x=ageYear,y=heightIn, colour=sex))+
geom_point()+geom_line(data=predvals)
#9、向散点图添加模型系数
##如何向图形添加模型的数值信息（文本注释、）
library(gcookbook)
model=lm(heightIn ~ ageYear, heightweight)
summary(model)#从模型结果可知，R2是0.4249.希望添加到图中
pred=predictvals(model, "ageYear", "heightIn")#调用定义的函数，生成预测得到的新数据
sp=ggplot(heightweight, aes(x=ageYear, y=heightIn)) + geom_point() +
geom_line(data=pred)#基本图形
sp+annotate("text", label="r^2=0.42", x=16.5, y=52)#annotate()函数手动添加文本“text”,(x,y)指示文本位置
sp+annotate("text", label="r^2 == 0.42", parse = TRUE, x=16.5, y=52)#parse指示调用R中的数学表达式语法来输入公式
#不能直接以表达式对象作为输入
expression(r^2 == 0.42)#正确的表达式，因为==合法，=不合法
expression(r^2 = 0.42)#不正确
###自动提取模型对象的值，
eqn=as.character(as.expression(
substitute(italic(y) == a + b * italic(x) * "," ~~ italic(r)^2 ~ "=" ~ r2,
list(a = format(coef(model)[1],digits=3),
b = format(coef(model)[2],digits=3),
r2 = format(summary(model)$r.squared, digits=2)#list里面的元素是从模型中提取的
))))#substitute里面是表达式，里面的a,b,m由list来给出
eqn
parse(text=eqn)#parse进行解析，返回表达式
sp + annotate("text", label=eqn, parse=TRUE, x=Inf, y=-Inf, hjust=1.1, vjust=-.5)
#指示的位置是图形右下角，两个just是对位置的调整，使其在图形内
#10、向散点图添加边际地毯marginal rugs
###调用geom_rug()
fix(faithful)#有两个变量：waiting和eruptions
ggplot(faithful, aes(x=eruptions, y=waiting))+geom_point()+
geom_rug()#geom_rug添加边际地毯：展示数据在每个数据轴上的分布
##存在的问题：纵轴的waiting重叠的很严重，下面添加扰动减小线宽减轻重叠
ggplot(faithful,aes(x=eruptions,y=waiting))+geom_point()+
geom_rug(position="jitter",size=0.2)#geom_rug添加参数是对边际的设置，线性更细，增加了扰动
ggplot(faithful,aes(x=eruptions,y=waiting))+geom_point()+
geom_rug(position=position_jitter(width=0.5,height=0.5),size=0.2)
##PS:扰动对于横纵坐标的值都有影响
#11、向散点图添加标签——annotate()函数、geom_text()函数
library(gcookbook)
subset(countries, Year==2009 & healthexp>2000)#subset用来选取符合条件的部分数据
sp=ggplot(subset(countries,Year==2009&healthexp>2000),aes(x=healthexp,y=infmortality))+
geom_point()#保存基本散点图对象
sp + annotate("text", x=4350, y=5.4, label="Canada") +
annotate("text", x=7400, y=6.8, label="USA")#手动添加注释
sp + geom_text(aes(label=Name), size=4)#按数据自动添加。geom_text()指示label，默认size是5
#此时，默认标注位置是将文本中心放在对应(x,y)坐标处。下面对位置进行调整
sp + geom_text(aes(label=Name), size=4, vjust=0)#vjust=0标签基线与数据点对齐
sp + geom_text(aes(y=infmortality+0.1, label=Name), size=4, vjust=0)#使y的取值增加0.1，用来调高标签位置
#geom_text里面y的值减小的话会降低标签位置
##其它可以调整位置方法：修改vjust
sp + geom_text(aes(label=Name), size=4, vjust=1)#vjust=1标签文本顶部与数据点对齐
sp + geom_text(aes(label=Name), size=4, vjust=2)#vjust=2的时候标签在点下面，比1的时候距离远
sp + geom_text(aes(label=Name), size=4, vjust=-2)#vjust=-2的时候标签在点上面，比1的时候距离远，有个点标签超出图形范围
sp + geom_text(aes(label=Name), size=4, hjust=0)#点与标签左对齐
sp + geom_text(aes(x=healthexp+100, label=Name), size=4, hjust=0)#先左对齐然后增加x的值，使距离远一点
sp + geom_text(aes(x=healthexp-100, label=Name), size=4, hjust=1)#先右对齐然后减少x的值，使距离远一点
#PS：这里在geom_text()里面增加减少x或是y只是改变标签的位置，不改变原始数据
cdat=subset(countries, Year==2009 & healthexp>2000)
cdat$Name1=cdat$Name#这两行创建副本
idx=cdat$Name1 %in% c("Canada", "Ireland", "United Kingdom", "United States",
"New Zealand", "Iceland", "Japan", "Luxembourg",
"Netherlands", "Switzerland")#%in%运算符：找出cdat$Name1里面属于后面的c()字符串的
##返回TRUE或是FALSE
idx#该逻辑向量用来指示标示哪些
cdat$Name1[!idx]=NA#把逻辑向量里面FALSE的改为NA，也就是不在输入的字符向量里面的记为NA
cda#这样对数据进行了修改，绘图时label里面NA的值不表示
ggplot(cdat, aes(x=healthexp, y=infmortality)) +
geom_point() +
geom_text(aes(x=healthexp+100, label=Name1), size=4, hjust=0)+
xlim(2000, 10000)#xlim()函数可以单独加，增加x范围使标签更美
#12、绘制气泡图——geom_point()+scale_size_area()
##并且令点的面积正比于变量值
library(gcookbook)
cdat=subset(countries, Year==2009 &Name %in% c("Canada", "Ireland", "United Kingdom", "United States",
"New Zealand", "Iceland", "Japan", "Luxembourg",
"Netherlands", "Switzerland"))#挑选数据
cdat#只有10条
p=ggplot(cdat, aes(x=healthexp, y=infmortality, size=GDP))+
geom_point(shape=21, colour="black", fill="cornsilk")#colour边框色，fill填充色
p#将GDP映射给大小size（对应点的半径），所以值增加一倍，点面积增加原来的4倍，这时无法直观理解图形
p + scale_size_area(max_size=15)#将gdp大小映射给点面积，仍然需要在geom_point把gdp映射给size，得到的气泡图就很直观比较gdp大小
#此时：气泡图实际是散点图
library(reshape2)
hec=HairEyeColor[,,"Male"] + HairEyeColor[,,"Female"]#该数据是两分类变量，每个有四种特性，数据显示为矩阵
hec=melt(hec,value.name="count")#reshape2里面的melt函数把矩阵hec按count转变为1列的长向量
ggplot(hec, aes(x=Eye, y=Hair)) +
geom_point(aes(size=count), shape=21, colour="black", fill="cornsilk") +
scale_size_area(max_size=20, guide=FALSE) +
geom_text(aes(y=as.numeric(Hair)-sqrt(count)/22, label=count), vjust=1,colour="grey60", size=4)
###1、geom_point对点设置颜色，映射count到size,此时显示为半径
###2、scale_size_area()的max_szie=20指示点面积反映count
###3、geom_text先vjust=1时标签与数据点y轴对应，然后对y做了变换使得标签正好在气泡的正下方
#13、绘制散点图矩阵——ggplot2不能绘制散点图矩阵，pairs()
#显示多变量两两关系
library(gcookbook)
c2009=subset(countries, Year==2009,select=c(Name, GDP, laborrate, healthexp, infmortality))
c2009
pairs(c2009[,2:5])#第一列是国家名字，不画
#自定义面板函数来展示变量间两两相关系数
panel.cor=function(x, y, digits=2, prefix="", cex.cor, ...)
{ usr=par("usr")
on.exit(par(usr))
par(usr = c(0, 1, 0, 1))
r=abs(cor(x, y, use="complete.obs"))
txt=format(c(r, 0.123456789), digits=digits)[1]
txt=paste(prefix, txt, sep="")
if(missing(cex.cor)) cex.cor=0.8/strwidth(txt)
text(0.5, 0.5, txt, cex = cex.cor * (1 + r) / 2)
}
#定义函数为了在面板的对角线上显示各变量的直方图
panel.hist <- function(x, ...) {
usr <- par("usr")
on.exit(par(usr))
par(usr = c(usr[1:2], 0, 1.5) )
h <- hist(x, plot = FALSE)
breaks <- h$breaks
nB <- length(breaks)
y <- h$counts
y <- y/max(y)
rect(breaks[-nB], 0, breaks[-1], y, col="white", ...)
}
pairs(c2009[,2:5], upper.panel = panel.cor,diag.panel = panel.hist,lower.panel = panel.smooth)
#调用前面的两个函数，在散点图矩阵中添加相关系数，直方图；lower.panel执行panel.smooth()函数，添加lowess平滑曲线
#自定义函数为了添加lm曲线(pairs里面没有panel.lm)
panel.lm=function (x, y, col = par("col"), bg = NA, pch = par("pch"),
cex = 1, col.smooth = "black", ...) {
points(x, y, pch = pch, col = col, bg = bg, cex = cex)
abline(stats::lm(y ~ x), col = col.smooth, ...)
}
pairs(c2009[,2:5], pch=".",
upper.panel = panel.cor,
diag.panel = panel.hist,
lower.panel = panel.lm)