Skip to content

Refactor plotting code #101

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
JakeConway merged 5 commits into from
Mar 27, 2018
Merged

Refactor plotting code #101

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
c246b9d
Remove grid calls, add print function
alanocallaghan Dec 2, 2017
da9c398
Merge branch 'master' of github.com:Alanocallaghan/UpSetR
Dec 5, 2017
fd7ba10
Change point shape to 16
Dec 5, 2017
0eae128
Add newpage arg
Dec 7, 2017
1a852eb
Add summary function
Dec 7, 2017
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,4 +26,4 @@ LazyData: true
VignetteBuilder: knitr
Suggests:
knitr
RoxygenNote: 5.0.1
RoxygenNote: 6.0.1.9000
1 change: 1 addition & 0 deletions NAMESPACE
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
# Generated by roxygen2: do not edit by hand

S3method(print,upset)
export(elements)
export(fromExpression)
export(fromList)
Expand Down
22 changes: 11 additions & 11 deletions R/Matrix.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -38,11 +38,11 @@ Create_layout <- function(setup, mat_color, mat_col, matrix_dot_alpha){
Matrix_layout$Intersection[i] <- paste(Matrix_layout$x[i], "yes", sep ="")
}
else{

Matrix_layout$color[i] <- "gray83"
Matrix_layout$alpha[i] <- matrix_dot_alpha
Matrix_layout$Intersection[i] <- paste(i, "No", sep = "")
}
}
}
if(is.null(mat_col) == F){
for(i in 1:nrow(mat_col)){
Expand All @@ -58,7 +58,7 @@ Create_layout <- function(setup, mat_color, mat_col, matrix_dot_alpha){
return(Matrix_layout)
}

## Create data set to shade matrix
## Create data set to shade matrix
MakeShading <- function(Mat_data, color){
y <- unique(Mat_data$y)
y <- (y[which(y %% 2 != 0)])
Expand All @@ -76,23 +76,23 @@ MakeShading <- function(Mat_data, color){
## Generate matrix plot
Make_matrix_plot <- function(Mat_data,Set_size_data, Main_bar_data, point_size, line_size, text_scale, labels,
shading_data, shade_alpha){

if(length(text_scale) == 1){
name_size_scale <- text_scale
name_size_scale <- text_scale
}
if(length(text_scale) > 1 && length(text_scale) <= 6){
name_size_scale <- text_scale[5]
}
Matrix_plot <- (ggplot()

Matrix_plot <- (ggplot()
+ theme(panel.background = element_rect(fill = "white"),
plot.margin=unit(c(-0.2,0.5,0.5,0.5), "lines"),
axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
axis.ticks.y = element_blank(),
axis.text.y = element_text(colour = "gray0",
axis.text.y = element_text(colour = "gray0",
size = 7*name_size_scale, hjust = 0.4),
panel.grid.major = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank())
+ xlab(NULL) + ylab(" ")
+ scale_y_continuous(breaks = c(1:nrow(Set_size_data)),
Expand All @@ -103,10 +103,10 @@ Make_matrix_plot <- function(Mat_data,Set_size_data, Main_bar_data, point_size,
ymin = "y_min", ymax = "y_max"),
fill = shading_data$shade_color, alpha = shade_alpha)
+ geom_point(data= Mat_data, aes_string(x= "x", y= "y"), colour = Mat_data$color,
size= point_size, alpha = Mat_data$alpha)
size= point_size, alpha = Mat_data$alpha, shape=16)
+ geom_line(data= Mat_data, aes_string(group = "Intersection", x="x", y="y",
colour = "color"), size = line_size)
+ scale_color_identity())
Matrix_plot <- ggplot_gtable(ggplot_build(Matrix_plot))
return(Matrix_plot)
}
}
93 changes: 50 additions & 43 deletions R/UpSet.plot.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,47 +11,47 @@
Make_base_plot <- function(Main_bar_plot, Matrix_plot, Size_plot, labels, hratios, att_x, att_y,
Set_data, exp, position, start_col, att_color, QueryData,
attribute_plots, legend, query_legend, boxplot, names, set_metadata,
set_metadata_plots){
set_metadata_plots, newpage){

end_col <- ((start_col + as.integer(length(labels))) - 1)
Set_data <- Set_data[which(rowSums(Set_data[ ,start_col:end_col]) != 0), ]
Main_bar_plot$widths <- Matrix_plot$widths
Matrix_plot$heights <- Size_plot$heights
if(is.null(set_metadata) ==F){
if(!is.null(set_metadata)){
ncols <- 0
for(i in 1:length(set_metadata_plots)){
ncols <- ncols + set_metadata$plots[[i]]$assign
set_metadata_plots[[i]]$heights <- Size_plot$heights
}
set_metadata$ncols <- ncols
}
if(is.null(legend)==F){
if(!is.null(legend)) {
legend$widths <- Matrix_plot$widths
}
if(is.null(boxplot) == F){
if(!is.null(boxplot)){
for(i in seq_along(boxplot)){
boxplot[[i]]$widths <- Matrix_plot$widths
}
}

size_plot_height <- (((hratios[1])+0.01)*100)
if((hratios[1] > 0.7 || hratios[1] < 0.3) ||
(hratios[2] > 0.7 || hratios[2] < 0.3)) warning("Plot might be out of range if ratio > 0.7 or < 0.3")
if(is.null(attribute_plots) == T && is.null(boxplot) == T){
if(is.null(attribute_plots) && is.null(boxplot)){
NoAttBasePlot(legend, size_plot_height, Main_bar_plot, Matrix_plot, hratios, Size_plot, query_legend,
set_metadata, set_metadata_plots)
set_metadata, set_metadata_plots, newpage=newpage)
}
else if(is.null(attribute_plots) == F && is.null(boxplot) == T){
else if(!is.null(attribute_plots) && is.null(boxplot)){
plots <- GenerateCustomPlots(attribute_plots, Set_data, QueryData, att_color, att_x, att_y, names)
# for(i in seq_along(plots)){
# attribute_plots$plots[[i]]$plot <- plots[[i]]
# }
BaseCustomPlot(attribute_plots, plots, position, size_plot_height, Main_bar_plot, Matrix_plot, Size_plot,
hratios, legend, query_legend, set_metadata, set_metadata_plots)
hratios, legend, query_legend, set_metadata, set_metadata_plots, newpage=newpage)
}
else if(is.null(boxplot)==F && is.null(attribute_plots) == T){
else if(!is.null(boxplot) && is.null(attribute_plots)){
BaseBoxPlot(boxplot, position, size_plot_height, Main_bar_plot, Matrix_plot, Size_plot,
hratios, set_metadata, set_metadata_plots)
hratios, set_metadata, set_metadata_plots, newpage=newpage)
}
}

Expand All @@ -62,11 +62,12 @@ vplayout <- function(x,y){

## Generates UpSet plot with boxplots representing distributions of attributes
BaseBoxPlot <- function(box_plot, position, size_plot_height, Main_bar_plot, Matrix_plot,
Size_plot, hratios, set_metadata, set_metadata_plots){
Size_plot, hratios, set_metadata, set_metadata_plots, newpage){

if(length(box_plot) > 2){
return(warning("UpSet can only show 2 box plots at a time"))
}
if(is.null(position) == T || position == tolower("bottom")){
if(is.null(position) || position == tolower("bottom")){
bar_top <- 1
matrix_bottom <- 100
att_top <- 101
Expand All @@ -77,7 +78,7 @@ BaseBoxPlot <- function(box_plot, position, size_plot_height, Main_bar_plot, Mat
gridrow <- 145
}
}
if((is.null(position) == F) && (position != tolower("bottom"))){
if((!is.null(position)) && (position != tolower("bottom"))){
if(length(box_plot)==1){
size_plot_height <- (size_plot_height + 35)
bar_top <- 36
Expand All @@ -94,21 +95,23 @@ BaseBoxPlot <- function(box_plot, position, size_plot_height, Main_bar_plot, Mat
gridrow <- 150
}
}
if(is.null(set_metadata) == T){
if(is.null(set_metadata)){
matrix_and_mainbar_right <- 100
matrix_and_mainbar_left <- 21
size_bar_right <- 20
size_bar_left <- 1
}
else if(is.null(set_metadata) == F){
else if(!is.null(set_metadata)){
matrix_and_mainbar_right <- set_metadata$ncols + 100
matrix_and_mainbar_left <- set_metadata$ncols + 21
size_bar_right <- set_metadata$ncols + 20
size_bar_left <- set_metadata$ncols + 1
metadata_right <- set_metadata$ncols
metadata_left <- 1
}
grid.newpage()
if (newpage) {
grid.newpage()
}
if(length(box_plot) == 1){
pushViewport(viewport(layout = grid.layout(135,matrix_and_mainbar_right)))
}
Expand All @@ -123,7 +126,7 @@ BaseBoxPlot <- function(box_plot, position, size_plot_height, Main_bar_plot, Mat
pushViewport(vp)
grid.draw(arrangeGrob(Size_plot))
popViewport()
if(is.null(set_metadata) == F){
if(!is.null(set_metadata)){
for(i in 1:length(set_metadata_plots)){
if(i != 1){
metadata_left <- 1+metadata_right
Expand All @@ -133,7 +136,7 @@ BaseBoxPlot <- function(box_plot, position, size_plot_height, Main_bar_plot, Mat
metadata_left <- 1
metadata_right <- set_metadata$plots[[i]]$assign
}

vp = vplayout(size_plot_height:matrix_bottom, metadata_left:metadata_right)
pushViewport(vp)
grid.draw(arrangeGrob(set_metadata_plots[[i]]))
Expand All @@ -154,10 +157,10 @@ BaseBoxPlot <- function(box_plot, position, size_plot_height, Main_bar_plot, Mat

## Generates UpSet plot when no attributes are selected to be plotted
NoAttBasePlot <- function(legend, size_plot_height, Main_bar_plot, Matrix_plot, hratios,
Size_plot, query_legend, set_metadata, set_metadata_plots){
Size_plot, query_legend, set_metadata, set_metadata_plots, newpage){
top <- 1
bottom <- 100
if((is.null(legend) == F) && (query_legend != tolower("none"))){
if((!is.null(legend)) && (query_legend != tolower("none"))){
if(query_legend == tolower("top")){
top <- 3
bottom <- 102
Expand All @@ -170,30 +173,32 @@ NoAttBasePlot <- function(legend, size_plot_height, Main_bar_plot, Matrix_plot,
legend_bottom <- 103
}
}
if(is.null(set_metadata) == T){
if(is.null(set_metadata)){
matrix_and_mainbar_right <- 100
matrix_and_mainbar_left <- 21
size_bar_right <- 20
size_bar_left <- 1
}
else if(is.null(set_metadata) == F){
else if(!is.null(set_metadata)){
matrix_and_mainbar_right <- set_metadata$ncols + 100
matrix_and_mainbar_left <- set_metadata$ncols + 21
size_bar_right <- set_metadata$ncols + 20
size_bar_left <- set_metadata$ncols + 1
metadata_right <- set_metadata$ncols
metadata_left <- 1
}
grid.newpage()
if((is.null(legend) == F) && (query_legend != tolower("none"))){
if (newpage) {
grid.newpage()
}
if((!is.null(legend)) && (query_legend != tolower("none"))){
if(query_legend == tolower("top")){
pushViewport(viewport(layout = grid.layout(102, matrix_and_mainbar_right)))
}
else if(query_legend == tolower("bottom")){
pushViewport(viewport(layout = grid.layout(103, matrix_and_mainbar_right)))
}
}
else if((is.null(legend) == T)|| (query_legend == tolower("none"))){
else if((is.null(legend))|| (query_legend == tolower("none"))){
pushViewport(viewport(layout = grid.layout(100,matrix_and_mainbar_right)))
}
vp = vplayout(top:bottom, matrix_and_mainbar_left:matrix_and_mainbar_right)
Expand All @@ -204,7 +209,7 @@ NoAttBasePlot <- function(legend, size_plot_height, Main_bar_plot, Matrix_plot,
pushViewport(vp)
grid.draw(arrangeGrob(Size_plot))
popViewport()
if(is.null(set_metadata) == F){
if(!is.null(set_metadata)){
for(i in 1:length(set_metadata_plots)){
if(i != 1){
metadata_left <- 1+metadata_right
Expand All @@ -214,14 +219,14 @@ NoAttBasePlot <- function(legend, size_plot_height, Main_bar_plot, Matrix_plot,
metadata_left <- 1
metadata_right <- set_metadata$plots[[i]]$assign
}

vp = vplayout(size_plot_height:bottom, metadata_left:metadata_right)
pushViewport(vp)
grid.draw(arrangeGrob(set_metadata_plots[[i]]))
popViewport()
}
}
if((is.null(legend) == F) && (query_legend != tolower("none"))){
if((!is.null(legend)) && (query_legend != tolower("none"))){
vp = vplayout(legend_top:legend_bottom, matrix_and_mainbar_left:matrix_and_mainbar_right)
pushViewport(vp)
grid.draw(arrangeGrob(legend))
Expand All @@ -231,35 +236,37 @@ NoAttBasePlot <- function(legend, size_plot_height, Main_bar_plot, Matrix_plot,

## Function that plots out the list of plots generated from custom plot input
BaseCustomPlot <- function(attribute_plots, plots, position, size_plot_height, Main_bar_plot, Matrix_plot,
Size_plot, hratios, legend, q_legend, set_metadata, set_metadata_plots){
Size_plot, hratios, legend, q_legend, set_metadata, set_metadata_plots, newpage){
bar_top <- 1
matrix_bottom <- 100
custom_top <- 101
custom_bottom <- (attribute_plots$gridrows + 100)
if(is.null(set_metadata) == T){

if(is.null(set_metadata)){
matrix_and_mainbar_right <- 100
matrix_and_mainbar_left <- 21
size_bar_right <- 20
size_bar_left <- 1
}
else if(is.null(set_metadata) == F){
else if(!is.null(set_metadata)){
matrix_and_mainbar_right <- set_metadata$ncols + 100
matrix_and_mainbar_left <- set_metadata$ncols + 21
size_bar_right <- set_metadata$ncols + 20
size_bar_left <- set_metadata$ncols + 1
metadata_right <- set_metadata$ncols
metadata_left <- 1
}
if((is.null(legend) == F) && (q_legend == tolower("bottom"))){custom_bottom <- (custom_bottom + 5)}
if((is.null(legend) == F) && (q_legend == tolower("top"))){

if((!is.null(legend)) && (q_legend == tolower("bottom"))){custom_bottom <- (custom_bottom + 5)}
if((!is.null(legend)) && (q_legend == tolower("top"))){
bar_top <- bar_top + 5
matrix_bottom <- matrix_bottom + 5
custom_top <- custom_top + 5
custom_bottom <- custom_bottom + 5
}
grid.newpage()
if (newpage) {
grid.newpage()
}
pushViewport(viewport(layout = grid.layout(custom_bottom,matrix_and_mainbar_right)))
vp = vplayout(bar_top:matrix_bottom, matrix_and_mainbar_left:matrix_and_mainbar_right)
pushViewport(vp)
Expand All @@ -269,7 +276,7 @@ BaseCustomPlot <- function(attribute_plots, plots, position, size_plot_height, M
pushViewport(vp)
grid.draw(arrangeGrob(Size_plot))
popViewport()
if(is.null(set_metadata) == F){
if(!is.null(set_metadata)){
for(i in 1:length(set_metadata_plots)){
if(i != 1){
metadata_left <- 1+metadata_right
Expand All @@ -279,14 +286,14 @@ BaseCustomPlot <- function(attribute_plots, plots, position, size_plot_height, M
metadata_left <- 1
metadata_right <- set_metadata$plots[[i]]$assign
}

vp = vplayout(size_plot_height:matrix_bottom, metadata_left:metadata_right)
pushViewport(vp)
grid.draw(arrangeGrob(set_metadata_plots[[i]]))
popViewport()
}
}
if((is.null(legend) == F) && (q_legend == tolower("bottom"))){
if((!is.null(legend)) && (q_legend == tolower("bottom"))){
vp = vplayout(custom_top:(custom_bottom - 5), 1:matrix_and_mainbar_right)
pushViewport(vp)
grid.draw(do.call(arrangeGrob, c(plots, ncol = attribute_plots$ncols)))
Expand All @@ -296,7 +303,7 @@ BaseCustomPlot <- function(attribute_plots, plots, position, size_plot_height, M
grid.draw(arrangeGrob(legend))
popViewport()
}
else if((is.null(legend) == F) && (q_legend == tolower("top"))){
else if((!is.null(legend)) && (q_legend == tolower("top"))){
vp = vplayout(custom_top:custom_bottom, 1:matrix_and_mainbar_right)
pushViewport(vp)
grid.draw(do.call(arrangeGrob, c(plots, ncol = attribute_plots$ncols)))
Expand All @@ -317,4 +324,4 @@ BaseCustomPlot <- function(attribute_plots, plots, position, size_plot_height, M

# printCustom <- function(attribute_plots){
# print(attribute_plots$plot, vp = vplayout(attribute_plots$rows, attribute_plots$cols), newpage = F)
# }
# }
8 changes: 4 additions & 4 deletions R/scatter_plot.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,16 +4,16 @@
#' @param mydata A data set containing intersection data provided internally
#' @param x The x aesthetic for the scatter plot
#' @param y The y aesthetic for the scatter plot
#' @note See examples section for upset function on how to use custom.plot parameter.
#' @note See examples section for upset function on how to use custom.plot parameter.
#' @export
scatter_plot <- function(mydata, x, y){
att_plot <- (ggplot(data = mydata, aes_string(x = x, y = y, colour = "color"))
+ geom_point() + scale_color_identity()
att_plot <- (ggplot(data = mydata, aes_string(x = x, y = y, colour = "color"))
+ geom_point(shape=16) + scale_color_identity()
+ theme(panel.background = element_rect(fill = "white"),
plot.title = element_text(vjust = 1.3),
panel.grid.minor = element_blank(),
panel.grid.major = element_blank(),
axis.title.y = element_text(vjust = 1.3, size = 8.3),
axis.title.x = element_text(size = 8.3),
plot.margin=unit(c(0.5,0,0,1), "cm")))
}
}
Loading