Allow custom formats, NA values in key columns

NEWS.md

@@ -1,4 +1,7 @@
 ## rlistings 0.2.4.9002
+ * Fixed bug in `as_listing` preventing custom formatting from being applied to key columns.
+ * Updated `matrix_form` to allow `NA` values in key columns.
+ * Updated `as_listing` to trim any rows containing only NA values and print an informative message.
 
 ## rlistings 0.2.4
  * Added `num_rep_cols` method for listings. Resolves error with key column repetition during pagination .

R/rlistings.R

@@ -156,8 +156,7 @@ as_listing <- function(df,
     stop("All format configurations supplied in `default_formatting`",
          " must be of type `fmt_config`.")
   }
-  if (!(is.null(col_formatting) ||
-        all(sapply(col_formatting, is, class2 = "fmt_config")))) {
+  if (!(is.null(col_formatting) || all(sapply(col_formatting, is, class2 = "fmt_config")))) {
     stop("All format configurations supplied in `col_formatting`",
          " must be of type `fmt_config`.")
   }
@@ -182,11 +181,16 @@ as_listing <- function(df,
   ## key cols must be leftmost cols
   cols <- c(key_cols, setdiff(cols, key_cols))
 
+  row_all_na <- apply(df[cols], 1, function(x) all(is.na(x)))
+  if (any(row_all_na)) {
+    message("rows that only contain NA values have been trimmed")
+    df <- df[!row_all_na, ]
+  }
+
   # set col format configs
   df[cols] <- lapply(cols, function(col) {
     col_class <- tail(class(df[[col]]), 1)
-    col_fmt_class <- if (!col_class %in% names(default_formatting) &&
-                         is.numeric(df[[col]])) "numeric" else col_class
+    col_fmt_class <- if (!col_class %in% names(default_formatting) && is.numeric(df[[col]])) "numeric" else col_class
     col_fmt <- if (col %in% names(col_formatting)) {
       col_formatting[[col]]
     } else if (col_fmt_class %in% names(default_formatting)) {
@@ -285,6 +289,7 @@ setMethod(
     for (i in seq_along(keycols)) {
       kcol <- keycols[i]
       kcolvec <- listing[[kcol]]
+      kcolvec <- vapply(kcolvec, format_value, "", format = obj_format(kcolvec), na_str = obj_na_str(kcolvec))
       curkey <- paste0(curkey, kcolvec)
       disp <- c(TRUE, tail(curkey, -1) != head(curkey, -1))
       bodymat[disp, kcol] <- kcolvec[disp]

tests/testthat/test-listings.R

@@ -247,3 +247,54 @@ testthat::test_that("unique_rows removes duplicate rows from listing", {
   )
   expect_equal(expected_strings, result_strings)
 })
+
+testthat::test_that("as_listing custom format works in key cols", {
+  lsting <- as_listing(
+    ex_adsl[1:10, ],
+    key_cols = c("AGE", "BMRKR1"),
+    disp_cols = c("SEX", "ARM"),
+    default_formatting = list(all = fmt_config(), numeric = fmt_config(format = "xx.xx"))
+  )
+
+  testthat::expect_identical(matrix_form(lsting)$strings[2, 1:2], c(AGE = "24.00", BMRKR1 = "4.57"))
+  testthat::expect_identical(matrix_form(lsting)$strings[3, 1:2], c(AGE = "", BMRKR1 = "5.00"))
+})
+
+testthat::test_that("as_listing works with NA values in key cols", {
+  mtcars$gear[1:5] <- NA
+  mtcars$carb[6:10] <- NA
+
+  lsting <- as_listing(
+    mtcars,
+    key_cols = c("gear", "carb"),
+    disp_cols = "qsec"
+  )
+
+  testthat::expect_identical(
+    matrix_form(lsting)$strings[29:33, ],
+    matrix(
+      c("NA", "1", "18.61", "", "", "19.44", "", "2", "17.02", "", "4", "16.46", "", "", "17.02"),
+      ncol = 3,
+      byrow = TRUE,
+      dimnames = list(c(), c("gear", "carb", "qsec"))
+    )
+  )
+
+  lsting <- as_listing(
+    mtcars,
+    key_cols = c("gear", "carb"),
+    disp_cols = "qsec",
+    default_formatting = list(all = fmt_config(), numeric = fmt_config(na_str = "<No data>"))
+  )
+
+  testthat::expect_identical(matrix_form(lsting)$strings[29, 1], c(gear = "<No data>"))
+  testthat::expect_identical(matrix_form(lsting)$strings[13, 2], c(carb = "<No data>"))
+
+  mtcars[33, ] <- mtcars[32, ]
+  mtcars[33, c(7, 10:11)] <- NA
+  suppressMessages(testthat::expect_message(lsting <- as_listing(
+    mtcars,
+    key_cols = c("gear", "carb"),
+    disp_cols = "qsec"
+  ), "rows that only contain NA"))
+})