ggplot2多图层颜色/legend重叠冲突的情况

最近在用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, 你实际属性指示的时候用的是什么就换成什么咯,例如fillshape啥的。一样的可以避免冲突。
效果展示:

示例图

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)*")
}

最后,如果还有其他别的有效简洁巧妙的方法,欢迎探索和分享~

你可能感兴趣的:(ggplot2多图层颜色/legend重叠冲突的情况)