R 语言实战Part 51笔记

---

R 语言实战（第二版）

part 5-1 技能拓展

---

----------第19章 使用ggplot2进行高级绘图-------------------------

#R的四种图形系统：
#①base：基础图形系统
#②grid图形系统： grid包，灵活，无完整绘图函数，适用开发者
#③lattice包：适用网格图形，即多变量/水平关系。基于grid包
#④ggplot2包：数据可视化利器
#前三者在基础安装中已包含，后三者使用时需显示加载

#1.以一个例子介绍ggplot2
library(ggplot2)
ggplot(data=mtcars,aes(x=wt,y=mpg))+ #aes(aesthetics)指定每个变量扮演角色
  geom_point()+
  labs(title = "automobile data",x="weight",y="miles per gallon")

#参数拓展
ggplot(data=mtcars,aes(x=wt,y=mpg))+
  geom_point(pch=17,color="red",size=2)+
  geom_smooth(method = "lm",color="red",linetype=2)+ #平滑曲线阴影默认95%置信区间
  labs(title = "automobile data",x="weight",y="miles per gallon")

#分组/刻面
mtcars$am <- factor(mtcars$am,levels = c(0,1),labels = c("automatic","manual"))
mtcars$vs <- factor(mtcars$vs,levels = c(0,1),labels = c("v-engine","straight engine"))
mtcars$cyl <- factor(mtcars$cyl)
ggplot(mtcars,aes(hp,mpg,shape=cyl,color=cyl))+
  geom_point(size=3)+
  facet_grid(am~vs)
#am和vs是刻面变量，cyl是分组变量

#2.几何函数指定图类型
#共37个
  # geom_bar() options: color,fill,alpha
  # geom_boxplot() color,fill,alpha,notch,width
  # geom_density() color,fill,alpha,linetype
  # geom_histogram() color,fill,alpha,linetype,binwidth
  # geom_hline()  color,alpha,linetype,size
  # geom_jitter() #抖动点 color,alpha,shape
  # geom_line() clorvalpha,linetype,size
  # geom_point() color,alpha,shape,size
  # geom_rug() #d地毯图 color,side
  # geom_smooth() method,formula,color,fill,linetype,size
  # geom_text() #文字注解，很多参数
  # geom_violin() color,fill,alpha,linetype
  # geom_vline() olor,alpha,linetype,size

data(singer,package = "lattice")
ggplot(singer,aes(height))+geom_histogram()
ggplot(singer,aes(voice.part,height))+geom_boxplot()
ggplot(singer,aes(voice.part,height))+geom_violin()

library(car)
ggplot(Salaries,aes(rank,salary))+
  geom_boxplot(fill="cornflowerblue",color="black",notch = T)+
  geom_point(position = "jitter",color="blue",alpha=.5)+
  geom_rug(sides = "l",color="black") #sides地毯图安置方向：b底，l左，t顶，r右，bl左下
#箱线图槽口没有重叠，差异显著？

#几何函数组合的威力
ggplot(singer,aes(voice.part,height))+
  geom_violin(fill="lightblue")+
  geom_boxplot(fill="lightgreen",width=.2)
  
#3.分组
#组：分类变量的水平（因子），用形状、颜色、填充、尺寸、线型等特征映射，aes分配变量（特征）
head(Salaries)
ggplot(Salaries,aes(salary,fill=rank))+geom_density(alpha=.3)
ggplot(Salaries,aes(yrs.since.phd,salary,color=rank,shape=sex))+geom_point()

ggplot(Salaries,aes(rank,fill=sex))+geom_bar(position = "stack")+ #堆叠
  labs(title = "postion=stack")
ggplot(Salaries,aes(rank,fill=sex))+geom_bar(position = "dodge") #并排
ggplot(Salaries,aes(rank,fill=sex))+geom_bar(position = "fill")+#按比例
  labs(y="proportion")

#参数在aes()内和外的区别
ggplot(Salaries,aes(rank,fill=sex))+geom_bar()
ggplot(Salaries,aes(rank))+geom_bar(aes(fill=sex)) #同上
ggplot(Salaries,aes(rank))+geom_bar(fill="blue")
ggplot(Salaries,aes(rank,fill="blue"))+geom_bar() #此时的"blue"视为一个变量名
#一般来说，变量应设在aes内，常数应分配在aes外

#4. 刻面
#即网格图形
facet_wrap(~var,ncol=n) #var个水平排成n列
facet_wrap(~var,nrow = n)#var个水平排成n行

facet_grid(rowvar~colvar) #排成rowvar和colvar水平组合的图
facet_grid(rowvar~.) #每个rowvar水平的单列图
facet_grid(.~colvar) #每个colvar水平的单行图

ggplot(singer,aes(height))+
  geom_histogram()+
  facet_wrap(~voice.part,nrow=4)

##刻面和分组相结合
ggplot(Salaries,aes(yrs.since.phd,salary,color=rank,shape=rank))+
  geom_point()+facet_grid(.~sex)

ggplot(singer,aes(height,fill=voice.part))+
  geom_density()+facet_grid(voice.part~.)

#5.添加光滑曲线
#平滑曲线包括线性、非线性、非参数(loess)等
#参数：method——smooth(默认)/lm/glm/rml/gam；formula——y~x(默认)/y~log(x)/y~ploy(x,n)；
#se——置信区间（T/F），默认T；level——默认95%置信区间水平；fullrange——拟合涵盖全图（T）/仅数据（F），默认F

ggplot(Salaries,aes(yrs.since.phd,salary))+geom_smooth()+geom_point()

#按性别拟合一个二次多项式回归
ggplot(Salaries,aes(yrs.since.phd,salary,linetype=sex,shape=sex,color=sex))+
  geom_smooth(method = lm,formula = y~poly(x,2),se=F,size=1)+
  geom_point(size=2)

#geom_smooth函数依赖于stat_smooth()函数来计算画出一个拟合曲线及其置信限所需的数量。更多信息介绍在stat_smooth函数中

#6.修改ggplot2图形外观
#R基本图形参数如par()函数等对ggplot2无作用，但它有特定函数来改变图形外观
##坐标轴：
scale_x_continuous(breaks = c(1,10,2),labels = c("a","b","c"),limits = c(1,12)) #连续变量
scale_y_continuous()
scale_x_discrete(breaks,labels,limits) #因子水平
scale_y_discrete()
coord_flip()

p <- ggplot(Salaries,aes(rank,salary,fill=sex))+geom_boxplot()+
  scale_x_discrete(breaks=c("asstprof","assocprof","prof"),
                   labels=c("assistant\nprofessor",
                            "associate\nprofessor",
                            "full\nprofessor"))+
  scale_y_continuous(breaks = c(50000,100000,150000,200000),
                     labels = c("$50k","$100k","$150k","$200k"))
p
#横轴标签不见了？？

#7.图例
#常定制标题和位置。映射aes中的fill，因此在labs()中通过fill=来修改标题。
p+labs(title = "faculty salary by rank and sex",x="",y="",fill="Gender")+
  theme(legend.position = c(0.2,0.8)) #分别据左侧和底部边缘的百分比距离。"left/right(default)/top/bottom/none"
#删除图例"none"

#8.标尺
#把数值映射到可视化空间
ggplot(mtcars,aes(wt,mpg,size=disp))+ #disp发动机排量连续变量
  geom_point(shape=21,color="black",fill="cornsilk")

ggplot(Salaries,aes(yrs.since.phd,salary,color=rank))+ #rank离散变量，对应设置的颜色
  scale_color_manual(values = c("orange","olivedrab","navy"))+
  geom_point(size=2)

ggplot(Salaries,aes(yrs.since.phd,salary,color=rank))+ 
  scale_color_brewer(palette = "Set1")+ #指定颜色集，同理sale_fill_brewer
  geom_point(size=2)

#查看颜色集
library(RColorBrewer)
display.brewer.all()

#9.主题
#theme函数调整字体、背景、颜色、网格线等
library(ggplot2)
mytheme <- theme(plot.title = element_text(face = "bold.italic",size = 14,color="brown"), #图标题
                 axis.title = element_text(face = "bold.italic",size = 10,color = "brown"), #轴标题
                 axis.text = element_text(face = "bold",size = 9,color = "darkblue"), #轴标签
                 panel.background = element_rect(fill="white",color = "darkblue"), #画图区域
                 panel.grid.major.y = element_line(color = "grey",linetype = 1), #主水平网格线
                 panel.grid.minor.y = element_line(color="grey",linetype = 2), #次水平网格线
                 panel.grid.minor.x = element_blank(),
                 legend.position = "top")
ggplot(Salaries,aes(rank,salary,fill=sex))+
  geom_boxplot()+
  labs(title="salary by rank and sex",x="rank",y="salary")+
  mytheme

#10.多重图
#基础函数中的mfrow和layout函数不适用于ggplot2，而是grid.arrange函数
p1 <- ggplot(Salaries,aes(rank))+geom_bar()
p2 <- ggplot(Salaries,aes(sex))+geom_bar()
p3 <- ggplot(Salaries,aes(yrs.since.phd,salary))+geom_point()
library(gridExtra)
grid.arrange(p1,p2,p3,ncol=3) #默认按行

#11.保存图形
myplot <- ggplot(mtcars,aes(mpg))+geom_histogram()
ggsave(file="mygraph.png",plot=myplot,width = 5,height = 4) #英寸*约1.25=cm
ggsave("mygraph.png")#保存最近创建的图形

------------------------第20章 高级编程-----------------------------

#面向对象（可被存储和命名的数据、函数和其他任何东西）编程
#每个对象都有属性，一个关键的属性是对象的类，R函数根据对象类的信息来处理对象
#attributes()函数罗列属性，attr()函数设置属性，class()函数读取和设置对象的类

#1.数据结构
#1）原子向量：向量、矩阵、数组
x <- c(1,2,3,4,5,6,7,8)
class(x)
print(x)

attr(x,"dim") <- c(2,4) #给x加一个dim属性
print(x)
class(x)
attributes(x)

attr(x,"dimnames") <- list(c("A1","A2"),
                           c("B1","B2","B3","B4")) #给x再加一个dimnames属性
print(x)

attr(x,"dim") <- NULL #去除dim属性
class(x)
print(x)

#2）泛型向量（即列表）：数据框、列表
#列表很重要，R函数通常返回列表作为值
#数据框是一种特殊的列表，集合中每个原子向量都有相同的长度
head(iris)
unclass(iris) #这个数据框是5个原子向量的列表
attributes(iris) #3个属性

set.seed(1234)
fit <- kmeans(iris[1:4],3)
str(fit) #查看对象结构
unclass(fit) #查看对象内容
length(fit)
names(fit)
attributes(fit)
sapply(fit,class)

#任何对象中的元素都可通过索引来提取
x <- c(20,30,40)
x[3]
x[c(2,3)]
x <- c(A=20,B=30,C=40)
x[c(2,3)]
x[c("B","C")]

fit[c(2,7)]
fit[2] #返回列表
fit[[2]] #返回矩阵
fit$centers #数据框也是列表，所以才也可如此操作

#例子：画出K means聚类分析的中心
set.seed(1234)
fit <- kmeans(iris[1:4],3)
means <- fit$centers
library(reshape2)
dfm <- melt(means)
names(dfm) <- c("Cluster","Measurement","Centimeters")
dfm$Cluster <- factor(dfm$Cluster)
head(dfm)
library(ggplot2)
ggplot(data = dfm,aes(x=Measurement,y=Centimeters,group=Cluster))+
  geom_point(size=3,aes(shape=Cluster,color=Cluster))+
  geom_line(size=1,aes(color=Cluster))+
  ggtitle("Profiles for Iris Clusters")

#2.控制结构
#for/if()else/ifelse/for/while/repeat/switch

for(i in 1:5){print(1:i)}
for (i in 5:1) print(i:1)

if(interactive()){ #代码是否交互运行
  plot(x,y)
}else{
  png("myplot.png")
  plot(x,y)
  dev.off()
}

#向量循环
pvalues <- c(0.234,0.12,0.002,0.34,0.004)
ifelse(pvalues<0.05,"significant","not significant")

#显示循环(耗时)
results <- vector(mode = "character",length = length(pvalues)) #初始化
for(i in 1:length(pvalues)){
  if(pvalues[i]<0.05) results[i] <- "significant"
  else results[i] <- "not significant"
}
results

#3.创建函数
f <- function(x,y,z=1){
  result <- x+2*y+3*z
  return(result)
}
f(2,3,4)
f(2,3)
f(x=2,y=3)
f(z=4,y=2,3)

args(f) #arg查看函数的参数及其默认值（主要用于交互式观测）
formals(f) #formals查看参数及其默认值（主要用于编程中，返回列表）

#参数是按值传递的，而不是按地址
result <- lm(height~weight,data=women) #women生成副本后再传给函数

#对象的作用范围：全局/局部
x=2;y=3;z=4
f <- function(w){
  z <- 2
  x <- w*y*z
  return(x)
}
f(x) #x的副本传入f函数中，return返回结果。x本身不变
x
y
z


#4.环境
#包括框架和外壳
#框架："对象-内容"的集合；外壳：指向封闭环境（父环境）的一个指针

x <- 5 #当前处于全局环境
myenv <- new.env() #创建一个新环境
assign("x","Homer",env=myenv) #在新环境中创建任务：x的对象其值为Homer
ls()
ls(myenv)
x
get("x",env=myenv) #从环境中得到对象的值

#也可用$符号
myenv <- new.env()
myenv$x <- "Homer"
myenv$x

#展示父环境
parent.env(myenv)
#myenv的父环境就是全局环境

#函数是对象，所以也有环境。函数一旦被创建，里面的对象就存在环境中。这在函数闭包（以创建时状态被打包的函数）中很重要
trim <- function(p){
  trimit <- function(x){
    n <- length(x)
    lo <- floor(n*p)+1
    hi <- n+1-lo
    x <- sort.int(x,partial = unique(c(lo,hi)))[lo:hi]
  } 
  trimit
}
#以上trim(p)函数返回一个函数，即从是两种修剪掉高低值的p%
x <- 1:10
trim10p <- trim(0.1) #p在trimit函数的环境中
y <- trim10p(x)
y
trim20p <- trim(0.2)
y <- trim20p(x)
y

ls(environment(trim10p))
get("p",env=environment(trim10p))

#函数中包含函数的另一个例子
makeFunction <- function(k){
  f <- function(x){
    print(x+k)
  }
}
g <- makeFunction(10)
g(4)
k <- 2
g(5) #无论在全局环境中设置k是什么，g()函数使用k=10？，因为当g函数被创建时即已赋值


#5.面向对象的编程
#两个分离的面向对象编程的模型：S3模型（更老、简单、结构少），S4模型（更新且复杂）
#对象——>类属性——>泛型函数——>执行

#example:
summary(women)
fit <- lm(weight~height,data=women)
summary(fit)

summary #查看该泛型函数代码。UseMethod函数将对象分给一个泛型函数，前提是该泛型函数有扩展与对象的类属性匹配
class(women) #data.frame类属性,即判断是否有summary.data.frame(women)存在，否则执行summary.default(women)
class(fit) #fit对象类属性，即判断是否有summary.lm(fit)存在，否则执行summary.default(fit)

methods(summary) #列出可获得的S3泛型函数

#查看泛型函数源码（针对可见函数，即名字后没加星号的函数）
summary.data.frame
summary.lm

getAnywhere(summary.ggplot)#针对不可见函数，即名字后加星号的函数，查看时去掉星号
getAnywhere(summary.ecdf)

#常见的对象的类属性：umeric/matrix/data.frame/array/lm/glm/table.....
#常见的泛型函数：print/plot/summary......
#实际上，对象的类属性可以是任意字符串，泛型函数也可以是任意函数

#一个自定义的任意的泛型函数例子：
#定义泛型函数
mymethod <- function(x,...) UseMethod("mymethod")
mymethod.a <- function(x) print("using A")
mymethod.b <- function(x) print("using B")
mymethod.default <- function(x) print("using Default")

#给对象分配类
x <- 1:5
y <- 6:10
z <- 10:15
class(x) <- "a"
class(y) <- "b"

#将泛型函数应用到对象中
mymethod(x)
mymethod(y)
mymethod(z)

#将泛型函数应用到包含两个类的对象中
class(z) <- c("a","b")
mymethod(z) #分配到多个类时，第一类来决定哪个泛型函数被调用

#泛型函数没有默认为“c"的类
class(z) <- c("c","a","b")
mymethod(z) #寻找第一个可用的泛型函数


##S3模型的限制
#任意的类能分配到任意的对象上，没有完整性检验。如：
class(women) <- "lm"
summary(women)

#S4面向对象编程的模型更加正式、严格，旨在克服由S3结构化程度低的困难


#6.编写有效的代码
#R的缺陷：大数据集、高重复任务，速度慢
#高效技巧：①只读取需要的数据②尽量矢量化循环③创建大小正确对象，而非反复调整④并行

#有效数据输入:colClasses指定变量类型
read.table(data,header = T,sep = ",",colClasses = c("numeric","numeric","character",NULL,"numeric",NULL,NULL))

#矢量化：使用R中的函数
set.seed(1234)
mymatrix <- matrix(rnorm(10000000),ncol = 10)
#计算各列的和
accum <- function(x){
  sums <- numeric(ncol(x))
  for (i in 1:ncol(x)) {
    for (j in nrow(x)) {
      sums[i] <- sums[i]+x[j,i]
    }
  }
}
system.time(accum(mymatrix))
system.time(colSums(mymatrix))

#大小正确的对象：
x <- rnorm(1000000)
y <- 0 #初始化一个值
system.time(for(i in 1:length(x)) y[i] <- x[i]^2)

y <- numeric(length = 1000000) #初始化100000个值
head(y)
system.time(for(i in 1:1000000) y[i] <- x[i]^2)

system.time(y <- x^2) #直接矢量化操作

#并行化：foreach和doParallel包
#需重复独立执行数字密集型函数的任务（如蒙特卡洛方法、自助法等）
#查看哪些函数耗时：
Rprof()
Rprof(NULL)
summaryRprof()

#7.调试
args(mad) #查看参数
debug(mad) #标记函数进行调试
mad(1:10) #设置调试函数,ls()列出对象查看
#或输入n，通过代码单步运行
#输入c移出单步运行并执行当前函数剩余部分

#调试会话
f <- function(x,y){
  z <- x+y
  g(z)
}
g <- function(x){
  z <- round(x)
  h(z)
}
h <- function(x){
  set.seed(1234)
  z <- rnorm(x)
  print(z)
}
options(error = recover) #出现错误时打印调用的栈
f(2,3)
f(2,-3)
#按c返回列表，0退出到R提示