From 60f823de664ae7c15456cb0d436f6c5c6eb6076d Mon Sep 17 00:00:00 2001 From: Sergio Oller Date: Wed, 16 Jun 2021 10:04:55 +0200 Subject: [PATCH] Corner case fixes for a single item UpSetR This commit provides some fixes to cover a corner case where there is only one element to intersect. While its utility is clearly limited, I was using UpSetR on a pipeline with an arbitrary number of items, and before this commit UpSetR was failing for this (trivial) case. ```r library(UpSetR) data <- fromList(list(a = c("b", "c"))) upset(data, nsets=6, keep.order = TRUE, order.by = "freq") ``` --- R/Helper.funcs.R | 2 +- R/MainBar.R | 12 ++++++------ R/Matrix.R | 2 +- R/SizeBar.R | 4 ++-- R/UpSet.plot.R | 2 +- R/fromList.R | 4 ++-- 6 files changed, 13 insertions(+), 13 deletions(-) diff --git a/R/Helper.funcs.R b/R/Helper.funcs.R index af9f8bc..dd7220c 100644 --- a/R/Helper.funcs.R +++ b/R/Helper.funcs.R @@ -44,7 +44,7 @@ FindStartEnd <- function(data){ ## Finds the n largest sets if the user hasn't specified any sets FindMostFreq <- function(data, start_col, end_col, n_sets){ - temp_data <- data[ ,start_col:end_col] + temp_data <- data[ ,start_col:end_col, drop = F] 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)) diff --git a/R/MainBar.R b/R/MainBar.R index e9cf791..1a0bf81 100644 --- a/R/MainBar.R +++ b/R/MainBar.R @@ -11,7 +11,7 @@ Counter <- function(data, num_sets, start_col, name_of_sets, nintersections, mba for( i in 1:num_sets){ temp_data[i] <- match(name_of_sets[i], colnames(data)) } - Freqs <- data.frame(count(data[ ,as.integer(temp_data)])) + Freqs <- data.frame(count(data[ ,as.integer(temp_data), drop =F])) colnames(Freqs)[1:num_sets] <- name_of_sets #Adds on empty intersections if option is selected if(is.null(empty_intersects) == F){ @@ -23,11 +23,11 @@ Counter <- function(data, num_sets, start_col, name_of_sets, nintersections, mba Freqs <- data.frame(all[!duplicated(all[1:num_sets]), ], check.names = F) } #Remove universal empty set - Freqs <- Freqs[!(rowSums(Freqs[ ,1:num_sets]) == 0), ] + Freqs <- Freqs[!(rowSums(Freqs[ ,1:num_sets, drop = F]) == 0), , drop = F] #Aggregation by degree if(tolower(aggregate) == "degree"){ for(i in 1:nrow(Freqs)){ - Freqs$degree[i] <- rowSums(Freqs[ i ,1:num_sets]) + Freqs$degree[i] <- rowSums(Freqs[ i ,1:num_sets, drop = F]) } order_cols <- c() for(i in 1:length(order_mat)){ @@ -36,7 +36,7 @@ Counter <- function(data, num_sets, start_col, name_of_sets, nintersections, mba # if(length(order_cols)==2 && order_cols[1]>order_cols[2]){decrease <- rev(decrease)} for(i in 1:length(order_cols)){ logic <- decrease[i] - Freqs <- Freqs[order(Freqs[ , order_cols[i]], decreasing = logic), ] + Freqs <- Freqs[order(Freqs[ , order_cols[i]], decreasing = logic), , drop = F] } } #Aggregation by sets @@ -46,7 +46,7 @@ Counter <- function(data, num_sets, start_col, name_of_sets, nintersections, mba } #delete rows used to order data correctly. Not needed to set up bars. delete_row <- (num_sets + 2) - Freqs <- Freqs[ , -delete_row] + Freqs <- Freqs[ , -delete_row, drop = F] for( i in 1:nrow(Freqs)){ Freqs$x[i] <- i Freqs$color <- mbar_color @@ -54,7 +54,7 @@ Counter <- function(data, num_sets, start_col, name_of_sets, nintersections, mba if(is.na(nintersections)){ nintersections = nrow(Freqs) } - Freqs <- Freqs[1:nintersections, ] + Freqs <- Freqs[1:nintersections, , drop = F] Freqs <- na.omit(Freqs) return(Freqs) } diff --git a/R/Matrix.R b/R/Matrix.R index b828672..7a0d7b1 100644 --- a/R/Matrix.R +++ b/R/Matrix.R @@ -2,7 +2,7 @@ ## Essentially strips uneeded columns, converts data to matrix, and adjusts the labels to appropriate length ## i.e. if the labels were one letter each, appropriate space is added to make it fit and look neat Create_matrix <- function(data){ - Matrix_setup <- as.matrix(t(data[ , 1:(length(data) -3)])) + Matrix_setup <- as.matrix(t(data[ , 1:(length(data) -3), drop =F])) names <- rownames(Matrix_setup) max <- max(nchar(names)) if( max < 7) diff --git a/R/SizeBar.R b/R/SizeBar.R index ebc7314..743b8b9 100644 --- a/R/SizeBar.R +++ b/R/SizeBar.R @@ -1,12 +1,12 @@ ## Find frequency of each set for set size bar plot FindSetFreqs <- function(data, start_col, num_sets, set_names, keep_order){ end_col <- as.numeric(((start_col + num_sets) -1)) - temp_data <- data[ ,start_col:end_col] + temp_data <- data[ ,start_col:end_col, drop =F] temp_data <- temp_data[set_names] temp_data <- as.data.frame(colSums(temp_data)) colnames(temp_data) <- c("y") if(keep_order == FALSE){ - temp_data <- temp_data[order(temp_data$y, decreasing = T), ] + temp_data <- temp_data[order(temp_data$y, decreasing = T), , drop =F] } else{ temp_data <- temp_data$y diff --git a/R/UpSet.plot.R b/R/UpSet.plot.R index 27ab9d8..360ab24 100644 --- a/R/UpSet.plot.R +++ b/R/UpSet.plot.R @@ -14,7 +14,7 @@ Make_base_plot <- function(Main_bar_plot, Matrix_plot, Size_plot, labels, hratio 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), ] + Set_data <- Set_data[which(rowSums(Set_data[ ,start_col:end_col, drop = F]) != 0), , drop = F] Main_bar_plot$widths <- Matrix_plot$widths Matrix_plot$heights <- Size_plot$heights if(!is.null(set_metadata)){ diff --git a/R/fromList.R b/R/fromList.R index 0acbd20..31604a9 100644 --- a/R/fromList.R +++ b/R/fromList.R @@ -8,8 +8,8 @@ fromList <- function(input){ elements <- unique(unlist(input)) data <- unlist(lapply(input, function(x){x <- as.vector(match(elements, x))})) data[is.na(data)] <- as.integer(0); data[data != 0] <- as.integer(1) - data <- data.frame(matrix(data, ncol = length(input), byrow = F)) - data <- data[which(rowSums(data) !=0), ] + data <- as.data.frame(matrix(data, ncol = length(input), byrow = F)) + data <- data[which(rowSums(data) != 0), ,drop = F] names(data) <- names(input) return(data) } \ No newline at end of file