From 22bbd3450bd5e5fc0522c0e99154047a804a79e0 Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 6 Oct 2023 11:37:11 -0400 Subject: [PATCH 01/12] Fix R CMD CHECK note --- DESCRIPTION | 1 - 1 file changed, 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index b58a53a..82370fb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -22,7 +22,6 @@ Imports: grDevices, scales License: MIT + file LICENSE -LazyData: true VignetteBuilder: knitr Suggests: knitr From 4076cb765d6766f87a7f6abf3c69159ba6397c70 Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 6 Oct 2023 11:37:30 -0400 Subject: [PATCH 02/12] Remove old travis.yml --- .Rbuildignore | 1 - .travis.yml | 52 --------------------------------------------------- 2 files changed, 53 deletions(-) delete mode 100644 .travis.yml diff --git a/.Rbuildignore b/.Rbuildignore index 112ad26..91114bf 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,3 +1,2 @@ ^.*\.Rproj$ ^\.Rproj\.user$ -^\.travis\.yml$ diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 23bfd62..0000000 --- a/.travis.yml +++ /dev/null @@ -1,52 +0,0 @@ -# Sample .travis.yml for R projects - -language: r -warnings_are_errors: true -sudo: true -dist: trusty - -env: - global: - - CRAN: http://cran.rstudio.com - -notifications: - email: - on_success: change - on_failure: change - -r_binary_packages: - - testthat - - devtools - -before_install: - - curl -OL http://raw.github.com/craigcitro/r-travis/master/scripts/travis-tool.sh - - chmod 755 ./travis-tool.sh - - ./travis-tool.sh bootstrap - -install: - ## For installing all CRAN dependencies using DESCRIPTION - - ./travis-tool.sh install_deps - - ## For installing all Bioconductor dependencies using DESCRIPTION - - ./travis-tool.sh install_bioc_deps - -# ## Install Github packages -# - ./travis-tool.sh install_github jimhester/covr - -env: - global: - - BIOC_USE_DEVEL="FALSE" ## Use the current release version - - R_BUILD_ARGS="--no-build-vignettes --no-manual" - - R_CHECK_ARGS="--no-build-vignettes --no-manual --timings" ## do not build vignettes or manual - - _R_CHECK_TIMINGS_="0" ## get the timing information for the examples for all of your functions - -script: - - travis_wait ./travis-tool.sh run_tests - -after_failure: - - ./travis-tool.sh dump_logs - -## Check how much time was spent in each of the example pages -after_script: - - ./travis-tool.sh dump_logs_by_extension "timings" - - ./travis-tool.sh dump_sysinfo From a53790e446e65e5c29569ea3d0570ea19a3d1587 Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 6 Oct 2023 11:38:45 -0400 Subject: [PATCH 03/12] devtools::document() --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 82370fb..f422d77 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,4 +25,5 @@ License: MIT + file LICENSE VignetteBuilder: knitr Suggests: knitr -RoxygenNote: 7.0.2 +RoxygenNote: 7.2.3 +Encoding: UTF-8 From 3de8266923d954bbe330b796ce56e3e3fb72a7c9 Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 6 Oct 2023 11:42:48 -0400 Subject: [PATCH 04/12] Delete vignettes/*.R files + add rmarkdown for vignette building. --- .gitignore | 1 + DESCRIPTION | 3 +- vignettes/.gitignore | 1 + vignettes/attribute.plots.R | 32 --------------------- vignettes/basic.usage.R | 38 ------------------------- vignettes/queries.R | 27 ------------------ vignettes/set.metadata.plots.R | 52 ---------------------------------- 7 files changed, 4 insertions(+), 150 deletions(-) create mode 100644 vignettes/.gitignore delete mode 100644 vignettes/attribute.plots.R delete mode 100644 vignettes/basic.usage.R delete mode 100644 vignettes/queries.R delete mode 100644 vignettes/set.metadata.plots.R diff --git a/.gitignore b/.gitignore index 728e389..75930f7 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,4 @@ .Rhistory .RData .DS_Store +inst/doc diff --git a/DESCRIPTION b/DESCRIPTION index f422d77..d9f4c7b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -24,6 +24,7 @@ Imports: License: MIT + file LICENSE VignetteBuilder: knitr Suggests: - knitr + knitr, + rmarkdown RoxygenNote: 7.2.3 Encoding: UTF-8 diff --git a/vignettes/.gitignore b/vignettes/.gitignore new file mode 100644 index 0000000..caa9612 --- /dev/null +++ b/vignettes/.gitignore @@ -0,0 +1 @@ +*.R diff --git a/vignettes/attribute.plots.R b/vignettes/attribute.plots.R deleted file mode 100644 index fbe0122..0000000 --- a/vignettes/attribute.plots.R +++ /dev/null @@ -1,32 +0,0 @@ -## ---- tidy=TRUE---------------------------------------------------------- -library(UpSetR); library(ggplot2); library(grid); library(plyr) -movies <- read.csv( system.file("extdata", "movies.csv", package = "UpSetR"), header=T, sep=";" ) - -## ---- fig.width=9, fig.height=5, out.width="850px",tidy=TRUE, fig.align='center'---- -upset(movies, main.bar.color = "black", queries = list(list(query = intersects, params = list("Drama"), active = T)), attribute.plots = list(gridrows = 50, plots = list(list(plot = histogram, x = "ReleaseDate", queries = F), list(plot = histogram, x = "AvgRating", queries = T)), ncols = 2)) - -## ---- fig.width=9, fig.height=5,out.width="850px",tidy=TRUE, fig.align='center'---- -upset(movies, main.bar.color = "black", queries = list(list(query = intersects, params = list("Drama"), color = "red", active = F), list(query = intersects, params = list("Action", "Drama"), active = T), list(query = intersects, params = list("Drama", "Comedy", "Action"), color = "orange", active = T)), attribute.plots = list(gridrows = 45, plots = list(list(plot = scatter_plot, x = "ReleaseDate", y = "AvgRating", queries = T), list(plot = scatter_plot, x = "AvgRating", y = "Watches", queries = F)), ncols = 2), query.legend = "bottom") - -## ---- tidy=TRUE---------------------------------------------------------- -myplot <- function(mydata,x,y){ - plot <- (ggplot(data = mydata, aes_string(x=x, y=y, colour = "color")) + geom_point() + scale_color_identity() + theme(plot.margin = unit(c(0,0,0,0), "cm"))) -} - -another.plot <- function(data, x, y){ - data$decades <- round_any(as.integer(unlist(data[y])), 10, ceiling) - data <- data[which(data$decades >= 1970), ] - myplot <- (ggplot(data, aes_string(x=x)) + - geom_density(aes(fill=factor(decades)), alpha = 0.4) - +theme(plot.margin = unit(c(0,0,0,0), "cm"), legend.key.size = unit(0.4,"cm"))) -} - -## ---- fig.width=9, fig.height=5, out.width="850px",tidy=TRUE, fig.align='center'---- -upset(movies, main.bar.color = "black", queries = list(list(query = intersects, params = list("Drama"), color = "red", active = F), list(query = intersects, params = list("Action", "Drama"), active = T), list(query = intersects, params = list("Drama", "Comedy", "Action"), color = "orange", active = T)), attribute.plots = list(gridrows = 45, plots = list(list(plot = myplot, x = "ReleaseDate", y = "AvgRating", queries = T), list(plot = another.plot, x = "AvgRating", y = "ReleaseDate", queries = F)), ncols = 2)) - -## ---- fig.width=9, fig.height=5,out.width="850px",tidy=TRUE, fig.align='center'---- -upset(movies, main.bar.color = "black", mb.ratio = c(0.5,0.5), queries = list(list(query = intersects, params = list("Drama"), color = "red", active = F), list(query = intersects, params = list("Action", "Drama"), active = T), list(query = intersects, params = list("Drama", "Comedy", "Action"), color = "orange", active = T)), attribute.plots = list(gridrows=50, plots = list(list(plot = histogram, x = "ReleaseDate", queries = F), list(plot = scatter_plot, x = "ReleaseDate", y = "AvgRating", queries = T),list(plot = myplot, x = "AvgRating", y = "Watches", queries = F)), ncols = 3)) - -## ---- fig.width=9, fig.height=5,out.width="850px", tidy=TRUE, fig.align='center'---- -upset(movies, boxplot.summary = c("AvgRating", "ReleaseDate")) - diff --git a/vignettes/basic.usage.R b/vignettes/basic.usage.R deleted file mode 100644 index ed10858..0000000 --- a/vignettes/basic.usage.R +++ /dev/null @@ -1,38 +0,0 @@ -## ---- tidy =TRUE--------------------------------------------------------- -library(UpSetR) -movies <- read.csv( system.file("extdata", "movies.csv", package = "UpSetR"), header=T, sep=";" ) - -## ---- tidy=TRUE---------------------------------------------------------- -#example of list input (list of named vectors) -listInput <-list(one = c(1,2,3,5,7,8,11,12,13), two = c(1,2,4,5,10), three = c(1,5,6,7,8,9,10,12,13)) - -#example of expression input -expressionInput <- c("one" = 2, "two" = 1, "three" = 2, "one&two" = 1, "one&three" = 4, "two&three" = 1, "one&two&three" = 2) - -## ---- out.width="850px", fig.width=9, fig.height =5,tidy=TRUE, fig.align='center'---- -upset(fromList(listInput), order.by = "freq") - -## ---- out.width="850px", fig.width=9, fig.height =5,tidy=TRUE, fig.align='center'---- -upset(fromExpression(expressionInput), order.by = "freq") - -## ---- out.width="850px", fig.width=9, fig.height =5, tidy =TRUE, fig.align='center'---- -upset(movies, nsets = 6, number.angles = 30, point.size = 3.5, line.size = 2, mainbar.y.label = "Genre Intersections", sets.x.label = "Movies Per Genre", text.scale=c(1.3, 1.3, 1, 1, 2, 0.75)) - -## ---- out.width="850px", fig.width=9, fig.height =5, tidy=TRUE, fig.align='center'---- -upset(movies, sets = c("Action", "Adventure", "Comedy", "Drama", "Mystery", "Thriller", "Romance", "War", "Western"), mb.ratio = c(0.55,0.45), order.by = "freq") - -## ---- out.width="850px", fig.width=9, fig.height =5,tidy=TRUE, fig.align='center'---- -upset(movies, sets = c("Action", "Adventure", "Comedy", "Drama", "Mystery", "Thriller", "Romance", "War", "Western"), mb.ratio = c(0.55,0.45), order.by = "degree") - -## ---- out.width="850px", fig.width=9, fig.height =5,tidy=TRUE, fig.align='center'---- -upset(movies, sets = c("Action", "Adventure", "Comedy", "Drama", "Mystery", "Thriller", "Romance", "War", "Western"), mb.ratio = c(0.55,0.45), order.by = c("degree", "freq")) - -## ---- out.width="850px", fig.width=9, fig.height =5, tidy=TRUE, fig.align='center'---- -upset(movies, sets = c("Action", "Adventure", "Comedy", "Drama", "Mystery", "Thriller", "Romance", "War", "Western"), mb.ratio = c(0.55,0.45), order.by = "freq", keep.order = TRUE) - -## ---- out.width="850px", fig.width=9, fig.height =5,tidy=TRUE, fig.align='center'---- -upset(movies, nintersects = 70, group.by = "sets", cutoff = 7) - -## ---- out.width="850px", fig.width=9, fig.height =5,tidy=TRUE, fig.align='center'---- -upset(movies, empty.intersections = "on", order.by = "freq") - diff --git a/vignettes/queries.R b/vignettes/queries.R deleted file mode 100644 index a39ee51..0000000 --- a/vignettes/queries.R +++ /dev/null @@ -1,27 +0,0 @@ -## ---- tidy=TRUE---------------------------------------------------------- -library(UpSetR) -movies <- read.csv( system.file("extdata", "movies.csv", package = "UpSetR"), header=T, sep=";" ) - -## ---- out.width="850px", fig.width=9, fig.height =5, tidy=TRUE, fig.align='center'---- -upset(movies, queries = list(list(query = intersects, params = list("Drama", "Comedy", "Action"), color = "orange", active = T), list(query = intersects, params = list("Drama"), color = "red", active = F), list(query = intersects, params = list("Action", "Drama"), active = T))) - -## ---- out.width="850px", fig.width=9, fig.height =5, tidy=TRUE, fig.align='center'---- -upset(movies, queries = list(list(query = elements, params = list("AvgRating", 3.5, 4.1), color = "blue", active = T), list(query = elements, params = list("ReleaseDate", 1980, 1990, 2000), color = "red", active = F))) - -## ---- out.width="850px", fig.width=9, fig.height =5, tidy=TRUE, fig.align='center'---- -upset(movies, queries = list(list(query = intersects, params = list("Action", "Drama"), active = T), list(query = elements, params = list("ReleaseDate", 1980, 1990, 2000), color = "red", active = F)), expression = "AvgRating > 3 & Watches > 100") - -## ---- tidy=TRUE---------------------------------------------------------- -Myfunc <- function(row, release, rating){ - data <- (row["ReleaseDate"] %in% release) & (row["AvgRating"] > rating) -} - -## ---- out.width="850px", fig.width=9, fig.height =5, tidy=TRUE, fig.align='center'---- -upset(movies, queries = list(list(query = Myfunc, params = list(c(1970,1980, 1990, 1999, 2000), 2.5), color = "blue", active =T))) - -## ---- out.width="850px", fig.width=9, fig.height =5, tidy=TRUE, fig.align='center'---- -upset(movies, query.legend = "top", queries = list(list(query = intersects, params = list("Drama", "Comedy", "Action"), color = "orange", active = T, query.name="Funny action"), list(query = intersects, params = list("Drama"), color = "red", active = F), list(query = intersects, params = list("Action", "Drama"), active = T, query.name="Emotional action"))) - -## ---- out.width="850px", fig.width=9, fig.height =5, tidy=TRUE, fig.align='center'---- -upset(movies, query.legend = "bottom", queries = list(list(query = Myfunc, params = list(c(1970,1980, 1990, 1999, 2000), 2.5), color = "orange", active =T), list(query = intersects, params = list("Action", "Drama"), active = F), list(query = elements, params = list("ReleaseDate", 1980, 1990, 2000), color = "red", active = F, query.name="Decades")), expression = "AvgRating > 3 & Watches > 100") - diff --git a/vignettes/set.metadata.plots.R b/vignettes/set.metadata.plots.R deleted file mode 100644 index 924de8c..0000000 --- a/vignettes/set.metadata.plots.R +++ /dev/null @@ -1,52 +0,0 @@ -## ---- tidy=TRUE---------------------------------------------------------- -library(UpSetR) -movies <- read.csv( system.file("extdata", "movies.csv", package = "UpSetR"), header=T, sep=";" ) - -## ---- tidy=TRUE---------------------------------------------------------- -sets <- names(movies[3:19]) -avgRottenTomatoesScore <- round(runif(17, min=0, max = 90)) -metadata <- as.data.frame(cbind(sets, avgRottenTomatoesScore)) -names(metadata) <- c("sets", "avgRottenTomatoesScore") - -## ---- tidy=TRUE---------------------------------------------------------- -is.numeric(metadata$avgRottenTomatoesScore) - -## ---- tidy=TRUE---------------------------------------------------------- -metadata$avgRottenTomatoesScore <- as.numeric(as.character(metadata$avgRottenTomatoesScore)) - -## ---- fig.width=9, fig.height=5,out.width="850px", tidy=TRUE, fig.align='center'---- -upset(movies, set.metadata = list(data = metadata, plots = list(list(type="hist", column="avgRottenTomatoesScore", assign=20)))) - -## ---- tidy=TRUE---------------------------------------------------------- -Cities <- sample(c("Boston","NYC","LA"), 17, replace = T) -metadata <- cbind(metadata, Cities) -metadata$Cities <- as.character(metadata$Cities) -metadata[which(metadata$sets %in% c("Drama", "Comedy", "Action", "Thriller", "Romance")), ] - -## ---- fig.width=9, fig.height=5,out.width="850px", tidy=TRUE, fig.align='center'---- -upset(movies, set.metadata = list(data = metadata, plots = list(list(type = "heat", column = "Cities", assign = 10, colors = c("Boston" = "green", "NYC" = "navy", "LA" = "purple"))))) - -## ---- fig.width=9, fig.height=5,out.width="850px", tidy=TRUE, fig.align='center'---- -upset(movies, set.metadata = list(data = metadata, plots = list(list(type = "heat", column = "Cities", assign = 10, colors = c("Boston" = "green", "NYC" = "navy", "LA" = "purple")), list(type = "heat", column = "avgRottenTomatoesScore", assign = 10)))) - -## ---- fig.width=9, fig.height=5,out.width="850px", tidy=TRUE, fig.align='center'---- -accepted <- round(runif(17, min = 0, max = 1)) -metadata <- cbind(metadata, accepted) -metadata[which(metadata$sets %in% c("Drama", "Comedy", "Action", "Thriller", "Romance")), ] -upset(movies, set.metadata = list(data = metadata, plots = list(list(type="bool", column= "accepted", assign = 5, colors = c("#FF3333", "#006400"))))) - -## ---- fig.width=9, fig.height=5,out.width="850px", tidy=TRUE, fig.align='center'---- -upset(movies, set.metadata = list(data = metadata, plots = list(list(type="heat", column= "accepted", assign = 5, colors = c("red", "green"))))) - -## ---- fig.width=9, fig.height=5,out.width="850px", tidy=TRUE, fig.align='center'---- -upset(movies, set.metadata = list(data = metadata, plots = list(list(type = "text", column = "Cities", assign = 10, colors = c("Boston" = "green", "NYC" = "navy", "LA" = "purple"))))) - -## ---- fig.width=9, fig.height=5,out.width="850px", tidy=TRUE, fig.align='center'---- -upset(movies, set.metadata = list(data = metadata, plots = list(list(type="hist", column="avgRottenTomatoesScore", assign=20),list(type="matrix_rows", column = "Cities", colors = c("Boston" = "green", "NYC" = "navy", "LA" = "purple"), alpha = 0.5)))) - -## ---- fig.width=9, fig.height=5,out.width="850px", tidy=TRUE, fig.align='center'---- -upset(movies, set.metadata = list(data = metadata, plots = list(list(type="hist", column="avgRottenTomatoesScore", assign=20),list(type="bool", column= "accepted", assign = 5, colors = c("#FF3333", "#006400")), list(type = "text", column = "Cities", assign = 5, colors = c("Boston" = "green", "NYC" = "navy", "LA" = "purple"))))) - -## ---- fig.width=9, fig.height=5,out.width="850px", tidy=TRUE, fig.align='center'---- -upset(movies, set.metadata = list(data = metadata, plots = list(list(type="hist", column="avgRottenTomatoesScore", assign=20), list(type="bool", column= "accepted", assign = 5, colors = c("#FF3333", "#006400")), list(type="text", column="Cities", assign=5, colors=c("Boston"="green","NYC"="navy","LA"="purple")), list(type="matrix_rows", column="Cities", colors=c("Boston"="green", "NYC"="navy", "LA"="purple"), alpha=0.5))), queries=list(list(query=intersects, params=list("Drama"), color="red", active=F), list(query=intersects, params=list("Action", "Drama"), active = T), list(query=intersects, params=list("Drama", "Comedy", "Action"), color="orange", active=T)), attribute.plots = list(gridrows=45, plots = list(list(plot=scatter_plot, x="ReleaseDate", y="AvgRating", queries=T), list(plot=scatter_plot, x="AvgRating", y="Watches", queries=F)), ncols=2), query.legend="bottom") - From 77190ca9f2a88d09f2f7ce19591b711f665b1d9e Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 6 Oct 2023 12:10:30 -0400 Subject: [PATCH 05/12] Various condition fixes. --- R/Custom.plots.R | 10 +++++----- R/Custom.user.queries.R | 6 +++--- R/Element.queries.R | 22 +++++++++++----------- R/General.query.funcs.R | 20 ++++++++++---------- R/Helper.funcs.R | 20 ++++++++++---------- R/Intersection.queries.R | 24 ++++++++++++------------ R/MainBar.R | 28 ++++++++++++++-------------- R/Matrix.R | 2 +- R/Metadata.plots.R | 16 ++++++++-------- R/Set.metadata.R | 2 +- R/SizeBar.R | 4 ++-- R/fromExpression.R | 2 +- R/upset.R | 32 ++++++++++++++++---------------- 13 files changed, 94 insertions(+), 94 deletions(-) diff --git a/R/Custom.plots.R b/R/Custom.plots.R index 9cc96c6..254a757 100644 --- a/R/Custom.plots.R +++ b/R/Custom.plots.R @@ -11,10 +11,10 @@ GenerateCustomPlots <- function(attribute_plots, Set_data, QueryData, att_color, if(length(QueryData) != 0){SetAndQueryData[1:nrow(Set_data), ]$color <- "gray23"} # x_att <- attribute_plots$plots[[i]]$x # y_att <- attribute_plots$plots[[i]]$y - if(isTRUE(attribute_plots$plots[[i]]$queries) == T){ + if(isTRUE(attribute_plots$plots[[i]]$queries)){ if(length(QueryData) == 0){ warning("To overlay with query data please specify att.x and att.y where applicable.") - if(is.null(attribute_plots$plots[[i]]$y) == F){ + if(!is.null(attribute_plots$plots[[i]]$y)){ CustomPlot[[i]] <- attribute_plots$plots[[i]]$plot(Set_data, attribute_plots$plots[[i]]$x, attribute_plots$plots[[i]]$y) } else{ @@ -22,8 +22,8 @@ GenerateCustomPlots <- function(attribute_plots, Set_data, QueryData, att_color, } } else if(length(QueryData) != 0){ - if(is.null(attribute_plots$plots[[i]]$y) == F){ - if(is.na(atty[i]) == T){ + if(!is.null(attribute_plots$plots[[i]]$y)){ + if(is.na(atty[i])){ warning("No y attribute provided to overlay with query data. If attempting to display plot that needs both x and y aesthetics please enter att.y parameter. Plots that require just the x aestheitc will not be affected.") @@ -39,7 +39,7 @@ GenerateCustomPlots <- function(attribute_plots, Set_data, QueryData, att_color, } } else { - if(is.null(attribute_plots$plots[[i]]$y) == F){ + if(!is.null(attribute_plots$plots[[i]]$y)){ CustomPlot[[i]] <- attribute_plots$plots[[i]]$plot(Set_data, attribute_plots$plots[[i]]$x, attribute_plots$plots[[i]]$y) } else{ diff --git a/R/Custom.user.queries.R b/R/Custom.user.queries.R index 3cff55b..b4e7877 100644 --- a/R/Custom.user.queries.R +++ b/R/Custom.user.queries.R @@ -32,11 +32,11 @@ customQueriesBar <- function(cust_data, sets,bar_data,custom){ cust_data[[i]] <- cust_data[[i]][!(rowSums(cust_data[[i]][ ,1:length(sets)]) == 0), ] setup[[i]] <- merge(cust_data[[i]], bar_data, by = sets) color2 <- rep(custom[[i]]$color, times = nrow(setup[[i]])) - if(isTRUE(custom[[i]]$active) == T){ - act <- rep(T, nrow(setup[[i]])) + if(isTRUE(custom[[i]]$active)){ + act <- rep(TRUE, nrow(setup[[i]])) } else{ - act <- rep(F, nrow(setup[[i]])) + act <- rep(FALSE, nrow(setup[[i]])) } setup[[i]] <- cbind(setup[[i]], color2, act) } diff --git a/R/Element.queries.R b/R/Element.queries.R index 46222ac..50e2dce 100644 --- a/R/Element.queries.R +++ b/R/Element.queries.R @@ -19,11 +19,11 @@ QuerieElemAtt <- function(q, data, start_col, exp, names, att_x, att_y, palette) test <- as.character(index_q[1]) check <- match(test, names) if(length(check) != 0){ - if(is.na(att_y[i]) == F){ + if(!is.na(att_y[i])){ elems <- GetElements(data, index_q) end_col <- ((start_col + as.integer(length(names))) - 1) elems <- elems[which(rowSums(elems[ ,start_col:end_col]) != 0), ] - if(is.null(exp) == F){ + if(!is.null(exp)){ elems <- Subset_att(elems, exp) } if(nrow(elems) != 0){ @@ -33,11 +33,11 @@ QuerieElemAtt <- function(q, data, start_col, exp, names, att_x, att_y, palette) elems <- NULL } } - else if(is.na(att_y[i]) == T){ + else if(is.na(att_y[i])){ elems <- GetElements(data, index_q) end_col <- ((start_col + as.integer(length(names))) - 1) elems <- elems[which(rowSums(elems[ ,start_col:end_col]) != 0), ] - if(is.null(exp) == F){ + if(!is.null(exp)){ elems <- Subset_att(elems, exp) } if(nrow(elems) != 0){ @@ -65,7 +65,7 @@ QuerieElemAtt <- function(q, data, start_col, exp, names, att_x, att_y, palette) ElemBarDat <- function(q, data1, first_col, exp, names, palette, mbdata){ - data1 <- data.frame(data1, check.names = F) + data1 <- data.frame(data1, check.names = FALSE) bar <- count(data1) bar$x <- 1:nrow(bar) rows <- data.frame() @@ -73,12 +73,12 @@ ElemBarDat <- function(q, data1, first_col, exp, names, palette, mbdata){ if(length(q) == 0){ return(NULL) } - for(i in 1:length(q)){ + for(i in seq_along(q)){ index_q <- unlist(q[[i]]$params) test <- as.character(index_q[1]) check <- match(test, names) elem_color <- q[[i]]$color - if(is.na(check) != T){ + if(!is.na(check)){ elem_data <- NULL } else{ @@ -93,11 +93,11 @@ ElemBarDat <- function(q, data1, first_col, exp, names, palette, mbdata){ elem_data <- merge(x[names], elem_data, by = names) x <- x$x elem_data$x <- x - if((isTRUE(q[[i]]$active) == T) && (is.null(elem_data) == F)){ - act <- T + if((!isTRUE(q[[i]]$active)) && !is.null(elem_data)){ + act <- TRUE } - else if((isTRUE(q[[i]]$active) == F || is.null(q[[i]]$active) == T) && (is.null(elem_data) == F)){ - act <- F + else if((!isTRUE(q[[i]]$active) || is.null(q[[i]]$active)) && !is.null(elem_data)){ + act <- FALSE } elem_data$color <- elem_color elem_data$act <- act diff --git a/R/General.query.funcs.R b/R/General.query.funcs.R index 6196fec..f15f226 100644 --- a/R/General.query.funcs.R +++ b/R/General.query.funcs.R @@ -3,18 +3,18 @@ SeperateQueries <- function(queries, choice, palette) { seperated <- list() for (i in 1:length(queries)) { - if (is.null(queries[[i]]$color) == T) { + if (is.null(queries[[i]]$color)) { queries[[i]]$color <- palette[1] palette <- palette[-1] } - else if (is.null(queries[[i]]$color) == F) { + else if (!is.null(queries[[i]]$color)) { next } } if (choice == 1) { for (i in 1:length(queries)) { - if (identical(intersects, queries[[i]]$query) == T || - identical(elements, queries[[i]]$query) == T) { + if (identical(intersects, queries[[i]]$query) || + identical(elements, queries[[i]]$query)) { seperated <- c(seperated, list(queries[[i]])) } else{ @@ -24,8 +24,8 @@ SeperateQueries <- function(queries, choice, palette) { } else if (choice == 2) { for (i in 1:length(queries)) { - if (identical(intersects, queries[[i]]$query) == F && - identical(elements, queries[[i]]$query) == F) { + if (!identical(intersects, queries[[i]]$query) && + !identical(elements, queries[[i]]$query)) { seperated <- c(seperated, list(queries[[i]])) } else{ @@ -61,18 +61,18 @@ GuideGenerator <- function(queries, palette) { return(NULL) } for (i in 1:length(queries)) { - if (is.null(queries[[i]]$color) == T) { + if (is.null(queries[[i]]$color)) { queries[[i]]$color <- palette[1] palette <- palette[-1] } - else if (is.null(queries[[i]]$color) == F) { + else if (!is.null(queries[[i]]$color)) { queries[[i]]$color <- queries[[i]]$color } colors[i] <- queries[[i]]$color - if (is.null(queries[[i]]$query.name) == FALSE) { + if (!is.null(queries[[i]]$query.name)) { numbers[i] <- queries[[i]]$query.name } - else if (is.null(queries[[i]]$query.name) == TRUE) { + else if (is.null(queries[[i]]$query.name)) { numbers[i] <- paste("Query", as.character(i), sep = "") } } diff --git a/R/Helper.funcs.R b/R/Helper.funcs.R index af9f8bc..4a42744 100644 --- a/R/Helper.funcs.R +++ b/R/Helper.funcs.R @@ -47,7 +47,7 @@ FindMostFreq <- function(data, start_col, end_col, n_sets){ temp_data <- data[ ,start_col:end_col] temp_data <- colSums(temp_data) temp_data <- as.data.frame(temp_data) - temp_data <- tail(temp_data[order(temp_data[ ,"temp_data"]), , drop = F], as.integer(n_sets)) + temp_data <- tail(temp_data[order(temp_data[ ,"temp_data"]), , drop = FALSE], as.integer(n_sets)) temp_data <- rev(row.names(temp_data)) return(temp_data) } @@ -55,17 +55,17 @@ FindMostFreq <- function(data, start_col, end_col, n_sets){ ## Finds the names of the sets that aren't being used Remove <- function(data, start_col, end_col, sets){ temp_data <- as.data.frame(data[ , start_col:end_col]) - Unwanted_sets <- colnames(temp_data[ ,!(colnames(temp_data) %in% sets), drop = F]) + Unwanted_sets <- colnames(temp_data[ ,!(colnames(temp_data) %in% sets), drop = FALSE]) } ## Removes unwanted sets from data Wanted <- function(data, unwanted_sets){ - temp_data <- (data[ ,!(colnames(data) %in% unwanted_sets), drop = F]) + temp_data <- (data[ ,!(colnames(data) %in% unwanted_sets), drop = FALSE]) } order_sets <- function(data, sets){ sets <- colSums(data[sets]) - sets <- names(sets[order(sets, decreasing = T)]) + sets <- names(sets[order(sets, decreasing = TRUE)]) return(sets) } @@ -73,7 +73,7 @@ order_sets <- function(data, sets){ Subset_att <- function(data, exp){ express <- unlist(strsplit(exp, " ")) for(i in seq_along(express)){ - if(is.na(match(express[i], colnames(data))) == F){ + if(!is.na(match(express[i], colnames(data)))){ express[i] <- paste("data$",express[i], sep = "") } else{ @@ -107,14 +107,14 @@ Get_aggregates <- function(data, num_sets, order_mat, cut){ } for(i in order_cols){ if(i == (num_sets + 1)){ - logic <- T + logic <- TRUE } else{ - logic <- F + logic <- FALSE } temp_data <- temp_data[order(temp_data[ , i], decreasing = logic), ] } - if(is.null(cut) == F){ + if(!is.null(cut)){ temp_data <- temp_data[1:cut, ] } set_agg <- rbind(set_agg, temp_data) @@ -139,14 +139,14 @@ OverlayEdit <- function(data1, data2, start_col, num_sets, intersects, exp, inte else{ temp_data <- temp_data[which(rowSums(temp_data[ ,start_col:new_end]) == length(intersects)), ] } - if(is.null(exp) == F){ + if(!is.null(exp)){ temp_data <- Subset_att(temp_data, exp) } temp_data <- temp_data[intersects] temp_data <- na.omit(temp_data) other_data <- data2[which(rowSums(data2[ ,1:num_sets]) == length(intersects)), ] - other_data <- (other_data[ ,!(colnames(data2) %in% unwanted), drop = F]) + other_data <- (other_data[ ,!(colnames(data2) %in% unwanted), drop = FALSE]) if(new_end == start_col){ other_data <- other_data[ which(other_data[intersects] == 1), ] } diff --git a/R/Intersection.queries.R b/R/Intersection.queries.R index dad93ec..9317207 100644 --- a/R/Intersection.queries.R +++ b/R/Intersection.queries.R @@ -27,13 +27,13 @@ QuerieInterData <- function(query, data1, first_col, num_sets, data2, exp, names inter_color <- query[[i]]$color test <- as.character(index_q[1]) check <- match(test, names) - if(is.na(check) == T){ + if(is.na(check)){ inter_data <- NULL } else{ for( i in 1:length(index_q)){ double_check <- match(index_q[i], names) - if(is.na(double_check) == T){ + if(is.na(double_check)){ warning("Intersection or set may not be present in data set. Please refer to matrix.") } } @@ -65,17 +65,17 @@ QuerieInterBar <- function(q, data1, first_col, num_sets, data2, exp, names, pa inter_color <- q[[i]]$color test <- as.character(index_q[1]) check <- match(test, names) - if(is.na(check) == T){ + if(is.na(check)){ inter_data <- NULL } else{ inter_data <- OverlayEdit(data1, data2, first_col, num_sets, index_q, exp, inter_color) } - if((isTRUE(q[[i]]$active) == T) && (is.null(inter_data) == F)){ - act[i] <- T + if(isTRUE(q[[i]]$active) && !is.null(inter_data)){ + act[i] <- TRUE } - else if((isTRUE(q[[i]]$active) == F) && (is.null(inter_data) == F)){ - act[i] <- F + else if(!isTRUE(q[[i]]$active) && !is.null(inter_data)){ + act[i] <- FALSE } rows <- rbind(rows, inter_data) } @@ -94,21 +94,21 @@ QuerieInterAtt <- function(q, data, first_col, num_sets, att_x, att_y, exp, name inter_color <- unlist(q[[i]]$color) test <- as.character(index_q[1]) check <- match(test, names) - if(is.na(check) == T){ + if(is.na(check)){ intersect <- NULL } else{ intersect <- GetIntersects(data, first_col, index_q, num_sets) - if(is.na(att_y[i]) == T){ - if(is.null(exp) == F){ + if(is.na(att_y[i])){ + if(!is.null(exp)){ intersect <- Subset_att(intersect, exp) } if(nrow(intersect) != 0){ intersect$color <- inter_color } } - else if(is.na(att_y[i]) == F){ - if(is.null(exp) == F){ + else if(!is.na(att_y[i])){ + if(!is.null(exp)){ intersect <- Subset_att(intersect, exp) } intersect$color <- inter_color diff --git a/R/MainBar.R b/R/MainBar.R index e9cf791..b0334fe 100644 --- a/R/MainBar.R +++ b/R/MainBar.R @@ -14,7 +14,7 @@ Counter <- function(data, num_sets, start_col, name_of_sets, nintersections, mba Freqs <- data.frame(count(data[ ,as.integer(temp_data)])) colnames(Freqs)[1:num_sets] <- name_of_sets #Adds on empty intersections if option is selected - if(is.null(empty_intersects) == F){ + if(!is.null(empty_intersects)){ empty <- rep(list(c(0,1)), times = num_sets) empty <- data.frame(expand.grid(empty)) colnames(empty) <- name_of_sets @@ -65,7 +65,7 @@ Make_main_bar <- function(Main_bar_data, Q, show_num, ratios, customQ, number_an bottom_margin <- (-1)*0.65 - if(is.null(attribute_plots) == FALSE){ + if(!is.null(attribute_plots)){ bottom_margin <- (-1)*0.45 } @@ -80,7 +80,7 @@ Make_main_bar <- function(Main_bar_data, Q, show_num, ratios, customQ, number_an intersection_size_number_scale <- text_scale } - if(is.null(Q) == F){ + if(!is.null(Q)){ inter_data <- Q if(nrow(inter_data) != 0){ inter_data <- inter_data[order(inter_data$x), ] @@ -89,7 +89,7 @@ Make_main_bar <- function(Main_bar_data, Q, show_num, ratios, customQ, number_an } else{inter_data <- NULL} - if(is.null(ebar) == F){ + if(!is.null(ebar)){ elem_data <- ebar if(nrow(elem_data) != 0){ elem_data <- elem_data[order(elem_data$x), ] @@ -99,8 +99,8 @@ Make_main_bar <- function(Main_bar_data, Q, show_num, ratios, customQ, number_an else{elem_data <- NULL} #ten_perc creates appropriate space above highest bar so number doesnt get cut off - if(is.null(ymax) == T){ - ten_perc <- ((max(Main_bar_data$freq)) * 0.1) + if(is.null(ymax)){ + ten_perc <- max(Main_bar_data$freq) * 0.1 ymax <- max(Main_bar_data$freq) + ten_perc } @@ -143,19 +143,19 @@ Make_main_bar <- function(Main_bar_data, Q, show_num, ratios, customQ, number_an pCustomDat <- NULL bElemDat <- NULL pElemDat <- NULL - if(is.null(elem_data) == F){ - bElemDat <- elem_data[which(elem_data$act == T), ] + if(!is.null(elem_data)){ + bElemDat <- elem_data[which(elem_data$act), ] bElemDat <- bElemDat[order(bElemDat$x), ] - pElemDat <- elem_data[which(elem_data$act == F), ] + pElemDat <- elem_data[which(!elem_data$act), ] } - if(is.null(inter_data) == F){ - bInterDat <- inter_data[which(inter_data$act == T), ] + if(!is.null(inter_data)){ + bInterDat <- inter_data[which(inter_data$act), ] bInterDat <- bInterDat[order(bInterDat$x), ] - pInterDat <- inter_data[which(inter_data$act == F), ] + pInterDat <- inter_data[which(!inter_data$act), ] } if(length(customQ) != 0){ - pCustomDat <- customQ[which(customQ$act == F), ] - bCustomDat <- customQ[which(customQ$act == T), ] + pCustomDat <- customQ[which(!customQ$act), ] + bCustomDat <- customQ[which(customQ$act), ] bCustomDat <- bCustomDat[order(bCustomDat$x), ] } if(length(bInterDat) != 0){ diff --git a/R/Matrix.R b/R/Matrix.R index b828672..606b72c 100644 --- a/R/Matrix.R +++ b/R/Matrix.R @@ -44,7 +44,7 @@ Create_layout <- function(setup, mat_color, mat_col, matrix_dot_alpha){ Matrix_layout$Intersection[i] <- paste(i, "No", sep = "") } } - if(is.null(mat_col) == F){ + if(!is.null(mat_col)){ for(i in 1:nrow(mat_col)){ mat_x <- mat_col$x[i] mat_color <- as.character(mat_col$color[i]) diff --git a/R/Metadata.plots.R b/R/Metadata.plots.R index b38bbfe..a64cae3 100644 --- a/R/Metadata.plots.R +++ b/R/Metadata.plots.R @@ -2,11 +2,11 @@ metadataHist <- function(metadata, y_data, colors){ colnum <- match(y_data, names(metadata)) names(metadata)[colnum] <- "current" - if(is.numeric(metadata$current) == FALSE){ + if(!is.numeric(metadata$current)){ warning("The values supplied for the metadata histogram were not numeric") } metadata <- metadata[c(1,colnum)] - if(is.factor(metadata$current) == TRUE){ + if(is.factor(metadata$current)){ warning("The data being used for the bar plot is not numeric!") } names(metadata)[colnum] <- y_data @@ -45,7 +45,7 @@ metadataHeat <- function(metadata, y_data, plot_type, colors){ "#CC79A7") colnum <- match(y_data, names(metadata)) names(metadata)[colnum] <- "current" - if(is.factor(metadata$current) == TRUE){ + if(is.factor(metadata$current)){ colortype <- "factor" levs <- levels(metadata$current) if(plot_type == "bool"){ @@ -60,11 +60,11 @@ metadataHeat <- function(metadata, y_data, plot_type, colors){ } metadata$current <- as.numeric(metadata$current) } - else if(is.character(metadata$current) == TRUE){ + else if(is.character(metadata$current)){ colortype <- "category" uniquecats <- length(unique(metadata$current)) } - else if(is.numeric(metadata$current) == TRUE){ + else if(is.numeric(metadata$current)){ if(plot_type != "bool"){ colortype <- "factor" } @@ -121,7 +121,7 @@ metadataHeat <- function(metadata, y_data, plot_type, colors){ warning("Please provide color palette when number of groups exceeds 8") } - else if(is.null(colors) == FALSE){ + else if(!is.null(colors)){ plot <- plot + geom_tile() plot <- plot + scale_fill_manual(values = colors) } @@ -189,7 +189,7 @@ metadataText <- function(metadata, y_data, colors, alignment){ + coord_flip() + ggtitle(y_data) + scale_y_reverse()) - if(is.null(colors) == FALSE){ + if(!is.null(colors)){ plot <- plot + geom_text(size = 2.7, hjust = align) plot <- plot + scale_colour_manual(values = colors) } @@ -223,7 +223,7 @@ get_shade_groups <- function(set_metadata, set_names, Mat_data, shade_alpha) { shade_data$y_max[k] <- ((k) + 0.5) } shade_data$shade_color <- data$color - if(is.null(set_metadata$plots[[i]]$alpha) == TRUE){ + if(is.null(set_metadata$plots[[i]]$alpha)){ shade_data$alpha <- shade_alpha } else{ diff --git a/R/Set.metadata.R b/R/Set.metadata.R index 95d9d21..3d55352 100644 --- a/R/Set.metadata.R +++ b/R/Set.metadata.R @@ -26,7 +26,7 @@ Make_set_metadata_plot <- function(set.metadata, set_names){ if(num_of_att != 0){ for(i in 1:num_of_att){ - if(is.null(set.metadata$plots[[i]]$colors) == FALSE){ + if(!is.null(set.metadata$plots[[i]]$colors)){ colors <- set.metadata$plots[[i]]$colors } else{ diff --git a/R/SizeBar.R b/R/SizeBar.R index ebc7314..cd58eda 100644 --- a/R/SizeBar.R +++ b/R/SizeBar.R @@ -5,7 +5,7 @@ FindSetFreqs <- function(data, start_col, num_sets, set_names, keep_order){ temp_data <- temp_data[set_names] temp_data <- as.data.frame(colSums(temp_data)) colnames(temp_data) <- c("y") - if(keep_order == FALSE){ + if(!keep_order){ temp_data <- temp_data[order(temp_data$y, decreasing = T), ] } else{ @@ -90,7 +90,7 @@ Make_size_plot <- function(Set_size_data, sbar_color, ratios, ylabel, scale_sets + xlab(NULL) + ylab(ylabel) + coord_flip()) - if(set_size.show == TRUE){ + if(set_size.show){ Size_plot <- (Size_plot + geom_text(aes(label=y,vjust=0.5,hjust=1.2, angle = set_size_angle), size=num.size)) } diff --git a/R/fromExpression.R b/R/fromExpression.R index 9639767..1704495 100644 --- a/R/fromExpression.R +++ b/R/fromExpression.R @@ -20,7 +20,7 @@ fromExpression <- function(input){ cols[!is.na(cols)] <- 1 cols[is.na(cols)] <- 0 cols <- rep(cols, times = counts[[1]][i]) - cols <- matrix(cols, ncol = length(sets), byrow = T) + cols <- matrix(cols, ncol = length(sets), byrow = TRUE) cols <- data.frame(cols) names(cols) <- sets data <- rbind(data, cols) diff --git a/R/upset.R b/R/upset.R index 20c09c8..8573a41 100644 --- a/R/upset.R +++ b/R/upset.R @@ -121,7 +121,7 @@ upset <- function(data, nsets = 5, nintersects = 40, sets = NULL, keep.order = F matrix.color = "gray23", main.bar.color = "gray23", mainbar.y.label = "Intersection Size", mainbar.y.max = NULL, sets.bar.color = "gray23", plot.title = NA, sets.x.label = "Set Size", point.size = 2.2, line.size = 0.7, mb.ratio = c(0.70,0.30), 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, number.colors=NULL, group.by = "degree",cutoff = NULL, + decreasing = c(TRUE, FALSE), show.numbers = "yes", number.angles = 0, number.colors=NULL, 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){ @@ -139,26 +139,26 @@ upset <- function(data, nsets = 5, nintersects = 40, sets = NULL, keep.order = F "#CC79A7") } - if(is.null(intersections) == F){ + if(!is.null(intersections)){ Set_names <- unique((unlist(intersections))) Sets_to_remove <- Remove(data, first.col, last.col, Set_names) New_data <- Wanted(data, Sets_to_remove) Num_of_set <- Number_of_sets(Set_names) - if(keep.order == F){ + if(!keep.order){ Set_names <- order_sets(New_data, Set_names) } All_Freqs <- 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){ + else if(is.null(intersections)){ Set_names <- sets - if(is.null(Set_names) == T || length(Set_names) == 0 ){ + if(is.null(Set_names) || length(Set_names) == 0 ){ Set_names <- FindMostFreq(data, first.col, last.col, nsets) } Sets_to_remove <- Remove(data, first.col, last.col, Set_names) New_data <- Wanted(data, Sets_to_remove) Num_of_set <- Number_of_sets(Set_names) - if(keep.order == F){ + if(!keep.order){ Set_names <- order_sets(New_data, Set_names) } All_Freqs <- Counter(New_data, Num_of_set, first.col, Set_names, nintersects, main.bar.color, @@ -171,7 +171,7 @@ upset <- function(data, nsets = 5, nintersects = 40, sets = NULL, keep.order = F #if I decided to make the NULL case (all x and no y, or vice versa), there would have been alot more if/else statements #NA can be indexed so that we still get the non NA y aesthetics on correct plot. NULL cant be indexed. att.x <- c(); att.y <- c(); - if(is.null(attribute.plots) == F){ + if(!is.null(attribute.plots)){ for(i in seq_along(attribute.plots$plots)){ if(length(attribute.plots$plots[[i]]$x) != 0){ att.x[i] <- attribute.plots$plots[[i]]$x @@ -189,7 +189,7 @@ upset <- function(data, nsets = 5, nintersects = 40, sets = NULL, keep.order = F } BoxPlots <- NULL - if(is.null(boxplot.summary) == F){ + if(!is.null(boxplot.summary)){ BoxData <- IntersectionBoxPlot(All_Freqs, New_data, first.col, Set_names) BoxPlots <- list() for(i in seq_along(boxplot.summary)){ @@ -203,17 +203,17 @@ upset <- function(data, nsets = 5, nintersects = 40, sets = NULL, keep.order = F Element <- NULL legend <- NULL EBar_data <- NULL - if(is.null(queries) == F){ + if(!is.null(queries)){ custom.queries <- SeperateQueries(queries, 2, palette) customDat <- customQueries(New_data, custom.queries, Set_names) legend <- GuideGenerator(queries, palette) legend <- Make_legend(legend) - if(is.null(att.x) == F && is.null(customDat) == F){ + if(!is.null(att.x) && !is.null(customDat)){ customAttDat <- CustomAttData(customDat, Set_names) } customQBar <- customQueriesBar(customDat, Set_names, All_Freqs, custom.queries) } - if(is.null(queries) == F){ + if(!is.null(queries)){ Intersection <- SeperateQueries(queries, 1, palette) Matrix_col <- intersects(QuerieInterData, Intersection, New_data, first.col, Num_of_set, All_Freqs, expression, Set_names, palette) @@ -227,12 +227,12 @@ upset <- function(data, nsets = 5, nintersects = 40, sets = NULL, keep.order = F Matrix_layout <- Create_layout(Matrix_setup, matrix.color, Matrix_col, matrix.dot.alpha) Set_sizes <- FindSetFreqs(New_data, first.col, Num_of_set, Set_names, keep.order) Bar_Q <- NULL - if(is.null(queries) == F){ + if(!is.null(queries)){ Bar_Q <- intersects(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)){ + if(!is.null(queries) && !is.null(att.x)){ QInter_att_data <- intersects(QuerieInterAtt, Intersection, New_data, first.col, Num_of_set, att.x, att.y, expression, Set_names, palette) QElem_att_data <- elements(QuerieElemAtt, Element, New_data, first.col, expression, Set_names, att.x, att.y, @@ -242,19 +242,19 @@ upset <- function(data, nsets = 5, nintersects = 40, sets = NULL, keep.order = F ShadingData <- NULL - if(is.null(set.metadata) == F){ + if(!is.null(set.metadata)){ ShadingData <- get_shade_groups(set.metadata, Set_names, Matrix_layout, shade.alpha) output <- Make_set_metadata_plot(set.metadata, Set_names) set.metadata.plots <- output[[1]] set.metadata <- output[[2]] - if(is.null(ShadingData) == FALSE){ + if(!is.null(ShadingData)){ shade.alpha <- unique(ShadingData$alpha) } } else { set.metadata.plots <- NULL } - if(is.null(ShadingData) == TRUE){ + if(is.null(ShadingData)){ ShadingData <- MakeShading(Matrix_layout, shade.color) } Main_bar <- suppressMessages(Make_main_bar(All_Freqs, Bar_Q, show.numbers, mb.ratio, customQBar, number.angles, number.colors, EBar_data, mainbar.y.label, From 90d8616786315b603ce5af714ac8494afbc2b1d6 Mon Sep 17 00:00:00 2001 From: olivroy Date: Fri, 6 Oct 2023 13:17:05 -0400 Subject: [PATCH 06/12] do not use `aes_string()` in code + use linewidth + use rlang .data --- DESCRIPTION | 6 +- NAMESPACE | 1 + R/Boxplot.R | 2 +- R/Element.queries.R | 2 +- R/MainBar.R | 18 +- R/Matrix.R | 10 +- R/Metadata.plots.R | 14 +- R/SizeBar.R | 4 +- R/UpSetR-package.R | 8 + R/histogram.R | 2 +- R/scatter_plot.R | 2 +- man/UpSetR-package.Rd | 28 ++ man/upset.Rd | 2 +- vignettes/attribute.plots.html | 460 +++++++++++++++++++++++++------ vignettes/basic.usage.html | 445 ++++++++++++++++++++++++------ vignettes/queries.Rmd | 9 +- vignettes/set.metadata.plots.Rmd | 2 +- 17 files changed, 820 insertions(+), 195 deletions(-) create mode 100644 R/UpSetR-package.R create mode 100644 man/UpSetR-package.Rd diff --git a/DESCRIPTION b/DESCRIPTION index d9f4c7b..a73a5ec 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -15,12 +15,14 @@ Depends: Imports: ggplot2, gridExtra, - plyr, + dplyr, utils, stats, methods, grDevices, - scales + scales, + rlang, + plyr License: MIT + file LICENSE VignetteBuilder: knitr Suggests: diff --git a/NAMESPACE b/NAMESPACE index 0a3bcf2..6066e07 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,3 +25,4 @@ importFrom(grid,popViewport) importFrom(grid,pushViewport) importFrom(grid,viewport) importFrom(plyr,count) +importFrom(rlang,.data) diff --git a/R/Boxplot.R b/R/Boxplot.R index 3939e25..431cabe 100644 --- a/R/Boxplot.R +++ b/R/Boxplot.R @@ -51,7 +51,7 @@ BoxPlotsPlot <- function(bdat, att, att_color){ panel.grid.minor = element_blank(), panel.grid.major = element_blank(), axis.title.x = element_blank()) - + geom_boxplot(data = bdat, aes_string(x="x", y="attribute"), + + geom_boxplot(data = bdat, aes(x=x, y=attribute), fill = att_color, colour = "gray80")) return(boxplots) } \ No newline at end of file diff --git a/R/Element.queries.R b/R/Element.queries.R index 50e2dce..62b2007 100644 --- a/R/Element.queries.R +++ b/R/Element.queries.R @@ -13,7 +13,7 @@ QuerieElemAtt <- function(q, data, start_col, exp, names, att_x, att_y, palette) if(length(q) == 0){ return(NULL) } - for(i in 1:length(q)){ + for(i in seq_along(q)){ index_q <- unlist(q[[i]]$params) elem_color <- unlist(q[[i]]$color) test <- as.character(index_q[1]) diff --git a/R/MainBar.R b/R/MainBar.R index b0334fe..ae0f4d7 100644 --- a/R/MainBar.R +++ b/R/MainBar.R @@ -115,7 +115,7 @@ Make_main_bar <- function(Main_bar_data, Q, show_num, ratios, customQ, number_an Main_bar_data$freq <- round(log10(Main_bar_data$freq), 2) ymax <- log10(ymax) } - Main_bar_plot <- (ggplot(data = Main_bar_data, aes_string(x = "x", y = "freq")) + Main_bar_plot <- (ggplot(data = Main_bar_data, aes(x = x, y = freq)) + scale_y_continuous(trans = scale_intersections) + ylim(0, ymax) + geom_bar(stat = "identity", width = 0.6, @@ -129,10 +129,10 @@ Make_main_bar <- function(Main_bar_data, Q, show_num, ratios, customQ, number_an size=7*y_axis_tick_label_scale))) if((show_num == "yes") || (show_num == "Yes")){ if(is.null(number.colors)) { - Main_bar_plot <- (Main_bar_plot + geom_text(aes_string(label = "freq"), size = 2.2*intersection_size_number_scale, vjust = -1, + Main_bar_plot <- (Main_bar_plot + geom_text(aes(label = freq), size = 2.2*intersection_size_number_scale, vjust = -1, angle = number_angles, colour = Main_bar_data$color)) } else { - Main_bar_plot <- (Main_bar_plot + geom_text(aes_string(label = "freq"), size = 2.2*intersection_size_number_scale, vjust = -1, + Main_bar_plot <- (Main_bar_plot + geom_text(aes(label = freq), size = 2.2*intersection_size_number_scale, vjust = -1, angle = number_angles, colour = number.colors)) } } @@ -160,32 +160,32 @@ Make_main_bar <- function(Main_bar_data, Q, show_num, ratios, customQ, number_an } if(length(bInterDat) != 0){ Main_bar_plot <- Main_bar_plot + geom_bar(data = bInterDat, - aes_string(x="x", y = "freq"), + aes(x = x, y = freq), fill = bInterDat$color, stat = "identity", position = "identity", width = 0.6) } if(length(bElemDat) != 0){ Main_bar_plot <- Main_bar_plot + geom_bar(data = bElemDat, - aes_string(x="x", y = "freq"), + aes(x = x, y = freq), fill = bElemDat$color, stat = "identity", position = "identity", width = 0.6) } if(length(bCustomDat) != 0){ - Main_bar_plot <- (Main_bar_plot + geom_bar(data = bCustomDat, aes_string(x="x", y = "freq2"), + Main_bar_plot <- (Main_bar_plot + geom_bar(data = bCustomDat, aes(x= x , y = freq2), fill = bCustomDat$color2, stat = "identity", position ="identity", width = 0.6)) } if(length(pCustomDat) != 0){ - Main_bar_plot <- (Main_bar_plot + geom_point(data = pCustomDat, aes_string(x="x", y = "freq2"), colour = pCustomDat$color2, + Main_bar_plot <- (Main_bar_plot + geom_point(data = pCustomDat, aes(x= x, y = freq2), colour = pCustomDat$color2, size = 2, shape = 17, position = position_jitter(width = 0.2, height = 0.2))) } if(length(pInterDat) != 0){ - Main_bar_plot <- (Main_bar_plot + geom_point(data = pInterDat, aes_string(x="x", y = "freq"), + Main_bar_plot <- (Main_bar_plot + geom_point(data = pInterDat, aes(x = x, y = freq), position = position_jitter(width = 0.2, height = 0.2), colour = pInterDat$color, size = 2, shape = 17)) } if(length(pElemDat) != 0){ - Main_bar_plot <- (Main_bar_plot + geom_point(data = pElemDat, aes_string(x="x", y = "freq"), + Main_bar_plot <- (Main_bar_plot + geom_point(data = pElemDat, aes(x = x, y = freq), position = position_jitter(width = 0.2, height = 0.2), colour = pElemDat$color, size = 2, shape = 17)) } diff --git a/R/Matrix.R b/R/Matrix.R index 606b72c..6ee257c 100644 --- a/R/Matrix.R +++ b/R/Matrix.R @@ -99,13 +99,13 @@ Make_matrix_plot <- function(Mat_data,Set_size_data, Main_bar_data, point_size, limits = c(0.5,(nrow(Set_size_data) +0.5)), labels = labels, expand = c(0,0)) + scale_x_continuous(limits = c(0,(nrow(Main_bar_data)+1 )), expand = c(0,0)) - + geom_rect(data = shading_data, aes_string(xmin = "min", xmax = "max", - ymin = "y_min", ymax = "y_max"), + + geom_rect(data = shading_data, aes(xmin = min, xmax = max, + 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, + + geom_point(data= Mat_data, aes(x= x, y= y), colour = Mat_data$color, 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) + + geom_line(data= Mat_data, aes(group = Intersection, x= x, y = y, + colour = color), linewidth = line_size) + scale_color_identity()) Matrix_plot <- ggplot_gtable(ggplot_build(Matrix_plot)) return(Matrix_plot) diff --git a/R/Metadata.plots.R b/R/Metadata.plots.R index a64cae3..192f4de 100644 --- a/R/Metadata.plots.R +++ b/R/Metadata.plots.R @@ -16,7 +16,7 @@ metadataHist <- function(metadata, y_data, colors){ } plot <- (ggplot(data=metadata) - + geom_bar(aes_string(x="sets", y=y_data), + + geom_bar(aes(x= sets, y=.data[[y_data]]), stat="identity", position="identity", width = 0.4, fill = colors) + scale_x_continuous(limits = c(0.5, (nrow(metadata)+0.5)), @@ -28,7 +28,7 @@ metadataHist <- function(metadata, y_data, colors){ axis.text.x = element_text(size = 7), axis.line = element_line(colour = "gray0"), axis.line.y = element_blank(), - axis.line.x = element_line(colour = "gray0", size = 0.3), + axis.line.x = element_line(colour = "gray0", linewidth = 0.3), axis.text.y = element_blank(), axis.ticks.y = element_blank(), panel.grid.minor = element_blank(), @@ -49,13 +49,13 @@ metadataHeat <- function(metadata, y_data, plot_type, colors){ colortype <- "factor" levs <- levels(metadata$current) if(plot_type == "bool"){ - newlevel <- c(0,1) + newlevel <- c(0, 1) } else if(plot_type == "heat"){ - newlevel <- c(1:length(levs)) + newlevel <- seq_along(levs) } metadata$current <- as.character(metadata$current) - for(i in seq(length(levs))){ + for(i in seq_along(levs)){ metadata$current[which(metadata$current == levs[i])] <- newlevel[i] } metadata$current <- as.numeric(metadata$current) @@ -84,7 +84,7 @@ metadataHeat <- function(metadata, y_data, plot_type, colors){ titleAdjustment <- 25 #} - plot <- (ggplot(data=metadata, aes_string(x="sets", y = 1, fill = y_data)) + plot <- (ggplot(data=metadata, aes(x= sets, y = 1, fill = .data[[y_data]])) + scale_x_continuous(expand = c(c(0,0), c(0,0))) + theme(panel.background = element_rect("white"), plot.title = element_text(margin = margin(b=titleAdjustment), @@ -167,7 +167,7 @@ metadataText <- function(metadata, y_data, colors, alignment){ ncols <- ncol(metadata) metadata <- cbind(metadata, c(1:nrow(metadata))) names(metadata)[ncol(metadata)] <- "x" - plot <- (ggplot(data=metadata, aes_string(x="x", y=1, label = y_data, colour = y_data, size =10)) + plot <- (ggplot(data=metadata, aes(x = x, y = 1, label = y_data, colour = .data[[y_data]], size =10)) + scale_x_continuous(limits = c(0.5, (nrow(metadata)+0.5)), expand = c(0,0)) + theme(panel.background = element_rect("white"), diff --git a/R/SizeBar.R b/R/SizeBar.R index cd58eda..bed246c 100644 --- a/R/SizeBar.R +++ b/R/SizeBar.R @@ -69,7 +69,7 @@ Make_size_plot <- function(Set_size_data, sbar_color, ratios, ylabel, scale_sets num.size <- (7/2.845276)*x_axis_tick_label_scale } - Size_plot <- (ggplot(data = Set_size_data, aes_string(x ="x", y = "y")) + Size_plot <- (ggplot(data = Set_size_data, aes(x =x, y = y)) + geom_bar(stat = "identity",colour = sbar_color, width = 0.4, fill = sbar_color, position = "identity") + scale_x_continuous(limits = c(0.5, (nrow(Set_size_data) + 0.5)), @@ -82,7 +82,7 @@ Make_size_plot <- function(Set_size_data, sbar_color, ratios, ylabel, scale_sets vjust = 1, hjust = 0.5), axis.line = element_line(colour = "gray0"), axis.line.y = element_blank(), - axis.line.x = element_line(colour = "gray0", size = 0.3), + axis.line.x = element_line(colour = "gray0", linewidth = 0.3), axis.text.y = element_blank(), axis.ticks.y = element_blank(), panel.grid.minor = element_blank(), diff --git a/R/UpSetR-package.R b/R/UpSetR-package.R new file mode 100644 index 0000000..3723fb4 --- /dev/null +++ b/R/UpSetR-package.R @@ -0,0 +1,8 @@ +#' @keywords internal +"_PACKAGE" + +## usethis namespace: start +#' @importFrom plyr count +#' @importFrom rlang .data +## usethis namespace: end +NULL diff --git a/R/histogram.R b/R/histogram.R index c0516d1..70b4f25 100644 --- a/R/histogram.R +++ b/R/histogram.R @@ -6,7 +6,7 @@ #' @note See examples section for upset function on how to use custom.plot parameter #' @export histogram <- function(mydata, x){ - att_plot <- (ggplot(data = mydata, aes_string(x = x, fill = "color")) + att_plot <- (ggplot(data = mydata, aes(x = .data[[x]], fill = color)) + scale_fill_identity() + geom_histogram(binwidth = 1) + ylab("Frequency") diff --git a/R/scatter_plot.R b/R/scatter_plot.R index 074dde6..bc901b4 100644 --- a/R/scatter_plot.R +++ b/R/scatter_plot.R @@ -7,7 +7,7 @@ #' @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")) + att_plot <- (ggplot(data = mydata, aes(x = .data[[x]], y = .data[[y]], colour = color)) + geom_point(shape=16) + scale_color_identity() + theme(panel.background = element_rect(fill = "white"), plot.title = element_text(vjust = 1.3), diff --git a/man/UpSetR-package.Rd b/man/UpSetR-package.Rd new file mode 100644 index 0000000..f4fe969 --- /dev/null +++ b/man/UpSetR-package.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/UpSetR-package.R +\docType{package} +\name{UpSetR-package} +\alias{UpSetR} +\alias{UpSetR-package} +\title{UpSetR: A More Scalable Alternative to Venn and Euler Diagrams for Visualizing Intersecting Sets} +\description{ +Creates visualizations of intersecting sets using a novel matrix design, along with visualizations of several common set, element and attribute related tasks (Conway 2017) \doi{10.1093/bioinformatics/btx364}. +} +\seealso{ +Useful links: +\itemize{ + \item \url{http://github.com/hms-dbmi/UpSetR} + \item Report bugs at \url{http://github.com/hms-dbmi/UpSetR/issues} +} + +} +\author{ +\strong{Maintainer}: Jake Conway \email{jake_conway@hms.harvard.edu} + +Authors: +\itemize{ + \item Nils Gehlenborg \email{nils@hms.harvard.edu} +} + +} +\keyword{internal} diff --git a/man/upset.Rd b/man/upset.Rd index 7947d64..85925a6 100644 --- a/man/upset.Rd +++ b/man/upset.Rd @@ -26,7 +26,7 @@ upset( att.pos = NULL, att.color = main.bar.color, order.by = c("freq", "degree"), - decreasing = c(T, F), + decreasing = c(TRUE, FALSE), show.numbers = "yes", number.angles = 0, number.colors = NULL, diff --git a/vignettes/attribute.plots.html b/vignettes/attribute.plots.html index a49f08c..746518b 100644 --- a/vignettes/attribute.plots.html +++ b/vignettes/attribute.plots.html @@ -1,12 +1,12 @@ - + - + @@ -14,179 +14,454 @@ Attribute Plots - + + - - - - - - - + + + + + + + + + + + + + + + + + + - - + + -
- - - + + + +
-