updated stretch to factor x and y columns by default

NEWS.md

@@ -4,6 +4,8 @@
 
 - Handle correlation of exactly zero or 1 in `network_plot()` (@s-scherrer, #89)
 
+- Add `.order` argument to `stretch()` with options "default" and "alphabet" (@mattwarkentin, #99)
+
 # corrr 0.4.2
 
 - Updates to work with tibble 3.0.0  and dplyr 1.0.0

R/cor_df.R

@@ -114,7 +114,8 @@ rplot.cor_df <- function(rdf,
                          shape = 16,
                          colours = c("indianred2", "white", "skyblue1"),
                          print_cor = FALSE,
-                         colors) {
+                         colors,
+                         .order = "default") {
 
   if (!missing(colors))
     colours <- colors
@@ -123,7 +124,7 @@ rplot.cor_df <- function(rdf,
   row_order <- rdf$rowname
 
   # Convert data to relevant format for plotting
-  pd <- stretch(rdf, na.rm = TRUE)
+  pd <- stretch(rdf, na.rm = TRUE, .order = .order)
   pd$size = abs(pd$r)
   pd$label = fashion(pd$r)
 

R/output.R

@@ -69,10 +69,15 @@ fashion.default <- function(x, decimals = 2, leading_zeros = FALSE, na_print = "
 #'
 #' @param rdf Correlation data frame (see \code{\link{correlate}}) or object
 #'   that can be coerced to one (see \code{\link{as_cordf}}).
-#' @param legend Boolean indicating whether a legend mapping the colors to the correlations should be displayed.
+#' @param legend Boolean indicating whether a legend mapping the colors to the
+#'   correlations should be displayed.
 #' @param shape \code{\link{geom_point}} aesthetic.
-#' @param print_cor Boolean indicating whether the correlations should be printed over the shapes.
+#' @param print_cor Boolean indicating whether the correlations should be
+#'   printed over the shapes.
 #' @param colours,colors Vector of colors to use for n-color gradient.
+#' @param .order Either "default", meaning x and y variables keep the same order
+#'   as the columns in \code{x}, or "alphabet", meaning the variables are
+#'   alphabetized.
 #' @return Plots a correlation data frame
 #' @export
 #' @examples
@@ -90,7 +95,9 @@ rplot <- function(rdf,
                   shape = 16,
                   colours = c("indianred2", "white", "skyblue1"),
                   print_cor = FALSE,
-                  colors) {
+                  colors,
+                  .order = c("default", "alphabet")) {
+  .order <- match.arg(.order)
   UseMethod("rplot")
 }
 

R/reshape.R

@@ -9,8 +9,8 @@
 #' function, see \code{\link[dplyr]{select}}.
 #'
 #' @param x cor_df. See \code{\link{correlate}}.
-#' @param ...  One or more unquoted expressions separated by commas. Variable 
-#'  names can be used as if they were positions in the data frame, so 
+#' @param ...  One or more unquoted expressions separated by commas. Variable
+#'  names can be used as if they were positions in the data frame, so
 #'  expressions like `x:y`` can be used to select a range of variables.
 #' @param .dots Use focus_ to do standard evaluations. See \code{\link[dplyr]{select}}.
 #' @param mirror Boolean. Whether to mirror the selected columns in the rows or
@@ -106,6 +106,9 @@ focus_if.default <- function(x, .predicate, ..., mirror = FALSE) {
 #'   matrix diagonal) should be dropped? Will automatically be set to TRUE if
 #'   mirror is FALSE.
 #' @param remove.dups Removes duplicate entries, without removing all NAs
+#' @param .order Either "default", meaning x and y variables keep the same order
+#'   as the columns in \code{x}, or "alphabet", meaning the variables are
+#'   alphabetized.
 #' @return tbl with three columns (x and y variables, and their correlation)
 #' @export
 #' @examples
@@ -116,16 +119,23 @@ focus_if.default <- function(x, .predicate, ..., mirror = FALSE) {
 #' x <- shave(x)  # use shave to set upper triangle to NA and then...
 #' stretch(x, na.rm = FALSE)  # omit all NAs, therefore keeping each
 #'                              # correlation only once.
-stretch <- function(x, na.rm = FALSE, remove.dups =  FALSE) {
+stretch <- function(x, na.rm = FALSE, remove.dups =  FALSE,
+                    .order = c("default", "alphabet")) {
+  .order <- match.arg(.order)
   UseMethod("stretch")
 }
 
 #' @export
-stretch.cor_df <- function(x, na.rm = FALSE, remove.dups =  FALSE) {
+stretch.cor_df <- function(x, na.rm = FALSE, remove.dups =  FALSE,
+                           .order = c("default", "alphabet")) {
+  .order <- match.arg(.order)
   if(remove.dups) x <- shave(x)
   row_name <- x$rowname
   x <- x[, colnames(x) != "rowname"]
   tb <- imap_dfr(x, ~tibble(x = .y, y = row_name, r = .x))
+  if(.order == "default")  {
+    tb[,c("x", "y")] <-  map_dfc(tb[,c("x", "y")], factor, levels = row_name)
+  }
   if(na.rm) tb <- tb[!is.na(tb$r), ]
   if(remove.dups) {
     stretch_unique(tb)

tests/testthat/stretch-keep.order_alphabet.txt

@@ -0,0 +1,3 @@
+> str(stretch(d, .order = FALSE))
+Error in match.arg(.order): 'arg' must be NULL or a character vector
+

tests/testthat/stretch-keep.order_default.txt

@@ -0,0 +1,6 @@
+> str(stretch(d))
+tibble [16 x 3] (S3: tbl_df/tbl/data.frame)
+ $ x: Factor w/ 4 levels "Sepal.Length",..: 1 1 1 1 2 2 2 2 3 3 ...
+ $ y: Factor w/ 4 levels "Sepal.Length",..: 1 2 3 4 1 2 3 4 1 2 ...
+ $ r: num [1:16] NA -0.112 0.871 0.817 -0.112 ...
+

tests/testthat/test-stretch.R

@@ -13,6 +13,12 @@ test_that("Converts to proper structure", {
     colnames(stretch(d)),
     c("x", "y", "r")
   )
+  verify_output("stretch-keep.order_default.txt",
+                str(stretch(d))
+  )
+  verify_output("stretch-keep.order_alphabet.txt",
+    str(stretch(d, .order = FALSE))
+  )
 
   exp_res <-
     tibble::tribble(
@@ -34,7 +40,8 @@ test_that("Converts to proper structure", {
       "Petal.Width", "Petal.Length",  0.962865431402796,
       "Petal.Width",  "Petal.Width",                 NA
     )
-  expect_equivalent(as.data.frame(stretch(d)), as.data.frame(exp_res))
+  expect_equivalent(as.data.frame(stretch(d, .order = "alphabet")),
+                    as.data.frame(exp_res))
 })
 
 test_that("na.rm", {