/
glimpse.R
108 lines (90 loc) · 3.18 KB
/
glimpse.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
#' Get a glimpse of your data
#'
#' This is like a transposed version of `print()`: columns run down the page,
#' and data runs across. This makes it possible to see every column in
#' a data frame. It's a little like [str()] applied to a data frame
#' but it tries to show you as much data as possible. (And it always shows
#' the underlying data, even when applied to a remote data source.)
#'
#' @section S3 methods:
#' `glimpse` is an S3 generic with a customised method for `tbl`s and
#' `data.frames`, and a default method that calls [str()].
#'
#' @param x An object to glimpse at.
#' @param width Width of output: defaults to the setting of the option
#' `tibble.width` (if finite) or the width of the console.
#' @param ... Other arguments passed on to individual methods.
#' @return x original x is (invisibly) returned, allowing `glimpse()` to be
#' used within a data pipe line.
#' @export
#' @examples
#' glimpse(mtcars)
#'
#' if (requireNamespace("nycflights13", quietly = TRUE)) {
#' glimpse(nycflights13::flights)
#' }
glimpse <- function(x, width = NULL, ...) {
UseMethod("glimpse")
}
#' @export
#' @importFrom pillar new_pillar_title
#' @importFrom pillar new_pillar_type
glimpse.tbl <- function(x, width = NULL, ...) {
width <- tibble_glimpse_width(width)
if (!is.finite(width)) {
abort(error_glimpse_infinite_width())
}
cat_line("Observations: ", big_mark(nrow(x)))
# this is an overestimate, but shouldn't be too expensive.
# every type needs at least three characters: "x, "
rows <- as.integer(width / 3)
df <- as.data.frame(head(x, rows))
cat_line("Variables: ", big_mark(ncol(df)))
if (ncol(df) == 0) return(invisible(x))
var_types <- map_chr(map(df, new_pillar_type), format)
ticked_names <- format(new_pillar_title(tick_if_needed(names(df))))
var_names <- paste0("$ ", justify(ticked_names, right = FALSE), " ", var_types, " ")
data_width <- width - crayon::col_nchar(var_names) - 2
formatted <- map_chr(df, function(x) collapse(format_v(x)))
truncated <- str_trunc(formatted, data_width)
cat_line(var_names, truncated)
invisible(x)
}
#' @export
glimpse.data.frame <- glimpse.tbl
#' @export
#' @importFrom utils str
glimpse.default <- function(x, width = NULL, max.level = 3, ...) {
str(x, width = tibble_width(width), max.level = max.level, ...)
invisible(x)
}
str_trunc <- function(x, max_width) {
width <- nchar(x)
nchar_ellipsis <- nchar_width(cli::symbol$ellipsis)
for (i in seq_along(x)) {
if (width[i] <= max_width[i]) next
x[i] <- paste0(substr(x[i], 1, max_width[i] - nchar_ellipsis), cli::symbol$ellipsis)
}
x
}
format_v <- function(x) UseMethod("format_v")
#' @export
format_v.default <- function(x) format(x, trim = TRUE, justify = "none")
#' @export
format_v.list <- function(x) {
out <- map(x, format_v)
atomic <- (map_int(out, length) == 1L)
out <- map_chr(out, collapse)
out[!atomic] <- paste0("<", out[!atomic], ">")
paste0("[", collapse(out), "]")
}
#' @export
format_v.character <- function(x) encodeString(x, quote = '"')
#' @export
format_v.factor <- function(x) {
if (any(grepl(",", x, fixed = TRUE))) {
encodeString(as.character(x), quote = '"')
} else {
format(x, trim = TRUE, justify = "none")
}
}