最近在使用一些包装好的作图函数绘图，如TCseq包中的timeclustplot函数，尽管这些函数可以满足大部分的需求，但是如果想做个性化的修饰的时候，需要自己使用ggplot2重新画。由于自己审美过于直男，因此配色方面过丑是个大问题。因此希望在绘图的时候能使用包装函数中的配色方案。这就涉及到本文的讨论的问题，如何从别人已经做好的ggplot对象中提取映射的颜色信息？
首先我们需要确认操作的对象是ggplot对象
> class(tcaplot_patient1[[1]])
[1] "gg" "ggplot"
其次需要查看ggplot对象中的基本的组织形式，来尝试寻找颜色信息存储的位置
> str(tcaplot_patient1[[1]],max.level = 2)
List of 10
$ data :'data.frame': 7630 obs. of 4 variables:
..$ group : Factor w/ 545 levels "EFNA2","PLAUR",..: 1 1 1 1 1 1 1 1 1 1 ...
..$ time : Factor w/ 14 levels "patient1_ctl",..: 12 4 10 1 7 9 13 2 8 14 ...
..$ value : num [1:7630] 0.765 -1.263 -0.13 0.839 -0.997 ...
..$ membership: num [1:7630] 0.25 0.25 0.25 0.25 0.25 ...
$ layers :List of 1
..$ :Classes 'LayerInstance', 'Layer', 'ggproto', 'gg'
aes_params: list
compute_aesthetics: function
compute_geom_1: function
compute_geom_2: function
compute_position: function
compute_statistic: function
data: waiver
draw_geom: function
finish_statistics: function
geom:
aesthetics: function
default_aes: uneval
draw_group: function
draw_key: function
draw_layer: function
draw_panel: function
extra_params: na.rm
handle_na: function
non_missing_aes:
optional_aes:
parameters: function
required_aes: x y
setup_data: function
use_defaults: function
super:
geom_params: list
inherit.aes: TRUE
layer_data: function
map_statistic: function
mapping: uneval
position:
compute_layer: function
compute_panel: function
required_aes:
setup_data: function
setup_params: function
super:
print: function
setup_layer: function
show.legend: NA
stat:
aesthetics: function
compute_group: function
compute_layer: function
compute_panel: function
default_aes: uneval
extra_params: na.rm
finish_layer: function
non_missing_aes:
parameters: function
required_aes:
retransform: TRUE
setup_data: function
setup_params: function
super:
stat_params: list
super:
$ scales :Classes 'ScalesList', 'ggproto', 'gg'
add: function
clone: function
find: function
get_scales: function
has_scale: function
input: function
n: function
non_position_scales: function
scales: list
super:
$ mapping :List of 3
..$ x : language ~time
.. ..- attr(*, ".Environment")=
..$ y : language ~value
.. ..- attr(*, ".Environment")=
..$ colour: language ~membership
.. ..- attr(*, ".Environment")=
..- attr(*, "class")= chr "uneval"
$ theme :List of 67
..$ line :List of 6
.. ..- attr(*, "class")= chr [1:2] "element_line" "element"
..$ rect :List of 5
.. ..- attr(*, "class")= chr [1:2] "element_rect" "element"
..$ text :List of 11
.. ..- attr(*, "class")= chr [1:2] "element_text" "element"
..$ axis.title :List of 11
.. ..- attr(*, "class")= chr [1:2] "element_text" "element"
..$ axis.title.x :List of 11
.. ..- attr(*, "class")= chr [1:2] "element_text" "element"
..$ axis.title.x.top :List of 11
.. ..- attr(*, "class")= chr [1:2] "element_text" "element"
..$ axis.title.y :List of 11
.. ..- attr(*, "class")= chr [1:2] "element_text" "element"
..$ axis.title.y.right :List of 11
.. ..- attr(*, "class")= chr [1:2] "element_text" "element"
..$ axis.text :List of 11
.. ..- attr(*, "class")= chr [1:2] "element_text" "element"
..$ axis.text.x :List of 11
.. ..- attr(*, "class")= chr [1:2] "element_text" "element"
..$ axis.text.x.top :List of 11
.. ..- attr(*, "class")= chr [1:2] "element_text" "element"
..$ axis.text.y :List of 11
.. ..- attr(*, "class")= chr [1:2] "element_text" "element"
..$ axis.text.y.right :List of 11
.. ..- attr(*, "class")= chr [1:2] "element_text" "element"
..$ axis.ticks :List of 6
.. ..- attr(*, "class")= chr [1:2] "element_line" "element"
..$ axis.ticks.length : 'unit' num 2.75pt
.. ..- attr(*, "valid.unit")= int 8
.. ..- attr(*, "unit")= chr "pt"
..$ axis.ticks.length.x : NULL
..$ axis.ticks.length.x.top : NULL
..$ axis.ticks.length.x.bottom: NULL
..$ axis.ticks.length.y : NULL
..$ axis.ticks.length.y.left : NULL
..$ axis.ticks.length.y.right : NULL
..$ axis.line : list()
.. ..- attr(*, "class")= chr [1:2] "element_blank" "element"
..$ axis.line.x :List of 6
.. ..- attr(*, "class")= chr [1:2] "element_line" "element"
..$ axis.line.y :List of 6
.. ..- attr(*, "class")= chr [1:2] "element_line" "element"
..$ legend.background :List of 5
.. ..- attr(*, "class")= chr [1:2] "element_rect" "element"
..$ legend.margin : 'margin' num [1:4] 5.5pt 5.5pt 5.5pt 5.5pt
.. ..- attr(*, "valid.unit")= int 8
.. ..- attr(*, "unit")= chr "pt"
..$ legend.spacing : 'unit' num 11pt
.. ..- attr(*, "valid.unit")= int 8
.. ..- attr(*, "unit")= chr "pt"
..$ legend.spacing.x : NULL
..$ legend.spacing.y : NULL
..$ legend.key :List of 5
.. ..- attr(*, "class")= chr [1:2] "element_rect" "element"
..$ legend.key.size : 'unit' num 1.2lines
.. ..- attr(*, "valid.unit")= int 3
.. ..- attr(*, "unit")= chr "lines"
..$ legend.key.height : NULL
..$ legend.key.width : NULL
..$ legend.text :List of 11
.. ..- attr(*, "class")= chr [1:2] "element_text" "element"
..$ legend.text.align : NULL
..$ legend.title :List of 11
.. ..- attr(*, "class")= chr [1:2] "element_text" "element"
..$ legend.title.align : NULL
..$ legend.position : chr "right"
..$ legend.direction : NULL
..$ legend.justification : chr "center"
..$ legend.box : NULL
..$ legend.box.margin : 'margin' num [1:4] 0cm 0cm 0cm 0cm
.. ..- attr(*, "valid.unit")= int 1
.. ..- attr(*, "unit")= chr "cm"
..$ legend.box.background : list()
.. ..- attr(*, "class")= chr [1:2] "element_blank" "element"
..$ legend.box.spacing : 'unit' num 11pt
.. ..- attr(*, "valid.unit")= int 8
.. ..- attr(*, "unit")= chr "pt"
..$ panel.background :List of 5
.. ..- attr(*, "class")= chr [1:2] "element_rect" "element"
..$ panel.border : list()
.. ..- attr(*, "class")= chr [1:2] "element_blank" "element"
..$ panel.spacing : 'unit' num 5.5pt
.. ..- attr(*, "valid.unit")= int 8
.. ..- attr(*, "unit")= chr "pt"
..$ panel.spacing.x : NULL
..$ panel.spacing.y : NULL
..$ panel.grid :List of 6
.. ..- attr(*, "class")= chr [1:2] "element_line" "element"
..$ panel.grid.major : list()
.. ..- attr(*, "class")= chr [1:2] "element_blank" "element"
..$ panel.grid.minor : list()
.. ..- attr(*, "class")= chr [1:2] "element_blank" "element"
..$ panel.ontop : logi FALSE
..$ plot.background :List of 5
.. ..- attr(*, "class")= chr [1:2] "element_rect" "element"
..$ plot.title :List of 11
.. ..- attr(*, "class")= chr [1:2] "element_text" "element"
..$ plot.subtitle :List of 11
.. ..- attr(*, "class")= chr [1:2] "element_text" "element"
..$ plot.caption :List of 11
.. ..- attr(*, "class")= chr [1:2] "element_text" "element"
..$ plot.tag :List of 11
.. ..- attr(*, "class")= chr [1:2] "element_text" "element"
..$ plot.tag.position : chr "topleft"
..$ plot.margin : 'margin' num [1:4] 5.5pt 5.5pt 5.5pt 5.5pt
.. ..- attr(*, "valid.unit")= int 8
.. ..- attr(*, "unit")= chr "pt"
..$ strip.background :List of 5
.. ..- attr(*, "class")= chr [1:2] "element_rect" "element"
..$ strip.placement : chr "inside"
..$ strip.text :List of 11
.. ..- attr(*, "class")= chr [1:2] "element_text" "element"
..$ strip.text.x : NULL
..$ strip.text.y :List of 11
.. ..- attr(*, "class")= chr [1:2] "element_text" "element"
..$ strip.switch.pad.grid : 'unit' num 2.75pt
.. ..- attr(*, "valid.unit")= int 8
.. ..- attr(*, "unit")= chr "pt"
..$ strip.switch.pad.wrap : 'unit' num 2.75pt
.. ..- attr(*, "valid.unit")= int 8
.. ..- attr(*, "unit")= chr "pt"
..- attr(*, "class")= chr [1:2] "theme" "gg"
..- attr(*, "complete")= logi TRUE
..- attr(*, "validate")= logi TRUE
$ coordinates:Classes 'CoordCartesian', 'Coord', 'ggproto', 'gg'
aspect: function
backtransform_range: function
clip: on
default: TRUE
distance: function
expand: TRUE
is_free: function
is_linear: function
labels: function
limits: list
modify_scales: function
range: function
render_axis_h: function
render_axis_v: function
render_bg: function
render_fg: function
setup_data: function
setup_layout: function
setup_panel_params: function
setup_params: function
transform: function
super:
$ facet :Classes 'FacetNull', 'Facet', 'ggproto', 'gg'
compute_layout: function
draw_back: function
draw_front: function
draw_labels: function
draw_panels: function
finish_data: function
init_scales: function
map_data: function
params: list
setup_data: function
setup_params: function
shrink: TRUE
train_scales: function
vars: function
super:
$ plot_env :
$ labels :List of 5
..$ x : chr "timepoint"
..$ y : chr "expression"
..$ title : chr "Cluster 1"
..$ colour: chr "membership"
..$ group : chr "group"
$ guides :List of 1
..$ colour:List of 28
.. ..- attr(*, "class")= chr [1:2] "guide" "colorbar"
- attr(*, "class")= chr [1:2] "gg" "ggplot"
显然，从ggplot的数据结构中，我们并不能得到什么有用的信息，唯一可能储存颜色信息的scales中也只是一些包装的函数信息，显然这个方法并行不通。
在查阅ggplot官网时发现，ggplot提供了ggplot_build，方便用户提取ggplot对象中有关渲染的信息
链接：https://ggplot2.tidyverse.org/reference/ggplot_build.html
并有如下描述
[ggplot_build()](https://ggplot2.tidyverse.org/reference/ggplot_build.html)takes the plot object, and performs all steps necessary to produce an object that can be rendered. This function outputs two pieces: a list of data frames (one for each layer), and a panel object, which contain all information about axis limits, breaks etc
所以我们可以使用这个函数来提取其中的信息
x<-ggplot_build(tcaplot_patient1[[1]])
其中与颜色相关的信息时保存在data slot里面，如果该图是离散型数据，那只需要对颜色进行unique即可得到所有的颜色代码，如果是连续型数据，可以使用scales包中的show_cols函数来进行挑选
#
m<-cbind(m$data[[1]],m$plot$membership
m<-m[order(m$`m$plot$data$membership`),]
m$colour<-as.factor(m$colour)
m$colour<-factor(m$colour,levels = unique(m$colour))
show_col(levels(m$colour),labels=F)
image.png