I'm using ComplexUpset in R. I have a results from a Transcription Experiment. It has 4 comparisons. Each gene in in each comparison can be significantly regulated. Furthermore, each can be positively regulated or negatively regulated or opposite.
When producing the plot the intersections are on the genes that are significantly regulated (independent of their direction). I would like to annotate the plot with either another Bar chart on top with stacked proportion of positively regulated or negatively regulated genes. For this I created an additional data set with a factor indicating this for all the 'intersections' shown in the upset plot.
I would like to have something like the examples in th vignette using movies but the MPAA Rating is a factor for all those:
This graph shows in principle what I want but not aligned as if it would using annotations=
The sample data and code used for this:
set.seed(45)
example_df <- data.frame(geneid=paste('gene_', 1:15000, sep = ''),
comparison_1=sample(c(T, F), size = 15000, replace = T, prob = c(.7, .3)),
comparison_2=sample(c(T, F), size = 15000, replace = T, prob = c(.40, .6)),
comparison_3=sample(c(T, F), size = 15000, replace = T, prob = c(.25, .75)),
comparison_4=sample(c(T, F), size = 15000, replace = T, prob = c(.12, .88)),
fill_comparison_1=sample(c('up', 'down'), size = 15000, replace = T, prob = c(.60,.40)),
fill_comparison_2=sample(c('up', 'down'), size = 15000, replace = T, prob = c(.55,.45)),
fill_comparison_3=sample(c('up', 'down'), size = 15000, replace = T, prob = c(.50,.50)),
fill_comparison_4=sample(c('up', 'down'), size = 15000, replace = T, prob = c(.65,.35)))
example_df[example_df$fill_comparison_1=='up' & example_df$fill_comparison_2=='up', "intersection_1"] <- 'up'
example_df[example_df$fill_comparison_1=='down' & example_df$fill_comparison_2=='down', "intersection_1"] <- 'down'
example_df[example_df$fill_comparison_1=='up' & example_df$fill_comparison_2=='down', "intersection_1"] <- 'opposite'
example_df[example_df$fill_comparison_1=='down' & example_df$fill_comparison_2=='up', "intersection_1"] <- 'opposite'
example_df[example_df$fill_comparison_3=='up' & example_df$fill_comparison_4=='up', "intersection_2"] <- 'up'
example_df[example_df$fill_comparison_3=='down' & example_df$fill_comparison_4=='down', "intersection_2"] <- 'down'
example_df[example_df$fill_comparison_3=='up' & example_df$fill_comparison_4=='down', "intersection_2"] <- 'opposite'
example_df[example_df$fill_comparison_3=='down' & example_df$fill_comparison_4=='up', "intersection_2"] <- 'opposite'
example_df[example_df$fill_comparison_1=='up' & example_df$fill_comparison_3=='up', "intersection_3"] <- 'up'
example_df[example_df$fill_comparison_1=='down' & example_df$fill_comparison_3=='down', "intersection_3"] <- 'down'
example_df[example_df$fill_comparison_1=='up' & example_df$fill_comparison_3=='down', "intersection_3"] <- 'opposite'
example_df[example_df$fill_comparison_1=='down' & example_df$fill_comparison_3=='up', "intersection_3"] <- 'opposite'
example_df[example_df$fill_comparison_2=='up' & example_df$fill_comparison_4=='up', "intersection_4"] <- 'up'
example_df[example_df$fill_comparison_2=='down' & example_df$fill_comparison_4=='down', "intersection_4"] <- 'down'
example_df[example_df$fill_comparison_2=='up' & example_df$fill_comparison_4=='down', "intersection_4"] <- 'opposite'
example_df[example_df$fill_comparison_2=='down' & example_df$fill_comparison_4=='up', "intersection_4"] <- 'opposite'
example_fill <- melt(data = example_df[, c(1, 6:ncol(example_df))], id.vars = 'geneid')
example_fill <- na.omit(example_fill)
fill_plot <-
ggplot(example_fill, mapping = aes(variable, fill=value))+
geom_bar(stat='count', position='fill')+
theme_minimal()+
theme(axis.text.x = element_text(angle = 90))
ex_upset <- upset(example_df, intersect = c(paste('comparison', 1:4, sep='_')), mode = 'inclusive_intersection', max_degree=4, keep_empty_groups=T, sort_sets=F, intersections=list('comparison_1', 'comparison_2', 'comparison_3', 'comparison_4', c(paste('comparison',1:2,sep='_')), c(paste('comparison',3:4,sep='_')), paste('comparison',c(1, 3),sep='_'), paste('comparison',c(2, 4),sep='_')))
fill_plot/ex_upset