边际图和组合折线图

边际图和组合折线图

#加载 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$grobs[[which(p2$layout$name={=}^{\prime }pane{l}^{\prime })]],pp$t, pp$l,pp$b, 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
1
2
3
4
5
6
7
8
9
10
11
12

}

Get the y axis title from p2

index <- which(p2$layout$name == ‘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$widths[p2$layout[index, ]$l],pp$r)
p1 <- gtable_add_grob(p1, ylab, pp$t,pp$r + 1, pp$b,pp$r + 1, clip = ‘off’, name = ‘ylab-r’)

Get the y axis from p2 (axis line, tick marks, and tick mark labels)

index <- which(p2$layout$name == ‘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$children[[1]]$x <- unit.c(unit(0, ‘npc’), unit(0, ‘npc’))

Second, swap tick marks and tick mark labels

ticks <- yaxis$children[[2]]ticks$widths <- rev(ticks$widths)ticks$grobs <- rev(ticks$grobs)

Third, move the tick marks

ticks$grobs[[1]]$x <- ticks$grobs[[1]]$x - unit(1, ‘npc’) + unit(3, ‘pt’)

Fourth, swap margins and fix justifications for the tick mark labels

ticks$grobs[[2]]<-hinver{t}_{t}itl{e}_{g}rob(ticks$grobs[[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$widths[p2$layout[index, ]$l],pp$r)
p1 <- gtable_add_grob(p1, yaxis, pp$t,pp$r + 1, pp$b,pp$r + 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$sp<-plots$sp + # sp为散点图主图
geom_hline(yintercept = 3, linetype = “dashed”, color = “blue”) +
geom_vline(xintercept = 6, linetype = “dashed”, color = “red”)
plots

plots$sp<-plots$sp +
stat_smooth(method=lm)
plots

model <- lm(Sepal.Length ~ Sepal.Width, iris)
summary(model)

plots$sp<-plots$sp +
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”)