为条形图中的每个组指定不同的 p 值色标

Question

我正在尝试生成一个与下面类似的条形图，但我的条形图将按“样本”着色（体外，BAT 和 WAT 按顺序排列，而不是 BP、CC 和 MF）。 每个组将具有表示 p 值 (0.0001 - 0.1) 的相同标度限制，但每个组（体外、BAT、WAT）的标度将采用不同的颜色，如样本图中所示。每个组还应该按我已经指定的重要性排序。我设法生成了以下几乎已经存在的图。我只需要弄清楚如何为每个“样本”组指定不同的比例颜色。

cell_cycle_sample <- structure(list(sample = c("WAT", "WAT", "WAT", "WAT", "WAT", 
"WAT", "WAT", "WAT", "WAT", "WAT", "WAT", "WAT", "WAT", "WAT", 
"WAT", "WAT", "BAT", "BAT", "BAT", "BAT", "BAT", "BAT", "BAT", 
"BAT", "BAT", "BAT", "BAT", "BAT", "BAT", "BAT", "BAT", "BAT", 
"BAT", "BAT", "BAT", "BAT", "BAT", "BAT", "BAT", "BAT", "BAT", 
"BAT", "BAT", "BAT", "BAT", "BAT", "BAT", "in_vitro", "in_vitro", 
"in_vitro", "in_vitro", "in_vitro"), label = structure(1:52, .Label = c("KEGG_CELL_CYCLE(WAT)(123)", 
"REACTOME_MITOTIC_G2_G2_M_PHASES(WAT)(183)", "REACTOME_CELL_CYCLE_CHECKPOINTS(WAT)(286)", 
"REACTOME_M_PHASE(WAT)(390)", "REACTOME_NUCLEAR_ENVELOPE_NE_REASSEMBLY(WAT)(65)", 
"REACTOME_SEPARATION_OF_SISTER_CHROMATIDS(WAT)(187)", "REACTOME_CELL_CYCLE(WAT)(601)", 
"REACTOME_POSTMITOTIC_NUCLEAR_PORE_COMPLEX_NPC_REFORMATION(WAT)(22)", 
"REACTOME_MITOTIC_METAPHASE_AND_ANAPHASE(WAT)(225)", "HALLMARK_MITOTIC_SPINDLE(WAT)(199)", 
"REACTOME_RESOLUTION_OF_SISTER_CHROMATID_COHESION(WAT)(122)", 
"REACTOME_MITOTIC_SPINDLE_CHECKPOINT(WAT)(111)", "REACTOME_MITOTIC_PROMETAPHASE(WAT)(193)", 
"REACTOME_AMPLIFICATION_OF_SIGNAL_FROM_THE_KINETOCHORES(WAT)(94)", 
"HALLMARK_MYC_TARGETS_V1(WAT)(197)", "HALLMARK_G2M_CHECKPOINT(WAT)(195)", 
"REACTOME_APC_C_CDH1_MEDIATED_DEGRADATION_OF_CDC20_AND_OTHER_APC_C_CDH1_TARGETED_PROTEINS_IN_LATE_MITOSIS_EARLY_G1(BAT)(74)", 
"REACTOME_ASSEMBLY_OF_THE_PRE_REPLICATIVE_COMPLEX(BAT)(83)", 
"REACTOME_RECOGNITION_OF_DNA_DAMAGE_BY_PCNA_CONTAINING_REPLICATION_COMPLEX(BAT)(30)", 
"REACTOME_APC_C_MEDIATED_DEGRADATION_OF_CELL_CYCLE_PROTEINS(BAT)(87)", 
"REACTOME_CYCLIN_D_ASSOCIATED_EVENTS_IN_G1(BAT)(44)", "REACTOME_MITOTIC_SPINDLE_CHECKPOINT(BAT)(111)", 
"REACTOME_RESOLUTION_OF_SISTER_CHROMATID_COHESION(BAT)(122)", 
"REACTOME_G1_S_DNA_DAMAGE_CHECKPOINTS(BAT)(67)", "REACTOME_MITOTIC_PROPHASE(BAT)(121)", 
"REACTOME_DNA_REPLICATION_PRE_INITIATION(BAT)(98)", "REACTOME_G1_S_TRANSITION(BAT)(106)", 
"REACTOME_RECRUITMENT_OF_NUMA_TO_MITOTIC_CENTROSOMES(BAT)(88)", 
"REACTOME_MITOTIC_G1_PHASE_AND_G1_S_TRANSITION(BAT)(130)", "REACTOME_G2_M_DNA_DAMAGE_CHECKPOINT(BAT)(90)", 
"REACTOME_DNA_REPLICATION(BAT)(126)", "REACTOME_G2_M_CHECKPOINTS(BAT)(163)", 
"REACTOME_S_PHASE(BAT)(148)", "REACTOME_MITOTIC_G2_G2_M_PHASES(BAT)(183)", 
"REACTOME_CYCLIN_A_CDK2_ASSOCIATED_EVENTS_AT_S_PHASE_ENTRY(BAT)(73)", 
"REACTOME_MITOTIC_PROMETAPHASE(BAT)(193)", "REACTOME_MITOTIC_METAPHASE_AND_ANAPHASE(BAT)(225)", 
"KEGG_CELL_CYCLE(BAT)(123)", "REACTOME_TP53_REGULATES_TRANSCRIPTION_OF_DNA_REPAIR_GENES(BAT)(43)", 
"REACTOME_M_PHASE(BAT)(390)", "REACTOME_DNA_REPAIR(BAT)(299)", 
"REACTOME_CELL_CYCLE_CHECKPOINTS(BAT)(286)", "REACTOME_CELL_CYCLE(BAT)(601)", 
"HALLMARK_MYC_TARGETS_V1(BAT)(197)", "HALLMARK_MITOTIC_SPINDLE(BAT)(199)", 
"HALLMARK_G2M_CHECKPOINT(BAT)(195)", "HALLMARK_E2F_TARGETS(BAT)(199)", 
"REACTOME_CELLULAR_SENESCENCE(invitro)(95)", "REACTOME_MITOTIC_PROMETAPHASE(invitro)(193)", 
"REACTOME_AMPLIFICATION_OF_SIGNAL_FROM_THE_KINETOCHORES(invitro)(94)", 
"REACTOME_RESOLUTION_OF_SISTER_CHROMATID_COHESION(invitro)(122)", 
"REACTOME_MITOTIC_SPINDLE_CHECKPOINT(invitro)(111)"), class = "factor"), 
    percent_ccgs = c(26.8, 26.2, 20.6, 19, 29.2, 21.9, 20.5, 
    40.9, 22.7, 22.6, 23, 21.6, 21.8, 22.3, 27.9, 25.6, 33.8, 
    32.5, 33.3, 34.5, 38.6, 24.3, 21.3, 31.3, 20.7, 31.6, 34, 
    27.3, 31.5, 21.1, 29.4, 25.2, 32.4, 29.5, 37, 25.4, 27.6, 
    32.5, 37.2, 25.9, 21.7, 24.8, 24.8, 27.9, 29.6, 30.3, 26.1, 
    28.4, 16.1, 19.1, 16.4, 18.9), kuiper_q = c(0.09611, 0.08737, 
    0.0695, 0.04749, 0.0278, 0.01853, 0.0139, 0.00927, 0.00927, 
    0.0068, 1e-04, 1e-04, 1e-04, 1e-04, 1e-04, 1e-04, 0.083925532, 
    0.067253165, 0.066876923, 0.066518421, 0.062635616, 0.0546, 
    0.054455882, 0.048555556, 0.042714286, 0.0406, 0.036672222, 
    0.03521875, 0.03442069, 0.03442069, 0.027906667, 0.025044444, 
    0.01932, 0.01932, 0.01932, 0.0161, 0.010733333, 0.007542857, 
    1e-04, 1e-04, 1e-04, 1e-04, 1e-04, 1e-04, 1e-04, 1e-04, 1e-04, 
    0.0125, 0.0122, 0.0012, 8e-04, 2e-04)), row.names = c(NA, 
-52L), class = "data.frame")

#import data
cell_cycle_sample <- read.csv("cell_cycle_sample.csv")
# make label an ordered factor
cell_cycle_sample$label <- factor(cell_cycle_sample$label, levels = cell_cycle_sample$label)
#specify scalebreaks
b <- c(0.0001, 0, 0.1)
#generate plot
ggplot(cell_cycle_sample,aes(x=percent_ccgs,y=label,fill=kuiper_q,group=sample)) + 
  geom_col(position="dodge",width=0.4,linewidth=0.7) +
  scale_fill_gradientn(limits = c(0.0001,0.1),
                       colours=c("navyblue", "darkmagenta", "darkorange1"),
                       breaks=b, labels=format(b))

Answer 1

一种方法是为数据中的每个

sample

生成新的尺度。我们将使用

ggnewscale

包来完成此操作。

对于

sample

中的每个，我们将单独调用

geom_col

，对数据进行子集化，将

aes(fill=)

从主调用移动到每个

geom_col

。我们还将为每个设置渐变。

ggplot(cell_cycle_sample, aes(x=percent_ccgs, y=label, group=sample)) + 
  geom_col(position="dodge", width=0.4, linewidth=0.7, aes(fill = kuiper_q),
           data = ~ subset(.x, sample == "WAT")) +
  scale_fill_gradient(
    name = "BAT", guide = guide_colorbar(order = 3),
    limits = c(0.0001, 0.1),
    low = "blue", high = "lightblue",
    breaks=b, labels = format(b)) +
  ggnewscale::new_scale_fill() +
  geom_col(position="dodge", width=0.4, linewidth=0.7, aes(fill = kuiper_q),
           data = ~ subset(.x, sample == "BAT")) +
  scale_fill_gradient(
    name = "WAT", guide = guide_colorbar(order = 2),
    limits = c(0.0001, 0.1),
    low = "green", high = "lightgreen",
    breaks=b, labels = format(b)) +
  ggnewscale::new_scale_fill() +
  geom_col(position="dodge", width=0.4, linewidth=0.7, aes(fill = kuiper_q),
           data = ~ subset(.x, sample == "in_vitro")) +
  scale_fill_gradient(
    name = "in_vitro", guide = guide_colorbar(order = 1),
    limits = c(0.0001, 0.1),
    low = "red", high = "pink",
    breaks=b, labels = format(b))

备注：

• 我不知道我是否分配了正确的颜色、标签或

  sample

  组的顺序，请您更新标签标题。
• 要意识到

  guide_colorbar(order=)

  是从下到上的，尽管我相信您是用

  factor

  来订购巧克力棒的。玩一玩，你应该能够实现你想要的任何顺序。
• 我承认我不知道为什么我需要将

  aes(fill = kuiper_q)

  从主调用移动到每个

  geom_col

  ，但如果没有这种更改，它就无法工作。

• data=~ subset(...)

  基于两件事：

  ggplot2

  使用

  rlang

  的波形符函数，其中

  .x

  被主

  ggplot(...)

  调用中提供的数据替换，我正在使用

  subset 

  因为我不知道你是否已经在使用

  dplyr

  （而且你并不只是为了这个而需要它）。您还可以从主调用中删除原始的

  cell_cycle_sample

  以及每个

  geom_call

  所以

  data = subset(cell_cycle_sample, sample == "BAT")

  （等等）。但是...如果您有其他几何/图层需要数据中的某些内容，这会变得更加繁重，所以...我保持这种方式。