R语言绘图实现—使用R语言绘制科研图形

###  6.1 常用图形参数   ###
# 6.1.1 颜色
# 对women数据集绘制散点图，并用红色表示散点。
plot(women,col="red") # 通过颜色名称
plot(women,col=554)   # 通过颜色下标
plot(women,col="#FF0000") #通过十六进制的颜色值
mycolor <- rgb(red=255,green=0,blue=0,max=255)
plot(women,col=mycolor) # 通过RGB值
# 对其他图形参数颜色进行设置
plot(women,main="身高 VS 体重 散点图",sub="数据来源：women数据集",
     col="red",col.main="green",col.sub="blue",
     col.axis="grey",col.lab="yellow")
colors()
# 主题颜色
par(mfrow=c(3,2))
barplot(rep(1,7),col=rainbow(7),main="barplot(rep(1,7),col=rainbow(7))",axes=F)
barplot(rep(1,7),col=heat.colors(7),main="barplot(rep(1,7),col=heat.colors(7))",axes=F)
barplot(rep(1,7),col=terrain.colors(7),main="barplot(rep(1,7),col=terrain.colors(7))",axes=F)
barplot(rep(1,7),col=topo.colors(7),main="barplot(rep(1,7),col=topo.colors(7))",axes=F)
barplot(rep(1,7),col=cm.colors(7),main="barplot(rep(1,7),col=cm.colors(7))",axes=F)
barplot(rep(1,7),col=gray(0:6/6),main="barplot(rep(1,7),col=gray(0:6/6))",axes=F)
par(mfrow=c(1,1))
# RColorBrewer包
if(!require(RColorBrewer)) install.packages("RColorBrewer")
library(RColorBrewer)
par(mfrow=c(3,1))
display.brewer.all(type = "seq")
title('seq连续型：共18组颜色，每组分为9个渐变颜色展示')
display.brewer.all(type = "div")
title("div极端型：共9组颜色，每组为11个渐变颜色展示")
display.brewer.all(type = "qual")
title("qual离散型：共8组颜色，每组渐变颜色数不尽相同")
par(mfrow=c(1,1))

attach(iris)
boxplot(Sepal.Length ~ Species,col = brewer.pal(3,'Set1'))

# 文字元素
# 字体 和 大小
plot(0:4,type="n",axes = F,xlab = NA,ylab = NA)
type <- c("正常字体(默认)","粗体字体","斜体字体","粗斜体字体")
for(i in 1:4){
  text(2,5-i,font = i,cex = i/2,
       labels = paste0("font=",i,":",type[i],";cex=",i/2,"放大",i/2,"倍"))
}

# 点线元素
# 点元素
plot(1,col="white",xlim=c(1,7),ylim=c(1,5),
     main = "点样式 cex=2,pch=",xlab=NA,ylab=NA,axes=FALSE)
for(i in c(0:25)){
  x<-(i %/% 5)*1+1
  y<-6-(i%%5)-1
  if(length(which(c(21:25)==i)>=1)){
    points(x,y,pch=i,col="blue",bg="yellow",cex=2)
  } else {
    points(x,y,pch=i,cex=2)
  }
  text(x+0.2,y,labels = i,font = 2)
}
# pch取值可以为"*，？，a，A，0，.，+，-，|"
points(6,4,pch="*",cex=2);text(6+0.2,4,labels="\"*\"",font = 2)
points(6,3,pch="?",cex=2);text(6+0.2,3,labels="\"?\"",font = 2)
points(6,2,pch="a",cex=2);text(6+0.2,2,labels="\"a\"",font = 2)
points(6,1,pch="A",cex=2);text(6+0.2,1,labels="\"A\"",font = 2)
points(7,5,pch="0",cex=2);text(7+0.2,5,labels="\"0\"",font = 2)
points(7,4,pch=".",cex=2);text(7+0.2,4,labels="\".\"",font = 2)
points(7,3,pch="+",cex=2);text(7+0.2,3,labels="\"+\"",font = 2)
points(7,2,pch="-",cex=2);text(7+0.2,2,labels="\"-\"",font = 2)
points(7,1,pch="|",cex=2);text(7+0.2,1,labels="\"|\"",font = 2)

# 线元素
plot(x=1:10,y=rep(1,10),type="l",lty=0,lwd=0,ylim=c(1,8),xlim=c(-1,10),
     axes=F,xlab=NA,ylab=NA)
text(0,1,labels="lty=0;lwd=0")
for(i in 2:7){
  lines(x=1:10,y=rep(i,10),lty=i-1,lwd = i/2,xlab=NA,ylab=NA)
  text(0,i,labels=paste0("lty=",i-1,";lwd=",i/2))
}


###  低级绘图函数  ###
# 标题
attach(iris)
boxplot(Sepal.Length~Species,col=heat.colors(3),
        main=list("Sepal.Length按照Species分类的箱线图",
                  font=4,col="red",cex=1.5),
        sub=list("数据来源：iris数据集",font=3,
                 col="green",cex=0.8),
        xlab="Species",ylab="Sepal.Length")
# title函数
boxplot(Sepal.Length~Species,col=heat.colors(3))
title(main=list("Sepal.Length按照Species分类的箱线图",
                font=4,col="red",cex=1.5),
      sub=list("数据来源：iris数据集",font=3,
               col="green",cex=0.8),
      xlab="Species",ylab="Sepal.Length")
# title另一种方式
boxplot(Sepal.Length~Species,col=heat.colors(3))
title(main="Sepal.Length按照Species分类的箱线图",
      font.main=4,col.main="red",cex.main=1.5,
      sub="数据来源：iris数据集",font.sub=3,
      col.sub="green",cex.sub=0.8,
      xlab="Species",ylab="Sepal.Length")

# 坐标轴
#加载iris数据到内存
attach(iris)
#绘制箱线图
boxplot(Sepal.Length~Species,col=heat.colors(3),
        axes=FALSE,xlab="Species",ylab="Sepal.Length")
#设置X轴样式
axis(side=1,at=1:3,labels=unique(Species),col.axis="red",tick=FALSE)
#设置Y轴样式
axis(side=2,col.ticks = "gold",font = 3,col = "blue")

# 图例 
#绘制分组柱状图
barplot(VADeaths,beside = TRUE,col=cm.colors(5))
# 添加图例
legend("top",legend=rownames(VADeaths),
       ncol=5,fill=cm.colors(5),bty="n")

# 网格线
op <- par(mfcol=1:2)
barplot(VADeaths,beside = TRUE,col=cm.colors(5),
        main="plot VADeaths with grid()")
grid()
barplot(VADeaths,beside = TRUE,col=cm.colors(5),
        main="plot VADeaths with grid(NA,7,lty=2,lwd=1.5,col='green')")
grid(NA,7,lty=2,lwd=1.5,col="green")
par(op)

# 点
set.seed(1234)
data <- c(rnorm(100,mean=0,sd=1),rnorm(3,mean=4,sd=1))
boxplot(data,col="violet",ylim=c(-4,5),outline=F)
points(rep(1,3),data[101:103],pch=21,bg="yellow",cex=1.2)

# 文字
text(rep(1,3),data[101:103],pos=4,label=paste0("异常值",round(data[101:103],3)))

#  线
# lines函数
data(economics, package = "ggplot2") 
attach(economics)                      #将economics加载到内存
plot(date,psavert,type="l",ylab="",ylim=c(0,26))    #绘制psavert随时间变化的时序图
lines(date,uempmed,type="l",col="blue") #绘制uempmed曲线，并设置为蓝色
detach(economics)                       #将economics从内存中移除
# abline函数
# 通常会调用abline画一条线
attach(iris)
# 绘制一幅简单的散点图
plot(Petal.Length~Petal.Width)
# 绘制Petal.Length变量均值的水平线
abline(h=mean(Petal.Length),col="gray60")
# 绘制Petal.Width变量均值的竖直线
abline(v=mean(Petal.Width),col="gray60")
# 绘制拟合直线
abline(lm(Petal.Length~Petal.Width),
       col="red",lwd=2,lty=3)
detach(iris)


### 高级绘图函数  ###
# 1.普通散点图
par(mfrow=c(1,2))
# 绘制一维数据
plot(x=rnorm(10)) 
# 绘制二维数据
plot(women)
par(mfrow=c(1,1))
# 2.散点图矩阵
# 利用plot函数
plot(iris[,1:4],col=iris$Species,
     main="利用plot函数绘制散点图矩阵")
# 利用pairs函数
# 方法一
pairs(iris[,1:4],col=iris$Species,
      main="利用pairs函数绘制散点图矩阵")
# 方法二
pairs(~Sepal.Length+Sepal.Width+Petal.Length+Petal.Width,
      data=iris,col=iris$Species,
      main="利用pairs函数绘制散点图矩阵")

# 高密度散点图
# 创建一个大数据集
n <- 10000
x1  <- matrix(rnorm(n), ncol = 2)
x2  <- matrix(rnorm(n, mean = 3, sd = 1.5), ncol = 2)
M   <- rbind(x1, x2)
# 利用plot与smoothScatter函数绘制散点图
par(mfrow=c(1,2))
plot(M,main="利用plot()函数绘制普通散点图")
smoothScatter(M,main="利用smoothScatter()函数绘制高密度散点图")
par(mfrow=c(1,1))

# 气泡图
data("diamonds",package = "ggplot2")
# 随机抽取500个样本
set.seed(1)
diamonds1 <- diamonds[sample(1:nrow(diamonds),500),]
attach(diamonds1)
# 计算钻石体积
volumn <- x*y*z
# 把钻石体积进行归一化处理，并赋予对象size
size <- (volumn-min(volumn))/(max(volumn)-min(volumn))
# 利用plot函数绘制气泡图
plot(carat,price,cex=size*2)
# 利用symbols函数绘制气泡图
set.seed(111)
x<-rnorm(10)
y<-rnorm(10)
r<-abs(rnorm(10))
symbols(x,y,circle = r,
        bg=rainbow(10))

# 线图
type <- c('l','b','c','o','s','S')
par(mfrow=c(2,3))
for(i in 1:6){
  plot(1:10,type=type[i],main=paste0("type=",type[i]))
}
par(mfrow=c(1,1))

#柱状图
par(mfrow=c(1,2))
for(i in c(FALSE,TRUE)){
  barplot(VADeaths,horiz = i,beside = T,col = rainbow(5))
}
par(mfrow=c(1,1))

# 饼图
pie(table(mtcars$cyl),col = RColorBrewer::brewer.pal(3,'Set2'))

# 直方图和核密度图
# 绘制直方图
data(economics, package = "ggplot2") 
attach(economics)                      #将economics加载到内存
par(mfrow=c(2,2))
hist(psavert,8,xlab="个人储蓄率",ylab="频数",col="blue",
     main="个人储蓄率直方图（较少区间）")
hist(psavert,30,xlab="个人储蓄率",ylab="频数",col="blue",
     main="个人储蓄率直方图（较多区间）")
hist(uempmed,8,xlab="一周内平均失业持续时间",ylab="频数",col="green",
     main="一周内平均失业持续时间（较少区间）")
hist(uempmed,30,xlab="一周内平均失业持续时间",ylab="频数",col="green",
     main="一周内平均失业持续时间（较多区间）")
par(mfrow=c(1,1))
detach(economics)                 #将economics从内存中释放

# 绘制核密度图
plot(density(economics$psavert))
rug(economics$psavert)

# 箱线图
boxplot(iris$Sepal.Length~iris$Species,col=rainbow(3))

### gglot2绘图工具 ###
# gplot函数
# 绘制散点图
if(!require(ggplot2)) install.packages("ggplot2")
plot(mtcars$wt,mtcars$mpg) #方法一
qplot(mtcars$wt,mtcars$mpg) #方法二
# 修改标题及坐标轴
plot(mtcars$wt,mtcars$mpg,main = "利用plot()函数绘制散点图",
     xlab = "重量",ylab = "英里/加仑",
     xlim=c(0,10),ylim=c(0,40)) # 方法一
qplot(mtcars$wt,mtcars$mpg,main = "利用qplot()函数绘制散点图",
      xlab = "重量",ylab = "英里/加仑",
      xlim=c(0,10),ylim=c(0,40)) # 方法二
# 修改颜色、形状、大小
plot(mtcars$wt,mtcars$mpg,main = "利用plot()函数绘制散点图",
     xlab = "重量",ylab = "英里/加仑",
     xlim=c(0,10),ylim=c(0,40),
     pch=7,cex=2,col="green") # 方法一
qplot(mtcars$wt,mtcars$mpg,main = "利用qplot()函数绘制散点图",
      xlab = "重量",ylab = "英里/加仑",
      xlim=c(0,10),ylim=c(0,40),pch = I(7),
      cex=I(2),col=I("green")) # 方法二

# qplot函数详解
# 通过geom参数指定图形的几何类型
library(ggplot2)
q1 <- qplot(wt,mpg,data=mtcars,geom="point",main = "散点图")
q2 <- qplot(wt,mpg,data=mtcars,geom=c("point","smooth"),
            main = "增加拟合曲线的散点图")
q3 <- qplot(Species,Sepal.Length,data=iris,geom="boxplot",main = "箱线图")
q4 <- qplot(Species,Sepal.Length,data=iris,geom="violin",main = "小提琴图")
q5 <- qplot(clarity,data=diamonds,geom="bar",main = "柱状图")
q6 <- qplot(carat,data=diamonds,geom="histogram",main = "直方图")
if(!require(gridExtra)) install.packages("gridExtra")
grid.arrange(q1,q2,q3,q4,q5,q6,ncol=3)

# 图形参数设置-颜色
# 手动设置指定颜色
q1 <- qplot(wt,mpg,data=mtcars,colour="darkblue",
            main = "colour='darkblue'")
q2 <- qplot(wt,mpg,data=mtcars,colour=I("darkblue"),
            main = "colour=I('darkblue')")
gridExtra::grid.arrange(q1,q2,ncol=2)

# 将分组变量指定给颜色
q1 <- qplot(wt,mpg,data=mtcars,colour=cyl,
            main = "colour=cyl")
q2 <- qplot(wt,mpg,data=mtcars,colour=factor(cyl),
            main = "colour=factor(cyl)")
# fill与colour参数区别
q3 <- qplot(Species,Sepal.Length,data=iris,geom="boxplot",colour=Species,
            main = "colour=Species")
q4 <- qplot(Species,Sepal.Length,data=iris,geom="boxplot",fill=Species,
            main = "fill=Species")
gridExtra::grid.arrange(q1,q2,q3,q4,ncol=2)

# 形状和大小
qplot(wt,mpg,data=mtcars,shape=factor(cyl),size=I(3))

# 修改图例
qplot(wt,mpg,data=mtcars,shape=factor(cyl),size=I(3)) +
  labs(shape = "Legend-Name") +
  theme(legend.position = "top")
# 删除图例
qplot(Species,Sepal.Length,data=iris,geom="boxplot",fill=Species) +
  theme(legend.position = "none")

# 分面
qplot(mpg,wt,data=mtcars,facets = gear~cyl,geom="point")

# 修改主题
# 只对当前图形设置
q1 <- qplot(mpg,wt,data=mtcars,geom="point",main = "默认主题")
# 改变所有labels的文字大小（base_size默认为11）
q2 <- qplot(mpg,wt,data=mtcars,geom="point",main = "背景色无填充主题") + 
  theme_bw(18) 
gridExtra::grid.arrange(q1,q2,ncol=2)

# ggplot绘图
# 利用ggplot函数绘制箱线图
library(ggplot2)
ggplot(iris,aes(x=Species,y=Sepal.Length,fill=Species))+
  geom_boxplot()+
  labs(title="依据种类分组的花萼长度箱线图") +
  theme(legend.position = "none")
# 利用ggplot函数绘制小提琴图
ggplot(iris,aes(x=Species,y=Sepal.Length,fill=Species))+
  geom_violin()+
  geom_jitter()+
  labs(title="依据种类分组的花萼长度小提琴图") +
  theme(legend.position = "none")
# 利用ggplot的分面函数绘制分面板密度图
data(singer,package = "lattice")
ggplot(data=singer,aes(x=height,fill=voice.part))+
  geom_density()+
  facet_wrap(~voice.part,ncol=4)+
  theme(legend.position="none")
# 调整图形填充颜色
# 方式一：使用scale_color_manual函数
g1 <- ggplot(iris,aes(x=Sepal.Length,y=Sepal.Width,colour=Species,shape=Species))+
  scale_color_manual(values=c("orange", "olivedrab", "navy"))+
  geom_point(size=3)
# 方式二:使用scale_color_brewer函数
g2 <- ggplot(iris,aes(x=Sepal.Length,y=Sepal.Width,colour=Species,shape=Species))+
  scale_color_brewer(palette="Set1")+
  geom_point(size=3)
gridExtra::grid.arrange(g1,g2,ncol=2)
# 保存ggplot的图形
ggplot(iris,aes(x=Sepal.Length,y=Sepal.Width,colour=Species))+
  geom_point(size=2)
ggsave(file="mygraph.pdf",width=5,height=4)

# ggthemes包
library(ggplot2)
library(ggthemes)
library(gridExtra)
p1 <- ggplot(mtcars, aes(x = wt, y = mpg)) +
  geom_point(size=3) 
# Economist themes
p2 <- p1 + ggtitle("Economist theme") +
  theme_economist() + scale_colour_economist() 
# Solarized theme
p3 <- p1 + ggtitle("Solarized theme") + 
  theme_solarized() + scale_colour_solarized("blue")
# Stata theme
p4 <- p1 + ggtitle("Stata theme") + 
  theme_stata() + scale_colour_stata()
# Excel 2003 theme
p5 <- p1 + ggtitle("Excel 2003 theme") + 
  theme_excel() + scale_colour_excel()
grid.arrange(p2,p3,p4,p5,ncol = 2)

# ggExtra包
library(ggExtra)
library(ggplot2)
set.seed(1234)
df <- data.frame(x = rnorm(1000, 50, 10), y = rnorm(1000, 50, 10))
p <- ggplot(df, aes(x, y)) + geom_point() + theme_classic()
# add marginal histograms
ggMarginal(p, type = "histogram")
# 修改颜色及填充色
ggMarginal(p,type = "histogram",colour = "pink",fill = "green")
# 只有Y轴边缘显示
ggMarginal(p,type = "histogram",margins = "y")
# 修改图形类型
ggMarginal(p,type = "box",fill = "green")


### 交互式绘图工具 ###
# recharts包
# 散点图
library(recharts)
echartr(iris, Sepal.Length, Sepal.Width)
# 分组散点图
g <- echartr(iris, Sepal.Width, Petal.Width, series =Species)
g %>% setSeries(symbolSize=8)
g %>% setSeries(symbolSize=8) %>%
  setSymbols(c('heart', 'arrow','diamond'))
# 改变散点符号,不显示工具箱
g <- echartr(iris, Sepal.Width, Petal.Width, series =Species) %>%
  setSeries(symbolSize=8) %>%
  setSymbols(c('heart', 'arrow','diamond')) %>%
  setToolbox(show=FALSE)
g
# 增加标记
g %>% addMarkPoint(series=unique(iris$Species),
                   data=data.frame(type="max",name="最大值"))
# 添加标题
g %>% setTitle("依据种类绘制的分组散点图")
# 改变标题和图例摆放位置
g %>% setTitle("依据种类绘制的分组散点图",pos=12) %>%
  setLegend(pos=3)
# 主题美化 
g <- echartr(iris, Sepal.Length, Sepal.Width) %>%
  setSeries(symbolSize=8)
g %>% setTheme('helianthus', calculable=TRUE)

# 条形图
revenue <- read.csv("../data/revenue.csv")
library(reshape2)
revenue <- melt(revenue,id="游戏名称")
colnames(revenue) <- c("游戏名称","时间段","收入")
# 绘制条形图，默认hbar类型
b <- echartr(revenue,"游戏名称","收入","时间段") %>%
  setTitle("游戏收入",pos=12) %>%
  setLegend(pos=6)
b
b %>% setGrid(x=180)

# 绘制龙卷风图
revenue_tc <- revenue
revenue_tc$收入[revenue_tc$时间段=="上周"] <-
  -revenue_tc$收入[revenue_tc$时间段=="上周"] 
g <- echartr(revenue_tc,"游戏名称","收入","时间段",type = "hbar") %>%
  setToolbox(show=FALSE) %>%
  setTitle("游戏收入",pos=12) %>%
  setLegend(pos=6) %>% 
  setGrid(x=180)
g

# 金字塔图
g <- echartr(revenue_tc,"游戏名称","收入","时间段",type = "hbar",subtype='stack') %>%
  setToolbox(show=FALSE) %>%
  setTitle("游戏收入",pos=12) %>%
  setLegend(pos=6) %>% 
  setGrid(x=180) %>%
  setYAxis(axisLine=list(onZero=TRUE)) %>%
  setXAxis(axisLabel=list(
    formatter=JS('function (value) {return Math.abs(value);}')
  ))
g

# rbokeh包
# 绘制散点图
if(!require(rbokeh)) install.packages("rbokeh")
z <- lm(dist ~ speed, data = cars)
p <- figure(width = 600, height = 600) %>%
  ly_points(cars, hover = cars) %>%
  ly_lines(lowess(cars), legend = "lowess") %>%
  ly_abline(z, type = 2, legend = "lm")
p
# 绘制直方图
h <- figure(width = 600, height = 400) %>%
  ly_hist(eruptions, data = faithful, breaks = 40, freq = FALSE) %>%
  ly_density(eruptions, data = faithful)
h
# 绘制箱线图
figure(ylab = "Height (inches)", width = 600) %>%
  ly_boxplot(voice.part, height, data = lattice::singer)

# plotly包
revenue <- read.csv("../data/revenue.csv")
# 绘制柱状图
if(!require(plotly)) install.packages("plotly")
p <- plot_ly(revenue,y = ~本周,x = ~游戏名称,type = "bar",name = "本周")
p
p %>% add_trace(y = ~上周,name = "上周") 
p %>% 
  add_trace(y = ~上周,name = "上周") %>%
  layout(barmode = 'stack',
         xaxis = list(title = ""),
         yaxis = list(title = ""),
         title = "游戏收入数据")
# 绘制箱线图
plot_ly(midwest, x = ~percollege, color = ~state, type = "box")