散点图及数据分布情况

🐶第五章 散点图
5.1 绘制基本散点图
5.2 使用点形或颜色属性对数据点进行分组
5.3 使用不同于默认设置的点形
5.4 将连续变量映射到点的颜色或大小属性上
5.5 处理图形重叠问题
5.6 添加回归模型拟合线
5.7 根据已有模型向散点图添加拟合线
5.8 添加来自多个已有模型的拟合线
5.9 向散点图添加模型系数
5.10 向散点图添加边际地毯
5.11 向散点图添加标签
5.12 绘制气泡图
5.13 绘制散点图矩阵
🐕第六章描述数据分布
6.1 绘制基本直方图
6.2 基于分组数据绘制多组直方图
6.3 绘制密度曲线
6.4 基于分组数据绘制多组密度曲线
6.5 绘制频数分布折线图
6.6 绘制基本箱型图
6.7 向箱型图添加槽口
6.8 向箱型图中添加均值
6.9 绘制小提琴图
6.10 绘制点图
6.11 基于分组数据绘制多个点图
6.12 绘制二维数据的密度图 

heightweight %>% select(ageYear,heightIn)#heightweight数据包含学龄儿童的身高体重
 ageYear heightIn
1     11.92     56.3
2     12.92     62.3
3     12.75     63.3
4     13.42     59.0
5     15.92     62.5
6     14.25     62.5

ggplot(heightweight,aes(x=ageYear,y=heightIn))+geom_point()

gplot(heightweight,aes(x=ageYear,y=heightIn))+
  geom_point(shape=21)#shape改变点形（空心圆）
ggplot(heightweight,aes(x=ageYear,y=heightIn))+
  geom_point(size=1.5)#size改变点大小

heightweight %>% select(sex,ageYear,heightIn)#使用性别分组
ggplot(heightweight,aes(x=ageYear,y=heightIn,shape=sex))+geom_point()#映射到shape
ggplot(heightweight,aes(x=ageYear,y=heightIn,colour=sex))+geom_point()#映射到colour
ggplot(heightweight,aes(x=ageYear,y=heightIn,colour=sex,shape=sex))+geom_point()#同时映射shape+colour
ggplot(heightweight,aes(x=ageYear,y=heightIn,colour=sex,shape=sex))+#手动调节美化
  geom_point()+
  scale_shape_manual(values = c(1:2))+
  scale_colour_brewer(palette = 'Set1')

#通过geom_point()的shape参数同时设定散点图中所有数据点的点形
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))

#在heightweight中增加一列用来表示儿童的体重是否超过100磅
hw <- heightweight %>% 
  mutate(weightgroup=ifelse(weightLb<100,'<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)))

heightweight %>% select(sex,ageYear,heightIn,weightLb)#导入新的变量weightLb         
ggplot(heightweight,aes(x=ageYear,y=heightIn,colour=weightLb))+
  geom_point()#通过colour表示第三个连续变量WeightLb
ggplot(heightweight,aes(x=ageYear,y=heightIn,size=weightLb))+
  geom_point()#通过size表示第三个连续变量WeightLb

range(heightweight$weightLb)
[1]  50.5 171.5
size_range <- range(heightweight$weightLb)/max(heightweight$weightLb)*6#查看范围
[1] 1.766764 6.000000
ggplot(heightweight,aes(x=ageYear,y=heightIn,size=weightLb))+#映射到点的直径
  geom_point()+
  scale_size_continuous(range=size_range)
ggplot(heightweight,aes(x=ageYear,y=heightIn,size=weightLb))+#映射到点的面积
  geom_point()+
  scale_size_area()

#巧用填充色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,size=weightLb,colour=sex))+
  geom_point(aes(alpha=0.5))+
  scale_size_area()+
  scale_color_brewer(palette = 'Set1')

#法一：半透明的数据点
diamonds_sp <- ggplot(diamonds,aes(x=carat,y=price))
diamonds_sp+geom_point(alpha=.1)#透明度为90%
diamonds_sp+geom_point(alpha=.01)#透明度为99%

#法二：将数据点分箱bin，并以矩形来表示，同时将数据点密度映射到矩形的填充色
diamonds_sp+stat_bin2d()
diamonds_sp+stat_bin2d(bins=50)+#将箱数增加到50（即每个像素块更小啦）
  scale_fill_gradient(low='lightblue',high='red',limits=c(0,6000))
#因此可以明显的看出左下角的密度点更大，所以大多数钻石又小又便宜（确实）

#法三：调用stat_binhex()函数用六边形代替，首先要加载hexbin包
library(hexbin)
diamonds_sp+stat_binhex()+
  scale_fill_gradient(low='lightblue',high='red',limits=c(0,8000))
diamonds_sp+stat_binhex()+
  scale_fill_gradient(low='lightblue',high='red',limits=c(0,5000))
#注意到当改变了count的范围后，范围以外的部分以灰黑色的方块出现了

#法四：当散点图的一个数据轴或者两个数据轴对应的离散型变量的时候会产生数据重叠
#此时调用position_jitter函数给数据点增加随机扰动。默认情况下每个方向添加的扰动值为数据点精度的40%
#也可以通过time和weight进行调整
#使用ChickenWeight数据集，讲述不同饮食对小鸡成长的影响
cw_sp <- ggplot(ChickWeight,aes(x=Time,y=weight))
   weight Time Chick Diet
1       42    0     1    1
2       51    2     1    1
3       59    4     1    1
4       64    6     1    1
5       76    8     1    1
6       93   10     1    1
cw_sp+geom_point()
cw_sp+geom_point(position='jitter')#等同于geom_jitter()函数
cw_sp+geom_point(position=position_jitter(width = 5,height = 0))

#比如上面的数据集，我们希望把time设置为一个离散的变量，但是time却被默认为数值型变量，因此要告诉ggplot进行分组。
cw_sp+geom_boxplot(aes(group=Time))#分组时间
cw_sp+geom_boxplot()#不分组

hw_sp <- ggplot(heightweight,aes(x=ageYear,y=heightIn))#绘图对象
hw_sp+geom_point()+stat_smooth(method = lm)#使用线性回归
hw_sp+geom_point()+stat_smooth(method = lm,level = 0.99)#置信区间为0.99
hw_sp+geom_point()+stat_smooth(method = lm,se=F)#不显示置信区间
hw_sp+geom_point(colour='grey60')+stat_smooth(method = lm,se=F,colour='black')#改变点和回归线的颜色

##1.LOESS（https://www.keyangou.com/topic/1090）
#LOESS模型是r默认的回归模型
hw_sp+geom_point(colour='grey60')+stat_smooth()
hw_sp+geom_point(colour='grey60')+stat_smooth(method = loess,method.args = list(degree=1))
#这里还可以设置回归的其他参数，比如说这里设置回归阶数为1

##2.Logistic回归
#这里我们使用MASS包的biopsy数据集，该数据集介绍了9个乳腺癌的相关信息
library(MASS)
biopsy_mod <-  biopsy %>% mutate(classn=recode(class,benign=0,malignant=1))#benign设置为0，malignant设置为1
       ID V1 V2 V3 V4 V5 V6 V7 V8 V9     class classn
1  1000025  5  1  1  1  2  1  3  1  1    benign      0
2  1002945  5  4  4  5  7 10  3  2  1    benign      0
3  1015425  3  1  1  1  2  2  3  1  1    benign      0
4  1016277  6  8  8  1  3  4  3  7  1    benign      0
5  1017023  4  1  1  3  2  1  3  1  1    benign      0
6  1017122  8 10 10  8  7 10  9  7  1 malignant      1
ggplot(biopsy_mod,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,method.args = list(family=binomial))#使用广义线性回归模型

#添加分组
hw_sp <- ggplot(heightweight,aes(x=ageYear,y=heightIn,colour=sex))+
  geom_point()+
  scale_colour_brewer(palette = 'Set1')+
  geom_smooth()
#这里发现蓝色拟合线没有绘制到图形的右边界，这是因为：
#1.stat_smooth()函数将预测值的范围限定在预测数据对那个范围内
#2.即使对模型进行外推，loess函数也只能根据整组数据对应的x轴的范围进行预测
> range(heightweight[heightweight$sex=='f',]$heightIn)
[1] 51.3 66.8
> range(heightweight[heightweight$sex=='m',]$heightIn)
[1] 50.5 72.0
#这里我们必须保证使用的是可以外推的函数，如lm,并将参数设置fullrange=T
ggplot(heightweight,aes(x=ageYear,y=heightIn,colour=sex))+
  geom_point()+
  scale_colour_brewer(palette = 'Set1')+
  geom_smooth(method=lm,se=F,fullrange=T)

#使用lm()建立一个二次模型
model <- lm(heightIn ~ ageYear + I(ageYear^2), heightweight)
model
#> 
#> Call:
#> lm(formula = heightIn ~ ageYear + I(ageYear^2), data = heightweight)
#> 
#> Coefficients:
#>  (Intercept)       ageYear  I(ageYear^2)  
#>     -10.3136        8.6673       -0.2478

# 创建一个包含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
#>     ageYear heightIn
#> 1   11.5800 56.82624
#> 2   11.6398 57.00047
#> 3   11.6996 57.17294
#>  ...<94 more rows>...
#> 98  17.3804 65.47641
#> 99  17.4402 65.47875
#> 100 17.5000 65.47933
#现在创建一个hw_sp的基本图
hw_sp <- ggplot(heightweight, aes(x = ageYear, y = heightIn)) +
    geom_point(colour = "grey40")

hw_sp +
  geom_line(data = predicted, size = 1)

#作者建立了一个predictval（）函数
# 根据模型和变量xvar预测yvar，仅支持单一预测变量和预测值
# xrange:x轴范围，当值为NULL的时候，等于模型对象中提取的x轴范围。当设定为包含两个数值的向量时
#两个数值分别对应于x轴范围的上下限.
# samples: x轴上包含的样本量
# ...: 更多参数
predictvals <- function(model, xvar, yvar, xrange = NULL, samples = 100, ...) {
  
  #如果xrange没有输入，则从模型对象中自动提取x轴范围作为参数
  # 提取xrange的方法视模型而定
  if (is.null(xrange)) {#如果xrange为null
    if (any(class(model) %in% c("lm", "glm")))#如果属于lm或者glm
      xrange <- range(model$model[[xvar]])#那么xrange是x轴的范围
    else if (any(class(model) %in% "loess"))#如果是loess
      xrange <- range(model$x)#那么输入的是x值
  }
  
  newdata <- data.frame(x = seq(xrange[1], xrange[2], length.out = samples))
  names(newdata) <- xvar
  #xvar的意义就是以样本数为间隔数的x轴范围的等差序列
  newdata[[yvar]] <- predict(model, newdata = newdata, ...)
  newdata
  #yvar就是对上述等差数列的预测值
}
#在这里，分别调用lm（）以及loess()建立模型
modlinear <- lm(heightIn ~ ageYear, heightweight)
modloess  <- loess(heightIn ~ ageYear, heightweight)
lm_predicted    <- predictvals(modlinear, "ageYear", "heightIn")
loess_predicted <- predictvals(modloess, "ageYear", "heightIn")
hw_sp +
  geom_line(data = lm_predicted, colour = "red", size = .8) +
  geom_line(data = loess_predicted, colour = "blue", size = .8)#上右侧图

#对于类似于glm模型一样的非线性模型，需要将predictvals函数的type=‘response’,这样使得
#默认情况下glm返回的预测结果是基于线型选项，而不是基于响应变量y的

#以下MASS包中的biopsy为例
biopsy_mod <- biopsy %>%
  mutate(classn = recode(class, benign = 0, malignant = 1))
#通过classn将benign=0，malignant=1
fitlogistic <- glm(classn ~ V1, biopsy_mod, family = binomial)#建模
glm_predicted <- predictvals(fitlogistic, "V1", "classn", type = "response")#获得预测值

ggplot(biopsy_mod, 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)#将线条设置为蓝色，并设置size加宽

library(dplyr)
# 依然是heightweight数据集，通过性别分成男女两组，分别使用数据集的内容对身高年龄做拟合，分别得到拟合结果
models <- heightweight %>%
  group_by(sex) %>%
  do(model = lm(heightIn ~ ageYear, .)) %>%
  ungroup()

# 输出数据框
models
#> # A tibble: 2 × 2
#>   sex   model 
#>   <fct> <list>
#> 1 f     <lm>  
#> 2 m     <lm>

# 输出数据框的模型列
models$model
#> [[1]]
#> 
#> Call:
#> lm(formula = heightIn ~ ageYear, data = .)
#> 
#> Coefficients:
#> (Intercept)      ageYear  
#>      43.963        1.209  
#> 
#> 
#> [[2]]
#> 
#> Call:
#> lm(formula = heightIn ~ ageYear, data = .)
#> 
#> Coefficients:
#> (Intercept)      ageYear  
#>      30.658        2.301

predvals <- models %>%
  group_by(sex) %>%
  do(predictvals(.$model[[1]], xvar = "ageYear", yvar = "heightIn"))#分开获得两种性别的预测值
ggplot(heightweight, aes(x = ageYear, y = heightIn, colour = sex)) +
  geom_point() +
  geom_line(data = predvals)#使用颜色区分

ggplot(heightweight, aes(x = ageYear, y = heightIn)) +
  geom_point() +
  geom_line(data = predvals) +
  facet_grid(. ~ sex)#使用分面

#和之前一样，我们发现女性的年龄范围比男性的要更长
#因此我们传递xrange函数让两组预测线对应的x轴范围一致
predvals <- models %>%
  group_by(sex) %>%
  do(predictvals(
    .$model[[1]],
    xvar = "ageYear",
    yvar = "heightIn",
    xrange = range(heightweight$ageYear))#设置了整体的xrange
  )

ggplot(heightweight, aes(x = ageYear, y = heightIn, colour = sex)) +
  geom_point() +
  geom_line(data = predvals)#好了，现在男女的x轴范围是一样的了

model <- lm(heightIn ~ ageYear, heightweight)
summary(model)

Call:
lm(formula = heightIn ~ ageYear, data = heightweight)

Residuals:
    Min      1Q  Median      3Q     Max 
-8.3517 -1.9006  0.1378  1.9071  8.3371 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  37.4356     1.8281   20.48   <2e-16 ***
ageYear       1.7483     0.1329   13.15   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 2.989 on 234 degrees of freedom
Multiple R-squared:  0.4249,	Adjusted R-squared:  0.4225 
F-statistic: 172.9 on 1 and 234 DF,  p-value: < 2.2e-16
#可以看出矫正后的R方值为0.4225
#创建预测值
pred <- predictvals(model, "ageYear", "heightIn")

# 建立底图
hw_sp <- ggplot(heightweight, aes(x = ageYear, y = heightIn)) +
    geom_point() +
    geom_line(data = pred)
#通过annotate输入r方值
hw_sp +
  annotate("text", x = 16.5, y = 52, label = "r^2=0.42")#这里是文本
#如果不想用文本想用公式，调用parse=T
hw_sp +
  annotate("text", x = 16.5, y = 52, label = "r^2==0.42"，parse=T)#这里是数学公式

expression(r^2 == 0.42) # 行
expression(r^2 = 0.42)  # 报错，不行
#除此之外还能自动提取模型对象的值创建一个引用这些值的表达式
#使用sprintf()函数创立字符串，%.3g， %.2g替换为三位和两位有效小数
eqn <- sprintf(
    "italic(y) == %.3g + %.3g * italic(x) * ',' ~~ italic(r)^2 ~ '=' ~ %.2g",
    coef(model)[1],
    coef(model)[2],
    summary(model)$r.squared
  )
eqn
> [1] "italic(y) == 37.4 + 1.75 * italic(x) * ',' ~~ italic(r)^2 ~ '=' ~ 0.42"

# 使用parse()查看是否成立
parse(text = eqn)
expression(italic(y) == 37.4 + 1.75 * italic(x) * "," ~ ~italic(r)^2 ~ 
     "=" ~ 0.42)
#现在就可以把它添加到图片上了
hw_sp +
  annotate(
    "text",
    x = Inf, y = -Inf,#置于图形的右下角
    label = eqn, parse = TRUE,
    hjust = 1.1, vjust = -.5#对位置进行上下左右的调整
  )

#调用faithful函数，其记载了黄石公园一喷泉的喷水时长和等待喷水的时常
faithful
eruptions waiting
1       3.600      79
2       1.800      54
3       3.333      74
4       2.283      62
5       4.533      85
6       2.883      55

ggplot(faithful, aes(x = eruptions, y = waiting)) +
  geom_point() +
  geom_rug()
#这里可以看出边际地毯传递的信息比较有限，且因精度时分钟所以重叠的比较严重。
#这里可以使用jitter添加扰动并且改变size减少线宽解决这个问题

countries#各国1960-2010的健康经济数据

           Name Code Year        GDP laborrate healthexp infmortality
1   Afghanistan  AFG 1960   55.60700        NA        NA           NA
2   Afghanistan  AFG 1961   55.66865        NA        NA           NA
3   Afghanistan  AFG 1962   54.35964        NA        NA           NA
4   Afghanistan  AFG 1963   73.19877        NA        NA           NA
5   Afghanistan  AFG 1964   76.37303        NA        NA           NA
6   Afghanistan  AFG 1965   94.09873        NA        NA           NA
#这里我们选取healthexp（健康支出）和infmortality（每1000个新生儿死亡率）数据
countries_sub <- countries %>%
  filter(Year == 2009 & healthexp > 2000)#过滤2009年健康支出大于2000的国家
countries_sp <- ggplot(countries_sub, aes(x = healthexp, y = infmortality)) +
    geom_point()#制作打底图

countries_sp +
  annotate("text", x = 4350, y = 5.4, label = "Canada") +
  annotate("text", x = 7400, y = 6.8, label = "USA")#给与坐标情况标记处加拿大和美国

#但是这样只能添加几个对象的标签，若想一次性添加所有就要使用geom_text()函数
countries_sp +
  geom_text(aes(label = Name), size = 4)

#我们使用了geom_text()函数，但是很显然所有的玩意都重叠到一起了，因此使用ggrepel包的geom_text_repel函数
#或者geom_label_repel()函数
library(ggrepel)
countries_sp +
  geom_text_repel(aes(label = Name), size = 3)

countries_sp +
  geom_label_repel(aes(label = Name), size = 3)

#vjust=0时变迁文本的基线会与数据点对齐，调高调低可以对文本位置做上下调整
countries_sp +
  geom_text(aes(label = Name), size = 3, vjust = 0)#通过vjust
#通过对y的映射增加或减小一些值得到相同的效果
countries_sp +
  geom_text(aes(y = infmortality + .1, label = Name), size = 3)#通过调整y轴坐标
#hjust可以设置注解左对齐或者右对齐，左对齐hjust=0，右对齐hjust=1，由于调整hjust时系统会
#按照文本标签长度的一定比例来移动标签的位置，此时长的文本会比短文本移动更多距离，因此最后不要调整
#可以通过增加或减少x来调整位置
countries_sp +
  geom_text(
    aes(label = Name),
    size = 3,
    hjust = 0#左对齐
  )

countries_sp +
  geom_text(
    aes(x = healthexp + 100, label = Name),#增加x调整位置
    size = 3,
    hjust = 0
  )

#通过position_nudge()整体调整水平竖直移动情况
countries_sp +
  geom_text(
    aes(x = healthexp + 100, label = Name),
    size = 3,
    hjust = 0,
    position = position_nudge(x = 100, y = -0.2)
  )

cdat <- countries %>%
  filter(Year == 2009, healthexp > 2000) %>%
  mutate(plotname = as.character(Name))#复制并增加与name相同的一列
countrylist <- c("Canada", "Ireland", "United Kingdom", "United States",
  "New Zealand", "Iceland", "Japan", "Luxembourg", "Netherlands", "Switzerland")#我们要展示的国家

cdat <- cdat %>%
  mutate(plotname = ifelse(plotname %in% countrylist, plotname, ""))
#更改增加plotname一列，即在countrylist里的国家显示名称，否则空字符串
cdat %>% dplyr::select(Name, plotname)
ggplot(cdat, aes(x = healthexp, y = infmortality)) +
  geom_point() +
  geom_text(aes(x = healthexp + 100, label = plotname), size = 4, hjust = 0) +
  xlim(2000, 10000)

#依旧使用countries数据集
countrylist <- c("Canada", "Ireland", "United Kingdom", "United States",
  "New Zealand", "Iceland", "Japan", "Luxembourg", "Netherlands", "Switzerland")#目标国家

cdat <- countries %>%
  filter(Year == 2009, Name %in% countrylist)#选取2009年目标国家信息
cdat
             Name Code Year       GDP laborrate healthexp infmortality
1          Canada  CAN 2009  39599.04      67.8  4379.761          5.2
2         Iceland  ISL 2009  37972.24      77.5  3130.391          1.7
3         Ireland  IRL 2009  49737.93      63.6  4951.845          3.4
4           Japan  JPN 2009  39456.44      59.5  3321.466          2.4
5      Luxembourg  LUX 2009 106252.24      55.5  8182.855          2.2
6     Netherlands  NLD 2009  48068.35      66.1  5163.740          3.8
7     New Zealand  NZL 2009  29352.45      68.6  2633.625          4.9
8     Switzerland  CHE 2009  63524.65      66.9  7140.729          4.1
9  United Kingdom  GBR 2009  35163.41      62.2  3285.050          4.7
10  United States  USA 2009  45744.56      65.0  7410.163          6.6
#如果仅将GDP映射到size属性上，则GDP被映射到了点的半径。只是，如果变量增加一倍，点的面积就会增加四倍
#因此我们更加希望将GDP映射到面积上，可以使用scale_size_area()
cdat_sp <- ggplot(cdat, aes(x = healthexp, y = infmortality, size = GDP)) +
    geom_point(shape = 21, colour = "black", fill = "cornsilk")#只映射到半径上

cdat_sp +
  scale_size_area(max_size = 15)#映射到面积上

##使用数据集HairEyeColor包含了592个学生头发眼睛颜色的分布
# 创建一个数据框，对男性组和女性组计数求和
hec <- HairEyeColor %>%
  # 转化为长格式
  as_tibble() %>%
  group_by(Hair, Eye) %>%
  summarize(count = sum(n))


# 绘制气泡图
hec_sp <- 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(as.factor(Hair)) - sqrt(count)/34, label = count),
    vjust = 1.3,
    colour = "grey60",
    size = 4
  )
#添加红色引导点
hec_sp +
  geom_point(aes(y = as.numeric(as.factor(Hair)) - sqrt(count)/34), colour = "red", size = 1)

#继续使用countries数据集
c2009 <- countries %>%
  filter(Year == 2009) %>%
  select(Name, GDP, laborrate, healthexp, infmortality)
c2009
                             Name         GDP laborrate  healthexp infmortality
1                      Afghanistan          NA      59.8   50.88597        103.2
2                          Albania   3772.6047      59.5  264.60406         17.2
3                          Algeria   4022.1989      58.5  267.94653         32.0
4                   American Samoa          NA        NA         NA           NA
5                          Andorra          NA        NA 3089.63589          3.1
6                           Angola   4068.5757      81.3  203.80787         99.9

c2009_num <- select(c2009, -Name)
pairs(c2009_num)

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(
  c2009_num,
  upper.panel = panel.cor,
  diag.panel  = panel.hist,
  lower.panel = panel.smooth#添加了一条LOWESS回归线
)

#使用LM线型回归代替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_num,
  upper.panel = panel.cor,
  diag.panel  = panel.hist,
  lower.panel = panel.smooth,
  pch = "."#使用更小的点
)

#继续使用喷泉的数据
ggplot(faithful, aes(x = waiting)) +
  geom_histogram()

#如果想快速查看未包含在数据框中的数据，可以将数据框参数设为NULL
w <- faithful$waiting

ggplot(NULL, aes(x = w)) +
  geom_histogram()
#默认情况下，数据将被切分为30组，此时可以通过调整组距binwidth或者调整数据的极差进行调整
#除此之外调整边框以及填充色可以看上去更加清晰明了
# 设定组距为5(每个条形跨五个单位)
ggplot(faithful, aes(x = waiting)) +
  geom_histogram(binwidth = 5, fill = "white", colour = "black")

# 将x的取值切分为15份
binsize <- diff(range(faithful$waiting))/15

ggplot(faithful, aes(x = waiting)) +
  geom_histogram(binwidth = binsize, fill = "white", colour = "black")
#直方图的外观会十分依赖于边界，当组距为8，分组边距分别为31，35时的情况
faithful_p <- ggplot(faithful, aes(x = waiting))

faithful_p +
  geom_histogram(binwidth = 8, fill = "white", colour = "black", boundary = 31)

faithful_p +
  geom_histogram(binwidth = 8, fill = "white", colour = "black", boundary = 35)

#使用MASS包中的birthwt数据集（低婴儿体重的风险因子）
birthwt
    low age lwt race smoke ptl ht ui ftv  bwt
85    0  19 182    2     0   0  0  1   0 2523
86    0  33 155    3     0   0  0  0   3 2551
87    0  20 105    1     1   0  0  0   1 2557
88    0  21 108    1     1   0  0  1   2 2594
89    0  18 107    1     1   0  0  1   0 2600
91    0  21 124    3     0   0  0  0   0 2622
92    0  22 118    1     0   0  0  0   1 2637

#基础图片
ggplot(birthwt, aes(x = bwt)) +
  geom_histogram(fill = "white", colour = "black") +
  facet_grid(smoke ~ .)
#修改因子水平的名称
birthwt_mod <- birthwt
birthwt_mod$smoke <- recode_factor(birthwt_mod$smoke, '0' = 'No Smoke', '1' = 'Smoke')
ggplot(birthwt_mod, aes(x = bwt)) +
  geom_histogram(fill = "white", colour = "black") +
  facet_grid(smoke ~ .)
#加入scales='free'可以单独设定各个分面的y轴标度（x轴时固定的）
ggplot(birthwt, aes(x = bwt)) +
  geom_histogram(fill = "white", colour = "black") +
  facet_grid(race ~ ., scales = "free")

#将分组变量对应在fill中，此时分组必须是因子或者时字符型向量
#一定要加上position='identity'
ggplot(birthwt_mod, aes(x = bwt, fill = smoke)) +
  geom_histogram(position = "identity", alpha = 0.4)

#使用geom_density()
ggplot(faithful, aes(x = waiting)) +
  geom_density()
#使用geom_line(stat='density')
ggplot(faithful, aes(x = waiting)) +
  geom_line(stat = "density") +
  expand_limits(y = 0)#设定截距

#核密度曲线是基于样本数据对总体分布做出的一个估计，曲线的平滑程度取决于带宽核函数的带宽，带宽越大
#曲线越平滑。带宽可以通过adjust参数进行设置，其默认值为1。
ggplot(faithful, aes(x = waiting)) +
  geom_line(stat = "density") +
  geom_line(stat = "density", adjust = .25, colour = "red") +
  geom_line(stat = "density", adjust = 2, colour = "blue")
#为了展示曲线更多部分，可以手动设置x轴的范围
#这里线画了蓝色多边形，再加的线
ggplot(faithful, aes(x = waiting)) +
  geom_density(fill = "blue", alpha = .2, colour = NA) +
  xlim(35, 105) +
  geom_line(stat = "density")

#将密度曲线叠加到直方图上可以为观测值的理论分布和实际分布进行比较
#由于密度曲线独影的y轴坐标较小，如果将其叠加到未做任何变换的直方图上可能很难看清曲线。
#通过设置又..density..可以减少直方图的标度以使其与密度曲线的标度相匹配
ggplot(faithful, aes(x = waiting, y = ..density..)) +
  geom_histogram(fill = "cornsilk", colour = "grey60", size = .2) +
  geom_density() +
  xlim(35, 105)

#依旧使用数据集birthwt
library(MASS) 
birthwt_mod <- birthwt %>%
  mutate(smoke = as.factor(smoke)) # 将smoke转化为一个factor

# 将变量smoke映射到colour上
ggplot(birthwt_mod, aes(x = bwt, colour = smoke)) +
  geom_density()

# 将变量smoke映射到fill上，并设置alpha使它半透明
ggplot(birthwt_mod, aes(x = bwt, fill = smoke)) +
  geom_density(alpha = .3)

birthwt_mod$smoke <- recode(birthwt_mod$smoke, '0' = 'No Smoke', '1' = 'Smoke')#更改因子水平的名称
ggplot(birthwt_mod, aes(x = bwt)) +
  geom_density() +
  facet_grid(smoke ~ .)#分面绘图

#如果想要让直方图和密度曲线一起展示，那么最好使用分面绘图，这样更加利于解释和可视化。
#还是要加上y=..density..这样会将直方图比例缩放致与密度曲线相同的高度，不会特别突兀
ggplot(birthwt_mod, aes(x = bwt, y = ..density..)) +
  geom_histogram(binwidth = 200, fill = "cornsilk", colour = "grey60", size = .2) +
  geom_density() +
  facet_grid(smoke ~ .)

#与直方图类似，可以通过binwidth（）函数来控制折线图的组距
#或者通过设定每组组距将x轴分为特定数目的组
ggplot(faithful, aes(x = waiting)) +
  geom_freqpoly(binwidth = 4)

# 将x轴分为15份
binsize <- diff(range(faithful$waiting))/15

ggplot(faithful, aes(x = waiting)) +
  geom_freqpoly(binwidth = binsize)

#依旧使用MASS包里的小孩数据集（小孩体重太低的因素，比如之前我们一直谈的小孩们妈妈抽烟）
 low age lwt race smoke ptl ht ui ftv  bwt
85    0  19 182    2     0   0  0  1   0 2523
86    0  33 155    3     0   0  0  0   3 2551
87    0  20 105    1     1   0  0  0   1 2557
88    0  21 108    1     1   0  0  1   2 2594
89    0  18 107    1     1   0  0  1   0 2600
91    0  21 124    3     0   0  0  0   0 2622
92    0  22 118    1     0   0  0  0   1 2637
93    0  17 103    3     0   0  0  0   1 2637
#这里的race分为1，2，3个数，分别代表1（白），2（黑），3（其他肤色）
#因为ggplot不知道要分组处理，所以同样在aes（）中加上factor(race)当作因子处理
#箱线图中的参数width可以设置箱型图的宽度
ggplot(birthwt, aes(x = factor(race), y = bwt)) +
  geom_boxplot(width = .5)
#如果图中的异常值比较多的话，可以通过outlier.size和ourlier.shape参数修改点的大小形状，默认大小为2，形状为16（空心圆）
ggplot(birthwt, aes(x = factor(race), y = bwt)) +
  geom_boxplot(outlier.size = 1.5, outlier.shape = 21)

#要绘制单组数据的宣布废墟部分人员，必须给x参数设定一个只，否则就不知道对应的x轴坐标
ggplot(birthwt, aes(x = 1, y = bwt)) +
  geom_boxplot() +
  scale_x_continuous(breaks = NULL) +#移除刻度标记
  theme(axis.title.x = element_blank())#移出标签

library(MASS) # 依旧是熟悉的birthwt数据集
ggplot(birthwt, aes(x = factor(race), y = bwt)) +
  geom_boxplot(notch = TRUE)
#然后他就报错啦
#notch went outside hinges. Try setting notch=FALSE.
#这是因为置信域即槽口的上边界超过了箱体，但是没有什么毛病图还是可以用的惹

ggplot(birthwt, aes(x = factor(race), y = bwt)) +
  geom_boxplot() +
  stat_summary(fun = "mean", geom = "point", shape = 23, size = 3, fill = "white")
#设置size=3让点大一点并且填充白色

#回到身高体重数据集
#1.基础小提琴图
hw_p <- ggplot(heightweight, aes(x = sex, y = heightIn))
hw_p +  geom_violin() 

#2.加了箱线图的小提琴图
hw_p +
  geom_violin() +
  geom_boxplot(width = .1, fill = "black", outlier.colour = NA) +#设置箱线图
  stat_summary(fun= median, geom = "point", fill = "white", shape = 21, size = 2.5)#为中位数加上白色点

#3.保留小提琴的尾部
#小提琴图的坐标范围时数据的最小值到最大值，扁平的尾部在这两个位置处截断。
#使用trim=F保留小提琴的尾部
hw_p +  geom_violin(trim = FALSE)

#4.使小提琴的区域面积与每组观测值数目成正比
#使用scale='count'
hw_p +  geom_violin(scale = "count")

#5.使用adjust参数调整小提琴图的平滑度，默认值为1
hw_p +  geom_violin(adjust = 2) #设定adjust=2平滑一点
hw_p +  geom_violin(adjust = .5)#设定adjust=0.5曲折一点

library(dplyr)
c2009 <- countries %>%  filter(Year == 2009 & healthexp > 2000)#挑选出2009年健康支出超过2000的国家
c2009_p <- ggplot(c2009, aes(x = infmortality))#建立一个底图，x轴使1000个婴儿的死亡率
#1.基础点图
c2009_p +  geom_dotplot()

#2.移出y轴坐标，并使用边际地毯
c2009_p +
  geom_dotplot(binwidth = .25) +
  geom_rug() +
  scale_y_continuous(breaks = NULL) +   # 移出可刻度线
  theme(axis.title.y = element_blank()) #移出y轴标签

#2.数据堆在水平方向上是不规则分布的，为了使他以固定的间距有规则分组，使method='histodot'
c2009_p +
  geom_dotplot(method = "histodot", binwidth = .25) +
  geom_rug() +
  scale_y_continuous(breaks = NULL) +
  theme(axis.title.y = element_blank())

#3.点图以一种奇数和偶数数量保持一致的中心堆叠方式
#设置stackdir='center'/stackdir='centerwhole'
c2009_p +
  geom_dotplot(binwidth = .25, stackdir = "center") +
  scale_y_continuous(breaks = NULL) +
  theme(axis.title.y = element_blank())

c2009_p +
  geom_dotplot(binwidth = .25, stackdir = "centerwhole") +
  scale_y_continuous(breaks = NULL) +
  theme(axis.title.y = element_blank())

##binaxis='y'
library(gcookbook) 
ggplot(heightweight, aes(x = sex, y = heightIn)) +
  geom_dotplot(binaxis = "y", binwidth = .5, stackdir = "center")

##将点图叠加在箱型图上（数据点变空心，隐去箱型图的outliers）
ggplot(heightweight, aes(x = sex, y = heightIn)) +
  geom_boxplot(outlier.colour = NA, width = .4) +#隐去outliers
  geom_dotplot(binaxis = "y", binwidth = .5, stackdir = "center", fill = NA)#加上点图

##将点图置于箱型图的旁边（一般是左边）
ggplot(heightweight, aes(x = sex, y = heightIn)) +
  geom_boxplot(aes(x = as.numeric(sex) + .2, group = sex), width = .25) +#对两个箱线图操作
#这里将x变量视为数值型变量并加减一个小的数值实现箱型的左右移动，这必须指定group，否则会只绘制一个箱线图
  geom_dotplot(
    aes(x = as.numeric(sex) - .2, group = sex),#这里对点图也进行操作
    binaxis = "y",
    binwidth = .5,
    stackdir = "center"
  ) +
  scale_x_continuous(
    breaks = 1:nlevels(heightweight$sex),#设置x轴的刻度
    labels = levels(heightweight$sex)#设置x轴的标签
  )

#制作底图
faithful_p <- ggplot(faithful, aes(x = eruptions, y = waiting))
#等高线图
faithful_p +  geom_point() +  stat_density2d()
#使用..level..将密度曲面高度映射到等高线颜色
faithful_p +  stat_density2d(aes(colour = ..level..))
#将密度估计映射到填充色
faithful_p +
  stat_density2d(aes(fill = ..density..), geom = "raster", contour = FALSE)
#带数据点并将密度估计映射到透明度的瓦片图
faithful_p +
  geom_point() +
  stat_density2d(aes(alpha = ..density..), geom = "tile", contour = FALSE)

faithful_p +
  stat_density2d(
    aes(fill = ..density..),
    geom = "raster",
    contour = FALSE,
    h = c(.5, 5)
  )