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
|
# data.table defined last(x) with no arguments, just for last. If you need the last 10 then use tail(x,10).
# for xts class objects it will dispatch to xts::last
# reworked to avoid loading xts namespace (#3857) then again to fix dispatching of xts class (#4053)
last = function(x, n=1L, ...) {
verbose = isTRUE(getOption("datatable.verbose", FALSE))
if (!inherits(x, "xts")) {
if (nargs()>1L) {
if ("package:xts" %chin% search()) {
if (verbose)
cat("last: using xts::last: !is.xts(x) & nargs>1 & 'package:xts'%in%search()\n")
xts::last(x, n=n, ...)
} else {
# nocov start
if (verbose)
cat("last: using utils::tail: !is.xts(x) & nargs>1 & !'package:xts'%in%search()\n")
utils::tail(x, n=n, ...)
# nocov end
}
} else {
dx = dim(x)
if (is.null(dx)) {
if (verbose)
cat("last: using 'x[[length(x)]]': !is.xts(x) & !nargs>1 & is.null(dim(x))\n")
lx = length(x)
if (!lx) x else x[[lx]]
} else if (is.data.frame(x)) {
if (verbose)
cat("last: using 'x[nrow(x),]': !is.xts(x) & !nargs>1 & is.data.frame(x)\n")
x[dx[1L], , drop=FALSE]
} else {
if (verbose)
cat("last: using utils::tail: !is.xts(x) & !nargs>1 & !is.null(dim(x)) & !is.data.frame(x)\n")
utils::tail(x, n=n, ...)
}
}
} else {
if (!requireNamespace("xts", quietly=TRUE))
stop(gettextf("'xts' class passed to %s function but 'xts' is not available, you should have 'xts' installed already", "data.table::last", domain="R-data.table")) # nocov
if (verbose)
cat("last: using xts::last: is.xts(x)\n")
xts::last(x, n=n, ...)
}
}
first = function(x, n=1L, ...) {
verbose = isTRUE(getOption("datatable.verbose", FALSE))
if (!inherits(x, "xts")) {
if (nargs()>1L) {
if ("package:xts" %chin% search()) {
if (verbose)
cat("first: using xts::first: !is.xts(x) & nargs>1 & 'package:xts'%in%search()\n")
xts::first(x, n=n, ...)
} else {
# nocov start
if (verbose)
cat("first: using utils::head: !is.xts(x) & nargs>1 & !'package:xts'%in%search()\n")
utils::head(x, n=n, ...)
# nocov end
}
} else {
dx = dim(x)
if (is.null(dx)) {
if (verbose)
cat("first: using 'x[[1L]]': !is.xts(x) & !nargs>1 & is.null(dim(x))\n")
lx = length(x)
if (!lx) x else x[[1L]]
} else if (is.data.frame(x)) {
if (verbose)
cat("first: using 'x[1L,]': !is.xts(x) & !nargs>1 & is.data.frame(x)\n")
if (!dx[1L]) x else x[1L, , drop=FALSE]
} else {
if (verbose)
cat("first: using utils::head: !is.xts(x) & !nargs>1 & !is.null(dim(x)) & !is.data.frame(x)\n")
utils::head(x, n=n, ...)
}
}
} else {
if (!requireNamespace("xts", quietly=TRUE))
stop(gettextf("'xts' class passed to %s function but 'xts' is not available, you should have 'xts' installed already", "data.table::first", domain="R-data.table")) # nocov
if (verbose)
cat("first: using xts::first: is.xts(x)\n")
xts::first(x, n=n, ...)
}
}
|
