lsos:

Usage Arguments Examples

View source: R/lsos.R

Usage

1
lsos(pos = 1, pattern, order.by, decreasing = FALSE, head = FALSE, n = 5)

Arguments

pos
pattern
order.by
decreasing
head
n

Examples

 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
##---- Should be DIRECTLY executable !! ----
##-- ==>  Define data, use random,
##--	or do  help(data=index)  for the standard data sets.

## The function is currently defined as
function (pos = 1, pattern, order.by, decreasing = FALSE, head = FALSE, 
    n = 5) 
{
    napply <- function(names, fn) sapply(names, function(x) fn(get(x, 
        pos = pos)))
    isRaster <- function(x) inherits(x, c("RasterStack", "RasterBrick"))
    nlayers <- function(x) ifelse(isRaster(x), raster::nlayers(x), 
        NA)
    names <- ls(pos = pos, pattern = pattern)
    if (length(names) == 0) 
        return(character(0))
    obj.class <- napply(names, function(x) as.character(class(x))[1])
    obj.mode <- napply(names, base::mode)
    obj.type <- ifelse(is.na(obj.class), obj.mode, obj.class)
    obj.size <- napply(names, function(x) {
        l <- capture.output(print(object.size(x), units = "auto"))
        l[length(l)]
    })
    obj.dim <- t(napply(names, function(x) as.integer(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[, 1], obj.dim[, 
        2])
    names(out) <- c("Type", "Size", "Rows", "Columns")
    if (any(obj.type %in% c("RasterBrick", "RasterStack"))) {
        obj.layers <- napply(names, nlayers)
        out <- cbind(out, Layers = obj.layers)
    }
    if (!missing(order.by)) {
        idx <- if (order.by == "Size") {
            sizes <- napply(names, object.size)
            order(sizes, decreasing = decreasing)
        }
        else {
            order(out[[order.by]], decreasing = decreasing)
        }
        out <- out[idx, ]
    }
    if (head) 
        out <- head(out, n)
    out
  }

vlulla/vlutils documentation built on May 21, 2019, 12:35 a.m.