hms-dbmi · MichaelChirico · May 31, 2025 · May 31, 2025 · May 31, 2025
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -15,7 +15,7 @@ Depends:
 Imports:
     ggplot2,
     gridExtra,
-    plyr,
+    dplyr (>= 1.1.0),
     utils,
     stats,
     methods,

diff --git a/NAMESPACE b/NAMESPACE
@@ -16,6 +16,11 @@ import(methods)
 import(scales)
 import(stats)
 import(utils)
+importFrom(dplyr,all_of)
+importFrom(dplyr,arrange)
+importFrom(dplyr,n)
+importFrom(dplyr,pick)
+importFrom(dplyr,summarize)
 importFrom(grid,gpar)
 importFrom(grid,grid.draw)
 importFrom(grid,grid.layout)
@@ -24,4 +29,3 @@ importFrom(grid,legendGrob)
 importFrom(grid,popViewport)
 importFrom(grid,pushViewport)
 importFrom(grid,viewport)
-importFrom(plyr,count)
diff --git a/R/Custom.user.queries.R b/R/Custom.user.queries.R
@@ -22,25 +22,25 @@ customQueries <- function(data, custom, names){
 customQueriesBar <- function(cust_data, sets,bar_data,custom){
   setup <- list()
   final_data <- list()
-  num <- (length(sets) + 1)
   if(length(cust_data) == 0){
     return(NULL)
   }
-  for(i in 1:length(cust_data)){
-    cust_data[[i]] <- count(cust_data[[i]][sets])
+  num <- (length(sets) + 1)
+  for(i in seq_along(cust_data)){
+    cust_data[[i]] <- plyr_count(cust_data[[i]][sets])
     colnames(cust_data[[i]])[num] <- "freq2"
-    cust_data[[i]] <- cust_data[[i]][!(rowSums(cust_data[[i]][ ,1:length(sets)]) == 0), ]
+    cust_data[[i]] <- cust_data[[i]][!(rowSums(cust_data[[i]][ ,seq_along(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)
   }
-  for(i in 1:length(setup)){
+  for(i in seq_along(setup)){
     final_data <- rbind(final_data, setup[[i]])
   }
   return(final_data)

diff --git a/R/Element.queries.R b/R/Element.queries.R
@@ -65,39 +65,39 @@ 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)
-  bar <- count(data1)
-  bar$x <- 1:nrow(bar)
-  rows <- data.frame()
-  act <- c()
   if(length(q) == 0){
     return(NULL)
   }
-  for(i in 1:length(q)){
+  data1 <- data.frame(data1, check.names = FALSE)
+  bar <- plyr_count(data1)
+  bar$x <- seq_len(nrow(bar))
+  rows <- data.frame()
+  act <- NULL
+  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) != TRUE){
       elem_data <- NULL
     }
     else{
       elem_data <- data1[which(as.character(data1[ ,test]) %in% c(index_q[2:length(index_q)])), ]
       if(!is.null(exp)){
       elem_data <- Subset_att(elem_data, exp)
       }
-      elem_data <- as.data.frame(count(elem_data[names]))
+      elem_data <- plyr_count(elem_data[names])
       names(elem_data) <- c(names, "freq")
       elem_data <- elem_data[which(rowSums(elem_data[names]) != 0), ]
       x <- merge(mbdata, elem_data[names], by = names)
       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) == TRUE) && (is.null(elem_data) == FALSE)){
+        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) == FALSE || is.null(q[[i]]$active) == TRUE) && (is.null(elem_data) == FALSE)){
+        act <- FALSE
       }
       elem_data$color <- elem_color
       elem_data$act <- act

diff --git a/R/MainBar.R b/R/MainBar.R
@@ -1,5 +1,3 @@
-#' @importFrom plyr count
-
 ## Counts the frequency of each intersection being looked at and sets up data for main bar plot.
 ## Also orders the data for the bar plot and matrix plot
 Counter <- function(data, num_sets, start_col, name_of_sets, nintersections, mbar_color, order_mat,
@@ -8,33 +6,33 @@ Counter <- function(data, num_sets, start_col, name_of_sets, nintersections, mba
   Freqs <- data.frame()
   end_col <- as.numeric(((start_col + num_sets) -1))
   #gets indices of columns containing sets used
-  for( i in 1:num_sets){
+  for( i in seq_len(num_sets)){
     temp_data[i] <- match(name_of_sets[i], colnames(data))
   }
-  Freqs <- data.frame(count(data[ ,as.integer(temp_data)]))
-  colnames(Freqs)[1:num_sets] <- name_of_sets
+  Freqs <- plyr_count(data[ ,as.integer(temp_data)])
+  colnames(Freqs)[seq_len(num_sets)] <- name_of_sets
   #Adds on empty intersections if option is selected
-  if(is.null(empty_intersects) == F){
+  if(is.null(empty_intersects) == FALSE){
     empty <- rep(list(c(0,1)), times = num_sets)
     empty <- data.frame(expand.grid(empty))
     colnames(empty) <- name_of_sets
     empty$freq <- 0
     all <- rbind(Freqs, empty)
-    Freqs <- data.frame(all[!duplicated(all[1:num_sets]), ], check.names = F)
+    Freqs <- data.frame(all[!duplicated(all[seq_len(num_sets)]), ], check.names = FALSE)
   }
   #Remove universal empty set
-  Freqs <- Freqs[!(rowSums(Freqs[ ,1:num_sets]) == 0), ]
+  Freqs <- Freqs[!(rowSums(Freqs[ ,seq_len(num_sets)]) == 0), ]
   #Aggregation by degree
   if(tolower(aggregate) == "degree"){
-    for(i in 1:nrow(Freqs)){
-      Freqs$degree[i] <- rowSums(Freqs[ i ,1:num_sets])
+    for(i in seq_len(nrow(Freqs))){
+      Freqs$degree[i] <- rowSums(Freqs[ i ,seq_len(num_sets)])
     }
-    order_cols <- c()
-    for(i in 1:length(order_mat)){
+    order_cols <- integer(length(order_mat))
+    for(i in seq_along(order_mat)){
       order_cols[i] <- match(order_mat[i], colnames(Freqs))
     }
     # if(length(order_cols)==2 && order_cols[1]>order_cols[2]){decrease <- rev(decrease)}
-    for(i in 1:length(order_cols)){
+    for(i in seq_along(order_cols)){
       logic <- decrease[i]
       Freqs <- Freqs[order(Freqs[ , order_cols[i]], decreasing = logic), ]
     }
@@ -47,14 +45,14 @@ 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]
-  for( i in 1:nrow(Freqs)){
+  for( i in seq_len(nrow(Freqs))){
     Freqs$x[i] <- i
     Freqs$color <- mbar_color
   }
   if(is.na(nintersections)){
     nintersections = nrow(Freqs)
   }
-  Freqs <- Freqs[1:nintersections, ]
+  Freqs <- Freqs[seq_len(nintersections), ]
   Freqs <- na.omit(Freqs)
   return(Freqs)
 }

diff --git a/R/Specific.intersections.R b/R/Specific.intersections.R
@@ -7,14 +7,14 @@ specific_intersections <- function(data, first.col, last.col, intersections, ord
   if(length(remove) != 0){
     data <- data[-remove]
   }
-  data <- count(data[keep])
-  sets <- names(data[1:length(keep)])
+  data <- plyr_count(data[keep])
+  sets <- names(data[seq_along(keep)])
   data <- lapply(intersections, function(x){
     temp_sets <- unlist(x)
-    x <- data[which(rowSums(data[1:length(keep)]) == length(temp_sets)), ]
+    x <- data[which(rowSums(data[seq_along(keep)]) == length(temp_sets)), ]
     x <- x[which(rowSums(x[temp_sets]) == length(temp_sets)), ]
     if(nrow(x) == 0){
-      names <- names(x[1:length(keep)])
+      names <- names(x[seq_along(keep)])
       x <- rbind(x, rep(0, ncol(x)))
       colnames(x) <- c(names, "freq")
       x[ ,which(names %in% temp_sets)] <- 1
@@ -24,7 +24,7 @@ specific_intersections <- function(data, first.col, last.col, intersections, ord
 
   Freqs <- data.frame()
 
-  for(i in seq(length(data))){
+  for(i in seq_along(data)){
     Freqs <- rbind(Freqs, data[[i]])
   }
 
@@ -33,15 +33,15 @@ specific_intersections <- function(data, first.col, last.col, intersections, ord
   num_sets <- length(keep)
 
   if(tolower(aggregate) == "degree"){
-    for(i in 1:nrow(Freqs)){
-      Freqs$degree[i] <- rowSums(Freqs[ i ,1:num_sets])
+    for(i in seq_len(nrow(Freqs))){
+      Freqs$degree[i] <- rowSums(Freqs[ i ,seq_len(num_sets)])
     }
-    order_cols <- c()
-    for(i in 1:length(order_mat)){
+    order_cols <- integer(length(order_mat))
+    for(i in seq_along(order_mat)){
       order_cols[i] <- match(order_mat[i], colnames(Freqs))
     }
 
-    for(i in 1:length(order_cols)){
+    for(i in seq_along(order_cols)){
       logic <- decrease[i]
       Freqs <- Freqs[order(Freqs[ , order_cols[i]], decreasing = logic), ]
     }
@@ -54,7 +54,7 @@ specific_intersections <- function(data, first.col, last.col, intersections, ord
   #delete rows used to order data correctly. Not needed to set up bars.
   delete_row <- (num_sets + 2)
   Freqs <- Freqs[ , -delete_row]
-  for( i in 1:nrow(Freqs)){
+  for( i in seq_len(nrow(Freqs))){
     Freqs$x[i] <- i
     Freqs$color <- mbar_color
   }

diff --git a/R/upset.R b/R/upset.R
@@ -71,7 +71,7 @@
 #' @seealso UpSetR github for additional examples: \url{http://github.com/hms-dbmi/UpSetR}
 #' @examples movies <- read.csv( system.file("extdata", "movies.csv", package = "UpSetR"), header=TRUE, sep=";" )
 #'
-#'require(ggplot2); require(plyr); require(gridExtra); require(grid);
+#'require(ggplot2); require(gridExtra); require(grid);
 #'
 #' between <- function(row, min, max){
 #'   newData <- (row["ReleaseDate"] < max) & (row["ReleaseDate"] > min)

diff --git a/R/util.R b/R/util.R
@@ -0,0 +1,7 @@
+# matching plyr::count behavior. this is non-trivial to do with
+#   pure base R; see PR description for full details.
+#' @importFrom dplyr all_of arrange n pick summarize
+plyr_count <- function(x) {
+  cols <- names(x)
+  arrange(summarize(x, .by = all_of(cols), freq = n()), pick(cols))
+}
diff --git a/man/upset.Rd b/man/upset.Rd
diff --git a/vignettes/attribute.plots.Rmd b/vignettes/attribute.plots.Rmd
@@ -11,7 +11,7 @@ vignette: >
 
 For all examples the movies data set contained in the package will be used.
 ```{r, tidy=TRUE}
-library(UpSetR); library(ggplot2); library(grid); library(plyr)
+library(UpSetR); library(ggplot2); library(grid)
 movies <- read.csv( system.file("extdata", "movies.csv", package = "UpSetR"), header=T, sep=";" )
 ```
 
@@ -68,7 +68,7 @@ myplot <- function(mydata,x,y){
 }
 
 another.plot <- function(data, x, y){
-  data$decades <- round_any(as.integer(unlist(data[y])), 10, ceiling)
+  data$decades <- 10 * ceiling(as.integer(unlist(data[y])) / 10)
   data <- data[which(data$decades >= 1970), ]
   myplot <- (ggplot(data, aes_string(x=x)) + 
                geom_density(aes(fill=factor(decades)), alpha = 0.4)