From b9368266c98ec27c212c72460625671c90902904 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 26 Oct 2021 12:19:47 -0400 Subject: [PATCH 1/4] rewsolves #50 --- NEWS.md | 3 +++ R/detail.R | 29 +++++++++++++++++------------ man/detail.Rd | 8 ++++++-- tests/testthat/test-detail.R | 5 +++++ 4 files changed, 31 insertions(+), 14 deletions(-) diff --git a/NEWS.md b/NEWS.md index f263353c..66f4005d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # mark (development version) +* `details(factor)` no longer adds `fact` class to `factors` [#50](https://github.com/jmbarbone/mark/issues/50) +* `details()` gains new argument `factor_n` to control threshold for making character vectors into factors + # mark 0.4.0 ## New features diff --git a/R/detail.R b/R/detail.R index 32fe3149..c0304b40 100644 --- a/R/detail.R +++ b/R/detail.R @@ -22,8 +22,11 @@ detail <- function(x, ...) { } #' @rdname detail +#' @param factor_n An `integer` threshold for making factors; will convert any +#' character vectors with `factor_n` or less unique values into a `fact`; +#' setting as `NA` will ignore this #' @export -detail.default <- function(x, ...) { +detail.default <- function(x, ..., factor_n = 5L) { stopifnot(!is.list(x)) op <- options(stringsAsFactors = FALSE) @@ -32,19 +35,21 @@ detail.default <- function(x, ...) { nas <- is.na(x) x2 <- x[!nas] - # If either of these exact, make as factor - has_lls <- - !is.null(attr(x, "levels", exact = TRUE)) || - !is.null(attr(x, "labels", exact = TRUE)) - - if (has_lls) { - x <- fact(x) - } - facts <- is.factor(x) quants <- !is.character(x) && !facts nc <- nchar(as.character(x)) + if (!is.na(factor_n) && !facts) { + # If either of these exist, make as factor + has_lls <- + !is.null(attr(x, "levels", exact = TRUE)) || + !is.null(attr(x, "labels", exact = TRUE)) + + if (has_lls) { + x <- fact(x) + } + } + if (!facts & !quants) { if (length(unique(x)) <= 5) { x <- fact(x) @@ -80,7 +85,7 @@ detail.default <- function(x, ...) { #' @rdname detail #' @export -detail.data.frame <- function(x, ...) { +detail.data.frame <- function(x, ..., factor_n = 5L) { op <- options(stringsAsFactors = FALSE) on.exit(options(op), add = TRUE) @@ -92,7 +97,7 @@ detail.data.frame <- function(x, ...) { } details <- lapply(x, detail) - reps <- vap_int(details, nrow) + reps <- vap_int(details, nrow, factor_n = factor_n) cbind( quick_dfl(i = rep(seq_along(x), reps)), diff --git a/man/detail.Rd b/man/detail.Rd index 3e3a1e0b..42320622 100644 --- a/man/detail.Rd +++ b/man/detail.Rd @@ -8,14 +8,18 @@ \usage{ detail(x, ...) -\method{detail}{default}(x, ...) +\method{detail}{default}(x, ..., factor_n = 5L) -\method{detail}{data.frame}(x, ...) +\method{detail}{data.frame}(x, ..., factor_n = 5L) } \arguments{ \item{x}{An object} \item{...}{Additional arguments passed to methods} + +\item{factor_n}{An \code{integer} threshold for making factors; will convert any +character vectors with \code{factor_n} or less unique values into a \code{fact}; +setting as \code{NA} will ignore this} } \description{ Provides details about an object diff --git a/tests/testthat/test-detail.R b/tests/testthat/test-detail.R index 2b373870..76589fc3 100644 --- a/tests/testthat/test-detail.R +++ b/tests/testthat/test-detail.R @@ -9,3 +9,8 @@ test_that("details() works", { expect_error(detail(data.frame())) }) + +test_that("details() keeps factors [50]", { + expect_identical(detail(factor("a"))$class, "factor") + expect_identical(detail(ordered("a"))$class, "ordered; factor") +}) From ae8b3f6e5830ff03575cbb48fe334697a6ef1ee9 Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 26 Oct 2021 13:55:20 -0400 Subject: [PATCH 2/4] changes argument order --- R/detail.R | 4 ++-- man/detail.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/detail.R b/R/detail.R index 74ec2af0..327b41d1 100644 --- a/R/detail.R +++ b/R/detail.R @@ -26,7 +26,7 @@ detail <- function(x, ...) { #' character vectors with `factor_n` or less unique values into a `fact`; #' setting as `NA` will ignore this #' @export -detail.default <- function(x, ..., factor_n = 5L) { +detail.default <- function(x, factor_n = 5L, ...) { stopifnot(!is.list(x)) op <- options(stringsAsFactors = FALSE) @@ -85,7 +85,7 @@ detail.default <- function(x, ..., factor_n = 5L) { #' @rdname detail #' @export -detail.data.frame <- function(x, ..., factor_n = 5L) { +detail.data.frame <- function(x, factor_n = 5L, ...) { op <- options(stringsAsFactors = FALSE) on.exit(options(op), add = TRUE) diff --git a/man/detail.Rd b/man/detail.Rd index 42320622..fc0f5af0 100644 --- a/man/detail.Rd +++ b/man/detail.Rd @@ -8,9 +8,9 @@ \usage{ detail(x, ...) -\method{detail}{default}(x, ..., factor_n = 5L) +\method{detail}{default}(x, factor_n = 5L, ...) -\method{detail}{data.frame}(x, ..., factor_n = 5L) +\method{detail}{data.frame}(x, factor_n = 5L, ...) } \arguments{ \item{x}{An object} From ace53c3f37c67a6e2a29d31e8bd13f3317e17dce Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 26 Oct 2021 13:55:37 -0400 Subject: [PATCH 3/4] corrects use of factor_n --- R/detail.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/detail.R b/R/detail.R index 327b41d1..1b02a242 100644 --- a/R/detail.R +++ b/R/detail.R @@ -96,8 +96,8 @@ detail.data.frame <- function(x, factor_n = 5L, ...) { stop("x does not have any non-list columns", call. = FALSE) } - details <- lapply(x, detail) - reps <- vap_int(details, nrow, factor_n = factor_n) + details <- lapply(x, detail, factor_n = factor_n) + reps <- vap_int(details, nrow) cbind( quick_dfl(i = rep(seq_along(x), reps)), From 998e585c9959b73010a84b7209a1257b31c9decd Mon Sep 17 00:00:00 2001 From: Jordan Mark Barbone Date: Tue, 26 Oct 2021 13:57:30 -0400 Subject: [PATCH 4/4] syntax typo --- tests/testthat/test-detail.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-detail.R b/tests/testthat/test-detail.R index e356f042..781a27c2 100644 --- a/tests/testthat/test-detail.R +++ b/tests/testthat/test-detail.R @@ -13,6 +13,7 @@ test_that("details() works", { test_that("details() keeps factors [50]", { expect_identical(detail(factor("a"))$class, "factor") expect_identical(detail(ordered("a"))$class, "ordered; factor") +}) test_that("details() and tibbles", { skip_if_not_installed("tibble")