R语言UpSet图：按自定义分组而非组合为主条形图着色

我有一个包含7列0、1值的R数据集，已通过规则将数据划分到自定义分组列group中。数据集存在17种数据组合，希望UpSet图的主条形图按自定义分组着色，而非默认的按组合着色，同时保留组合的展示效果。

原尝试代码（含语法错误） #

data <- data.frame(
    x1 = c(0, 1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0),
    x2= c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1),
    x3 = c(0, 1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
    x4 = c(0, 1, 0, 1, 0, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0),
    x5 = c(0, 1, 0, 1, 0, 0, 0, 1, 1, 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 1, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0),
    x6 = c(0, 1, 1, 1, 0, 0, 0, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0),
    x7 = c(0, 1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0))

data1 <- data %>% 
    mutate(numeric=rowSums(.[c("x1", "x2", "x3", "x4", "x5", "x6", "x7")])) %>% 
    mutate(group=case_when(
        x1==1 & x2==1 & x3==1 ~ "A",
        x1==1 & x2==1 ~ "B",
        x1=1 & x3==1 ~ "C",  # 语法错误：应为x1==1
        numeric ==1 ~ "D",
        numeric >=2 ~ "E",
        TRUE ~ "F"))
color <- c("A"="red", "B"="orange", "C"="#228822", "D"="#00BFFF", "E"="yellow", 
"F"=="gray")  # 语法错误：应为"F"="gray"
upset(data1, sets=c("x1", "x2", "x3", "x4", "x5", "x6", "x7"),
            group.by = "group",
            main.bar.color = color)

问题分析 #

1. 原代码存在两处语法错误，需修正后才能运行
2. UpSetR包的group.by参数用于按组合大小区间分组，无法直接指定自定义group列实现着色。需先建立数据组合与自定义分组的映射关系，再为每个组合分配对应分组的颜色。

修正后解决方案代码 #

library(UpSetR)
library(dplyr)

# 生成带自定义分组的数据集（修正语法错误）
data <- data.frame(
    x1 = c(0, 1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0),
    x2= c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1),
    x3 = c(0, 1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
    x4 = c(0, 1, 0, 1, 0, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0),
    x5 = c(0, 1, 0, 1, 0, 0, 0, 1, 1, 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 1, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0),
    x6 = c(0, 1, 1, 1, 0, 0, 0, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0),
    x7 = c(0, 1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0))

data1 <- data %>% 
    mutate(numeric=rowSums(.[c("x1", "x2", "x3", "x4", "x5", "x6", "x7")])) %>% 
    mutate(group=case_when(
        x1==1 & x2==1 & x3==1 ~ "A",
        x1==1 & x2==1 ~ "B",
        x1==1 & x3==1 ~ "C",
        numeric ==1 ~ "D",
        numeric >=2 ~ "E",
        TRUE ~ "F"))

# 1. 建立数据组合与自定义分组的映射
combo_group_map <- data1 %>%
    group_by(x1, x2, x3, x4, x5, x6, x7) %>%
    summarise(group = first(group), .groups = "drop") %>%
    mutate(combo = paste(x1, x2, x3, x4, x5, x6, x7, sep = "-")) %>%
    select(combo, group)

# 2. 定义分组颜色映射
color_map <- c("A"="red", "B"="orange", "C"="#228822", "D"="#00BFFF", "E"="yellow", "F"="gray")

# 3. 生成UpSet图展示的组合对应的颜色向量
upset_combos <- upset(data1, sets=c("x1", "x2", "x3", "x4", "x5", "x6", "x7"), plot = FALSE)$combinations %>%
    mutate(combo = paste(x1, x2, x3, x4, x5, x6, x7, sep = "-"))

combo_colors <- upset_combos %>%
    left_join(combo_group_map, by = "combo") %>%
    pull(group) %>%
    recode(!!!color_map)

# 4. 绘制按自定义分组着色的UpSet图
upset(data1, 
      sets=c("x1", "x2", "x3", "x4", "x5", "x6", "x7"),
      main.bar.color = combo_colors)

可复现数据测试代码 #

# 加载可复现数据
data <- structure(list(X1 = c(0, 1, 0, 1, 0, 0, 0, 0, 0, 0), X2 = c(1,1, 1,
 1, 1, 1, 1, 1, 1, 1), X3 = c(0, 1, 0, 1, 0, 0, 0, 0, 0,0), X4 = c(0, 1, 0,
 1, 0, 0, 0, 0, 0, 0), X5 = c(0, 1, 1, 1,0, 0, 0, 0, 0, 1), X6 = c(0, 1, 0,
 0, 0, 0, 0, 0, 0, 0), X7 = c(0,0, 0, 0, 0, 0, 0, 0, 0, 0), X8 = c(0, 0, 0,
 0, 0, 0, 0, 0, 0,0), X9 = c(1, 1, 0, 0, 0, 1, 1, 1, 1, 1), X10 = c(0, 0, 0,
 0,0, 0, 0, 0, 0, 0), X11 = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), X12 = c(0,0, 0,
 0, 0, 0, 0, 0, 0, 0), group = c("C", "D", "C", "A", "B","C", "C", "C", "C",
 "C")), row.names = c(NA, -10L), class = c("tbl_df","tbl", "data.frame"))

# 建立组合-分组映射
combo_group_map <- data %>%
    group_by(across(X1:X12)) %>%
    summarise(group = first(group), .groups = "drop") %>%
    mutate(combo = paste(across(X1:X12), collapse = "-")) %>%
    select(combo, group)

# 定义颜色映射
color_map <- c("A"="red", "B"="orange", "C"="#228822", "D"="#00BFFF")

# 生成组合颜色向量
upset_combos <- upset(data, sets=paste0("X", 1:12), plot = FALSE)$combinations %>%
    mutate(combo = paste(across(X1:X12), collapse = "-"))

combo_colors <- upset_combos %>%
    left_join(combo_group_map, by = "combo") %>%
    pull(group) %>%
    recode(!!!color_map)

# 绘图
upset(data, 
      sets=paste0("X", 1:12),
      main.bar.color = combo_colors)

内容的提问来源于stack exchange，提问作者user142632