R/lsos.R

In vlulla/vlutils: Common utilities that I find useful

lsos <-
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
}