50 prevents factor to fact in details()

NEWS.md

@@ -1,5 +1,7 @@
 # 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
 * `detail.data.frame()` now works with single column data.frames [#48](https://github.com/jmbarbone/mark/issues/48)
 
 # mark 0.4.0
@@ -26,7 +28,7 @@
 * `import(, overwrite = TRUE)` now works
 * `ls_function()`, `ls_object()`, `ls_dataframe()`, and `ls_all()` have improvements for environmental searching
 * `assign_labels.data.frame(.missing = "warning")` correctly removes missing columns
-* `remove_na.factor()` no long drops additional classes other than `ordered` and `factor` 
+* `remove_na.factor()` no long drops additional classes other than `ordered` and `factor`
 
 ## Others
 

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)
 
@@ -91,7 +96,7 @@ detail.data.frame <- function(x, ...) {
     stop("x does not have any non-list columns", call. = FALSE)
   }
 
-  details <- lapply(x, detail)
+  details <- lapply(x, detail, factor_n = factor_n)
   reps <- vap_int(details, nrow)
 
   cbind(

tests/testthat/test-detail.R

@@ -10,6 +10,11 @@ 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")
+})
+
 test_that("details() and tibbles", {
   skip_if_not_installed("tibble")