R tips：进一步的debug并修复cnetplot绘图bug
在R升级到4.0+后，clusterProfiler的cnetplot会报如下的rescale错误，这个现象以及解决方法在以前的推文：R tips：debug并修复一个ggplot2绘图错误的例子中曾经说过。现在再提到一次，主要是对这个现象进一步的进行深入探讨，并给出一个更加优雅的解决办法。
Error in UseMethod("rescale") : "rescale"没有适用于"AsIs"目标对象的方法问题回顾及第一次的解决方案
考虑到上一次的推文以思路复现为主，当时没注意到给出的解决方案代码的截图没有截完整，这一次先把上一次的解决方案附上。
同样的使用的测试R对象在如下位置 文件名：test.rds 链接：https://pan.baidu.com/s/1l2hqNw034OEBwVvfy7_01g 提取码：kezh
载入工具包及导入rds文件：
library(tidyverse)
# 下载文件test.rds
# 将富集分析对象读入R
dat <- readRDS("test.rds")
class(dat)
#[1] "enrichResult"
#attr(,"package")
#[1] "DOSE"
如果我们直接使用cnetplot绘图是会报错的：
dat %>% clusterProfiler::cnetplot() # < 报错 >
上次给出的解决方案如下，只需要在绘图前先定义一个函数如下即可：
ggplot_build.gg <-
function (plot){
# cat("ggplot_build.ggplot called...\n\n")
plot <- ggplot2:::plot_clone(plot)
if (length(plot$layers) == 0) {
plot <- plot + geom_blank()
}
layers <- plot$layers
layer_data <- lapply(layers, function(y) y$layer_data(plot$data))
scales <- plot$scales
by_layer <- function(f) {
out <- vector("list", length(data))
for (i in seq_along(data)) {
out[[i]] <- f(l = layers[[i]], d = data[[i]])
}
out
}
data <- layer_data
data <- by_layer(function(l, d) l$setup_layer(d, plot))
layout <- ggplot2:::create_layout(plot$facet, plot$coordinates)
data <- layout$setup(data, plot$data, plot$plot_env)
data <- by_layer(function(l, d) l$compute_aesthetics(d, plot))
# AsIs出现在下一条命令，原因未知
data <- lapply(data, ggplot2:::scales_transform_df, scales = scales)
scale_x <- function() scales$get_scales("x")
scale_y <- function() scales$get_scales("y")
layout$train_position(data, scale_x(), scale_y())
data <- layout$map_position(data)
data <- by_layer(function(l, d) l$compute_statistic(d, layout))
data <- by_layer(function(l, d) l$map_statistic(d, plot))
ggplot2:::scales_add_missing(plot, c("x", "y"), plot$plot_env)
data <- by_layer(function(l, d) l$compute_geom_1(d))
data <- by_layer(function(l, d) l$compute_position(d, layout))
layout$reset_scales()
layout$train_position(data, scale_x(), scale_y())
layout$setup_panel_params()
data <- layout$map_position(data)
npscales <- scales$non_position_scales()
if (npscales$n() > 0) {
lapply(data, ggplot2:::scales_train_df, scales = npscales)
# fix bug
for(i in seq_along(data)){
is_AsIs <- vapply(data[[i]], function(x) "AsIs" %in% class(x), FUN.VALUE = logical(1))
if(sum(is_AsIs) > 0){
col_with_bug <- which(is_AsIs)
for(j in col_with_bug){
data[[i]][[j]] <- unclass(data[[i]][[j]])
}
}
}
# 报错在此处，由于data中的AsIs对象的存在
data <- lapply(data, ggplot2:::scales_map_df, scales = npscales)
}
data <- by_layer(function(l, d) l$compute_geom_2(d))
data <- by_layer(function(l, d) l$finish_statistics(d))
data <- layout$finish_data(data)
plot$labels$alt <- get_alt_text(plot)
structure(list(data = data, layout = layout, plot = plot),
class = "ggplot_built")
}
此时再去绘图就没有问题了：
dat %>% clusterProfiler::cnetplot()
进一步的解析问题并给出优雅解决方案
这部分主要解决两个问题：
（1）上一篇的推文提到过，错误出现的原因是cnetplot生成的ggplot2对象中的data对象在渲染过程中某些数据被转换为了AsIs对象，最终导致报错。这个现象出现的具体的原因我们今天去探讨一下细节。
（2）而报错的直接位置是来源于data <- lapply(data, ggplot2:::scales_map_df, scales = npscales)，正是其中的scales_map_df函数出错，今天会就这里进一步的探讨细节，找到出错的真正第一现场，然后给出一个非常简洁的解决方案。
我们先看一下第一个问题：
# 删除刚才定义的ggplot_build.gg函数，让其重新处于未修复bug的状态
rm(ggplot_build.gg)
# 先将函数ggplot_build.ggplot处于debug状态，然后绘图，在Rstudio中会自动进入debug界面
debug(ggplot2:::ggplot_build.ggplot)
dat %>% clusterProfiler::cnetplot()
在Rstudio界面中一直next，直到下面这一条命令时停止，因为这条命令之后就会出现AsIs对象。
这条命令的含义是根据每一个配对的图层layer和图层源数据data，对data进行compute_aesthetics处理。
注意：by_layer是一个本地函数，它在图示的第10行定义，它的作用就是对layer和data的每一层都进行一个特定处理，这个处理由具体调用的函数确定，比如图示中就是进行compute_aesthetics处理。
那么compute_aesthetics是什么含义呢？
我们可以看一下compute_aesthetics的源码，可以看到其实他是layer对象下的一个方法，因此可以通过如下方式获取源码：
由于是从layer中获取的方法，因此源码中的self就是代表一个layer，这里可以认为就是layers[[1]]。 注意这个函数返回的对象是evaled<可以自己手动查看一下源码>，由于调用这个函数的地方的运算结果是重新赋值给data，因此这个evaled其实就是计算好的data，也就是说evaled出现了AsIs就代表data就会出现AsIs。
layers[[1]]$compute_aesthetics
# <ggproto method>
# <Wrapper function>
# function (...)
# f(..., self = self)
#
# <Inner function (f)>
# function (self, data, plot)
# {
# aesthetics <- self$computed_mapping
# set <- names(aesthetics) %in% names(self$aes_params)
# calculated <- is_calculated_aes(aesthetics)
# modifiers <- is_scaled_aes(aesthetics)
# aesthetics <- aesthetics[!set & !calculated & !modifiers]
# if (!is.null(self$geom_params$group)) {
# aesthetics[["group"]] <- self$aes_params$group
# }
# scales_add_defaults(plot$scales, data, aesthetics, plot$plot_env)
# env <- child_env(baseenv(), stage = stage)
# evaled <- lapply(aesthetics, eval_tidy, data = data, env = env)
# ...<余下省略>...
关键点在于我复制的代码中的函数第一行代码和最后一行代码：
# aesthetics <- self$computed_mapping
# ...<省略>...
# evaled <- lapply(aesthetics, eval_tidy, data = data, env = env)
也就是说获得每一个layer的美学映射数据aesthetics并将其进行eval计算。
我们现在把每一个layer的aesthetics映射全部拿到，看一下是什么情况：
layers %>% map("computed_mapping")
# [[1]]
# Aesthetic mapping:
# * `x` -> `x`
# * `y` -> `y`
# * `xend` -> `xend`
# * `yend` -> `yend`
# * `group` -> `edge.id`
#
# [[2]]
# Aesthetic mapping:
# * `colour` -> `I(color)`
# * `size` -> `size`
# * `x` -> `x`
# * `y` -> `y`
#
# [[3]]
# Aesthetic mapping:
# * `colour` -> `I(color)`
# * `size` -> `I(3 * cex_gene)`
# * `x` -> `x`
# * `y` -> `y`
#
# [[4]]
# Aesthetic mapping:
# * `label` -> `name`
# * `x` -> `x`
# * `y` -> `y`
#
# [[5]]
# Aesthetic mapping:
# * `label` -> `name`
# * `x` -> `x`
# * `y` -> `y`
是不是发现问题了？第二图层的colour和第三图层的colour、size都是用了I函数进行了处理。其结果就是变为一个AsIs对象。
我们还可以进一步的看一下为何这个映射是经过I函数处理的，原因在enrichplot:::cnetplot.enrichResult的源码中，这里需要对S3对象有一定的了解，以前的R tips中推文有专门说过如何真正的获取一个R函数的源码。
enrichplot:::cnetplot.enrichResult
# function (x, showCategory = 5, foldChange = NULL, layout = "kk",
# colorEdge = FALSE, circular = FALSE, node_label = "all",
# cex_category = 1, cex_gene = 1, cex_label_category = 1, cex_label_gene = 1,
# color_category = "#E5C494", color_gene = "#B3B3B3",
# shadowtext = "all", ...)
# {
# ...<省略>...
# if (!is.null(foldChange)) {
# fc <- foldChange[V(g)$name[(n + 1):length(V(g))]]
# V(g)$color <- NA
# V(g)$color[(n + 1):length(V(g))] <- fc
# show_legend <- c(TRUE, FALSE)
# names(show_legend) <- c("color", "size")
# p <- ggraph(g, layout = layout, circular = circular)
# 下面的代码值得关注
# p <- p + edge_layer + geom_node_point(aes_(color = ~I("#E5C494"),
# size = ~size), data = p$data[1:n, ]) + scale_size(range = c(3,
# 8) * cex_category) + ggnewscale::new_scale_color() +
# geom_node_point(aes_(color = ~as.numeric(as.character(color)),
# size = ~I(3 * cex_gene)), data = p$data[-(1:n),
# ], show.legend = show_legend) + scale_colour_gradient2(name = "fold change",
# low = "blue", mid = "white", high = "red")
# }
# else {
# V(g)$color <- color_gene
# V(g)$color[1:n] <- color_category
# p <- ggraph(g, layout = layout, circular = circular)
# 下面的代码值得关注
# p <- p + edge_layer + geom_node_point(aes_(color = ~I(color),
# size = ~size), data = p$data[1:n, ]) + scale_size(range = c(3,
# 8) * cex_category) + geom_node_point(aes_(color = ~I(color),
# size = ~I(3 * cex_gene)), data = p$data[-(1:n), ],
# show.legend = FALSE)
# }
# ...<省略>...
# }
# <bytecode: 0x00000269beff5940>
# <environment: namespace:enrichplot>
可以发现里面的美学映射是经过I函数包裹的：
color = ~I(color)
color = ~I(color), size = ~I(3 * cex_gene)
等等...
源头找到了，是不是可以改这里的代码呢？
也不是不可以，但是首先是工作量太大，手动去创建一个cnetplot.enrichResult并把其中的I函数位置给修改掉，然后再根据clusterProfiler::cnetplot的调用栈进行函数修改，保证自己定义的函数被优先调用。然后还要考虑到这里的I函数包裹是否有一些特殊作用，是否是用于了屏蔽特定的bug。
这个思路想想就比较头痛，有没有更好的办法解决问题呢？
现在去看看第一现场发生了什么？
在Rstudio的debug界面中，继续next，一直到第40行代码，也就是报错的代码处暂停：
同样的逻辑，我们去深入一下代码细节，先看一下scales_map_df的作用：对每一个scale对象，调用了它的map_df方面对数据进行调整，根据调用的代码可知，其依然是对图层的数据data做处理。
scales_map_df
# function (scales, df)
# {
# if (empty(df) || length(scales$scales) == 0)
# return(df)
# 关键点在这里：对每一个scale对象，调用了它的map_df函数
# mapped <- unlist(lapply(scales$scales, function(scale) scale$map_df(df = df)),
# recursive = FALSE)
# new_data_frame(c(mapped, df[setdiff(names(df), names(mapped))]))
# }
# <bytecode: 0x00000269e8aba280>
# <environment: namespace:ggplot2>
我们进一步看一下scale对象的map_df函数：
npscales$scales[[1]]$map_df
# <ggproto method>
# <Wrapper function>
# function (...)
# f(..., self = self)
#
# <Inner function (f)>
# function (self, df, i = NULL)
# {
# if (empty(df)) {
# return()
# }
# aesthetics <- intersect(self$aesthetics, names(df))
# names(aesthetics) <- aesthetics
# if (length(aesthetics) == 0) {
# return()
# }
# 关键点在这里，继续调用map方法
# if (is.null(i)) {
# lapply(aesthetics, function(j) self$map(df[[j]]))
# }
# else {
# lapply(aesthetics, function(j) self$map(df[[j]][i]))
# }
# }
这里是对每一个scale记录的美学映射对data调用map方法，那么继续看map方法的细节：
npscales$scales[[1]]$map
# <ggproto method>
# <Wrapper function>
# function (...)
# f(..., self = self)
#
# <Inner function (f)>
# function (self, x, limits = self$get_limits())
# {
# 熟悉的字符rescale开始出现了...
# x <- self$rescale(self$oob(x, range = limits), limits)
# uniq <- unique(x)
# pal <- self$palette(uniq)
# scaled <- pal[match(x, uniq)]
# ifelse(!is.na(scaled), scaled, self$na.value)
# }
一眼就可以看到的第一句话的rescale调用，如果继续查看rescale方法npscalesscales[[1]]rescale，可知它是调用了rescaler方法，查看rescaler的源码npscalesscales[[1]]rescaler，可知真正的调用是传给了一个rescale的S3泛型方法UseMethod("rescale")。
而如果看rescale调用的对象，可知是selfoob(x, range = limits)，oob的源码可以这么查看npscalesscales[[1]]
根据S3方法的调用规则，如果美学映射是一个AsIs对象，比如前文的colour和size映射，那么self$rescale就最终被分发到rescale.AsIs方法上，但是由于这个方法没有定义，导致了最终的报错。
上一次的debug推文中提到，AsIs对象可以通过unclass来还原，但是这并不完全恰当，在某些比较特殊的情况下，比如一个data.frame经过I函数封装后，它unclass就会丢失掉它的data.frame属性。
因此这一次是自定义一个dropAsis函数来还原AsIs对象，它的逻辑如下：
dropAsis <- function(x){
cls <- class(x)
structure(x, class = setdiff(cls, "AsIs"))
}
然后还原了的AsIs对象就可以使用它自己的rescale方法了，所以我们只需要定义一个rescale.AsIs方法，并让它分发到它本来的rescale方法即可。
rescale.AsIs <- function(x, ...){
# 自定义dropAsis方法
dropAsis <- function(x){
cls <- class(x)
structure(x, class = setdiff(cls, "AsIs"))
}
# 调用本来的rescale方法
scales:::rescale(dropAsis(x), ...)
}
在Rstudio界面中，点击stop退出debug状态。
然后将ggplot_build.ggplot函数退出debug模式（记得再运行一下刚才的rescale.AsIs函数的定义）。
undebug(ggplot2:::ggplot_build.ggplot)
stopifnot(exists("rescale.AsIs")) # 判断一下rescale.AsIs是否存在，保证已经定义了rescale.AsIs函数
dat %>% clusterProfiler::cnetplot() # 成功
至此问题就得到解决了，只需要一个非常简单的自定义rescale.AsIs函数即可。
腾讯云开发者
