边际图和组合折线图
#加载 R 包，其中 ggplot2 用于作图，gtable 用于提取图像属性，grid 用于合并图像
library(ggplot2)
library(gtable)
library(grid)
定义函数，用于组合 ggplot2 绘图结果构建双坐标轴，参考自：
https://stackoverflow.com/questions/36754891/ggplot2-adding-secondary-y-axis-on-top-of-a-plot
y2_plot <- function(p1, p2) {
p1 <- ggplotGrob(p1)
p2 <- ggplotGrob(p2)
Get the location of the plot panel in p1.
These are used later when transformed elements of p2 are put back into p1
pp <- c(subset(p1$layout, name == ‘panel’, se = t:r))
Overlap panel for second plot on that of the first plot
p1 <- gtable_add_grob(p1, p2 g r o b s [ [ w h i c h ( p 2 grobs[[which(p2 grobs[[which(p2layout n a m e = = ′ p a n e l ′ ) ] ] , p p name == 'panel')]], pp name==′panel′)]],ppt, pp l , p p l, pp l,ppb, pp$l)
Then proceed as before:
ggplot contains many labels that are themselves complex grob;
usually a text grob surrounded by margins.
When moving the grobs from, say, the left to the right of a plot,
Make sure the margins and the justifications are swapped around.
The function below does the swapping.
Taken from the cowplot package:
https://github.com/wilkelab/cowplot/blob/master/R/switch_axis.R
hinvert_title_grob <- function(grob){
# Swap the widths
widths <- grob$widths
grob$widths[1] <- widths[3]
grob$widths[3] <- widths[1]
grob$vp[[1]]$layout$widths[1] <- widths[3]
grob$vp[[1]]$layout$widths[3] <- widths[1]
# Fix the justification
grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust
grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust
grob$children[[1]]$x <- unit(1, 'npc') - grob$children[[1]]$x
grob
}
Get the y axis title from p2
index <- which(p2
l
a
y
o
u
t
layout
layoutname == ‘ylab-l’) # Which grob contains the y axis title?
ylab <- p2$grobs[[index]] # Extract that grob
ylab <- hinvert_title_grob(ylab) # Swap margins and fix justifications
Put the transformed label on the right side of p1
p1 <- gtable_add_cols(p1, p2
w
i
d
t
h
s
[
p
2
widths[p2
widths[p2layout[index, ]
l
]
,
p
p
l], pp
l],ppr)
p1 <- gtable_add_grob(p1, ylab, pp
t
,
p
p
t, pp
t,ppr + 1, pp
b
,
p
p
b, pp
b,ppr + 1, clip = ‘off’, name = ‘ylab-r’)
Get the y axis from p2 (axis line, tick marks, and tick mark labels)
index <- which(p2
l
a
y
o
u
t
layout
layoutname == ‘axis-l’) # Which grob
yaxis <- p2$grobs[[index]] # Extract the grob
yaxis is a complex of grobs containing the axis line, the tick marks, and the tick mark labels.
The relevant grobs are contained in axis$children:
axis$children[[1]] contains the axis line;
axis$children[[2]] contains the tick marks and tick mark labels.
First, move the axis line to the left
yaxis c h i l d r e n [ [ 1 ] ] children[[1]] children[[1]]x <- unit.c(unit(0, ‘npc’), unit(0, ‘npc’))
Second, swap tick marks and tick mark labels
ticks <- yaxis c h i l d r e n [ [ 2 ] ] t i c k s children[[2]] ticks children[[2]]tickswidths <- rev(ticks w i d t h s ) t i c k s widths) ticks widths)ticksgrobs <- rev(ticks$grobs)
Third, move the tick marks
ticks g r o b s [ [ 1 ] ] grobs[[1]] grobs[[1]]x <- ticks g r o b s [ [ 1 ] ] grobs[[1]] grobs[[1]]x - unit(1, ‘npc’) + unit(3, ‘pt’)
Fourth, swap margins and fix justifications for the tick mark labels
ticks g r o b s [ [ 2 ] ] < − h i n v e r t t i t l e g r o b ( t i c k s grobs[[2]] <- hinvert_title_grob(ticks grobs[[2]]<−hinverttitlegrob(ticksgrobs[[2]])
Fifth, put ticks back into yaxis
yaxis$children[[2]] <- ticks
Put the transformed yaxis on the right side of p1
p1 <- gtable_add_cols(p1, p2
w
i
d
t
h
s
[
p
2
widths[p2
widths[p2layout[index, ]
l
]
,
p
p
l], pp
l],ppr)
p1 <- gtable_add_grob(p1, yaxis, pp
t
,
p
p
t, pp
t,ppr + 1, pp
b
,
p
p
b, pp
b,ppr + 1, clip = ‘off’, name = ‘axis-r’)
grid.newpage()
grid.draw(p1)
}
#使用的 R 自带的 mtcars 数据集，绘制“mpg-disp”与“mpg-drat”折线图，并尝试组合展示
#“mpg-disp”的折线图
p1 <- ggplot(mtcars, aes(mpg, disp)) +
geom_line(color = ‘blue’) +
theme(panel.grid = element_blank(), panel.background = element_rect(fill = NA, color = ‘black’),
axis.text.y = element_text(color = ‘blue’), axis.ticks.y = element_line(color = ‘blue’),
axis.title.y = element_text(color = ‘blue’)) +
labs(y = ‘disp’)
p1
#“mpg-drat”的折线图
p2 <- ggplot(mtcars, aes(mpg, drat)) +
geom_line(color = ‘red’) +
theme(panel.grid = element_blank(), panel.background = element_rect(fill = NA, color = ‘black’),
axis.text.y = element_text(color = ‘red’), axis.ticks.y = element_line(color = ‘red’),
axis.title.y = element_text(color = ‘red’)) +
labs(y = ‘drat’)
p2
#两张图共用同一 x 轴，尝试组合到一起，组合后默认第一张图的 y 轴在左侧，第二张图的 y 轴在右侧
y2_plot(p1, p2)
#输出图片
ggsave(‘p12.pdf’, y2_plot(p1, p2)[2], width = 5, height = 4)
ggsave(‘p12.png’, y2_plot(p1, p2), width = 5, height = 4)
setwd(“C:\Users\dell\Desktop”)
mtcarss=read.csv(“RF.csv”)
mtcarss
#使用的 R 自带的 mtcars 数据集，绘制“mpg-disp”与“mpg-drat”折线图，并尝试组合展示
#“mpg-disp”的折线图
p1 <- ggplot(mtcarss, aes(Year, PPM)) +
geom_line(color = ‘blue’) +
theme(panel.grid = element_blank(), panel.background = element_rect(fill = NA, color = ‘black’,size=1.5),
axis.text.y = element_text(size=16,color = ‘blue’), axis.ticks.y = element_line(color = ‘blue’),
axis.title.y = element_text(size=16,color = ‘blue’),axis.text.x = element_text(size=16,color = ‘black’) , axis.title.x = element_text(size=16,color = ‘black’)) +geom_line( color = ‘blue’,size=1)+
labs(y = ‘PPM’)
p1
#“mpg-drat”的折线图
p2 <- ggplot(mtcarss, aes(Year,temp )) +
geom_line(color = ‘red’) +
theme(panel.grid = element_blank(), panel.background = element_rect(fill = NA, color = ‘black’,size=1.5),
axis.text.y = element_text(size=16,color = ‘red’), axis.ticks.y = element_line(color = ‘red’),
axis.title.y = element_text(size=16,color = ‘red’),axis.text.x = element_text(size=16,color = ‘black’) , axis.title.x = element_text(size=16,color = ‘black’)) +geom_line( color = ‘red’,size=1)+
labs(y = ‘temp’)
p2
#两张图共用同一 x 轴，尝试组合到一起，组合后默认第一张图的 y 轴在左侧，第二张图的 y 轴在右侧
y2_plot(p1, p2)
#输出图片
ggsave(‘p12.pdf’, y2_plot(p1, p2), width = 5, height = 4)
ggsave(‘p121.png’, y2_plot(p1, p2), width = 5, height = 4)
/R语言基本功：绘制带边际图的散点图
刘老师医学统计 2020-08-25 20:35
#install.packages(“ggpubr”) # 安装包
library(ggpubr) # 加载包
data(iris) # 加载数据集
View(iris) # 预览数据集
plots <- ggscatterhist(iris, # 包含绘图变量的数据集
x = “Sepal.Length”, y = “Sepal.Width”, # 绘图变量
color = “#00AFBB”, # 设置颜色
margin.params = list(fill = “#00AFBB”)) # 设置边际图的颜色
plots <- ggscatterhist(iris, # 包含绘图变量的数据集
x = “Sepal.Length”, y = “Sepal.Width”, # 绘图变量
color = “#00AFBB”, # 设置颜色
margin.plot = “histogram”, # 设置边际图的类型
margin.params = list(fill = “#00AFBB”)) # 设置边际图的颜色
plots
s
p
<
−
p
l
o
t
s
sp <- plots
sp<−plotssp + # sp为散点图主图
geom_hline(yintercept = 3, linetype = “dashed”, color = “blue”) +
geom_vline(xintercept = 6, linetype = “dashed”, color = “red”)
plots
plots
s
p
<
−
p
l
o
t
s
sp <- plots
sp<−plotssp +
stat_smooth(method=lm)
plots
model <- lm(Sepal.Length ~ Sepal.Width, iris)
summary(model)
plots
s
p
<
−
p
l
o
t
s
sp <- plots
sp<−plotssp +
annotate(“text”, x=4.7, y=4.4, parse=TRUE,
label=“r^2 == 0.0138 * ’ p-value = 0.1529’”)
plots
ggscatterhist(
iris, x = “Sepal.Length”, y = “Sepal.Width”,
color = “Species”, size = 2.5, alpha = 0.5,
palette = c(“#00AFBB”, “#E7B800”, “#FC4E07”),
margin.params = list(fill = “Species”, color = “black”, size = 0.2)
)
ggscatterhist(
iris, x = “Sepal.Length”, y = “Sepal.Width”,
color = “Species”, size = 3, alpha = 0.6,
palette = c(“#00AFBB”, “#E7B800”, “#FC4E07”),
margin.plot = “histogram”,
ggtheme = theme_bw()
)
setwd(“C:\Users\dell\Desktop”)
library(ggpubr)
ggscatterhist(iris,
x = “Sepal.Length”,
y = “Sepal.Width”)
ggscatterhist(iris,
x = “Sepal.Length”,
y = “Sepal.Width”,
color = “Species”,
size=4,
palette = c(“#00AFBB”, “#E7B800”, “#FC4E07”),
margin.plot = “boxplot”,
ggtheme = theme_bw(),
margin.params = list(fill=“Species”))
#https://www.jianshu.com/p/ec9e39362f24
##https://www.jianshu.com/p/ece7c8848fd9
Import the data
file_path <- “http://www.sthda.com/sthda/RDoc/data/housetasks.txt”
housetasks <- read.delim(file_path, row.names = 1)
head(housetasks)
chisq <- chisq.test(housetasks)
ggballoonplot(housetasks,
fill = “value”,
size.range = c(1,15))+
scale_fill_viridis_c(option = “C”)
4674
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
