最近在用ggplot2画图的时候遇到了一个挺有意思的bug,因为ggplot2以图层的使用著称,但最近在将两张图叠在一起的时候遇到的颜色指定上面的bug,因为都是连续性的数据,同时又都是用的边缘色(color),所以手动指定完一个的时候,再去指定另一个就会把原来的也给强制统一(override)。当然,讲究可视化显著的人是接受不了这个问题的,但是百度了好久都没有合适的解释,但是Google上面有人提供了一个解决办法,还挺简介有效的,记录分享。
1.问题
ggplot2多个legend指定统一类别性质的时候会冲突和覆盖。例如我需要非要绘制一个点图和一个线图,且分别指定不同的颜色指示梯度(插一句,ggplot2重叠两个图层的时候,最好是xy坐标系一致,不然叠起来也不好看)。
当然,如果你不是必须用到同一类别,例如可以一个属性是color,一个用的是fill或者shape,就可以巧妙的避免这个问题,legend的修改的时候不会覆盖,同时进一步也可以使用guide()
函数精准地修改。
2.解决
其实只需要使用new_scale("fill")
类似的函数进行分隔即可(这个函数需要定义,见后),然后再分别进行颜色的调整就会冲突了,很简单的。
例如:
ggplot(data = data,aes(x=x,y=y)) +
# 图层1 点图
geom_point(aes(color=gene1)) +
scale_colour_gradient(low='grey',high='#32a676',name='legend1_scatter_plot')+ #图层1的颜色修改
# 用于两个图层的连接
new_scale("colour")+
# 图层2 等高线图(不用了解怎么画等高线图,详见我的另一篇,反正就是另一个图就行了)
geom_isobands(aes(z=distance,color = stat(zmin)), fill = NA)+
scale_color_viridis_c(name='legend2_contour_plot') + # 图层2的颜色修改
coord_cartesian(expand = FALSE) + theme_bw()
上面的colour, 你实际属性指示的时候用的是什么就换成什么咯,例如fill,shape啥的。一样的可以避免冲突。
效果展示:
3.函数补充
上面用的那个函数和简介高效的解决方法来自于:https://eliocamp.github.io/codigo-r/2018/09/multiple-color-and-fill-scales-with-ggplot2/这篇博客,具体函数在github上面:https://gist.github.com/eliocamp/eabafab2825779b88905954d84c82b32。大家可以自行进一步感受。还是非常genius的这个人,因为遇到这个bug的人非常多,但有效解决的人却不多。
注意:运行使用前面new_scale()
这个函数前,必须运行以下代码进行函数定义,它不是ggplot2自带的函数。全部复制跑一下就行,问题不大。
new_scale <- function(new_aes) {
structure(ggplot2::standardise_aes_names(new_aes), class = "new_aes")
}
#' Convenient functions
new_scale_fill <- function() {
new_scale("fill")
}
new_scale_color <- function() {
new_scale("colour")
}
new_scale_colour <- function() {
new_scale("colour")
}
#' Special behaviour of the "+" for adding a `new_aes` object
#' It changes the name of the aesthethic for the previous layers, appending
#' "_new" to them.
ggplot_add.new_aes <- function(object, plot, object_name) {
plot$layers <- lapply(plot$layers, bump_aes, new_aes = object)
plot$scales$scales <- lapply(plot$scales$scales, bump_aes, new_aes = object)
plot$labels <- bump_aes(plot$labels, new_aes = object)
plot
}
bump_aes <- function(layer, new_aes) {
UseMethod("bump_aes")
}
bump_aes.Scale <- function(layer, new_aes) {
old_aes <- layer$aesthetics[remove_new(layer$aesthetics) %in% new_aes]
new_aes <- paste0(old_aes, "_new")
layer$aesthetics[layer$aesthetics %in% old_aes] <- new_aes
if (is.character(layer$guide)) {
layer$guide <- match.fun(paste("guide_", layer$guide, sep = ""))()
}
layer$guide$available_aes[layer$guide$available_aes %in% old_aes] <- new_aes
layer
}
bump_aes.Layer <- function(layer, new_aes) {
original_aes <- new_aes
old_aes <- names(layer$mapping)[remove_new(names(layer$mapping)) %in% new_aes]
new_aes <- paste0(old_aes, "_new")
old_geom <- layer$geom
old_setup <- old_geom$handle_na
new_setup <- function(self, data, params) {
colnames(data)[colnames(data) %in% new_aes] <- original_aes
old_setup(data, params)
}
new_geom <- ggplot2::ggproto(paste0("New", class(old_geom)[1]), old_geom,
handle_na = new_setup)
new_geom$default_aes <- change_name(new_geom$default_aes, old_aes, new_aes)
new_geom$non_missing_aes <- change_name(new_geom$non_missing_aes, old_aes, new_aes)
new_geom$required_aes <- change_name(new_geom$required_aes, old_aes, new_aes)
new_geom$optional_aes <- change_name(new_geom$optional_aes, old_aes, new_aes)
layer$geom <- new_geom
old_stat <- layer$stat
old_setup2 <- old_stat$handle_na
new_setup <- function(self, data, params) {
colnames(data)[colnames(data) %in% new_aes] <- original_aes
old_setup2(data, params)
}
new_stat <- ggplot2::ggproto(paste0("New", class(old_stat)[1]), old_stat,
handle_na = new_setup)
new_stat$default_aes <- change_name(new_stat$default_aes, old_aes, new_aes)
new_stat$non_missing_aes <- change_name(new_stat$non_missing_aes, old_aes, new_aes)
new_stat$required_aes <- change_name(new_stat$required_aes, old_aes, new_aes)
new_stat$optional_aes <- change_name(new_stat$optional_aes, old_aes, new_aes)
layer$stat <- new_stat
layer$mapping <- change_name(layer$mapping, old_aes, new_aes)
layer
}
bump_aes.list <- function(layer, new_aes) {
old_aes <- names(layer)[remove_new(names(layer)) %in% new_aes]
new_aes <- paste0(old_aes, "_new")
names(layer)[names(layer) %in% old_aes] <- new_aes
layer
}
change_name <- function(list, old, new) {
UseMethod("change_name")
}
change_name.character <- function(list, old, new) {
list[list %in% old] <- new
list
}
change_name.default <- function(list, old, new) {
nam <- names(list)
nam[nam %in% old] <- new
names(list) <- nam
list
}
change_name.NULL <- function(list, old, new) {
NULL
}
remove_new <- function(aes) {
stringi::stri_replace_all(aes, "", regex = "(_new)*")
}
最后,如果还有其他别的有效简洁巧妙的方法,欢迎探索和分享~