Add parameter sort_cols to sort listings (#250)

Closes #248

NEWS.md

@@ -1,4 +1,6 @@
 ## rlistings 0.2.10.9003
+ * Added parameter `sort_cols` to `as_listing` to specify columns to sort the listing on. Previously listings were 
+   always sorted on key columns.
 
 ## rlistings 0.2.10
  * Added an error message for listings with variables of `difftime` class.

R/rlistings.R

@@ -17,6 +17,8 @@ setOldClass(c("MatrixPrintForm", "list"))
 #'   `non_disp_cols`.
 #' @param non_disp_cols (`character` or `NULL`)\cr vector of names of non-key columns to be excluded as display
 #'   columns. All other non-key columns are treated as display columns. Ignored if `disp_cols` is non-`NULL`.
+#' @param sort_cols (`character` or `NULL`)\cr vector of names of columns (in order) which should be used to sort the
+#'   listing. Defaults to `key_cols`. If `NULL`, no sorting will be performed.
 #' @param unique_rows (`flag`)\cr whether only unique rows should be included in the listing. Defaults to `FALSE`.
 #' @param default_formatting (`list`)\cr a named list of default column format configurations to apply when rendering
 #'   the listing. Each name-value pair consists of a name corresponding to a data class (or "numeric" for all
@@ -132,6 +134,7 @@ as_listing <- function(df,
                        key_cols = names(df)[1],
                        disp_cols = NULL,
                        non_disp_cols = NULL,
+                       sort_cols = key_cols,
                        unique_rows = FALSE,
                        default_formatting = list(all = fmt_config()),
                        col_formatting = NULL,
@@ -174,12 +177,28 @@ as_listing <- function(df,
 
   df <- as_tibble(df)
   varlabs <- var_labels(df, fill = TRUE)
-  o <- do.call(order, df[key_cols])
-  if (is.unsorted(o)) {
-    if (interactive()) {
-      message("sorting incoming data by key columns")
+  if (!is.null(sort_cols)) {
+    sort_miss <- setdiff(sort_cols, names(df))
+    if (length(sort_miss) > 0) {
+      stop(
+        "The following columns were specified as sorting columns (sort_cols) but are missing from df: ",
+        paste0("`", sort_miss, "`", collapse = ", ")
+      )
+    }
+    o <- do.call(order, df[sort_cols])
+    if (is.unsorted(o)) {
+      if (interactive()) {
+        message(paste(
+          "sorting incoming data by",
+          if (identical(sort_cols, key_cols)) {
+            "key columns"
+          } else {
+            paste0("column", if (length(sort_cols) > 1) "s", " ", paste0("`", sort_cols, "`", collapse = ", "))
+          }
+        ))
+      }
+      df <- df[o, ]
     }
-    df <- df[o, ]
   }
 
   ## reorder the full set of cols to ensure key columns are first

tests/testthat/test-listings.R

@@ -299,6 +299,75 @@ testthat::test_that("as_listing works with NA values in key cols", {
   ), "rows that only contain NA")
 })
 
+testthat::test_that("as_listing(sort_cols) works", {
+  # default behavior (sort by key_cols)
+  lsting <- as_listing(
+    mtcars,
+    key_cols = c("gear", "carb"),
+    disp_cols = "qsec"
+  )
+  testthat::expect_true(!is.unsorted(lsting$gear))
+  testthat::expect_identical(
+    lsting$carb,
+    c(1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 4, 4, 4, 4, 4, 1, 1, 1, 1, 2, 2, 2, 2, 4, 4, 4, 4, 2, 2, 4, 6, 8),
+    ignore_attr = TRUE
+  )
+  testthat::expect_true(is.unsorted(lsting$qsec))
+
+  # works with only one key column
+  lsting <- as_listing(
+    mtcars,
+    key_cols = c("gear", "carb"),
+    disp_cols = "qsec",
+    sort_cols = "carb"
+  )
+  testthat::expect_identical(
+    lsting$gear,
+    c(4, 3, 3, 4, 4, 3, 4, 3, 4, 4, 4, 3, 3, 3, 5, 5, 4, 3, 3, 3, 4, 4, 3, 4, 4, 3, 3, 3, 3, 5, 5, 5),
+    ignore_attr = TRUE
+  )
+  testthat::expect_true(!is.unsorted(lsting$carb))
+  testthat::expect_true(is.unsorted(lsting$qsec))
+
+  # works with columns not displayed in listing
+  lsting <- as_listing(
+    mtcars,
+    key_cols = c("gear", "carb"),
+    disp_cols = "qsec",
+    sort_cols = c("am", "vs")
+  )
+  testthat::expect_true(is.unsorted(lsting$gear))
+  testthat::expect_true(is.unsorted(lsting$carb))
+  testthat::expect_true(is.unsorted(lsting$qsec))
+  testthat::expect_true(!is.unsorted(lsting$am))
+  testthat::expect_identical(
+    lsting$vs,
+    c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1),
+    ignore_attr = TRUE
+  )
+
+  # works with no sorting
+  lsting <- as_listing(
+    mtcars,
+    key_cols = c("gear", "carb"),
+    disp_cols = "qsec",
+    sort_cols = NULL
+  )
+  testthat::expect_identical(lsting$gear, mtcars$gear, ignore_attr = TRUE)
+  testthat::expect_true(is.unsorted(lsting$carb))
+  testthat::expect_true(is.unsorted(lsting$qsec))
+
+  # error if sort column given is not in df
+  testthat::expect_error(
+    lsting <- as_listing(
+      mtcars,
+      key_cols = c("gear", "carb"),
+      disp_cols = "qsec",
+      sort_cols = "test"
+    )
+  )
+})
+
 testthat::test_that("add_listing_col works with a function when a format is applied", {
   lsting <- as_listing(
     mtcars[1:5, ],