美文网首页
R语言拼图

R语言拼图

作者: 白云梦_7 | 来源:发表于2020-02-08 16:33 被阅读0次

转自https://mp.weixin.qq.com/s/W2nKMe4u2VLBswFkvhoXDw
实例

customLayout拼图
cowplot是ggplot2包的简单补充,可以组合多个”ggplot2”绘制的图为一个图,并且为每个图加上例如A,B,C等标签
grid画布分割
gridExtra可子母图

1. customLayout包

library(ggplot2)
library(customLayout)

(1)简单布局

i.lay1<-lay_new(mat = matrix(1:4,ncol=2),widths = c(3,2),heights = c(2,1))
lay_show(lay1)

I

ii.lay2 <- lay_new( matrix(1:4, nc = 2), widths = c(3, 5),heights = c(2, 4))

II
iii.cl_1 <- lay_bind_col(lay1, lay2, widths = c(3, 1))
按行合并
iv.cl_2 <- lay_bind_row(lay1, lay2, heights = c(3, 1))
按列合并
v.slay <- lay_split_field(lay1, lay2, field = 1)
填充

(2)绘图对象填充

lay1 <- lay_new(matrix(1:2, ncol = 1))
lay2 <- lay_new(matrix(1:3))
cl <- lay_bind_col(lay1, lay2, widths = c(3, 1))

lay_show(cl)

image.png
cuts <- sort(unique(diamonds[["cut"]]), decreasing = TRUE)
make_cut_plot <- function(cut) {
                                dd <- diamonds[cut == diamonds[["cut"]], ]
                                ggplot(dd) + geom_point(aes(carat, price)) +  facet_wrap("cut")
                                }

plots <- lapply(cuts, make_cut_plot)
lay_grid(plots, cl)
image.png

2. cowplot包

library(gridExtra)
library(ggplot2)
library(cowplot)
library(showtext)
font_add_google("Dancing Script", "Dancing")
plot.iris <- ggplot(iris, aes(Sepal.Length, Sepal.Width)) +
geom_point() +
facet_grid(cols = vars(Species))
plot.iris
plot.mpg <- ggplot(mpg, aes(x = cty, y = hwy, colour = factor(cyl))) +
geom_point(size = 2.5) +
labs(title = "dot plot")
plot.mpg
plot.diamonds <- ggplot(diamonds, aes(clarity, fill = cut)) +
geom_bar() +
theme(axis.text.x = element_text(angle = 70, vjust = 0.5)) +
labs(title = "bar plot")
plot.diamonds
gg <- ggdraw() +
draw_plot(plot.iris, 0, 0.5, 1, 0.5) + # 在母图上半部,占母图比例1/2
draw_plot(plot.mpg, 0, 0, 0.5, 0.5) + # 在母图左下角,占母图比例1/4
draw_plot(plot.diamonds, 0.5, 0, 0.5, 0.5) + # 在母图右下角,占母图比例1/4
draw_plot_label(c("A", "B", "C"), c(0, 0, 0.5), c(1, 0.5, 0.5), size = 15, colour = "cyan", family = "Dancing") # 加上标签,
showtext_begin()
print(gg)
showtext_end()
image.png

3. grid包

library(ggplot2)
library(grid)
library(showtext)

(1) 简单布局

YaHei <- windowsFont("微软雅黑")font_add("YaHei", regular = "msyh.ttc", bold = "msyhbd.ttc")  # 右键字体,然后点击属性,regular指定常规, bold表示指定粗体字体 
showtext_auto()

plot.iris <- ggplot(iris, aes(Sepal.Length, Sepal.Width)) + 
geom_point() + 
facet_grid(cols = vars(Species))  # 按Species列分面

plot.mpg <- ggplot(mpg, aes(x = cty, y = hwy, colour = factor(cyl))) + 
geom_point(size = 2.5) +       
labs(title = "dot plot")

plot.diamonds <- ggplot(diamonds, aes(clarity, fill = cut)) + 
geom_bar() + 
theme(axis.text.x = element_text(angle = 70, 
    vjust = 0.5)) + labs(title = "bar plot")

grid.newpage() # 新建画布
layout_1 <- grid.layout(nrow = 3, ncol = 2, widths = c(1, 1), heights = c(1, 4, 5)) # 分成上下2*3共6个版块,最上面版块显示标题

pushViewport(viewport(layout = layout_1))  # 推出分成6个版块的视窗
print(plot.iris, vp = viewport(layout.pos.row = 2, layout.pos.col = c(1, 2)))  # 在中间一行子视窗中画plot.iris
print(plot.mpg, vp = viewport(layout.pos.row = 3, layout.pos.col = 1))  # 在左下角子视窗中画plot.mpg
print(plot.diamonds, vp = viewport(layout.pos.row = 3, layout.pos.col = 2))  #在右下角子视窗中画plot.diamonds
grid.text("我是画布名称", x = 0.5, y = 0.95, gp = gpar(col = "orange", fontfamily = "YaHei", fontsize = 15))  # 增加画布标题
image.png

(2)蝴蝶图

library(ggplot2)
library(grid)
library(dplyr)
library(showtext)
library(Cairo)
YaHei <-  windowsFont("微软雅黑")
font_add("YaHei",regular = "msyh.ttc", bold = "msyhbd.ttc") # 右键字体,然后点击属性,regular指定常规, bold表示指定粗体字体 
showtext_begin()#生成图形所需数据集:
mydata<-data.frame(id=1:14,
A=c(5.0,14.7,2.5,8.5,5.1,6.9,7.7,6.8,4.4,4.9,5.3,1.0,0.9,7.8),
B=c(31.3,24.7,17.8,17.2,15.3,14.3,13.9,13.9,12.4,10.0,6.5,4.2,2.5,0.9),
Label=c("Website","Customer & Employee Referral","Webinar","Facebook/Twitter/Other Social","Marketting & Advertising","Paid Serch","Other","Sales generated","Tradeshows","Parter","Linkedin","Events","Lead list","Emial Campaign"))
p1<-ggplot(mydata) + # 绘制右侧的柱形图  
geom_hline(yintercept=mean(mydata$A),linetype=2,size=.25,colour="grey")+  
geom_bar(aes(x=id,y=A),stat="identity",fill="#E2BB1E",colour=NA)+  
ylim(-5.5,16)+   
scale_x_reverse()+   
geom_text(aes(x=id,y=-4,label=Label),vjust=.5)+  
geom_text(aes(x=id,y=A+.75,label=paste0(A,"%")),size=4.5,family="YaHei",fontface="bold")+  
coord_flip()+  
theme_void()
p2<-ggplot(mydata)+ # 绘制左侧柱形图, 左侧图没有横坐标刻度标签  
geom_hline(yintercept=-mean(mydata$B),linetype=2,size=.25,colour="grey")+  geom_bar(aes(x=id,y=-B),stat="identity",fill="#C44E4C",colour=NA)+ 
# y=-B,绘制的图形在另一侧  
ylim(-40,0)+  scale_x_reverse()+ #   
geom_text(aes(x=id,y=-B-1.75,label=paste0(B,"%")),size=4.5,family="YaHei",fontface="bold")+  
coord_flip()+  
theme_void()
# 图形拼接
grid.newpage() # 新建画布
layout_1 <- grid.layout(nrow = 2, ncol = 2, widths = c(2, 3), heights = c(1, 9)) # 分成2*2共4个版块
pushViewport(viewport(layout = layout_1)) # 推出分为4个版块的视窗
print(p1, vp = viewport(layout.pos.row = 2, layout.pos.col = 2)) # 将p1输出到右下角
print(p2, vp = viewport(layout.pos.row = 2, layout.pos.col = 1)) # 将p2输出到左下角# 添加主标题和分标题

grid.text(label="我是主标题",x = 0.5,y = 0.97,gp=gpar(col="cyan",fontsize=15,fontfamily="YaHei",draw=TRUE,just = "centre"))
grid.text(label="我是左标题", x = 0.15,y =0.94,gp=gpar(col="blue",fontsize=10,fontfamily="YaHei",draw=TRUE,just = c("left", "top")))
grid.text(label="我是右标题",x = 0.85,y =0.94,gp=gpar(col="blue",fontsize=10,fontfamily="YaHei",draw=TRUE,just = c("right", "top")))
showtext_end()
蝴蝶图

4. gridExtra包

(1)简单布局

library(ggplot2)
library(gridExtra)
library(showtext)

YaHei <-  windowsFont("微软雅黑")
font_add("YaHei",regular = "msyh.ttc", bold = "msyhbd.ttc") # 右键字体,然后点击属性,regular指定常规, bold表示指定粗体字体 
showtext.auto()

empty <- ggplot() + geom_point(aes(1, 1), colour = "white") +   
theme(axis.ticks = element_blank(), 
        panel.background = element_blank(), 
        axis.line = element_blank(), 
        axis.text.x = element_blank(), axis.text.y = element_blank(), 
        axis.title.x = element_blank(), axis.title.y = element_blank())

scatter <- ggplot() + 
geom_point(aes(mtcars$mpg, mtcars$qsec)) # 绘制主图散点图
hist_top <- ggplot() + 
geom_histogram(aes(mtcars$mpg)) # 绘制上方频率分布直方图
hist_right <- ggplot() + 
geom_histogram(aes(mtcars$qsec)) + coord_flip() # 绘制右侧频率分布直方图# 最终组合,由4个图拼图而成,只有右上角的图已经将标注移除了
grid.arrange(hist_top, empty, scatter, hist_right, 
# 按从左到右,从上到下顺序排列4个图ncol = 2, nrow = 2, widths = c(4, 1), heights = c(1, 4)) 

4个版块的长宽比例# 其实这种组合图已经有相应的R包了,

df <- data.frame(x = mtcars$mpg, y = mtcars$qsec)
p <- ggplot(df, aes(x, y)) + geom_point() + theme_classic()
ggExtra::ggMarginal(p, type = "histogram")
1
2

(2)子母图

library(ggplot2)
library(gridExtra)
g <- ggplotGrob(qplot(1, 1) +                               
theme(plot.background = element_rect(colour = "black")))
qplot(1:10, 1:10) +    
annotation_custom(      # 通过添加注释的方式,向图形内部添加一个图形
    grob = g,  # 插入图形对象,即添加内容
    xmin = 1, xmax = 5, ymin = 5, ymax = 10 # 添加位置4个坐标
  )
image.png

相关文章

网友评论

      本文标题:R语言拼图

      本文链接:https://www.haomeiwen.com/subject/nvsiwctx.html