From e7506e3cbbce884611f6ee081491dfad429f8fcb Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 27 Sep 2023 18:14:18 -0400 Subject: [PATCH 01/10] Allow NA values in key columns --- NEWS.md | 1 + R/rlistings.R | 4 ++++ tests/testthat/test-listings.R | 31 +++++++++++++++++++++++++++++++ 3 files changed, 36 insertions(+) diff --git a/NEWS.md b/NEWS.md index 2bf2a3c6..96ebc26c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,5 @@ ## rlistings 0.2.4.9001 + * Updated `as_listing` to allow `NA` values in key columns. ## rlistings 0.2.4 * Added `num_rep_cols` method for listings. Resolves error with key column repetition during pagination . diff --git a/R/rlistings.R b/R/rlistings.R index 0ce29f45..42553f83 100644 --- a/R/rlistings.R +++ b/R/rlistings.R @@ -203,6 +203,10 @@ as_listing <- function(df, obj_format(df[[col]]) <- obj_format(col_fmt) obj_na_str(df[[col]]) <- if (is.null(obj_na_str(col_fmt))) "NA" else obj_na_str(col_fmt) obj_align(df[[col]]) <- if (is.null(obj_align(col_fmt))) "left" else obj_align(col_fmt) + + if (is(df[[col]], "listing_keycol") && any(is.na(df[[col]]))) { + df[[col]][is.na(df[[col]])] <- obj_na_str(df[[col]]) + } df[[col]] }) diff --git a/tests/testthat/test-listings.R b/tests/testthat/test-listings.R index 8ba325c2..9acf9d37 100644 --- a/tests/testthat/test-listings.R +++ b/tests/testthat/test-listings.R @@ -247,3 +247,34 @@ testthat::test_that("unique_rows removes duplicate rows from listing", { ) expect_equal(expected_strings, result_strings) }) + +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 = "")) + ) + + testthat::expect_identical(matrix_form(lsting)$strings[29, 1], c(gear = "")) + testthat::expect_identical(matrix_form(lsting)$strings[13, 2], c(carb = "")) +}) From de0939b356e38b44217d30519a23d61a753dde01 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 27 Sep 2023 18:36:57 -0400 Subject: [PATCH 02/10] Fix lint --- R/rlistings.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/R/rlistings.R b/R/rlistings.R index 42553f83..24305b13 100644 --- a/R/rlistings.R +++ b/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`.") } @@ -185,8 +184,7 @@ as_listing <- function(df, # 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)) { From e5a0f709362aefcfefe5921e732bee3889aa579e Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 27 Sep 2023 18:37:06 -0400 Subject: [PATCH 03/10] Refactor --- R/rlistings.R | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/R/rlistings.R b/R/rlistings.R index 24305b13..ca53ca9e 100644 --- a/R/rlistings.R +++ b/R/rlistings.R @@ -201,10 +201,6 @@ as_listing <- function(df, obj_format(df[[col]]) <- obj_format(col_fmt) obj_na_str(df[[col]]) <- if (is.null(obj_na_str(col_fmt))) "NA" else obj_na_str(col_fmt) obj_align(df[[col]]) <- if (is.null(obj_align(col_fmt))) "left" else obj_align(col_fmt) - - if (is(df[[col]], "listing_keycol") && any(is.na(df[[col]]))) { - df[[col]][is.na(df[[col]])] <- obj_na_str(df[[col]]) - } df[[col]] }) @@ -287,6 +283,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] From a6e8cb719d7f564a384f594ef389be26d1c65832 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 27 Sep 2023 18:49:42 -0400 Subject: [PATCH 04/10] Add test for bug fix --- NEWS.md | 1 + tests/testthat/test-listings.R | 13 +++++++++++++ 2 files changed, 14 insertions(+) diff --git a/NEWS.md b/NEWS.md index 96ebc26c..0173da71 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,5 @@ ## rlistings 0.2.4.9001 + * Fixed bug in `as_listing` preventing custom formatting from being applied to key columns. * Updated `as_listing` to allow `NA` values in key columns. ## rlistings 0.2.4 diff --git a/tests/testthat/test-listings.R b/tests/testthat/test-listings.R index 9acf9d37..db6853cf 100644 --- a/tests/testthat/test-listings.R +++ b/tests/testthat/test-listings.R @@ -248,6 +248,19 @@ 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:20,], + key_cols = c("AGE", "BMRKR1"), + disp_cols = c("SEX", "ARM"), + default_formatting = list(all = fmt_config(), numeric = fmt_config(format = "xx.xx")) + ) + lsting + + testthat::expect_identical(matrix_form(lsting)$strings[2, 1:2], c(AGE = "24.00", BMRKR1 = "2.86")) + testthat::expect_identical(matrix_form(lsting)$strings[3, 1:2], c(AGE = "", BMRKR1 = "4.57")) +}) + testthat::test_that("as_listing works with NA values in key cols", { mtcars$gear[1:5] <- NA mtcars$carb[6:10] <- NA From 21afeacb817028ff565ccc70415427ab3739aa8e Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 27 Sep 2023 18:58:30 -0400 Subject: [PATCH 05/10] Fix lint --- tests/testthat/test-listings.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-listings.R b/tests/testthat/test-listings.R index db6853cf..f63b1909 100644 --- a/tests/testthat/test-listings.R +++ b/tests/testthat/test-listings.R @@ -250,7 +250,7 @@ testthat::test_that("unique_rows removes duplicate rows from listing", { testthat::test_that("as_listing custom format works in key cols", { lsting <- as_listing( - ex_adsl[1:20,], + 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")) From fcf794e1a21bc00956755b279f61bf3e4f581405 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 27 Sep 2023 19:06:45 -0400 Subject: [PATCH 06/10] Fix test --- tests/testthat/test-listings.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-listings.R b/tests/testthat/test-listings.R index f63b1909..7c1bce8c 100644 --- a/tests/testthat/test-listings.R +++ b/tests/testthat/test-listings.R @@ -255,10 +255,9 @@ testthat::test_that("as_listing custom format works in key cols", { disp_cols = c("SEX", "ARM"), default_formatting = list(all = fmt_config(), numeric = fmt_config(format = "xx.xx")) ) - lsting - testthat::expect_identical(matrix_form(lsting)$strings[2, 1:2], c(AGE = "24.00", BMRKR1 = "2.86")) - testthat::expect_identical(matrix_form(lsting)$strings[3, 1:2], c(AGE = "", BMRKR1 = "4.57")) + 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", { From c83aececd9bfc4e8f0c30b78c08f918660d4bb9e Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Fri, 29 Sep 2023 10:41:16 -0400 Subject: [PATCH 07/10] Trim all-NA rows --- R/rlistings.R | 6 ++++++ tests/testthat/test-listings.R | 8 ++++++++ 2 files changed, 14 insertions(+) diff --git a/R/rlistings.R b/R/rlistings.R index ca53ca9e..90b2683e 100644 --- a/R/rlistings.R +++ b/R/rlistings.R @@ -181,6 +181,12 @@ 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) diff --git a/tests/testthat/test-listings.R b/tests/testthat/test-listings.R index 7c1bce8c..a4e8f364 100644 --- a/tests/testthat/test-listings.R +++ b/tests/testthat/test-listings.R @@ -289,4 +289,12 @@ testthat::test_that("as_listing works with NA values in key cols", { testthat::expect_identical(matrix_form(lsting)$strings[29, 1], c(gear = "")) testthat::expect_identical(matrix_form(lsting)$strings[13, 2], c(carb = "")) + + 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 containing only NA")) }) From c8a21bd0f1057032125e6a54becf03eb0d9f9038 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Fri, 29 Sep 2023 10:43:41 -0400 Subject: [PATCH 08/10] Update NEWS --- NEWS.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 637e19a3..686aa6c0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,7 @@ ## rlistings 0.2.4.9002 * Fixed bug in `as_listing` preventing custom formatting from being applied to key columns. - * Updated `as_listing` to allow `NA` values in 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 . From a0b0f4ea0b1cb8555551f11fa952d96343c39dad Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Fri, 29 Sep 2023 10:48:54 -0400 Subject: [PATCH 09/10] Fix test --- tests/testthat/test-listings.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-listings.R b/tests/testthat/test-listings.R index a4e8f364..4033dedb 100644 --- a/tests/testthat/test-listings.R +++ b/tests/testthat/test-listings.R @@ -296,5 +296,5 @@ testthat::test_that("as_listing works with NA values in key cols", { mtcars, key_cols = c("gear", "carb"), disp_cols = "qsec" - ), "rows containing only NA")) + ), "rows that only contain NA")) }) From 52ecfd12ecac31929dc42b12eedbb2b49692b48f Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Fri, 29 Sep 2023 10:56:38 -0400 Subject: [PATCH 10/10] Fix lint --- tests/testthat/test-listings.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-listings.R b/tests/testthat/test-listings.R index 4033dedb..a3497f10 100644 --- a/tests/testthat/test-listings.R +++ b/tests/testthat/test-listings.R @@ -290,7 +290,7 @@ testthat::test_that("as_listing works with NA values in key cols", { testthat::expect_identical(matrix_form(lsting)$strings[29, 1], c(gear = "")) testthat::expect_identical(matrix_form(lsting)$strings[13, 2], c(carb = "")) - mtcars[33,] <- mtcars[32,] + mtcars[33, ] <- mtcars[32, ] mtcars[33, c(7, 10:11)] <- NA suppressMessages(testthat::expect_message(lsting <- as_listing( mtcars,