R语言数据可视化教程（ggplot2）_绘制散点图

# 5.散点图
# 散点图通常用来刻画两个连续型变量之间的关系
# 5.1 绘制散点图
# 运行geom_point()函数，分别映射一个变量到x和y
library(gcookbook)
library(ggplot2)
# 列出用到的列
heightweight[,c("ageYear","heightIn")]
ggplot(heightweight,aes(x=ageYear,y=heightIn))+geom_point()
# 通过设定点型（shape）参数可以在散点图中绘制默认值以外的点型。
ggplot(heightweight,aes(x=ageYear,y=heightIn))+geom_point(shape=21)
# 大小（size)参数可以控制图中点的大小。系统默认的大小（size)值等于2
ggplot(heightweight,aes(x=ageYear,y=heightIn))+geom_point(size=1.5)
# 5.2 使用点形和颜色属性，并基于某变量对数据进行分组
# 将分组变量映射给点形（shape)和颜色（colours)属性。
library(gcookbook)
heightweight[,c("sex","ageYear","heightIn")]
ggplot(heightweight,aes(x=ageYear,y=heightIn,colour=sex))+geom_point()
ggplot(heightweight,aes(x=ageYear,y=heightIn,shape=sex))+geom_point()
# 分组变量必须是分类变量，换言之，它必须是因子型或者字符串型的向量。如果分组变量以数值型变量进行存储
# ，则需要将它转化为因子型变量之后，才能以其作为分组变量
# 可以将一个变量同时映射给shape和colour属性。当有多个分组变量时可以将它们分别映射给这两个图形属性
ggplot(heightweight,aes(x=ageYear,y=heightIn,shape=sex,colour=sex))+geom_point()
# 通过调用scale_shape_manual()函数可以使用其他点形；调用scale_colour_brewer()或者scale_colour_manual()函数可以使用其他调色板
ggplot(heightweight,aes(x=ageYear,y=heightIn,shape=sex,colour=sex))+geom_point()+scale_shape_manual(values = c(1,2))+scale_color_brewer(palette = "Set1")


# 5.3 使用不同于默认设置的点形
# 通过指定geom_point()函数的点形（shape)参数可以设定散点图中所有数据点的点形
library(gcookbook)
ggplot(heightweight,aes(x=ageYear,y=heightIn))+geom_point(shape=3)
# 如果已将分组变量映射给shape,则可以调用scale_shape_manual()函数来修改点形
# 使用略大且自定义点形的数据点
ggplot(heightweight,aes(x=ageYear,y=heightIn,shape=sex))+geom_point(size=3)+scale_shape_manual(values = c(1,4))
# 生成一个数据副本
hw <- heightweight
# 将数据按照是否大于100磅分为两组
hw$weightGroup <- cut(hw$weightLb,breaks = c(-Inf,100,Inf),labels = c("< 100",">=100"))
# 使用具有颜色和填充色的点形及对应于空值（NA)和填充色的颜色
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.aes = list(shape=21)))


# 5.4 将连续型变量映射到点的颜色或大小属性上
library(gcookbook)
# 列出要用到的四列
heightweight[,c("sex","ageYear","heightIn","weightLb")]
ggplot(heightweight,aes(x=ageYear,y=heightIn,colour=weightLb))+geom_point()
ggplot(heightweight,aes(x=ageYear,y=heightIn,size=weightLb))+geom_point()


# 基本散点图通过将两个连续型变量分别映射给x轴和y轴来刻画它们之间的关系，当变量超过两个时，必须将它们映射到其他图形属性上
# 只有当一个变量不需要高精度的解释时，它才适合被映射给图形的大小和颜色属性


# 当将变量映射给大小（size)属性时，绘制的图形结果常常具有误导性。默认情况下，点的大小为1~6ms。
# 运行scale_size_continuous(range=c(2,5))可以将其修改为2~5ms


# 对于颜色，实际上有两个相关的图形属性可以使用，即colour和fill。
ggplot(heightweight,aes(x=ageYear,y=heightIn,fill=weightLb))+geom_point(shape=21,size=2.5)+scale_fill_gradient(low="black",high = "white")
# 使用guide_legend()函数以离散的图例代替色阶
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())
# 当我们把一个连续型变量映射给某个图形属性之后，这并不会妨碍我们同时将分类变量映射给其他图形属性
ggplot(heightweight,aes(x=ageYear,y=heightIn,colour=sex))+geom_point(alpha=.5)+scale_size_area()+scale_colour_brewer(palette = "Set1")
# 将某个变量映射给size属性时，最好避免将其他变量映射给shape属性。因为不同点形的点大小很难相互比较


# 处理图形重叠
# 如果图形的重叠程度较低，可以通过使用较小的数据点或者使用不会遮盖其他数据点的点形来避免数据重叠
# 如果图形的重叠程度较高，下面是一系列可行的解决方案：
# ## （1）使用半透明的点；
# ## （2）将数据分箱（bin)，并用矩形表示（适用于量化分析）；
# ## （3）将数据分箱（bin)，并用六边形表示；
# ## （4）使用箱线图
sp <- ggplot(diamonds,aes(x=carat,y=price))
sp + geom_point()


# 设定alpha参数可以使数据点半透明。通过设定alpha=.1和alpha=.01使数据点分别具有90%和99%的透明点
sp + geom_point(alpha=.1)
sp + geom_point(alpha=.01)


# 默认情况下，stat_bin_2d()函数分别在x轴和y轴方向上将数据分割为30个组，总计900个箱子
# 通过scale_fill_grandient()重新设定数据点的颜色，并指定颜色的最小色阶low和最大色阶high。
# 默认情况下，图例中不包括最小值，这是应为颜色标度的氛围不是从0开始的，而是以各箱中的最小非零值为起始点的。
# 如果想在图例中包括零值，可以调用limits参数手动将范围设定为0到最大值6000
sp + stat_bin2d()
sp + stat_bin2d(bins = 50)+scale_fill_gradient(low = "lightblue",high = "red",limits=c(0,6000))


# 如果不想以数据分箱并以矩形表示的话，可以调用stat_binhex()函数使用六边形代替。
# 使用函数之前，必须先运行install.packages("hexbin")命令安装hexbin包
install.packages("hexbin")
library(hexbin)
sp + stat_binhex()+scale_fill_gradient(low = "lightblue",high = "red",limits=c(0,8000))
sp + stat_binhex()+scale_fill_gradient(low = "lightblue",high = "red",breaks=c(0,250,500,1000,2000,4000,6000),limits=c(0,6000))


# 当散点图的其中一个数据轴或者两个数据轴都对应于离散型数据时，也会出现图形重叠的情况，可以调用position_jitter()函数给数据点增加随机扰动，默认情况下，该函数在每个方向上添加的扰动值为数据点最小精度的40%
sp1 <- ggplot(ChickWeight,aes(x=Time,y=weight))
sp1 + geom_point()
sp1 + geom_point(position = "jitter")
sp1 + geom_point(position = position_jitter(width = .5,height = 0))


# 当数据集对应于一个离散型数据轴和一个连续型数据轴时，箱线图可能是一种较好的展示方式
sp1 + geom_boxplot(aes(group=Time))


# 5.6 添加回归模型拟合线
# 运行stat_smooth()函数并设定method=lm即可向散点图中添加线性回归拟合线，这将调用lm()函数对数据拟合线性模型。
# 首先，将基本绘图对象存储在对象sp中，然后，再添加更过的图形部件：
library(gcookbook)
# 基本绘制对象
sp <- ggplot(heightweight,aes(x=ageYear,y=heightIn))
sp + geom_point()+stat_smooth(method = lm)
# 默认情况下，stat_smooth()函数会为回归拟合线添加95%的置信区间，置信域对应的置信水平可通过设置level参数来调整。
# 设置参数se=FALSE时，系统将不会对回归拟合线添加置信域
# 99%置信域
sp+geom_point()+stat_smooth(method = lm,level = 0.99)
# 没有置信域
sp+ geom_point()+stat_smooth(method = lm,se=FALSE)
# 拟合线的默认颜色是蓝色，可以通过设定colour参数对其进行调整。
sp + geom_point(colour="grey60")+stat_smooth(method = lm,se=FALSE,colour="black")
# 线性模型并不是唯一可对数据进行拟合的模型，事实上，它甚至不是默认的模型，如果在调用stat_smooth()函数时未指定模型类型，那么，该函数会对数据拟合loess曲线（局部加权多项式)。
sp +geom_point(colour="grey60")+stat_smooth()
sp +geom_point(colour="grey60")+stat_smooth(method = loess)


# 另一种常用的模型是Logistic回归
library(MASS)
b <- biopsy
b$classn[b$class=="benign"] <- 0
b$classn[b$class=="malignant"] <- 1
b
# stat_smooth()函数使用选项family=binomial的glm()函数向散点图添加Logistic回归拟合线
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(method = glm,family = binomial)
sps <- ggplot(heightweight,aes(x=ageYear,y=heightIn,colour=sex))+geom_point()+scale_color_brewer(palette = "Set1")
sps + geom_smooth()
# 默认情况下，stat_smooth函数将预测值的范围限定在预测数据对应的范围内（对应于x轴）；第二个原因在于，即使对模型进行外推，loess()函数也只能根据整组数据对应的x轴的范围进行预测
# 如果想基于数据集对拟合线进行外推，必须保证绘图过程中能够调用的是支持外推的模型，如lm()，并将选项fullrange=TRUE传递给stat_smooth()函数
sps + geom_smooth(method = lm,se=FALSE,fullrange=TRUE)
# 5.7根据已有模型向散点图添加拟合线
# 常用的向散点图添加模型拟合线的方法是调用stat_smooth()函数。
library(gcookbook)
model <- lm(heightIn ~ ageYear+I(ageYear^2),heightweight)
model
# 创建一个包含变量ageYear的列，并对其进行插值
xmin <- min(heightweight$ageYear)
xmax <- max(heightweight$ageYear)
predicted <- data.frame(ageYear = seq(xmin,xmax,length.out = 100))
# 计算变量heightIn的预测值
predicted$heightIn <- predict(model,predicted)
predicted


sp <- ggplot(heightweight,aes(x=ageYear,y=heightIn))+geom_point(colour="grey60")
sp+geom_line(data=predicted,size=1)
# 无论哪种模型，只要有对应的predict()方法，则其都可以用来绘制拟合线
# lm()函数和loess()函数对应的predict()方法分别是predict.lm()和predict.loess()等
# 下面定义的predictvals()函数可以简化向散点图添加模型拟合线的过程


# 根据模型和变量xvar预测变量yvar
# 仅支持单一预测变量的模型
# xrange：x轴范围，当值为NULL时，等于模型对象中提取的x轴范围；当设定为包含两个数字的向量时，两个数字分别对应于x轴范围的上下线
# sample:x轴上包含的样本数量
# ...:可传递给predict()函数的其他参数
predictvals <- function(model,xvar,yvar,xrange=NULL,samples=100,...){
  # 如果xrange没有输入，则从模型对象中自动提取x轴范围作为参数
  # 提取xrange参数的方法视模型而定
  if(is.null(xrange)){
    if(any(class(model)%in% c("lm","glm")))
      xrange <- range(model$model[[xvar]])
    else if(any(class(model)%in% "loess"))
      xrange <- range(model$x)
  }
  newdata <- data.frame(x=seq(xrange[1],xrange[2],length.out = samples))
  names(newdata) <- xvar
  newdata[[yvar]] <- predict(model,newdata = newdata,...)
  newdata
}


# 调用lm()函数和loess()函数对数据集建立线性模型和LOESS模型
modlinear <- lm(heightIn ~ ageYear,heightweight)
modloess <- loess(heightIn ~ageYear,heightweight)
# 分别调用predictvals()函数，将得到的结果（数据框）传递给geom_line（）
lm_predicted <- predictvals(modlinear,"ageYear","heightIn")
loess_predicted <- predictvals(modloess,"ageYear","heightIn")
sp+geom_line(data = lm_predicted,colour="red",size=.8)+geom_line(data=loess_predicted,colour="blue",size=.8)


library(MASS)
b <- biopsy
b$classn[b$class=="benign"] <- 0
b$classn[b$class=="maligant"] <- 1
# 建立Logistic回归模型
fitlogistic <- glm(classn ~ V1,b,family = binomial)
# 获取预测值
glm_predicted <- predictvals(fitlogistic,"V1","classn",type="response")
ggplot(b,aes(x=V1,y=classn))+geom_point(position = position_jitter(width = .3,height = .08),alpha=0.4,shape=21,size=1.5)+geom_line(data=glm_predicted,colour="#1177ff",size=1)


# 5.8 添加来自多个模型的拟合线
# 使用之前提到的predictva()函数和来自plyr包的dlply()和ldply()函数
# 定义函数建立模型
make_model <- function(data){
  lm(heightIn~ ageYear, data)
}
# 根据变量sex的水平对heightweight数据集进行分组，调用lm()函数对每组数据分别建立线性模型，并将模型结果放在一个列表内。
# 调用建模函数，向其输入一个数据框作为参数，该函数会返回一个lm对象
# 调用dlply()函数分别对数据集的每个子集建立模型。
library(gcookbook)
library(plyr)
library(ggplot2)
models <- dlply(heightweight,"sex",fun=make_model)
# 打印出两个lm对象f和m组成的列表
models
# 得到模型对象后，使用ldply()函数和predictvals()函数即可获得两个模型对应的预测值
predvals <- ldply(models,fun=predictvals,xvar="ageYear",yvar="heightIn")
predvals
# 绘制带预测值得散点图
ggplot(heightweight,aes(x=ageYear,y=heightIn,colour=sex))+geom_point()+geom_line(data=predvals)


# dlply()函数和ldply()函数的作用是切分数据，对各个部分执行某一函数，并对执行结果进行重组
# 为了使两组预测线对应的x轴范围与整个数据集对应的x轴范围相同，可以向其传入一个xrange参数
predvals <- ldply(models,.fun = predictvals,xvar="ageYear",yvar="heightIn",xrange=range(heightweight$ageYear))
# Error in UseMethod("predict") : no applicable method for 'predict' applied to an object of class "data.frame"
ggplot(heightweight,aes(x=ageYear,y=heightIn,colour=sex))+geom_point()+geom_line(data=predvals)


# 5.9 向散点图添加模型系数
library(gcookbook)
model <- lm(heightIn~ageYear,heightweight)
summary(model)
# 其中r^2的值是0.4249，创建一个图形，调用annotate()函数向其手动添加文本
# 首先，生成预测值
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)
# 如果不想使用纯文本字符串来当注释的话，可以通过设置parse=TRUE调用R的数学表达式语法来输入公式
sp + annotate("text",label="r^2 ==0.42",parse=TRUE,x=16.5,y=52)


# ggplot2中的文本对象不能直接以表达式对象作为输入，其参数通常是一个字符串，接收字符串后，通过parse(text="a+b")函数将其转化为公式
# 使用数学公式作为注释，必须使用正确的语法才能保证系统输出一个合法的R表达式对象。
# 把公式封装在expression()内部，检验其输出结果可以辅助判断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)))))
eqn
parse(text = eqn) # 解析并返回一个表达式
# 将表达式添加到图形上
# 设置x=Inf和y=-Inf将公式放置于图形的右下角，同时对其位置进行上下和左右调整，使其位于绘图区域内
sp + annotate("text",label=eqn,parse=TRUE,x=Inf,y=-Inf,hjust=1.1,vjust=-.5)


# 5.10 向散点图添加边际地毯
# 调用geom_rug()函数即可
ggplot(faithful,aes(x=eruptions,y=waiting))+geom_point()+geom_rug()
# 边际地毯本质上是一个一维的散点图，它可被用于展示每个坐标轴上数据的分布情况
ggplot(faithful,aes(x=eruptions,y=waiting))+geom_point()+geom_rug(position = "jitter",size=.2)


# 5.11 向散点图添加标签
# 调用annotate()函数或者geom_text()函数可以为一个或几个数据点添加标签。
library(gcookbook)
subset(countries,Year==2009 & healthexp > 2000)
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")


# 要根据数据集自动向散点图添加数据标签，可以使用geom_text()函数。此时，只需要映射一个因子型或者字符串型的向量给标签（label)属性。
# 默认的标签size属性为5，这个数值并不与字号直接对应
sp + geom_text(aes(label=Name),size=4)
# 系统自动放置注释时会将其中心置于x坐标和y坐标的位置。
# 设定vjust=0时，标签文本的极限会与数据点对齐；设定vjust=1时，标签文本的顶部会与数据点对齐。
# 还可以通过增加或减少vjust参数的值来调高或者调低文本标签的位置；也可以通过对y的映射增加或减少一个值得到相同的效果
sp +geom_text(aes(label=Name),size=4,vjust=0)
# 增加一些y的属性
sp +geom_text(aes(y=infmortality+.1,label=Name),size=4,vjust=0)
# 有时候，有必要根据数据点的位置令注释左对齐或右对齐，要左对齐，可设置hjust=0;要右对齐，可设定hjust=1.
# 最好将hjust设定为0或者1,然后，通过对x增加或者减少一个值来调整文本标签的位置
sp + geom_text(aes(label=Name),size=4,hjust=0)
sp+geom_text(aes(x=healthexp+100,label=Name),size=4,hjust=0)
# 如果绘图时用的是对数坐标轴，要想将文本标签移动同样的位置，就不能通过增加x或y的数值来实现了。此时需要令x或者y乘以一个数值才行
# 如果只想给为数不多的几个点添加标签，但希望R自动设定标签位置的话，可以给数据框增加一个只包含拟使用的标签的新列。
cdat <- subset(countries,Year==2009&healthexp >2000)
cdat$Name1 <- cdat$Name
# 使用%in%运算符找出绘图时希望保有的标签所处的位置。
idx <- cdat$Name1 %in% c("Canada","Ireland","United Kingdom","United States","New Zealand","Iceland","Japan","Luxembourg","Netherlands","Switzerland")
idx
cdat$Name1[!idx] <- NA
cdat
ggplot(cdat,aes(x=healthexp,y=infmortality))+geom_point()+geom_text(aes(x=healthexp+100,label=Name1),size=4,hjust=0)+xlim(2000,10000)
# 如果一些个别的位置需要调整，有两个选择：
# 一是复制x轴坐标和y轴坐标对应的列，修改它们的数值并以此调整文本的位置。当然，绘制数据点所用的坐标必须是原始的数值
# 二是把图形输出为矢量格式，比如PDF或者SVG，再用Illustrator或者Inkscape软件对其进行编辑


# 5.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
p <- ggplot(cdat,aes(x=healthexp,y=infmortality,size=GDP))+geom_point(shape=21,colour="black",fill="cornsilk")
# 将GDP映射给半径（scale_size_continuous的默认值）
p
# 将GDP映射给面积，得到一个略大的圆圈
p+scale_size_area(max_size = 15)
# 当x轴和y轴皆为分类变量时，气泡图可以用来表示网格点上的变量值
# 对男性组合女性组求和
hec <- HairEyeColor[,,"Male"]+HairEyeColor[,,"Female"]
# 转化为长格式(long format)
library(reshape2)
hec <- melt(hec,value.name = "count")
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)
# 首先，设定vjust=1，将文本标签顶端与数据点的y轴对应。接下来，调整y坐标，使其刚好位于每个圆圈的底部。


# 5.13 绘制散点图矩阵
# 散点图矩阵是一种对多个变量两两之间关系进行可视化的有效方法。调用R基础绘图系统中的pairs()函数可以绘制散点图矩阵
library(gcookbook)
c2009 <- subset(countries,Year==2009,select = c(Name,GDP,laborrate,healthexp,infmortality))
c2009
pairs(c2009[,2:5])
# 使用自定义的面板函数
# 定义panel.cor()函数来展示变量两两之间的相关系数以代替默认的散点图。
# 相关系数较大的位置将对应于较大的字体
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函数，在面板的对角线上展示各个变量的直方图
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()函数在面板上三角执行panel.cor函数，在面板的对角线执行panel.hist函数
# 在面板的下三角执行panel.smooth函数，该函数将在散点图矩阵的下三角绘制散点图，并添加一个LOWESS平滑曲线
pairs(c2009[,2:5],upper.panel = panel.cor,diag.panel = panel.hist,lower.panel = panel.smooth)


# 用线性模型代替LOWESS模型
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)
# 调用函数pairs()时，设定col.smooth参数可以对线条颜色进行修改
# cex参数可以控制图中点的大小，cex的参数的默认值是1，其值越大，相应的数据点也越大，反之亦然。如果参数cex小于0.5，图形输出为PDF文件时可能无法很好地渲染

# GGally包中的ggpairs()函数也可以绘制散点图矩阵.