Merge pull request #662 from ryanzomorrodi/glimpse_red_NA

r-lib · Jul 7, 2024 · 106a50d · 106a50d
2 parents 6dce54d + c6217ca
commit 106a50d
Show file tree

Hide file tree

Showing 4 changed files with 109 additions and 6 deletions.
diff --git a/R/glimpse.R b/R/glimpse.R
@@ -140,11 +140,12 @@ format_glimpse_ <- function(x, ...) {
 format_glimpse.default <- function(x, ...) {
   dims <- dim(x)
 
-  if (!is.null(dims)) {
+  if (is.null(dims)) {
+    out <- format(x, trim = TRUE, justify = "none")
+    style_na_if(out, is.na(x))
+  } else {
     dims_out <- paste0(dims, collapse = " x ")
     paste0("<", class(x)[[1]], "[", dims_out, "]>")
-  } else {
-    format(x, trim = TRUE, justify = "none")
   }
 }
 
@@ -169,14 +170,16 @@ format_glimpse.list <- function(x, ..., .inner = FALSE) {
 
 #' @export
 format_glimpse.character <- function(x, ...) {
-  encodeString(x, quote = '"')
+  out <- encodeString(as.character(x), quote = '"')
+  style_na_if(out, is.na(x))
 }
 
 #' @export
 format_glimpse.factor <- function(x, ...) {
   if (any(grepl(",", levels(x), fixed = TRUE))) {
-    encodeString(as.character(x), quote = '"')
+    out <- encodeString(as.character(x), quote = '"')
   } else {
-    format(x, trim = TRUE, justify = "none")
+    out <- format(x, trim = TRUE, justify = "none")
   }
+  style_na_if(out, is.na(x))
 }
diff --git a/R/styles.R b/R/styles.R
@@ -84,6 +84,15 @@ style_na <- function(x) {
   crayon_red(x)
 }
 
+style_na_if <- function(x, p) {
+  idx <- which(p)
+  if (length(idx) == 0) {
+    return(x)
+  }
+  x[p] <- style_na(x[idx[[1]]])
+  x
+}
+
 #' @details
 #' `style_neg()` is affected by the `pillar.neg` [option][pillar_options].
 #'

diff --git a/tests/testthat/_snaps/glimpse.md b/tests/testthat/_snaps/glimpse.md
@@ -216,3 +216,72 @@
       $ cyl  <dbl> 6, 4, 8
       $ data <list> [<tbl[11 x 11]>], [<tbl[7 x 11]>], [<tbl[14 x 11]>]
 
+# color test for missing values
+
+    Code
+      # individual data types
+      format_glimpse(df_all$a)
+    Output
+      [1] "1.0"                "2.5"                "\033[31mNA\033[39m"
+    Code
+      format_glimpse(df_all$b)
+    Output
+      [1] "1"                  "2"                  "\033[31mNA\033[39m"
+    Code
+      format_glimpse(df_all$c)
+    Output
+      [1] "TRUE"               "FALSE"              "\033[31mNA\033[39m"
+    Code
+      format_glimpse(df_all$d)
+    Output
+      [1] "\"a\""              "\"b\""              "\033[31mNA\033[39m"
+    Code
+      format_glimpse(df_all$e)
+    Output
+      [1] "a"                  "b"                  "\033[31mNA\033[39m"
+    Code
+      format_glimpse(df_all$f)
+    Output
+      [1] "2015-12-10"         "2015-12-11"         "\033[31mNA\033[39m"
+    Code
+      format_glimpse(df_all$g)
+    Output
+      [1] "2015-12-09 10:51:35" "2015-12-09 10:51:36" "\033[31mNA\033[39m" 
+    Code
+      format_glimpse(df_all$h)
+    Output
+      [1] "1"                  "2"                  "\033[31mNA\033[39m"
+    Code
+      format_glimpse(df_all$i)
+    Output
+      [1] "[1, <2, 3>]"          "[<4, 5, 6>]"          "[\033[31mNA\033[39m]"
+    Code
+      # tables
+      glimpse(df_all)
+    Output
+      Rows: 3
+      Columns: 9
+      $ a [3m[90m<dbl>[39m[23m 1.0, 2.5, [31mNA[39m
+      $ b [3m[90m<int>[39m[23m 1, 2, [31mNA[39m
+      $ c [3m[90m<lgl>[39m[23m TRUE, FALSE, [31mNA[39m
+      $ d [3m[90m<chr>[39m[23m "a", "b", [31mNA[39m
+      $ e [3m[90m<fct>[39m[23m a, b, [31mNA[39m
+      $ f [3m[90m<date>[39m[23m 2015-12-10, 2015-12-11, [31mNA[39m
+      $ g [3m[90m<dttm>[39m[23m 2015-12-09 10:51:35, 2015-12-09 10:51:36, [31mNA[39m
+      $ h [3m[90m<list>[39m[23m 1, 2, [31mNA[39m
+      $ i [3m[90m<list>[39m[23m [1, <2, 3>], [<4, 5, 6>], [[31mNA[39m]
+    Code
+      glimpse(as.data.frame(df_all))
+    Output
+      Rows: 3
+      Columns: 9
+      $ a [3m[90m<dbl>[39m[23m 1.0, 2.5, [31mNA[39m
+      $ b [3m[90m<int>[39m[23m 1, 2, [31mNA[39m
+      $ c [3m[90m<lgl>[39m[23m TRUE, FALSE, [31mNA[39m
+      $ d [3m[90m<chr>[39m[23m "a", "b", [31mNA[39m
+      $ e [3m[90m<fct>[39m[23m a, b, [31mNA[39m
+      $ f [3m[90m<date>[39m[23m 2015-12-10, 2015-12-11, [31mNA[39m
+      $ g [3m[90m<dttm>[39m[23m 2015-12-09 10:51:35, 2015-12-09 10:51:36, [31mNA[39m
+      $ h [3m[90m<list>[39m[23m 1, 2, [31mNA[39m
+      $ i [3m[90m<list>[39m[23m [1, <2, 3>], [<4, 5, 6>], [[31mNA[39m]
+
diff --git a/tests/testthat/test-glimpse.R b/tests/testthat/test-glimpse.R
@@ -100,3 +100,25 @@ test_that("output test for glimpse()", {
     glimpse(nested_mtcars_tbl, width = 70L)
   })
 })
+
+test_that("color test for missing values", {
+  local_colors()
+
+  expect_snapshot({
+
+    "individual data types"
+    format_glimpse(df_all$a)
+    format_glimpse(df_all$b)
+    format_glimpse(df_all$c)
+    format_glimpse(df_all$d)
+    format_glimpse(df_all$e)
+    format_glimpse(df_all$f)
+    format_glimpse(df_all$g)
+    format_glimpse(df_all$h)
+    format_glimpse(df_all$i)
+
+    "tables"
+    glimpse(df_all)
+    glimpse(as.data.frame(df_all))
+  })
+})