R语言 画图标准化方法 r语言绘制图例

ggplot2包可以说是R语言吸引众多R爱好者的关键，甚至是唯一的原因。鉴于ggplot2包对应的扩展包太多，加上本身大量参数调整，个人打算结合每个图形逐一演示,便于理解和记忆。

对于ggplot2的部分设计可参与ggThemeAssist包进行设计

一、柱状图

先以并列柱状图为实例,把部分基础信息汇总到一起,其他形状就可以套用了

1.并列柱状图

library(tidyverse)

df<-diamonds %>% filter(cut %in% c("Fair","Very Good","Ideal")) %>%
  group_by(cut,color) %>% summarize(avg_price=mean(price))

ggplot(df,aes(x=color,y=avg_price,fill=cut)) + # 设置填充
  geom_bar(stat="identity",position="dodge") +  # 设置为并列柱状图 (统计变换)
  geom_text(aes(label = round(avg_price),color = cut), # 新增标签和标签的颜色
            position = position_dodge(0.8), # 设置标签位置
            hjust = .5,vjust = -.5) +
  xlab('x轴') +
  ylab('y轴') +
  ggtitle('标题') +
  theme(plot.title = element_text(hjust =0.5,size=20), # 设置标题位置和字体大小
        legend.position="top", # 图例位置
        axis.text.y = element_blank()) +  # 取出y轴刻度
  scale_fill_manual(values = c("red","blue","black")) + # 设置填充颜色
  scale_color_manual(values = c("red","blue","black")) # 设置标签的颜色

2.堆积柱状图

ggplot(df,aes(x=color,y=avg_price,fill=cut))+
  geom_bar(stat="identity",position="stack") # 注意和并列的统计变换的区别

3.简单柱状图

ggplot(diamonds, aes(cut)) + 
  geom_bar()

4.瀑布图

set.seed(1)
x <- 1980 + 1:50
y <- round(100*rnorm(50))
df <- data.frame(x = x,y = y)
# 判断y是否为正值用于添加颜色
df <- transform(df,judge = ifelse(y>0,"YES","NO"))

ggplot(df,aes(x = x,y = y,fill = judge))+
  geom_bar(stat = "identity")+
  theme(legend.position= "")+
  xlab("Year")+
  scale_fill_manual(values = c("darkred","blue"))

二、散点图

1.简单散点图

ggplot(diamonds, aes(carat, depth)) + # 这里横纵坐标是随便选的  无任何意义
  geom_point(color = 'red', # 控制点的颜色
             size = 3 ) + # 控制点的大小
  theme(axis.text = element_text(size = 20, # 控制坐标轴刻度字体大小
                                 angle = 45)) # 控制坐标轴字体倾斜度

2.气泡图

气泡图 其实就是散点图基于不同的分类变量显示不同的大小

ggplot(diamonds, aes(carat, depth)) +
  geom_point(aes(size = as.factor(diamonds$color)),color = "red") +
  labs(size = "分类变量") # 调整图例的名称

三、折线图

1.单折线图

ggplot(mtcars, aes(wt, mpg)) +
  geom_point() +
  geom_line()

2.多折线图

ggplot(mtcars, aes(wt, mpg,group = as.factor(vs))) +
  geom_point(aes(color = as.factor(vs)),show.legend = F) + # 去掉图例
  geom_line(aes(color = as.factor(vs)),show.legend = F)

3.面积图

df3 <- mpg %>%
  group_by(year,class) %>%
  summarize(mean_cty=mean(cty)) 

ggplot(df3,aes(x=class,group=year))+
  geom_area(aes(y=mean_cty,fill=as.factor(year)))

四、条形图

条形图其实是柱状图的变种,只是进行了坐标翻转

ggplot(df,aes(x=color,y=avg_price,fill=cut))+
  geom_bar(stat="identity",position="stack")  + 
  coord_flip() # 坐标翻转

五、直方图

ggplot(diamonds, aes(price, fill = cut)) +
  geom_histogram(binwidth = 200)

六、箱型图

1. 箱线图

ggplot(mpg, aes(class, hwy)) +
  geom_boxplot()

2.小提琴图

ggplot(mpg, aes(class, hwy)) +
  geom_violin()

七、饼图

1.饼图

data5<-diamonds %>% count(cut) %>% 
  mutate(percent=n/sum(n),
         占比 = paste(round(percent,4)*100,"%",sep =""))
ggplot(data5,aes(x=factor(1),y=percent,fill=cut))+
  geom_bar(stat="identity")+
  geom_text(aes(label= 占比),position = position_stack(0.5)) + # 调整标签在图形中间
  coord_polar("y") +
  theme(axis.title=element_blank(), # 去掉横纵坐标轴标签
        axis.ticks=element_blank(), # 去掉左上角的坐标刻度线
        axis.text = element_blank(), # 去掉坐标刻度
        panel.grid=element_blank()) # 去掉白色外框

2.圆环图

ad = data.frame(type = c("Poster", "Billboard", "Bus", "Digital"),n = c(529, 356, 59, 81))
ad$fraction = ad$n / sum(ad$n)
ad$ymax = cumsum(ad$fraction)
ad$ymin = c(0, head(ad$ymax, n = -1))

ggplot(data = ad, aes(fill = type, ymax = ymax, ymin = ymin, xmax = 4, xmin = 3)) +
  geom_rect(colour = "grey30", show_guide = FALSE) +
  coord_polar(theta = "y") +
  labs(x = "", y = "", title = "") + 
  xlim(c(0, 4)) +
  theme_bw() +
  theme(panel.grid=element_blank()) + ## 去掉白色外框
  theme(axis.text=element_blank()) + ## 把图旁边的标签去掉
  theme(axis.ticks=element_blank()) + ## 去掉左上角的坐标刻度线
  theme(panel.border=element_blank()) + ## 去掉最外层的正方形边框
  geom_text(aes(x = 3.5, y = ((ymin+ymax)/2), label = type))

3.旭日图(多饼图)

df1<-diamonds %>% filter(cut %in% c("Fair","Very Good","Ideal")) %>%
  group_by(cut,color) %>% summarize(avg_price=mean(price))

ggplot(df1,aes(x=color,y=avg_price,fill=cut))+
  geom_bar(stat="identity",position="stack") + # 注意和并列的统计变换的区别
  coord_polar("y") +
  theme(axis.title=element_blank(), # 去掉横纵坐标轴标签
        axis.ticks=element_blank(), # 去掉左上角的坐标刻度线
        axis.text = element_blank(), # 去掉坐标刻度
        panel.grid=element_blank()) # 去掉白色外框

df2<-mpg%>%group_by(year,drv)%>%summarize(mean_cty=mean(cty))
ggplot(df2,aes(x=year,y=mean_cty,fill=drv))+geom_col(position="fill")+
  coord_polar(theta="y") +#格式修改
  theme(axis.text = element_blank(),
        axis.title=element_blank(),
        axis.ticks=element_blank(),
        panel.grid=element_blank())+#
  geom_text(aes(label=round(mean_cty,2)),position=position_fill(0.5)
  ) #添加数值标注

4.玫瑰图

ggplot(mtcars)+ 
  geom_bar(aes(x = factor(carb),fill=factor(gear))) + 
  coord_polar() + 
  labs(title="玫瑰图") +
  theme(axis.title=element_blank(), # 去掉横纵坐标轴标签
        axis.ticks=element_blank(), # 去掉左上角的坐标刻度线
        axis.text = element_blank(), # 去掉坐标刻度
        panel.grid=element_blank()) # 去掉白色外框

八、热力图

1. 树状图

df <- data.frame(
  x = rep(c(2, 5, 7, 9, 12), 2),
  y = rep(c(1, 2), each = 5),
  z = factor(rep(1:5, each = 2)),
  w = rep(diff(c(0, 4, 6, 8, 10, 14)), 2)
)


ggplot(df, aes(xmin = x - w / 2, xmax = x + w / 2, ymin = y, ymax = y + 1)) +
  geom_rect(aes(fill = z), colour = "grey50")

2.相关系数图

library(corrplot)
corr <- cor(mtcars[,1:7])
corrplot(corr = corr, method="number", col="black", cl.pos="n")

corrplot(corr = corr,order="AOE",type="upper",tl.pos="d")
corrplot(corr = corr,add=TRUE, type="lower", method="number",order="AOE", col="black",diag=FALSE,tl.pos="n", cl.pos="n")

# 常用参数
corrplot(corr,

method = c("circle", "square", "ellipse", "number", "shade", "color", "pie"),

type = c("full", "lower", "upper"), add = FALSE,

col = NULL, bg = "white", title = "",  is.corr = TRUE,

diag = TRUE, outline = FALSE, mar = c(0,0,0,0),

addgrid.col = NULL, addCoef.col = NULL, addCoefasPercent = FALSE, 



order = c("original", "AOE", "FPC", "hclust", "alphabet"),

hclust.method = c("complete", "ward", "single", "average",

                      "mcquitty", "median", "centroid"),

addrect = NULL, rect.col = "black", rect.lwd = 2,



tl.pos = NULL, tl.cex = 1,

tl.col = "red", tl.offset = 0.4, tl.srt = 90,



cl.pos = NULL, cl.lim = NULL,

cl.length = NULL, cl.cex = 0.8, cl.ratio = 0.15, 

cl.align.text = "c",cl.offset = 0.5,



addshade = c("negative", "positive", "all"),

shade.lwd = 1, shade.col = "white",



p.mat = NULL, sig.level = 0.05,

insig = c("pch","p-value","blank", "n"),

pch = 4, pch.col = "black", pch.cex = 3,


plotCI = c("n","square", "circle", "rect"),

lowCI.mat = NULL, uppCI.mat = NULL, ...)

corr：需要可视化的相关系数矩阵

method：指定可视化的方法，可以是圆形、方形、椭圆形、数值、阴影、颜色或饼图形

type：指定展示的方式，可以是完全的、下三角或上三角

col：指定图形展示的颜色，默认以均匀的颜色展示

bg：指定图的背景色

title：为图形添加标题

is.corr：是否为相关系数绘图，默认为TRUE，同样也可以实现非相关系数的可视化，只需使该参数设为FALSE即可

diag：是否展示对角线上的结果，默认为TRUE

outline：是否绘制圆形、方形或椭圆形的轮廓，默认为FALSE

mar：具体设置图形的四边间距

addgrid.col：当选择的方法为颜色或阴影时，默认的网格线颜色为白色，否则为灰色

addCoef.col：为相关系数添加颜色，默认不添加相关系数，只有方法为number时，该参数才起作用

addCoefasPercent：为节省绘图空间，是否将相关系数转换为百分比格式，默认为FALSE

order：指定相关系数排序的方法，可以是原始顺序(original)、特征向量角序(AOE)、第一主成分顺序(FPC)、层次聚类顺序(hclust)和字母顺序，一般”AOE”排序结果都比”FPC”要好

hclust.method：当order为hclust时，该参数可以是层次聚类中ward法、最大距离法等7种之一

addrect：当order为hclust时，可以为添加相关系数图添加矩形框，默认不添加框，如果想添加框时，只需为该参数指定一个整数即可

rect.col：指定矩形框的颜色

rect.lwd：指定矩形框的线宽

tl.pos：指定文本标签(变量名称)的位置，当type=full时，默认标签位置在左边和顶部(lt)，当type=lower时，默认标签在左边和对角线(ld)，当type=upper时，默认标签在顶部和对角线，d表示对角线，n表示不添加文本标签

tl.cex：指定文本标签的大小

tl.col：指定文本标签的颜色

cl.pos：图例（颜色）位置，当type=upper或full时，图例在右表(r)，当type=lower时，图例在底部，不需要图例时，只需指定该参数为n

addshade：只有当method=shade时，该参数才有用，参数值可以是negtive/positive和all，分表表示对负相关系数、正相关系数和所有相关系数添加阴影。注意：正相关系数的阴影是45度，负相关系数的阴影是135度

shade.lwd：指定阴影的线宽

shade.col：指定阴影线的颜色

九、仪表盘图

library(tidyverse)
bardata<-seq(from=0,to=270,length=1000)
rectdata<-seq(from=0,to=270,by=27)%>%c(360)
target<-1/3
assist<-target*270

ggplot(data=NULL)+
  geom_rect(
    aes(xmin=rectdata[-12],xmax=rectdata[-1],ymin=5,ymax=10),
    fill="#F2F2F2",col="white") +
  geom_bar(aes(x=bardata,y=5,col=bardata),
           stat="identity",fill=NA,size=2) +
  geom_text(aes(x=rectdata[-12],y=-5,
                label=seq(0,100,by=10)),
            vjust=.5,hjust=.5,size=5,col="#0F1110") +
  geom_segment(aes(x=assist,y=-50,xend=assist,yend=-10),
               arrow =arrow(length=unit(0.4,"cm")),
               size=1.2,col="red") +
  geom_point(aes(x=assist,y=-50),
             shape=21,fill="white",col="black",size=7) +
  annotate("text",x=315,y=-30,
           label=paste(round(target,4)*100,"%",sep=""),
           size=12,hjust=.5,vjust=.5,
           col=ifelse(target<.5,"#F32626","#38E968")) + 
  annotate("text",x=315,y=-15,
           label="指标1",size=15,
           hjust=.5,vjust=.5) + 
  ylim(-50,12) +
  coord_polar(theta="x",start=179.85)+
  scale_colour_gradient(low="#F32626",high="#38E968",guide=FALSE) +
  theme(
    text=element_blank(),
    line=element_blank(),
    rect=element_blank()
  )

十、集合图(维恩图)

library(grid)
library(VennDiagram)


venn.plot <- draw.pairwise.venn(
  area1 = 100,  #区域1的数
  area2 = 70,   #区域2的数
  cross.area = 30,  #交叉数
  category = c("First", "Second"),#分类名称
  fill = c("blue", "red"),#区域填充颜色
  lty = "blank",  #区域边框线类型
  cex = 2,        #区域内部数字的字体大小
  cat.cex = 2,    #分类名称字体大小
  cat.pos = c(285, 105), #分类名称在圆的位置，默认正上方，通过角度进行调整
  cat.dist = 0.09,   #分类名称距离边的距离（可以为负数）
  cat.just = list(c(-1, -1), c(1, 1)),  #分类名称的位置
  ext.pos = 30,  #线的角度 默认是正上方12点位置
  ext.dist = -0.05,   #外部线的距离
  ext.length = 0.85,  #外部线长度
  ext.line.lwd = 2,  #外部线的宽度
  ext.line.lty = "dashed"   #外部线为虚线
)
grid.draw(venn.plot); #显示图形

十二、雷达图

library(fmsb) 

set.seed(99)
data=as.data.frame(matrix( sample( 0:20 , 15 , replace=F) , ncol=5))
colnames(data)=c("math" , "english" , "biology" , "music" , "R-coding" )
rownames(data)=paste("mister" , letters[1:3] , sep="-")

data=rbind(rep(20,5) , rep(0,5) , data)

colors_border=c( rgb(0.2,0.5,0.5,0.9), rgb(0.8,0.2,0.5,0.9) , rgb(0.7,0.5,0.1,0.9) )
colors_in=c( rgb(0.2,0.5,0.5,0.4), rgb(0.8,0.2,0.5,0.4) , rgb(0.7,0.5,0.1,0.4) )

radarchart( data  , 
            axistype=1 , 
            pcol=colors_border , 
            pfcol=colors_in , 
            plwd=4 , 
            plty=1,
            cglcol="grey", 
            cglty=1, 
            axislabcol="grey", 
            caxislabels=seq(0,20,5), 
            cglwd=0.8,
            vlcex=0.8 
)
legend(x=0.7, y=1, legend = rownames(data[-c(1,2),]), bty = "n", pch=20 , col=colors_in , text.col = "grey", cex=1.2, pt.cex=3)

十三、组合图

library(tidyverse)
library(grid)
library(gtable)

colors <- c('#a28563','#faab59','#95d41c','#ffcc60','#ffc8a6','#febd7a','#6eba2c','#faab57','#faab58','#faab62','#faab64')

date <- rep(c("2019-01-01","2019-01-02","2019-01-03","2019-01-04","2019-01-05","2019-01-06","2019-01-07","2019-01-08","2019-01-09","2019-01-10","2019-01-11","2019-01-12","2019-01-13","2019-01-14","2019-01-15"),times = 2)

category <- rep(c("A","B"),each = 15)
num <- c(30736,27282,29025,31194,29924,28932,27832,31903,27909,32738,30244,31615,30173,32812,28460,47842,54023,57654,60445,59533,60608,72821,67248,63039,57283,65021,56505,56931,65328,66393)

df1 <- data.frame(date,category,num,stringsAsFactors = FALSE) %>%
  mutate(week_date = weekdays(as.Date(date)))
df2 <- data.frame(date= c("2019-01-01","2019-01-02","2019-01-03","2019-01-04","2019-01-05","2019-01-06","2019-01-07","2019-01-08","2019-01-09","2019-01-10","2019-01-11","2019-01-12","2019-01-13","2019-01-14","2019-01-15"),num2 = c(25.29,24.54,24.61,25.68,24.28,21.68,25.53,25.5,28.11,24.47,26.36,25.79,22.11,24,26.25),stringsAsFactors = FALSE) %>%
  mutate(week_date = weekdays(as.Date(date)))

p1 <- ggplot(df1,
             aes(x= ifelse(df1$date == max(df1$date),
                           df1$week_date,
                           as.character(format(as.Date(df1$date),'%m/%d'))),
                 y= num,
                 fill = category)) +
  geom_bar(stat = 'identity',position = position_dodge(),width = 0.4) +
  geom_text(aes(label = prettyNum(num,big.mark = ","), #加千分位符号
                hjust = 0.5,vjust = -0.5,color = category),
            position = position_dodge(0.4),size = 8,
            show.legend = F) +
  xlab('时间') +
  ylab('') +
  ggtitle('随意标题') +
  ylim(0,100000) +
  theme(plot.title = element_text(hjust =0.5,size=20),
        legend.position="top",
        axis.text.y = element_blank()) +
  scale_fill_manual(values = colors) +
  scale_color_manual(values = colors)


p2 <- ggplot(df2,
             aes(x = ifelse(df2$date == max(df2$date),
                            df2$week_date,
                            as.character(format(as.Date(df2$date),'%m/%d'))),
                 y = num2,
                 group =1 )) +
  geom_point(size = ifelse(df2$week_date == weekdays(as.Date(max(df2$date))),3,1),
             color = ifelse(df2$week_date == weekdays(as.Date(max(df2$date))),'red','black')) +
  geom_line(color = '#6eba2c') +
  geom_text(aes(label = num2, y = num2 + .2 ),size = 8) +
  theme(panel.grid.major=element_blank(),
        panel.grid.minor=element_blank(),
        plot.background=element_blank(),
        panel.background=element_blank(),
        axis.text.x=element_blank(),
        axis.title.x =element_blank(),
        axis.title.y =element_blank())%+replace% 
  theme(panel.background = element_rect(fill = NA))

g1 <- ggplot_gtable(ggplot_build(p1))
g2 <- ggplot_gtable(ggplot_build(p2))
# 重叠两张图
pp <- c(subset(g1$layout, name == "panel", se = t:r))


g <- gtable_add_grob(g1, 
                     g2$grobs[[which(g2$layout$name == "panel")]], 
                     pp$t,pp$l, pp$b, pp$l)

grid.newpage()
#axis tweaks
ia <- which(g2$layout$name == "axis-l")
ga <- g2$grobs[[ia]]
ax <- ga$children[[2]]
ax$widths <- rev(ax$widths)
ax$grobs <- rev(ax$grobs)
ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15, "cm")
g <- gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], length(g$widths))
g <- gtable_add_grob(g, ax, pp$t, length(g$widths) - 1, pp$b)
grid.newpage() #一定要加，表示在新增一页作图，不加图形会重叠
grid.draw(g)