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
|
# -*- encoding: utf-8 -*-
# Tricks to manage the available memory in an R session
# http://stackoverflow.com/q/1358003/4856091
# improved list of objects
.ls.objects <- function(pos=1, pattern, order.by,
decreasing=FALSE, pretty.size=FALSE,
head=FALSE, n=10) {
napply <- function(names, fn) {
sapply(names, function(x) fn(get(x, pos=pos)))
}
names <- ls(pos=pos, pattern=pattern)
obj.class <- napply(names, function(x) as.character(class(x))[1])
obj.mode <- napply(names, mode)
obj.type <- ifelse(is.na(obj.class), obj.mode, obj.class)
obj.size.bytes <- napply(names, object.size)
if (pretty.size) {
obj.size <- napply(names, function(x) {
format(object.size(x), units="auto")
})
} else {
obj.size <- obj.size.bytes
}
obj.dim <- t(napply(names, function(x) as.numeric(dim(x))[1:2]))
vec <- is.na(obj.dim)[, 1] & (obj.type != "function")
obj.dim[vec, 1] <- napply(names, length)[vec]
out <- data.frame(obj.type, obj.size, obj.dim)
names(out) <- c("Type", "Size", "Rows", "Columns")
if (! missing(order.by))
if (order.by == "Size") {
out <- out[order(obj.size.bytes, decreasing=decreasing), ]
} else {
out <- out[order(out[[order.by]], decreasing=decreasing), ]
}
if (head)
out <- head(out, n)
out
}
# shorthand
lsobjs <- function(..., n=10) {
.ls.objects(..., order.by="Size", decreasing=TRUE,
pretty.size=TRUE, head=TRUE, n=n)
}
|
