ggplot2 学术绘图案例
lcpmgh
2024-03-31
ggplot2 学术绘图案例
在这份笔记中，我将尝试用ggplot2复现自己在学术期刊、新闻报刊中看到的漂亮的数据可视化图，或是总结自己在科研过程中使用ggplot2学习到的画图技巧。所有内容都会以案例形式展示，并将持续更新。
注意：
由于全部笔记都为案例形式，其中的画图技巧可能总结得不全面而且比较零散，因此仅供参考。
所有案例数据都为公开数据或测试数据（无实际意义），仅供画图学习，本人不保证数据真实正确、所有数据也都不代表本人观点。
如果对这些绘图案例有修改意见，欢迎交流讨论。
文中所有代码均为原创，转载请注明出处。
环境设定
# 加载包
library(data.table)## Warning: 程辑包'data.table'是用R版本4.3.3 来建造的library(ggplot2)## Warning: 程辑包'ggplot2'是用R版本4.3.3 来建造的library(magrittr)
# 定义函数
# 1. 建立函数将R environment中的data.frame转为字符串，用于在文档中保存短小的数据（如案例5数据，注意数据量大时会报错）
texttable <- function(data){
# 表格转文字格式的函数
col.n <- ncol(data)
col.name <- names(data)
res <- "data <- data.frame("
for(i in 1:col.n){
val <- data[[i]]
if(is.character(val)){
tres <- paste0(col.name[i]," = c('", paste0(val, collapse = "', '"), "'), ")
} else{
tres <- paste0(col.name[i], " = c(", paste0(val, collapse = ", "), "), ")
}
res <- paste(res, tres)
}
# res <- str_remove(res,", $") %>% paste0(")")
res <- gsub(", $", "", res)
res <- paste0(res, ")")
return(res)
}案例1：显示数学符号和公式
ggplot2中，显示数学符号公式的方法有Rbase的expression(...)和html语法的ggtext::element_markdown()
注意：
expression函数中任意字符如不能识别为符号，则以字符串形式（公式中的变量名）显示，例如
expression(abscsdfwlapha3)直接会显示abscsdfwlapha3，可以有括号，但是要单独在首尾。expression或parse函数（将字符串转为expression）中，数学符号和字符串之间必须有连接符，连接方法有
*和paste（无空格连接）以及~（有空格连接）。例如以下三个结果相同：expression(''^210*Pb[ex])和expression(paste(''^210,Pb[ex]))和parse(text="''^210*Pb[ex]")。注意有一些符号(如上下标)前必须要有字符，没有要加空字符，例如上面^号前的''；注意^后至*或~前所有字符都是上标，如果不确定，可以用^{210}指定上标部分，当然遇到特殊符号格式不对会报错。geom_text中，使用expression类型的输入会报警告(无论是否有
parse=T)，但仍可在图像上画出数学符号(ggplot2 v.3.4.2)。解决办法是，直接用字符型，然后设置parse=T（注意仅在geom_text中这么用），例如：建议用geom_text(label="''^210*Pb[ex]",parse=T)取代geom_text(label=expression(''^210*Pb[ex]))。对于geom_text，如果有向量变量（如a）单独存储数学符号（expression或字符串），则只能在aes外指定label：
geom_text(label=a,parse=T)；如果在画图数据中有一列（如dt$l）储存字符串格式的数学符号，则只能这样使用：geom_text(aes(label=l), parse = T)。在数据的一些位置不能使用expression，例如data.table的元素和列名都不支持，而虽然data.frame支持，但是在ggplot2分面标题中，也不能使用expression，此时可借助
ggtext::element_markdown()，使用html语法实现分面标题的数学符号（如下面第二个图），注意这个方法，除了分面标题，其他位置不建议用，因为常不起作用。查看或生成html格式的数学公式，可参考以下资料：5.1 HTML数学公式
5.2 公式手写识别与html代码生成
5.4 Unicode字符代码
关于expression在绘图中显示的符号，详细帮助见
?plotmath；其他可用符号，可参考The Adobe Symbol Encoding
图1，base::expression
point <- data.table(px = c(18,20,22,24,26,28,30,32,34,36,38,40),
py = c(4,5,12,35,84,45,47,41,22,25,3,5))
fline <- data.table(lx = seq(15, 43, by = 0.02),
ly = 60.5921*exp(-((seq(15, 43, by = 0.02)-28.0006)/6.0670)^2))
x.labl <- c(expression(gamma),expression(delta),expression(epsilon),
expression(zeta),expression(eta),expression(kappa),expression(lambda))
y.labl <- c(expression(Alpha), expression(Beta), expression(Gamma), expression(Delta),
expression(Epsilon), expression(Zeta), expression(Eta), expression(Theta),
expression(Iota), expression(Kappa))
# 注释掉的代码有助于理解其他方法，但不推荐使用；数据和符号无实际意义，纯粹为了实验能否使用
ggplot()+
geom_point(data = point, aes(px, py, shape = "sha"), colour = "red", size = 2)+ #给定一个shape的名称为sha
geom_line(data = fline, aes(lx, ly, color = "col"), linetype = 2)+
scale_color_manual(values = c("col" = "blue"), labels = expression(beta))+ #线label
scale_shape_manual(values = c("sha" = 15), labels = expression(alpha))+ #点label
guides(color = guide_legend(title = expression(r^2 == 111), order = 1))+ #线title
guides(shape = guide_legend(title = expression(r[2] == 222), order = 2))+ #点title
geom_text(data = NULL, aes(36, 70), label = "Fit~line:~y == 61*e^{-(frac(x-28,6))}^2", parse = T)+ #拟合线
geom_text(data = NULL, aes(36, 60), label = "r^2 * '=' * '0.7610'", parse = T)+ #拟合优度
# geom_text(data = NULL, aes(36, 60), label = "paste(r^2, '=','0.7610')", parse = T)+ #结果同上，但略复杂
# geom_text(data = NULL, aes(36, 60), label = "r^2 == 0.7610", parse = T)+ #结果类似，但等式格式最后0不显示
scale_x_continuous(breaks = seq(15, 45, by = 5), limits = c(15, 45), expand = c(0,0), labels = x.labl)+
scale_y_continuous(breaks = seq(0, 90, by = 10), limits = c(0, 90), expand = c(0,0), labels = y.labl)+
labs(title = expression(sqrt(a,b)), x = expression(bold(prod(plain(P)(X==x), x))~(km^3)), y = expression(intersect(A[i], i==1, n)~italic(H[2]*CO[3]~mol%.%L^-1)))+
theme_bw()+
theme(aspect.ratio = 1/1.5,
panel.border = element_rect(linewidth = 1),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 0.5))
图2，ggtext::element_markdown
library(ggtext)
data <- data.table(class = c("a"),
cs137 = c(1), pb210 = c(2), xlf = c(3),
xhf = c(4), L_star = c(5), a_star = c(6),
b_star = c(7), c_star = c(8), h_star = c(9))
ename <- c("<sup>137</sup>Cs (Bq/kg)",
"<sup>210</sup>Pb<sub>ex</sub> (Bq/kg)",
"χ<sub>lf</sub> (10<sup>-8</sup> m<sup>3</sup>/kg)",
"χ<sub>hf</sub> (10<sup>-8</sup> m<sup>3</sup>∙kg<sup>-1</sup>)",
"L<sup>*</sup> (∫)",
"a<sup>*</sup> (δ)",
"b<sup>*</sup> (∆)",
"c<sup>*</sup> (σ)",
"h<sup>*</sup> (Ω)")
dt.plot <- data %>% set_colnames(c("class", ename)) %>% melt(id = "class", variable = "tracer", value = "value")
ggplot(dt.plot, aes(class, value)) +
geom_point()+
facet_wrap(tracer~., scales = "free") +
labs(x = "", y = "", title = "")+
theme_bw() +
theme(aspect.ratio = 1/1.5,
plot.title = element_text(hjust = 0.5),
strip.background = element_rect(fill = "white", color = "black"),
strip.text = element_markdown())
案例2：ggplot2设置文字字体
注意：
\* 注意使用`sysfonts::font.families()`查看当前可用字体，这几个字体一般可以直接在ggplot中使用，而不需要额外包，windows版默认的字体中，'sans'是无衬线（Arial），'serif'是有衬线（times new roman），'mono'是等宽字体（Courier New），科研绘图最常用是'serif'。一个可行的ggplot2配置、显示字体流程：
1.1. 在R中查看哪些字体可用：
sysfonts::font.families()；1.2. 选择字体或使用
sysfonts::font.add()用本地文件添加字体；1.3. 使用
showtext::showtext_auto()在ggplot2中显示字体；1.4. 使用ggplot2画图并定义字体
windows字体保存位置
C:\Windows\Fonts某些时候Rstudio的plot窗口不能显示字体，可在Tools - Global options - General - Graphics - Graphics Device - Backend修改参数，或者将图片保存本地后查看
在Rstudio中绘图显示不同字体，与Rmd和Rmd保存为html时，显示结果不一样。例如有时windows系统字体虽然sysfonts::font_families()不显示，但是在Rstudio也能调用，如Times New Roman，但是在Rmd html中则必须要载入、调用，否则提示没有该字体。如果在Rstudio中可以直接用，则不建议showtext::showtext_auto()，因为它会让文字变得非常小，要显著调大size才能正常显示，也因此建议画完图后就用showtext::showtext_auto(FALSE)关闭该功能。
library(showtextdb)
library(sysfonts)## Warning: 程辑包'sysfonts'是用R版本4.3.3 来建造的library(showtext)## Warning: 程辑包'showtext'是用R版本4.3.3 来建造的sysfonts::font_add("font1", regular = "D:/#R/learn_ggplot2/STXINGKA.TTF")
sysfonts::font_add("font2", regular = "D:/#R/learn_ggplot2/times.ttf")
sysfonts::font_add("font3", regular = "D:/#R/learn_ggplot2/SmileySans-Oblique.TTF")
sysfonts::font_add("font4", regular = "D:/#R/learn_ggplot2/STHUPO.TTF")
# sysfonts::font_families() #查看可行字体
showtext::showtext_auto() #在ggplot2图中显示字体
p <- ggplot()+
geom_text(aes(1.5,1),label="(theme改字体geom_text不生效)\nABcde\n12345\n中文字体",size=8)+
geom_text(aes(4.5,1),label="(必须在geom_text改字体)\nABcde\n12345\n中文字体",size=8,family="font1")+
geom_text(aes(0,0.86),label="注意：轴label字体会随theme的element_text(family='font1')设置改变",size=7,hjust=0)+
scale_x_continuous(limits=c(0,6))+
scale_y_continuous(limits=c(0.85,1.1), expand=c(0,0))+
labs(x="variable 12345 横坐标轴", y="value 12345 纵坐标轴", title="title 12345 图标题")+
theme_bw()+
theme(panel.grid = element_blank(),
text = element_text(family = "font1"),
axis.text = element_text(size=20),
axis.title.x = element_text(family = "font2", size=20), #Times New Roman不显示中文
axis.title.y = element_text(family = "font3", size=20),
title = element_text(family = "font4", size=20))
# ggsave("text.tiff",p,width = 10, height = 10, units = "cm", dpi = 300) #保存图注意p的位置
print(p)
showtext_auto(FALSE) #画完图关闭，打开时画图文字会变得非常小，只能把字号设置的额外大才正常案例3：指示线
来自网上的一个画图案例，具体来源记不清了，我把代码简化了，画图结果不变。
mydata <- data.table(response = c("Stringent complete response", "Complete response", "Very good partial response", "Partial response"), percentage = c(0.327, 0.067, 0.194, 0.042))
mydata$response <- factor(mydata$response , levels = c("Stringent complete response", "Complete response", "Very good partial response", "Partial response"))
dat.col <- c("darkgreen", "darkolivegreen3", "steelblue4", "lightskyblue3")
dat.tex <- data.table(x=c(1,0.55,1.5), y=c(0.66,0.43,0.33), l=c("63.0 (104/165)", " ≥CR: \n39.4", " ≥VGPR: \n58.8"))
dat.seg.left <- data.table(x=c(0.65,0.69,0.69,0.69),
xe=c(0.69,0.73,0.73,0.69),
y=c(0.43,0.63,0.236,0.236),
ye=c(0.43,0.63,0.236,0.63))
dat.seg.righ <- data.table(x=c(1.31,1.27,1.27,1.31),
xe=c(1.35,1.31,1.31,1.31),
y=c(0.33,0.63,0.042,0.042),
ye=c(0.33,0.63,0.042,0.63))
ggplot(mydata, aes(x = "", y = percentage, fill = response)) +
geom_bar(stat = "identity", width = 0.5, alpha = 0.9) +
geom_text(aes(label = percentage * 100), position = position_stack(vjust = 0.5), size = 2.3, colour = c("white", "white", "white", "black")) +
geom_text(data=dat.tex, aes(x,y,label=l,fill=NULL), size=2.5)+ #无法继承的aes要为NULL
geom_segment(data=dat.seg.left, aes(x=x,xend=xe,y=y,yend=ye,fill=NULL))+ # 左侧{
geom_segment(data=dat.seg.righ, aes(x=x,xend=xe,y=y,yend=ye,fill=NULL))+ # 右侧{
scale_fill_manual(values = dat.col) +
scale_y_continuous(breaks = seq(0, 1, 0.1), label = seq(0, 100, 10), limits = c(0, 1), expand = c(0, 0)) +
labs(x="All Patients", y="Percentage of Patients with Response", fill = "Response:") +
coord_cartesian(clip = "off") +
theme_classic() +
theme(legend.position = "top",
legend.text = element_text(size = 7),
legend.title = element_text(size = 7, face = "bold"),
legend.key.size = unit(3, "mm"),
axis.title = element_text(size = 8, face = "bold"),
axis.text = element_text(size = 8),
axis.ticks.x = element_blank(),
axis.ticks.length.y = unit(2, "mm"),
plot.margin = unit(c(0.6, 5, 0.6, 5), "cm")
) 
案例4：误差棒+显著性+ggsci
注意
bar，errorbar和text的position参数要相同
调整bar和errorbar图层顺序，可实现显示全部或半个errorbar
library(ggsci)## Warning: 程辑包'ggsci'是用R版本4.3.3 来建造的dat <- data.table(layer = rep(c("A","B"), 4),
control = rep(c("ck", "slight", "moderate", "severe"), each = 2),
sig = c("a", "a", "a", "a", "b", "b", "c", "c"),
value = c(126.40, 78.47, 112.77, 70.57, 81.87, 55.53, 61.33, 46.83),
sd = c(7.05, 7.94, 8.25, 4.55, 3.98, 3.94, 11.48, 5.14))
dat[, control:=factor(control, levels = c("ck", "slight", "moderate", "severe"))]
ggplot(dat, aes(control, value, fill = layer))+
geom_errorbar(aes(ymin = value-sd, ymax = value+sd), width = 0.2, position = position_dodge(0.9))+
geom_bar(stat = "identity", position = position_dodge(0.9))+
geom_text(aes(y = value+1.5*sd, label = sig), vjust = 0, position = position_dodge(0.9))+
scale_fill_npg()+
scale_y_continuous(breaks = seq(0, 150, by=25), limits = c(0, 150), expand = c(0, 0))+
theme_bw()+
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
legend.position = c(0.9,0.85),
plot.title = element_text(hjust = 0.5))## Warning: A numeric `legend.position` argument in `theme()` was deprecated in ggplot2
## 3.5.0.
## ℹ Please use the `legend.position.inside` argument of `theme()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
案例5：全球气温变化图
尝试实现和NOAA Global Time Series相同的静态图
注意coord_cartesian(clip=“off”)的作用，控制仅在边框处的点线，是否进行裁切，并不能让点线画在绘图区域以外，而对于文字，同一个文字图层可以跨过绘图区域而不被裁掉。至于legend，即使没有设置这个，也可以放在绘图区域外，通过负数或大于1的数即可。
dat <- data.table(Year = c(1959, 1960, 1961, 1962, 1963, 1964, 1965, 1966, 1967, 1968, 1969, 1970, 1971, 1972, 1973, 1974, 1975, 1976, 1977, 1978, 1979, 1980, 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021, 2022), CO2 = c(315.98, 316.91, 317.64, 318.45, 318.99, 319.62, 320.04, 321.37, 322.18, 323.05, 324.62, 325.68, 326.32, 327.46, 329.68, 330.19, 331.13, 332.03, 333.84, 335.41, 336.84, 338.76, 340.12, 341.48, 343.15, 344.87, 346.35, 347.61, 349.31, 351.69, 353.2, 354.45, 355.7, 356.54, 357.21, 358.96, 360.97, 362.74, 363.88, 366.84, 368.54, 369.71, 371.32, 373.45, 375.98, 377.7, 379.98, 382.09, 384.02, 385.83, 387.64, 390.1, 391.85, 394.06, 396.74, 398.81, 401.01, 404.41, 406.76, 408.72, 411.66, 414.24, 416.45, 418.56), Value = c(0.07, 0.02, 0.06, 0.05, 0.08, -0.15, -0.07, -0.02, 0.01, -0.06, 0.09, 0.05, -0.05, 0.02, 0.2, -0.05, 0.01, -0.03, 0.21, 0.11, 0.22, 0.29, 0.35, 0.19, 0.34, 0.19, 0.16, 0.21, 0.34, 0.41, 0.31, 0.44, 0.42, 0.23, 0.27, 0.32, 0.48, 0.35, 0.5, 0.63, 0.42, 0.43, 0.55, 0.62, 0.63, 0.55, 0.7, 0.66, 0.66, 0.55, 0.66, 0.73, 0.63, 0.66, 0.68, 0.76, 0.91, 1.03, 0.94, 0.86, 0.97, 1.01, 0.86, 0.91))
dat[, col:=ifelse(Value>0,"b","r")]
ggplot(dat,aes(Year, Value))+
geom_bar(aes(fill=col), color="black", width=0.7, linewidth=0.1, stat = "identity", show.legend = F)+
geom_smooth(aes(linetype = "l"), color="black", formula = y~x, se = F, method = "lm")+
# geom_hline(yintercept = 0)+
scale_x_continuous(breaks = seq(1960, 2022, by=5), limits = c(1958, 2023),expand = c(0,0))+
scale_y_continuous(limits = c(-0.2,1.2),
breaks = seq(-0.20, 1.20, by=0.2),
expand = c(0,0),
labels=sprintf("%.2f\u00B0C",seq(-0.20, 1.20, by=0.2)),
sec.axis = sec_axis(trans = ~.*1.8, #注意纵坐标为温度差值，所以只*1.8
breaks = seq(-0.36,2.16, by=0.36),
labels=sprintf("%.2f\u00B0F",seq(-0.36,2.16, by=0.36))))+
scale_fill_manual(values = c("b"="#4366AA", "r"="#961A2B"))+
scale_linetype_discrete(labels = c("l" = "1959 ~ 2022 Trend \n (+ 1.64 °C/Century)"))+
guides(linetype = guide_legend(title = NULL))+
labs(x=NULL, y = NULL,
title="Global Land and Ocean",
subtitle = "January-December Temperature Anomalies")+
# coord_cartesian(clip = "off") +
theme_bw()+
theme(aspect.ratio = 1/2,
axis.line = element_line(),
panel.border = element_blank(),
panel.grid.minor = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.major = element_line(color = "gray97"),
plot.title = element_text(face = "bold", size = 14, hjust = 0),
plot.subtitle = element_text(size = 12, hjust = 0),
legend.position = c(0.85,1.09),
legend.background = element_blank(),
legend.text = element_text(size = 12)
)## Warning: The `trans` argument of `sec_axis()` is deprecated as of ggplot2 3.5.0.
## ℹ Please use the `transform` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
案例6：流域岩石风化碳汇强度
这个图注意，离散坐标系实际也是连续的，若要在其中添加线，可以用序号加0.5添加在这两个bar之间
data <- data.table(Basin = c('SiKiang', 'Irrawaddi', 'Amazon', 'Mekong', 'Yangtze-Kiang',
'Ganges-Brahmaputra', 'Magdalena', 'Orinoco', 'SevernaiaDvina',
'St.Lawrence', 'Fraser', 'SaoFrancisco', 'Danube', 'Yenisei',
'Tigris-Euphrates', 'Mississippi', 'Yukon', 'Columbia',
'Mackenzie', 'Indus', 'Zaire', 'Godavari', 'Ob', 'Parana',
'Lena', 'Indigirka', 'Don', 'Amour', 'Kolyma', 'Yana',
'Zambesi', 'Nile', 'Limpopo', 'Niger', 'Huangho', 'Murray',
'Orange', 'Senegal', 'Colorado'),
x = c(13.88, 10.88, 6.11, 5.72, 5.56, 5.17, 5.07, 2.86, 2.62,
2.41, 2.25, 2.05, 1.64, 1.64, 1.58, 1.54, 1.48, 1.44, 1.38,
1.29, 1.12, 1.02, 0.99, 0.86, 0.74, 0.7, 0.67, 0.66, 0.59,
0.52, 0.41, 0.33, 0.31, 0.2, 0.18, 0.14, 0.13, 0.08, 0.08))
ggplot(data, aes(reorder(Basin, x), x, label = x))+
geom_bar(stat = 'identity', fill = 'steelblue4', color = 'white')+
geom_text(stat = 'identity', hjust = 0, vjust = 0.5, size = 2.5)+
geom_segment(aes(x = 28.5, y = 0, xend = 28.5, yend = 7), color = "red", linewidth = 0.5)+
geom_text(data = NULL, aes(28.5, 7.5), label = "Average: 2.21", hjust = 0, size = 3, color = "red")+
scale_y_continuous(expand = expansion(mult = c(0,0.08)))+
labs(x = 'Basins', y = expression(CO[2] ~ "Consumed (" ~ tC%.%km^-2%.%yr^-1 ~ ")"))+
coord_flip()+
theme_light()+
theme(axis.text = element_text(size = 6),
axis.text.y = element_text(size = 7),
axis.title = element_text(size = 10),
panel.grid.minor = element_blank(),
panel.grid.major.y = element_blank())## Warning in geom_text(data = NULL, aes(28.5, 7.5), label = "Average: 2.21", : All aesthetics have length 1, but the data has 39 rows.
## ℹ Did you mean to use `annotate()`?
案例7：在映射处使用字符类型
一般情况下ggplot函数，在美学影射aes处，要么用数据框+列名，如ggplot(mpg,aes(displ, hwy))；或者不用数据框直接用变量，如ggplot(data=NULL,aes(1:3,4:6))。
但是当对一个数据框中的多列或不特定列绘图时，可能会用到字符型变量作为美学影射。此时可以用以下方法实现：
aes_string()
aes()+!!sym()
aes()+str2expression()+eval()
aes()+.data[[]] #推荐方法
如果用color或fill映射，但是变量可能为空，可以用条件语句进行判断
library(ggplot2)
a <- "displ"
b <- "hwy"
d <- "drv"
d <- c() #测试空字符是否可以正常运行
# aes_string(), 虽然可行并且对空字符也能适应，但是已被ggplot2弃用，会出warning
# ggplot(mpg, aes_string(a,b, color=d))+
# geom_point()
# 1.aes()+get()+
# ggplot(mpg, aes(get(a), get(b), color=if(!is.null(d)) get(d)))+
# geom_point()+
# labs(x=a, y=b, color=d)
# 2.aes()+!!sym()
# ggplot(mpg, aes(!!sym(a), !!sym(b), color=!!sym(d)))+
# geom_point()
# 3.aes()+str2expression()+eval()
# ggplot(mpg, aes(eval(str2expression(a)), eval(str2expression(b)), color=eval(str2expression(d))))+
# geom_point()+
# labs(x=a, y=b)+
# guides(color=guide_legend(title=d))
# 4.aes()+.data[[]]
# ggplot(mpg)+
# geom_point(aes(.data[[a]], .data[[b]], color=if(is.null(d)) NULL else .data[[d]]))+
# labs(color=d)案例8：地理信息图
下面两个图，代码来自网络
#### 79. 画全球国家边界图 #####
library(ggplot2)
library(sf)
library(rnaturalearth)
library(rnaturalearthhires)
world <- ne_countries(scale = "large", returnclass = "sf")
china <- ne_countries(country = "china")
ggplot()+
geom_sf(data = world)+
geom_sf(data = china, fill="red")+
geom_point(aes(-33, -50), color="red")+ #添加一个数据点
labs(x="", y="")+
theme_void()
library(maps)
library(ggplot2)
library(colorspace)
# 加载世界地图数据
world_map <- map_data("world")
# 将wanwan的region字段改为中国
world_map$region[world_map$region == "Taiwan"] <- "China"
# 自定义颜色映射
custom_colors <- c(
"Australia" = "#8C3627", # RGB(140, 54, 39)
"Brazil" = "#7B378C", # RGB(123, 55, 140)
"Canada" = "#518B8C", # RGB(81, 139, 140)
"China" = "#CD8500", # RGB(205, 133, 0)
"Germany" = "#CD950C", # RGB(205, 149, 12)
"Indonesia" = "#EE4001", # RGB(238, 64, 1)
"The Netherlands" = "#9DCB34",# RGB(157, 203, 52)
"UK" = "#6B8A6A", # RGB(107, 138, 106)
"USA" = "#37648B" # RGB(55, 100, 139)
)
# 其他国家使用的颜色
other_countries_color <- "gray90" # gray80
# 创建一个新列用于颜色填充
world_map$color <- ifelse(world_map$region %in% names(custom_colors), world_map$region, "Other")
ggplot(world_map, aes(x=long,y=lat,group=group))+ # 设置横纵坐标
geom_polygon(aes(fill = color), color = "gray80")+
geom_point(aes(-33, -50), color="red")+ #添加一个数据点
scale_fill_manual(values = c(custom_colors, "Other" = other_countries_color)) +
scale_x_continuous(breaks = seq(-180, 210, 45), expand = c(0,0), labels = function(x){paste0(x, "°")})+
scale_y_continuous(breaks = seq(-60, 100, 30), expand = c(0,0), labels = function(x){paste0(x, "°")}) +
labs(title="world map",
y="Latitude", x="Longitude",
subtitle = "Highlighting 9 countries") +
theme_light() +
coord_fixed(ratio=1) # coord_fixed()函数确保了一个单位长度在x轴(经度)和y轴(纬度)上是相等的
案例9：单独设置分面子图坐标轴
可用这个包进行子图坐标单独设置：ggh4x包
library(ggh4x)
data <- data.frame(class = c('z'), x = 1:10, value = 1, f = c("a","a","a", "b","b","b", "c","c","c","c"))
ind_scale_x <- list(
scale_x_continuous(limits = c(0,100), breaks = seq(0, 100, 20), labels = scales::dollar),
scale_x_log10(limits = c(1,10000)),
scale_x_continuous(limits = c(40,60), breaks = seq(0, 100, 10), position = "top")
)
ind_scale_y <- list(
scale_y_continuous(limits = c(0,100), breaks = seq(0, 100, 50), expand = c(0,0)),
scale_y_continuous(limits = c(0,100), breaks = seq(0, 100, 20), minor_breaks = seq(0,100,5)),
scale_y_continuous(limits = c(0,100), n.breaks = 10)
)
ggplot(data, aes(x, value)) +
geom_blank()+
facet_wrap(f~., scales = "free") +
facetted_pos_scales(x = ind_scale_x, y = ind_scale_y)+
labs(x = "x", y = "y", title = "Setting individual axis limits and breaks")+
theme_bw() +
theme(aspect.ratio = 1/1.2,
strip.background = element_rect(fill = "grey89", color = "gray30"),
axis.text = element_text(size = 9),
text = element_text(size = 13, family = "serif"))
案例10：显著性标记
一般情况下，为箱形图添加显著性标记可用ggsignif::geom_signif包进行。
下面的例子中，为了向bar图添加显著性标记，自定义了一个函数，因为bar图数据中存储的一般是均值和方差，这一般不能像ggsignif包那样，直接添加显著性标记，而需要事先计算好显著性，然后画在图中。
# 加载所需包
library(magrittr)
library(data.table)
library(ggplot2)
library(multcomp) #计算avo的pvalue
library(ggsci)
# library(ggsignif) #当画箱形图时，可用这个包
# 定义一个函数，生成均值方差和显著性标记线、标签
data_material <- function(data, xdrift=0.15, ydrift=0.04, equleg=T){
# xdrift和ydrift为xy方向偏移量，其中xdrift应为bar宽度width的一半，equleg设置标记的腿是否等长
# 提取计算列，备份原列名，然后赋予新列名，便于后续计算
con_data <- data[,1:3]
ori_name <- colnames(con_data)
names(con_data) <- c("xaxis", "compare", "value")
#先按因子类型排序con_data
setorder(con_data, xaxis, compare)
# 生成均值、方差列
data_msd <- con_data[, .(m=mean(value), sd=sd(value)), by=c("xaxis", "compare")]
# 方差分析，生成p值显著性标签
p.frame <- data.table(xaxis=unique(con_data$xaxis), p.value=NA_real_, p.label=NA_character_)
for(i in p.frame$xaxis){
tres <- aov(value~compare, con_data[xaxis==i,])
tp <- glht(tres, linfct = mcp(compare = "Tukey")) %>% summary()
p.frame[xaxis == i, p.value:=tp$test$pvalues]
p.frame[xaxis == i, p.label:=ifelse(p.value<0.01, "***", ifelse(p.value<0.05, "**", ifelse(p.value<0.1, "*", "NS")))]
}
# 生成标记线图层
data_msd[, msd:=m+sd] #添加一列，为mean+sd
compare_lv1 <- levels(data_msd$compare)[1]
compare_lv2 <- levels(data_msd$compare)[2]
xcen <- seq_along(unique(data_msd$xaxis)) #x的中心位置，为fa1的变量个数
xoff <- xdrift #x起止位置偏移量，为bar宽度的一半
m_plus_sd <- data_msd[, max(msd), by=c("xaxis")]$V1
unitdrift <- ydrift*max(m_plus_sd) #全图中最大的mean+sd乘以偏移比，为单位偏移量
ycen <- m_plus_sd+unitdrift #y中心位置，为m+sd加单位偏移量
yleft <- data_msd[compare==compare_lv1, msd]+unitdrift*0.5 #左脚最低位置，为m+sd加0.5个单位偏移量
yrigh <- data_msd[compare==compare_lv2, msd]+unitdrift*0.5 #右脚最低位置，为m+sd加0.5个单位偏移量
if(isTRUE(equleg)) yleft <- yrigh <- pmax(yleft,yrigh) #如果相同，则取最大的那个
# 生成标记线和标签数据，p值默认两位小数
sig_seg <- data.table(x0=c(xcen-xoff, xcen-xoff, xcen+xoff), x1=c(xcen-xoff, xcen+xoff, xcen+xoff),
y0=c(yleft, ycen, ycen), y1=c(ycen, ycen, yrigh))
sig_lab <- data.table(x=xcen, y=ycen+unitdrift*0.5, p.value=sprintf("%.2f", p.frame$p.value), p.label=p.frame$p.label)
# 恢复数据列名
names(data_msd) <- c(ori_name[1:2], "m", "sd","msd")
names(p.frame) <- c(ori_name[1], "p.value", "p.label")
# 输出结果
res <- list(data.msd=data_msd, sig.segment=sig_seg, sig.label=sig_lab)
return(res)
}
# 数据，第一列是x轴，第二列是对比类（只有两类），第三列是数据
# 其中，第一、二列必须是因子型，顺序是已定义的
data <- data.frame(method = c('B', 'B', 'B', 'A', 'A', 'A', 'C', 'C', 'C', 'D', 'D', 'D',
'E', 'E', 'E', 'F', 'F', 'F', 'G', 'G', 'G', 'H', 'H', 'H',
'I', 'I', 'I', 'J', 'J', 'J', 'B', 'B', 'B', 'A', 'A', 'A',
'C', 'C', 'C', 'D', 'D', 'D', 'E', 'E', 'E', 'F', 'F', 'F',
'G', 'G', 'G', 'H', 'H', 'H', 'I', 'I', 'I', 'J', 'J', 'J'),
model = c('Model_B', 'Model_B', 'Model_B', 'Model_B', 'Model_B',
'Model_B', 'Model_B', 'Model_B', 'Model_B', 'Model_B',
'Model_B', 'Model_B', 'Model_B', 'Model_B', 'Model_B',
'Model_B', 'Model_B', 'Model_B', 'Model_B', 'Model_B',
'Model_B', 'Model_B', 'Model_B', 'Model_B', 'Model_B',
'Model_B', 'Model_B', 'Model_B', 'Model_B', 'Model_B',
'Model_A', 'Model_A', 'Model_A', 'Model_A',
'Model_A', 'Model_A', 'Model_A', 'Model_A',
'Model_A', 'Model_A', 'Model_A', 'Model_A',
'Model_A', 'Model_A', 'Model_A', 'Model_A',
'Model_A', 'Model_A', 'Model_A', 'Model_A',
'Model_A', 'Model_A', 'Model_A', 'Model_A',
'Model_A', 'Model_A', 'Model_A', 'Model_A',
'Model_A', 'Model_A'),
MAE = c(9.0444, 1.2, 4.8, 16.2444, 7.8, 7.6333, 15.3778, 7.3333,
5.1, 10.1444, 6.7667, 11.2, 2.4889, 5.2, 2.3333, 15.7778,
7, 14.6333, 8.1778, 2.7333, 4.1333, 16.1778, 7.8667, 13.9667,
14.5111, 4.9333, 9.8667, 14.4444, 5.9333, 9.3, 7.5967, 5.2359,
6.9372, 19.084, 7.5944, 1.6948, 16.9531, 7.3885, 5.091, 14.5886,
6.0335, 10.0814, 8.6601, 10.3094, 2.7081, 22.9976, 10.2779,
18.1038, 15.7489, 7.1314, 6.4975, 20.835, 7.8965, 15.1705,
21.3323, 8.2463, 17.2792, 20.6349, 8.073, 15.9878))
setDT(data)
method_lev <- c("A","B","C","D","E","F","G","H","I","J")
model_lev <- c("Model_A", "Model_B")
data[, method:=factor(method, levels = method_lev)]
data[, model:=factor(model, levels = model_lev)]
# 生成均值方差、和显著性数据
res <- data_material(data)
data_msd <- res$data.msd
sig_seg <- res$sig.segment
sig_lab <- res$sig.label
# 画图
ggplot(data_msd, aes(method, m, fill = model))+
geom_errorbar(aes(ymin= m-sd, ymax=m+sd), position = position_dodge(0.6), width = 0.3)+
geom_bar(stat = "identity", position = position_dodge(), width = 0.6)+
scale_fill_npg(labels = c("Model_A", "Model_B"))+
geom_segment(data = sig_seg, aes(x=x0, xend=x1, y=y0, yend=y1, fill=NULL), color="red")+
geom_text(data=sig_lab, aes(x=x, y=y, label=p.value, fill=NULL), color="red", vjust=0, family = "serif")+ #可选，显示p值
# geom_text(data=sig_lab, aes(x=x, y=y, label=p.label, fill=NULL), color="red", vjust=0, family = "serif")+ #可选，显示显著性符号
scale_y_continuous(limits = c(0, 26), expand = c(0,0))+
guides(fill = guide_legend(title = NULL))+
labs(x = "Method", y = "MAE")+
theme_bw()+
theme(aspect.ratio = 1/1.8,
axis.text = element_text(size = 10, family = "serif"),
axis.title = element_text(size = 13, family = "serif"),
text = element_text(family = "serif"),
panel.grid = element_blank(),
legend.text = element_text(size = 10),
legend.position = c(0.12, 0.89),
plot.title = element_text(hjust = 0.5))
案例11：三元图
定义了三个函数，分别为3D转2D、2D转3D、三元图坐标轴，画完坐标轴，额外添加绘图数据即可
注意，三元点，和必须为1
# 加载包
library(data.table)
library(ggplot2)
library(magrittr)
# 定义函数
ratio2xy <- function(w1, w2, w3, ...){
# 将三维坐标w1w2w3转化为迪卡尔xy，支持向量格式，原理为两直线相交
# 自12点方向顺时针为s1、s2、s3，同时每个轴顺时针方向为贡献率0至100
# 不考虑外部，只考虑内部，（内部外部无所谓？）
# 判断，输入的三维数据，对应和必须为1
if(length(w1) != length(w2) | length(w2) != length(w3) | length(w3) != length(w1)){
stop("Error: length of parameters must be equal!")
} else if(length(w1) == 1){
if(round(sum(w1, w2, w3), 13) != 1) stop("Erro: sum of ratio must be 1!")
} else{
allsum <- matrix(c(w1,w2,w3), ncol=3, byrow = F) %>% apply(1,sum)
if(any(allsum != 1)) stop("Erro: sum of ratio must be 1!")
}
y <- s3[2]+w3*(s1[2]-s3[2]) #可根据z3贡献直接推断出y值
a <- s1[1]+w1*(s2[1]-s1[1]) #可根据z1推断出一个f(x)经过的点(a,b)
b <- s1[2]-w1*(s1[2]-s2[2]) #可根据z1推断出一个f(x)经过的点(a,b)
x <- (s3[1]-s1[1])/(s3[2]-s1[2])*(y-b)+a #(x-a)/(y-b)=(x3-x1)/(y3-y1)
res <- list(x = x, y = y)
return(res)
}
xy2ratio <- function(x, y, ...){
# 将迪卡尔xy转化为三维坐标w1w2w3，支持向量格式，原理为纵坐标差值、坐标轴旋转
# 自12点方向顺时针为s1、s2、s3，同时每个轴顺时针方向为贡献率0至100
# 不考虑外部，只考虑内部
xycw60 <- function(x, y, ...){
# 坐标轴顺时针旋转60度，所有点逆时针旋转60度
x2 <- x*cos(-pi/3)+y*sin(-pi/3)
y2 <- -x*sin(-pi/3)+y*cos(-pi/3)
return(list(x=x2,y=y2))
}
# 直接利用纵坐标差值求w3，
w3 <- (y-s3[2])/(s1[2]-s3[2])
# 旋转坐标轴，再利用纵坐标差值求w2，好处是直接判定正负（点到直线距离无法判断正负号）
s1p <- c(xycw60(s1[1], s1[2])$x, xycw60(s1[1], s1[2])$y)
s2p <- c(xycw60(s2[1], s2[2])$x, xycw60(s2[1], s2[2])$y)
s3p <- c(xycw60(s3[1], s3[2])$x, xycw60(s3[1], s3[2])$y)
xp <- xycw60(x,y)$x
yp <- xycw60(x,y)$y
w2 <- (s2p[2]-yp)/(s2p[2]-s3p[2])
# 根据和为1求w1
w1 <- 1-w3-w2
return(list(w1=w1, w2=w2, w3=w3))
}
triAxis <- function(tri = 1, axis.title = c("a", "b", "c")){
# point，点，dataframe格式，如果有3列，则为贡献坐标，如果有2列，则为xy坐标
t.axi <- axis.title
# 绘制三轴图
# 设定属性
r.cir <- tri #外接圆半径
d.dri <- 0.2*r.cir #垂线方向漂移量（用于标记、轴刻度）
d.axi <- 0.1 #轴刻度密度
l.axi <- 0.03 #轴刻度线长度
cos30 <- sqrt(3)/2 #cos(30deg)
sin30 <- 1/2 #sin(30deg)
s1 <- c(0,r.cir) #顶点1
s2 <- c(cos30*r.cir, -0.5*r.cir) #顶点2
s3 <- c(-cos30*r.cir, -0.5*r.cir) #顶点3
t.font <- "sans" #文字字体
### common part
# three axis
triaxis <- data.table(x0 = c(s1[1], s2[1], s3[1]),
x1 = c(s2[1], s3[1], s1[1]),
y0 = c(s1[2], s2[2], s3[2]),
y1 = c(s2[2], s3[2], s1[2]))
# midpoint of axis
m.s1s2 <- c((s1[1]+s2[1])/2, (s1[2]+s2[2])/2)
m.s2s3 <- c((s2[1]+s3[1])/2, (s2[2]+s3[2])/2)
m.s3s1 <- c((s3[1]+s1[1])/2, (s3[2]+s1[2])/2)
# axis title
a.title <- data.table(x = c(m.s1s2[1]+cos30*d.dri, m.s2s3[1]+0, m.s3s1[1]-cos30*d.dri),
y = c(m.s1s2[2]+sin30*d.dri, m.s2s3[2]-d.dri, m.s3s1[2]+sin30*d.dri),
l = t.axi,
a = c(300, 0, 60))
# grid
a.grid.s1 <- data.table(x0 = seq(s1[1], s2[1], length = 1/d.axi+1),
y0 = seq(s1[2], s2[2], length = 1/d.axi+1),
x1 = seq(s3[1], s2[1], length = 1/d.axi+1),
y1 = seq(s3[2], s2[2], length = 1/d.axi+1))
a.grid.s1.n <- nrow(a.grid.s1)
a.grid.s2 <- data.table(x0 = seq(s2[1], s3[1], length = 1/d.axi+1),
y0 = seq(s2[2], s3[2], length = 1/d.axi+1),
x1 = seq(s1[1], s3[1], length = 1/d.axi+1),
y1 = seq(s1[2], s3[2], length = 1/d.axi+1))
a.grid.s2.n <- nrow(a.grid.s2)
a.grid.s3 <- data.table(x0 = seq(s3[1], s1[1], length = 1/d.axi+1),
y0 = seq(s3[2], s1[2], length = 1/d.axi+1),
x1 = seq(s2[1], s1[1], length = 1/d.axi+1),
y1 = seq(s2[2], s1[2], length = 1/d.axi+1))
a.grid.s3.n <- nrow(a.grid.s3)
a.grid <- rbind(a.grid.s1[2:(a.grid.s1.n-1),],
a.grid.s2[2:(a.grid.s2.n-1),],
a.grid.s3[2:(a.grid.s3.n-1),])
# tick
a.tick.line.s1s2 <- data.table(x0 = seq(s1[1], s2[1], length = 1/d.axi+1),
y0 = seq(s1[2], s2[2], length = 1/d.axi+1),
x1 = seq(s1[1], s2[1], length = 1/d.axi+1)+sin30*l.axi,
y1 = seq(s1[2], s2[2], length = 1/d.axi+1)+cos30*l.axi)
a.tick.line.s2s3 <- data.table(x0 = seq(s2[1], s3[1], length = 1/d.axi+1),
y0 = seq(s2[2], s3[2], length = 1/d.axi+1),
x1 = seq(s2[1], s3[1], length = 1/d.axi+1)+sin30*l.axi,
y1 = seq(s2[2], s3[2], length = 1/d.axi+1)-cos30*l.axi)
a.tick.line.s3s1 <- data.table(x0 = seq(s3[1], s1[1], length = 1/d.axi+1),
y0 = seq(s3[2], s1[2], length = 1/d.axi+1),
x1 = seq(s3[1], s1[1], length = 1/d.axi+1)-l.axi,
y1 = seq(s3[2], s1[2], length = 1/d.axi+1)+0)
a.tick.line <- rbind(a.tick.line.s1s2, a.tick.line.s2s3, a.tick.line.s3s1)
# axis text
a.tick.text.s1s2 <- data.table(x = seq(s1[1], s2[1], length = 1/d.axi+1)+sin30*l.axi,
y = seq(s1[2], s2[2], length = 1/d.axi+1)+cos30*l.axi,
l = paste0(seq(0,100,length =1/d.axi+1), "%"),
a = 240)
a.tick.text.s2s3 <- data.table(x = seq(s2[1], s3[1], length = 1/d.axi+1)+sin30*l.axi,
y = seq(s2[2], s3[2], length = 1/d.axi+1)-cos30*l.axi,
l = paste0(seq(0,100,length =1/d.axi+1), "%"),
a = 120)
a.tick.text.s3s1 <- data.table(x = seq(s3[1], s1[1], length = 1/d.axi+1)-l.axi,
y = seq(s3[2], s1[2], length = 1/d.axi+1)+0,
l = paste0(seq(0,100,length =1/d.axi+1), "%"),
a = 0)
a.tick.text <- rbind(a.tick.text.s1s2, a.tick.text.s2s3, a.tick.text.s3s1)
### plot
pic <- ggplot()+
geom_segment(data = triaxis, aes(x = x0, y = y0, xend = x1, yend = y1), linewidth = 1)+ #坐标轴
geom_segment(data = a.grid, aes(x = x0, y = y0, xend = x1, yend = y1), color = "gray90", linewidth = 0.8)+ #网格线
geom_segment(data = a.tick.line, aes(x = x0, y = y0, xend = x1, yend = y1), linewidth = 0.8)+ #坐标轴刻度
geom_text(data = a.title, aes(x, y, label = l, angle = a), size = 6, family = t.font)+ #坐标轴标题
geom_text(data = a.tick.text, aes(x, y, label = l, angle = a), size = 3, hjust = 1.2, family = t.font)+ #坐标轴刻度数字
scale_x_continuous(limits = c(-cos30*r.cir*1.1, cos30*r.cir*1.1))+
scale_y_continuous(limits = c(-sin30*r.cir*1.5, r.cir*1.1))+
coord_fixed()+
theme_void()+
labs(title = NULL, fill = "")+
theme(aspect.ratio = 1,
text = element_text(family = t.font))
return(pic)
}
# 设定属性
tri <- 1
r.cir <- tri #外接圆半径
d.dri <- 0.45*r.cir #垂线方向漂移量（用于标记、轴刻度）
d.axi <- 0.1 #轴刻度密度
l.axi <- 0.03 #轴刻度线长度
cos30 <- sqrt(3)/2 #cos(30deg)
sin30 <- 1/2 #sin(30deg)
s1 <- c(0,r.cir) #顶点1
s2 <- c(cos30*r.cir, -0.5*r.cir) #顶点2
s3 <- c(-cos30*r.cir, -0.5*r.cir) #顶点3
# 定义一个三维点，并转化为二维
point_3d <- c(0.2, 0.1, 0.7) #注意三个数相加必须等于1
point_2d <- ratio2xy(point_3d[1], point_3d[2], point_3d[3])
# 画图
triAxis()+
geom_point(data=NULL, aes(x=point_2d$x, y=point_2d$y), color="red")
案例12：笛卡尔直角坐标轴
画笛卡尔直角坐标轴，即将坐标轴放在图像中心，而非绘图区的边缘
### 加载包 ###
library(data.table)
library(magrittr)
library(ggplot2)
### 定义参数 ###
# 坐标轴
axis.width <- 0.3 #坐标轴线宽
tick.width <- 0.2 #轴tick线宽
axistext.size <- 3 #轴标签字号
axistitle.size <- 5 #轴名字字号
# x轴
axisx.name <- "x" #x轴名字
axisx.y <- 0 #x轴与y轴交点的y值，若axisx.y=axisy.x，则重合点不重复标记
axisx.range <- c(-8.5, 8.5) #x轴范围
axisx.break <- seq(-8,8,1) #x轴主间隔
axisx.break.minor.n <- 0 #x轴次间隔数，非负整数，若为0，则无次间隔
shifh <- diff(axisx.range)*0.01 #水平方向上偏移量，用于y轴标签、x轴标题的偏移
axisx.lab.dec <- 0 #x轴标签数值小数位数，必须为大于0的整型值
# y轴
axisy.name <- "y" #y轴名字
axisy.x <- 0 #y轴与x轴交点的x值，若axisx.y=axisy.x，则重合点不重复标记
axisy.range <- c(-7.5, 7.5) #y轴范围
axisy.break <- seq(-7,7,1) #y轴主间隔
axisy.break.minor.n <- 1 #y轴次间隔数，非负整数，若为0，则无次间隔
shifv <- diff(axisy.range)*0.01 #垂直方向上偏移量，用于x轴标签、y轴标题的偏移
axisy.lab.dec <- 0 #y轴标签数值小数位数，必须为大于0的整型值
# 其他
break.min <- T #是否标记次要间隔
### 定义函数 ###
math.axis <- function(){
### 参数生成 ###
# x轴breaks
if(axisx.break.minor.n == 0){
axisx.tick <- data.table(x0=axisx.break, x1=axisx.break, y0=axisx.y, y1=axisx.y-shifv)
} else{
axisx.tick.major <- data.table(x0=axisx.break, x1=axisx.break, y0=axisx.y, y1=axisx.y-shifv)
axisx.break.minor <- seq(min(axisx.break), max(axisx.break), diff(axisx.break)[1]/(axisx.break.minor.n+1)) %>% setdiff(axisx.break)
axisx.tick.minor <- data.table(x0=axisx.break.minor, x1=axisx.break.minor, y0=axisx.y, y1=axisx.y-shifv*0.5)
axisx.tick <- rbind(axisx.tick.major, axisx.tick.minor)
}
# y轴breaks
if(axisy.break.minor.n == 0){
axisy.tick <- data.table(x0=axisy.x, x1=axisy.x-shifh, y0=axisy.break, y1=axisy.break)
} else{
axisy.tick.major <- data.table(x0=axisy.x, x1=axisy.x-shifh, y0=axisy.break, y1=axisy.break)
axisy.break.minor <- seq(min(axisy.break), max(axisy.break), diff(axisy.break)[1]/(axisy.break.minor.n+1)) %>% setdiff(axisy.break)
axisy.tick.minor <- data.table(x0=axisy.x, x1=axisy.x-shifh*0.5, y0=axisy.break.minor, y1=axisy.break.minor)
axisy.tick <- rbind(axisy.tick.major, axisy.tick.minor)
}
# x轴标签
axisx.label <- data.table(x=axisx.break, y=axisx.y-shifv*2, l=sprintf(paste0("%.", axisx.lab.dec, "f"), axisx.break))
# y轴标签
axisy.label <- data.table(x=axisy.x-shifh*2, y=axisy.break, l=sprintf(paste0("%.", axisy.lab.dec, "f"), axisy.break))
# 剔除交点的标签
if(axisx.y == axisy.x){
axisx.label <- axisx.label[x!=axisx.y, ] #剔除x轴标签中，交点的标签
axisy.label <- axisy.label[y!=axisy.x, ] #剔除y轴标签中，交点的标签
}
# 生成ggplot组件
modu <- list(
# x轴
geom_segment(data=NULL, aes(x=axisx.range[1], xend=axisx.range[2], y=axisx.y, yend=axisx.y), linewidth=axis.width, arrow = arrow(length = unit(shifh, "cm"))),
geom_segment(data=axisx.tick, aes(x=x0, xend=x1, y=y0, yend=y1), linewidth=tick.width),
geom_text(data=axisx.label, aes(x=x, y=y, label=l), size=axistext.size, vjust=1, hjust=0.5, family = "serif"),
geom_text(aes(x=axisx.range[2]+shifh, y=axisx.y), label=axisx.name, size=axistitle.size, vjust=0.5, hjust=0, family = "serif"),
# y轴
geom_segment(data=NULL, aes(x=axisy.x, xend=axisy.x, y=axisy.range[1], yend=axisy.range[2]), linewidth=axis.width, arrow = arrow(length = unit(shifv, "cm"))),
geom_segment(data=axisy.tick, aes(x=x0, xend=x1, y=y0, yend=y1), linewidth=tick.width),
geom_text(data=axisy.label, aes(x=x, y=y, label=l), size=axistext.size, vjust=0.5, hjust=1, family = "serif"),
geom_text(aes(x=axisy.x, y=axisy.range[2]+shifv), label=axisy.name, size=axistitle.size, vjust=0, hjust=0.5, family = "serif"),
# 主题
theme_void(),
theme(aspect.ratio = 1)
)
return(modu)
}
### 测试 ###
ggplot(data=NULL, aes(x=rnorm(10), y=rnorm(10)))+
geom_point(color="red")+
math.axis()
© 2021-2024, LIANG Chen, Institute of Mountain Hazards and Environment, CAS. All rights reserved.