Added order and decr arguments to order bars according to their value…

R/barplot2.R

@@ -1,3 +1,9 @@
+# Revision 2.2 2020/03/26
+# - updated function with vectorInput according to current version 
+#   of grpahics::barplot
+# - Added order and decr arguments (logical; default = FALSE) to order
+#   bars according to their values while keeping colors.
+
 # Revision 2.1 2005/06/06
 # - Modified default behavior with 0's and NA's in
 #   'height' so that these values are not plotted.
@@ -65,6 +71,9 @@ barplot2.default <-
         add = FALSE,
         panel.first = NULL,
         panel.last = NULL,
+
+        order = FALSE, 
+        decr = TRUE,
         ...)
 {
     if (!missing(inside)) .NotYetUsed("inside", error = FALSE)# -> help(.)
@@ -77,9 +86,10 @@ barplot2.default <-
       names.arg <-
           if(is.matrix(height)) colnames(height) else names(height)
 
-    if (is.vector(height)
-        || (is.array(height) && (length(dim(height)) == 1))) {
+    vectorInput <- (is.vector(height)
+        || (is.array(height) && (length(dim(height)) == 1)))
         ## Treat vectors and 1-d arrays the same.
+    if(vectorInput){
 	height <- cbind(height)
 	beside <- TRUE
         ## The above may look strange, but in particular makes color
@@ -117,7 +127,7 @@ barplot2.default <-
     NC <- ncol(height)
 
     if (beside) {
-	if (length(space) == 2)
+	if (length(space) == 2 && !vectorInput)
 	    space <- rep.int(c(space[2], rep.int(space[1], NR - 1)), NC)
 	width <- rep(width, length.out = NR)
     } else
@@ -218,7 +228,14 @@ barplot2.default <-
 
       # if stacked bar, set up base/cumsum levels, adjusting for log scale
       if (!beside)
-        height <- rbind(rectbase, apply(height, 2, cumsum))
+        if(order){
+          orderHeight <- apply(height, 2L, order, decreasing = decr)
+          height <- rbind(
+            rectbase, 
+            apply(apply(height, 2L, sort, decreasing = decr), 2L, cumsum))
+        }else{
+          height <- rbind(rectbase, apply(height, 2, cumsum))
+        }
 
       # if plot.ci, be sure that appropriate axis limits are set to include range(ci)
       lim <-
@@ -237,7 +254,14 @@ barplot2.default <-
 
       # if stacked bar, set up base/cumsum levels
       if (!beside)
-        height <- rbind(rectbase, apply(height, 2, cumsum))
+        if(order){
+          orderHeight <- apply(height, 2L, order, decreasing = decr)
+          height <- rbind(
+            rectbase, 
+            apply(apply(height, 2L, sort, decreasing = decr), 2L, cumsum))
+        }else{
+          height <- rbind(rectbase, apply(height, 2, cumsum))
+        }
 
       # if plot.ci, be sure that appropriate axis limits are set to include range(ci)
       lim <-
@@ -357,10 +381,20 @@ barplot2.default <-
                angle = angle, density = density, col = col, border = border)
       else
       {
-        for (i in 1:NC)
-          xyrect(height[1:NR, i] + offset[i], w.l[i], height[-1, i] + offset[i], w.r[i],
-                 horizontal=horiz, angle = angle, density = density,
-                 col = col, border = border)
+        if(!order)
+        {
+          for (i in 1:NC)
+            xyrect(height[1:NR, i] + offset[i], w.l[i], height[-1, i] + offset[i], w.r[i],
+                   horizontal=horiz, angle = angle, density = density,
+                   col = col, border = border)
+        }else{
+          for (i in 1L:NC) {
+            xyrect(height[1L:NR, i] + offset[i], w.l[i],
+                   height[ -1,  i] + offset[i], w.r[i],
+                   horizontal = horiz, angle = angle, density = density,
+                   col = col[orderHeight[,i]], border = border)
+          }
+        }
       }
 
       # Execute the panel.last expression here

man/barplot2.Rd

@@ -1,3 +1,9 @@
+%% Revision 2.2 2020/03/26
+%% - updated function with vectorInput according to current version 
+%%   of graphics::barplot
+%% - Added order and decr arguments (logical; default = FALSE) to order
+%%   bars according to their values while keeping colors.
+
 %% Revision 2.1 2005/06/06
 %% - Modified default behavior with 0's and NA's in
 %%   'height' so that these values are not plotted.
@@ -88,7 +94,8 @@
         ci.color = "black", ci.lty = "solid", ci.lwd = 1, ci.width = 0.5,
         plot.grid = FALSE, grid.inc = NULL,
         grid.lty = "dotted", grid.lwd = 1, grid.col = "black",
-        add = FALSE, panel.first = NULL, panel.last = NULL, \dots)
+        add = FALSE, panel.first = NULL, panel.last = NULL, 
+        order = FALSE, decr = TRUE, \dots)
 }
 \arguments{
   \item{height}{either a vector or matrix of values describing the
@@ -197,6 +204,10 @@
   \item{\dots}{further graphical parameters (\code{\link{par}}) are
     passed to \code{\link{plot.window}()}, \code{\link{title}()} and
     \code{\link{axis}}.}
+  \item{order}{logical. If \code{TRUE}, bars of the barplot from a matrix
+    are ordered according to their value (only if \code{beside = FALSE}).}
+  \item{decr}{logical. If \code{TRUE}, bars are ordered by decreasing order,
+    and by inincresaing order otherwise (only if \code{order = TRUE}).}
 }
 \description{
   An enhancement of the standard barplot() function. Creates a bar plot
@@ -284,5 +295,25 @@ title(main = list("Death Rates in Virginia", font = 4))
 # border :
 barplot2(VADeaths, border = "dark blue") % lwd = 2 << not passed
 %notyet barplot(VADeaths, inside = FALSE, main = "barplot(*, inside=FALSE)")
+
+# example with ordered bars
+set.seed(1234)
+dataset <- matrix(sample(1:20, 104/2, replace = TRUE), ncol = 13)
+myCol <- c("#1B9E77", "#D95F02", "#7570B3", "#E7298A")
+barplot2(
+  height = dataset, 
+  col = myCol, 
+  names.arg = 
+  LETTERS[1:13])
+barplot2(
+  height = dataset, 
+  col = myCol, 
+  names.arg = LETTERS[1:13], 
+  order = TRUE, decr = TRUE)
+barplot2(
+  height = dataset, 
+  col = myCol, 
+  names.arg = LETTERS[1:13], 
+  order = TRUE, decr = FALSE)
 }
 \keyword{hplot}