我已经盯着这个看了几个小时，似乎没有找到解决办法。我希望 upSet 图表按集合着色。例如，
library('UpSetR')
movies <- read.csv( system.file("extdata", "movies.csv", package = "UpSetR"),
header=T, sep=";" )
upset(movies,
sets = c("Action", "Comedy", "Drama"),
group.by="sets", matrix.color="blue", point.size=5,
sets.bar.color=c("maroon","blue","orange"))
看起来像：
但是，我希望它看起来像：
换句话说，所有戏剧的交叉点都是红色的，喜剧的交叉点是蓝色的，动作的交叉点是黄色的。谢谢！
我向函数添加了一个mat_col参数，该参数upset允许自定义交叉点的颜色。这是修改后的myupset功能。
myupset <- function (data, nsets = 5, nintersects = 40, sets = NULL, keep.order = F,
set.metadata = NULL, intersections = NULL, matrix.color = "gray23", mat_col=NULL,
main.bar.color = "gray23", mainbar.y.label = "Intersection Size",
mainbar.y.max = NULL, sets.bar.color = "gray23", sets.x.label = "Set Size",
point.size = 2.2, line.size = 0.7, mb.ratio = c(0.7, 0.3),
expression = NULL, att.pos = NULL, att.color = main.bar.color,
order.by = c("freq", "degree"), decreasing = c(T, F), show.numbers = "yes",
number.angles = 0, group.by = "degree", cutoff = NULL, queries = NULL,
query.legend = "none", shade.color = "gray88", shade.alpha = 0.25,
matrix.dot.alpha = 0.5, empty.intersections = NULL, color.pal = 1,
boxplot.summary = NULL, attribute.plots = NULL, scale.intersections = "identity",
scale.sets = "identity", text.scale = 1, set_size.angles = 0,
set_size.show = FALSE, set_size.numbers_size = NULL, set_size.scale_max = NULL) {
startend <- UpSetR:::FindStartEnd(data)
first.col <- startend[1]
last.col <- startend[2]
if (color.pal == 1) {
palette <- c("#1F77B4", "#FF7F0E", "#2CA02C", "#D62728",
"#9467BD", "#8C564B", "#E377C2", "#7F7F7F", "#BCBD22",
"#17BECF")
}
else {
palette <- c("#E69F00", "#56B4E9", "#009E73", "#F0E442",
"#0072B2", "#D55E00", "#CC79A7")
}
if (is.null(intersections) == F) {
Set_names <- unique((unlist(intersections)))
Sets_to_remove <- UpSetR:::Remove(data, first.col, last.col, Set_names)
New_data <- UpSetR:::Wanted(data, Sets_to_remove)
Num_of_set <-UpSetR:::Number_of_sets(Set_names)
if (keep.order == F) {
Set_names <- UpSetR:::order_sets(New_data, Set_names)
}
All_Freqs <- UpSetR:::specific_intersections(data, first.col,
last.col, intersections, order.by, group.by, decreasing,
cutoff, main.bar.color, Set_names)
}
else if (is.null(intersections) == T) {
Set_names <- sets
if (is.null(Set_names) == T || length(Set_names) == 0) {
Set_names <- UpSetR:::FindMostFreq(data, first.col, last.col,
nsets)
}
Sets_to_remove <- UpSetR:::Remove(data, first.col, last.col, Set_names)
New_data <- UpSetR:::Wanted(data, Sets_to_remove)
Num_of_set <- UpSetR:::Number_of_sets(Set_names)
if (keep.order == F) {
Set_names <- UpSetR:::order_sets(New_data, Set_names)
}
All_Freqs <- UpSetR:::Counter(New_data, Num_of_set, first.col,
Set_names, nintersects, main.bar.color, order.by,
group.by, cutoff, empty.intersections, decreasing)
}
Matrix_setup <- UpSetR:::Create_matrix(All_Freqs)
labels <- UpSetR:::Make_labels(Matrix_setup)
att.x <- c()
att.y <- c()
if (is.null(attribute.plots) == F) {
for (i in seq_along(attribute.plots$plots)) {
if (length(attribute.plots$plots[[i]]$x) != 0) {
att.x[i] <- attribute.plots$plots[[i]]$x
}
else if (length(attribute.plots$plots[[i]]$x) ==
0) {
att.x[i] <- NA
}
if (length(attribute.plots$plots[[i]]$y) != 0) {
att.y[i] <- attribute.plots$plots[[i]]$y
}
else if (length(attribute.plots$plots[[i]]$y) ==
0) {
att.y[i] <- NA
}
}
}
BoxPlots <- NULL
if (is.null(boxplot.summary) == F) {
BoxData <- UpSetR:::IntersectionBoxPlot(All_Freqs, New_data, first.col,
Set_names)
BoxPlots <- list()
for (i in seq_along(boxplot.summary)) {
BoxPlots[[i]] <- UpSetR:::BoxPlotsPlot(BoxData, boxplot.summary[i],
att.color)
}
}
customAttDat <- NULL
customQBar <- NULL
Intersection <- NULL
Element <- NULL
legend <- NULL
EBar_data <- NULL
if (is.null(queries) == F) {
custom.queries <- UpSetR:::SeperateQueries(queries, 2, palette)
customDat <- UpSetR:::customQueries(New_data, custom.queries,
Set_names)
legend <- UpSetR:::GuideGenerator(queries, palette)
legend <- UpSetR:::Make_legend(legend)
if (is.null(att.x) == F && is.null(customDat) == F) {
customAttDat <- UpSetR:::CustomAttData(customDat, Set_names)
}
customQBar <- UpSetR:::customQueriesBar(customDat, Set_names,
All_Freqs, custom.queries)
}
if (is.null(queries) == F) {
Intersection <- UpSetR:::SeperateQueries(queries, 1, palette)
Matrix_col <- intersects(UpSetR:::QuerieInterData, Intersection,
New_data, first.col, Num_of_set, All_Freqs, expression,
Set_names, palette)
Element <- UpSetR:::SeperateQueries(queries, 1, palette)
EBar_data <- UpSetR:::ElemBarDat(Element, New_data, first.col,
expression, Set_names, palette, All_Freqs)
}
else {
Matrix_col <- NULL
}
if (!is.null(mat_col)) {
Matrix_col <- mat_col
}
Matrix_layout <- UpSetR:::Create_layout(Matrix_setup, matrix.color,
Matrix_col, matrix.dot.alpha)
Set_sizes <- UpSetR:::FindSetFreqs(New_data, first.col, Num_of_set,
Set_names, keep.order)
Bar_Q <- NULL
if (is.null(queries) == F) {
Bar_Q <- intersects(UpSetR:::QuerieInterBar, Intersection, New_data,
first.col, Num_of_set, All_Freqs, expression, Set_names,
palette)
}
QInter_att_data <- NULL
QElem_att_data <- NULL
if ((is.null(queries) == F) & (is.null(att.x) == F)) {
QInter_att_data <- intersects(UpSetR:::QuerieInterAtt, Intersection,
New_data, first.col, Num_of_set, att.x, att.y, expression,
Set_names, palette)
QElem_att_data <- elements(UpSetR:::QuerieElemAtt, Element, New_data,
first.col, expression, Set_names, att.x, att.y, palette)
}
AllQueryData <- UpSetR:::combineQueriesData(QInter_att_data, QElem_att_data,
customAttDat, att.x, att.y)
ShadingData <- NULL
if (is.null(set.metadata) == F) {
ShadingData <- UpSetR:::get_shade_groups(set.metadata, Set_names,
Matrix_layout, shade.alpha)
output <- UpSetR:::Make_set_metadata_plot(set.metadata, Set_names)
set.metadata.plots <- output[[1]]
set.metadata <- output[[2]]
if (is.null(ShadingData) == FALSE) {
shade.alpha <- unique(ShadingData$alpha)
}
}
else {
set.metadata.plots <- NULL
}
if (is.null(ShadingData) == TRUE) {
ShadingData <- UpSetR:::MakeShading(Matrix_layout, shade.color)
}
Main_bar <- suppressMessages(UpSetR:::Make_main_bar(All_Freqs, Bar_Q,
show.numbers, mb.ratio, customQBar, number.angles, EBar_data,
mainbar.y.label, mainbar.y.max, scale.intersections,
text.scale, attribute.plots))
Matrix <- UpSetR:::Make_matrix_plot(Matrix_layout, Set_sizes, All_Freqs,
point.size, line.size, text.scale, labels, ShadingData,
shade.alpha)
Sizes <- UpSetR:::Make_size_plot(Set_sizes, sets.bar.color, mb.ratio,
sets.x.label, scale.sets, text.scale, set_size.angles,
set_size.show, set_size.scale_max, set_size.numbers_size)
structure(class = "upset", .Data = list(Main_bar = Main_bar,
Matrix = Matrix, Sizes = Sizes, labels = labels, mb.ratio = mb.ratio,
att.x = att.x, att.y = att.y, New_data = New_data, expression = expression,
att.pos = att.pos, first.col = first.col, att.color = att.color,
AllQueryData = AllQueryData, attribute.plots = attribute.plots,
legend = legend, query.legend = query.legend, BoxPlots = BoxPlots,
Set_names = Set_names, set.metadata = set.metadata, set.metadata.plots = set.metadata.plots))
}
这是一个展示如何使用它的示例。
# The matrix of colors for the 3 x 12 intersection grid
mtxcol <- data.frame(x=rep(1:12,each=3),
color=rep(c("maroon","blue","orange"),each=12))
movies <- read.csv(system.file("extdata", "movies.csv", package = "UpSetR"),
header=T, sep=";")
myupset(movies,
sets = c("Action", "Comedy", "Drama"),
group.by="sets", point.size=5, mat_col=mtxcol,
sets.bar.color=c("maroon","blue","orange"))
如果您愿意使用不同的包，我的ComplexUpset允许这样做：
library(ComplexUpset)
upset(
movies, c("Action", "Comedy", "Drama"),
width_ratio=0.2,
group_by='sets',
queries=list(
upset_query(group='Drama', color='maroon'),
upset_query(group='Comedy', color='blue'),
upset_query(group='Action', color='orange'),
upset_query(set='Drama', fill='maroon'),
upset_query(set='Comedy', fill='blue'),
upset_query(set='Action', fill='orange')
)
)
可重现的设置：
movies = as.data.frame(ggplot2movies::movies)
genres = colnames(movies)[18:24]
movies[genres] = movies[genres] == 1
movies[movies$mpaa == '', 'mpaa'] = NA
movies = na.omit(movies)