-
Notifications
You must be signed in to change notification settings - Fork 992
/
Copy pathprint.data.table.R
166 lines (159 loc) · 8.15 KB
/
print.data.table.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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
# Moved here out from data.table.R on 10 Aug 2017. See data.table.R for history prior to that.
print.data.table = function(x, topn=getOption("datatable.print.topn"),
nrows=getOption("datatable.print.nrows"),
class=getOption("datatable.print.class"),
row.names=getOption("datatable.print.rownames"),
col.names=getOption("datatable.print.colnames"),
print.keys=getOption("datatable.print.keys"),
quote=FALSE,
timezone=FALSE, ...) {
# topn - print the top topn and bottom topn rows with '---' inbetween (5)
# nrows - under this the whole (small) table is printed, unless topn is provided (100)
# class - should column class be printed underneath column name? (FALSE)
if (!col.names %chin% c("auto", "top", "none"))
stop("Valid options for col.names are 'auto', 'top', and 'none'")
if (col.names == "none" && class)
warning("Column classes will be suppressed when col.names is 'none'")
if (!shouldPrint(x)) {
# := in [.data.table sets .global$print=address(x) to suppress the next print i.e., like <- does. See FAQ 2.22 and README item in v1.9.5
# The issue is distinguishing "> DT" (after a previous := in a function) from "> DT[,foo:=1]". To print.data.table(), there
# is no difference. Now from R 3.2.0 a side effect of the very welcome and requested change to avoid silent deep copy is that
# there is now no longer a difference between > DT and > print(DT). So decided that DT[] is now needed to guarantee print; simpler.
# This applies just at the prompt. Inside functions, print(DT) will of course print.
# Other options investigated (could revisit): Cstack_info(), .Last.value gets set first before autoprint, history(), sys.status(),
# topenv(), inspecting next statement in caller, using clock() at C level to timeout suppression after some number of cycles
SYS = sys.calls()
if (length(SYS) <= 2L || # "> DT" auto-print or "> print(DT)" explicit print (cannot distinguish from R 3.2.0 but that's ok)
( length(SYS) >= 3L && is.symbol(thisSYS <- SYS[[length(SYS)-2L]][[1L]]) &&
as.character(thisSYS) == 'source') || # suppress printing from source(echo = TRUE) calls, #2369
( length(SYS) > 3L && is.symbol(thisSYS <- SYS[[length(SYS)-3L]][[1L]]) &&
as.character(thisSYS) %chin% mimicsAutoPrint ) ) {
return(invisible(x))
# is.symbol() temp fix for #1758.
}
}
if (!is.numeric(nrows)) nrows = 100L
if (!is.infinite(nrows)) nrows = as.integer(nrows)
if (nrows <= 0L) return(invisible(x)) # ability to turn off printing
if (!is.numeric(topn)) topn = 5L
topnmiss = missing(topn)
topn = max(as.integer(topn),1L)
if (print.keys){
if (!is.null(ky <- key(x)))
cat("Key: <", paste(ky, collapse=", "), ">\n", sep="")
if (!is.null(ixs <- indices(x)))
cat("Ind", if (length(ixs) > 1L) "ices" else "ex", ": <",
paste(ixs, collapse=">, <"), ">\n", sep="")
}
if (any(dim(x)==0L)) {
class = if (is.data.table(x)) "table" else "frame" # a data.frame could be passed to print.data.table() directly, #3363
if (all(dim(x)==0L)) {
cat("Null data.",class," (0 rows and 0 cols)\n", sep="") # See FAQ 2.5 and NEWS item in v1.8.9
} else {
cat("Empty data.",class," (", dim(x)[1L], " rows and ",length(x)," cols)", sep="")
if (length(x)>0L) cat(": ",paste(head(names(x),6L),collapse=","),if(length(x)>6L)"...",sep="")
cat("\n")
}
return(invisible(x))
}
if ((topn*2L+1L)<nrow(x) && (nrow(x)>nrows || !topnmiss)) {
toprint = rbindlist(list(head(x, topn), tail(x, topn)), use.names=FALSE) # no need to match names because head and tail of same x, and #3306
rn = c(seq_len(topn), seq.int(to=nrow(x), length.out=topn))
printdots = TRUE
} else {
toprint = x
rn = seq_len(nrow(x))
printdots = FALSE
}
toprint=format.data.table(toprint, na.encode=FALSE, timezone = timezone, ...) # na.encode=FALSE so that NA in character cols print as <NA>
require_bit64_if_needed(x)
# FR #5020 - add row.names = logical argument to print.data.table
if (isTRUE(row.names)) rownames(toprint)=paste0(format(rn,right=TRUE,scientific=FALSE),":") else rownames(toprint)=rep.int("", nrow(toprint))
if (is.null(names(x)) || all(names(x) == ""))
# fixes bug #97 (RF#4934) and #545 (RF#5253)
colnames(toprint)=rep("", ncol(toprint))
if (isTRUE(class) && col.names != "none") {
#Matching table for most common types & their abbreviations
class_abb = c(list = "<list>", integer = "<int>", numeric = "<num>",
character = "<char>", Date = "<Date>", complex = "<cplx>",
factor = "<fctr>", POSIXct = "<POSc>", logical = "<lgcl>",
IDate = "<IDat>", integer64 = "<i64>", raw = "<raw>",
expression = "<expr>", ordered = "<ord>")
classes = vapply(x, function(col) class(col)[1L], "", USE.NAMES=FALSE)
abbs = unname(class_abb[classes])
if ( length(idx <- which(is.na(abbs))) ) abbs[idx] = paste0("<", classes[idx], ">")
toprint = rbind(abbs, toprint)
rownames(toprint)[1L] = ""
}
if (quote) colnames(toprint) <- paste0('"', old <- colnames(toprint), '"')
if (printdots) {
toprint = rbind(head(toprint, topn + isTRUE(class)), "---"="", tail(toprint, topn))
rownames(toprint) = format(rownames(toprint), justify="right")
if (col.names == "none") {
cut_top(print(toprint, right=TRUE, quote=quote))
} else {
print(toprint, right=TRUE, quote=quote)
}
return(invisible(x))
}
if (nrow(toprint)>20L && col.names == "auto")
# repeat colnames at the bottom if over 20 rows so you don't have to scroll up to see them
# option to shut this off per request of Oleg Bondar on SO, #1482
toprint=rbind(toprint, matrix(if (quote) old else colnames(toprint), nrow=1L)) # fixes bug #4934
if (col.names == "none") {
cut_top(print(toprint, right=TRUE, quote=quote))
} else {
print(toprint, right=TRUE, quote=quote)
}
invisible(x)
}
format.data.table = function (x, ..., justify="none", timezone = FALSE) {
if (is.atomic(x) && !is.null(x)) {
stop("Internal structure doesn't seem to be a list. Possibly corrupt data.table.")
}
format.item = function(x) {
if (is.null(x)) # NULL item in a list column
""
else if (is.atomic(x) || inherits(x,"formula")) # FR #2591 - format.data.table issue with columns of class "formula"
paste(c(format(head(x, 6L), justify=justify, ...), if (length(x) > 6L) "..."), collapse=",") # fix for #5435 - format has to be added here...
else
paste0("<", class(x)[1L], ">")
}
# FR #2842 add timezone for posix timestamps
format.timezone = function(col) { # paste timezone to a time object
tz = attr(col,'tzone', exact=TRUE)
if (!is.null(tz)) { # date object with tz
nas = is.na(col)
col = paste0(as.character(col)," ",tz) # parse to character
col[nas] = NA_character_
}
return(col)
}
# FR #1091 for pretty printing of character
# TODO: maybe instead of doing "this is...", we could do "this ... test"?
char.trunc = function(x, trunc.char = getOption("datatable.prettyprint.char")) {
trunc.char = max(0L, suppressWarnings(as.integer(trunc.char[1L])), na.rm=TRUE)
if (!is.character(x) || trunc.char <= 0L) return(x)
idx = which(nchar(x) > trunc.char)
x[idx] = paste0(substr(x[idx], 1L, as.integer(trunc.char)), "...")
x
}
do.call("cbind",lapply(x,function(col,...) {
if (!is.null(dim(col))) return("<multi-column>")
if(timezone) col = format.timezone(col)
if (is.list(col)) col = vapply_1c(col, format.item)
else col = format(char.trunc(col), justify=justify, ...) # added an else here to fix #5435
col
},...))
}
mimicsAutoPrint = c("knit_print.default")
# add maybe repr_text.default. See https://github.com/Rdatatable/data.table/issues/933#issuecomment-220237965
shouldPrint = function(x) {
ret = (.global$print=="" || # to save address() calls and adding lots of address strings to R's global cache
address(x)!=.global$print)
.global$print = ""
ret
}
# for removing the head (column names) of matrix output entirely,
# as opposed to printing a blank line, for excluding col.names per PR #1483
cut_top = function(x) cat(capture.output(x)[-1L], sep = '\n')