Nothing
setClass("sysinfo", representation="VIRTUAL")
meminfo_retvals <- function(retval)
{
if (length(retval) > 1)
return(sapply(retval, meminfo_retvals))
.Call(R_meminfo_retvals, as.integer(retval))
}
#' @export
"[.sysinfo" <- function(x, i)
{
class(x) <- NULL
ret <- x[i]
if (length(ret) > 0)
class(ret) <- "sysinfo"
else
return(numeric(0))
return(ret)
}
meminfo_check = function(out)
{
if (any(unlist(out) == -1))
stop("There were errors accessing hardware info")
if (all(unlist(out) == -10))
stop("platform not supported at this time")
}
# ---------------------------------------------------------
# ram
# ---------------------------------------------------------
#' meminfo
#'
#' Platform memory information.
#'
#' \code{Sys.meminfo()} returns some basic memory values, such as total ram,
#' free ram, and ram used for buffers/cache (when applicable).
#'
#' All of the C-level source code for these methods (in src/meminfo of the root
#' directory of the memuse source tree) is licensed under the permissive
#' 2-Clause BSD license.
#'
#' @param compact.free
#' logical; determines whether various free memory values
#' should be combined into a single value. See details section for more
#' information.
#'
#' @return
#' Returns a list, whose values are platform dependent in addition to
#' being modified by input arguments.
#'
#' @examples
#' \dontrun{
#' library(memuse)
#'
#' Sys.meminfo()
#' }
#'
#' @seealso \code{\link{procmem}}
#' @name meminfo
#' @rdname meminfo
#' @export
Sys.meminfo <- function(compact.free=TRUE)
{
out <- .Call(R_meminfo_raminfo)
meminfo_check(out)
tmp <- -which(out == -10)
if (length(tmp) > 0)
out <- out[tmp]
ret <- lapply(out, mu)
if (compact.free)
{
ret$freeram <- val_or_zero(ret$freeram) + val_or_zero(ret$bufferram) + val_or_zero(ret$cachedram)
ret$bufferram <- ret$cachedram <- NULL
}
class(ret) <- "sysinfo"
ret
}
# ---------------------------------------------------------
# swap
# ---------------------------------------------------------
#' swapinfo
#'
#' Platform swap information.
#'
#' \code{Sys.swapinfo()} returns basic swap/page (virtual memory) information.
#' \code{Sys.pageinfo()} is identical to \code{swapinfo()} in every way but
#' name (provided for Windows users who may be more comfortable/familiar with
#' the 'pagefile' naming convention).
#'
#' All of the C-level source code for these methods (in src/meminfo of the root
#' directory of the memuse source tree) is licensed under the permissive
#' 2-Clause BSD license.
#'
#' @return
#' Returns a list, whose values are platform dependent in addition to
#' being modified by input arguments.
#'
#' @examples
#' \dontrun{
#' library(memuse)
#'
#' Sys.swapinfo()
#' }
#'
#' @seealso \code{\link{procmem}}
#' @name swapinfo
#' @rdname swapinfo
#' @export
Sys.swapinfo <- function()
{
out <- .Call(R_meminfo_swapinfo)
meminfo_check(out)
tmp <- -which(out == -10)
if (length(tmp) > 0)
out <- out[tmp]
ret <- lapply(out, mu)
class(ret) <- "sysinfo"
ret
}
#' @rdname swapinfo
#' @export
Sys.pageinfo <- Sys.swapinfo
# ---------------------------------------------------------
# Current R process memory usage
# ---------------------------------------------------------
#' procmem
#'
#' Shows the amount of ram used by the current R process.
#'
#' \code{Sys.procmem()} returns the total memory usage of the current R
#' process, and (if supported), the maximum memory usage as well.
#'
#' All of the C-level source code for these methods (in src/meminfo of the root
#' directory of the memuse source tree) is licensed under the permissive
#' 2-Clause BSD license.
#'
#' @param gcFirst
#' logical; determines if garbage collection should be called
#' before getting process memory usage.
#'
#' @return
#' Returns a list, whose values are platform dependent in addition to
#' being modified by input arguments.
#'
#' @examples
#' \dontrun{
#' library(memuse)
#'
#' ### How much is being used?
#' Sys.procmem()
#'
#' ### Use more.
#' x <- rnorm(1e7)
#' Sys.procmem()
#'
#' ### Use less.
#' rm(x)
#' gc(FALSE)
#' Sys.procmem()
#' }
#'
#' @seealso \code{\link{meminfo}}
#' @name procmem
#' @rdname procmem
#' @export
Sys.procmem <- function(gcFirst=TRUE)
{
if (gcFirst)
gc(FALSE)
out <- .Call(R_meminfo_procinfo)
meminfo_check(out)
tmp <- -which(out == -10)
if (length(tmp) > 0)
out <- out[tmp]
ret <- lapply(out, mu)
class(ret) <- "sysinfo"
ret
}
# ---------------------------------------------------------
# Cache sizes
# ---------------------------------------------------------
getcache <- function(level) .Call(R_meminfo_cacheinfo_size, level)
#' Cache Sizes
#'
#' Shows the sizes of the CPU caches.
#'
#' \code{Sys.cachesize()} will check the various levels of cache and return all
#' available cache information in a list. If you don't have some kind of
#' level-1 cache, then it will return an error. If you have some kind of
#' future space computer with more than 3 levels of cache, levels higher than 3
#' will not be displayed.
#'
#' @return
#' Returns a list, whose values are platform dependent.
#'
#' @examples
#' \dontrun{
#' library(memuse)
#'
#' Sys.cachesize()
#' }
#'
#' @seealso \code{\link{meminfo}}
#' @name cachesize
#' @rdname cachesize
#' @export
Sys.cachesize <- function()
{
levels <- 0L:4L
ret <- sapply(levels, getcache)
names(ret) <- c("L1I", "L1D", "L2", "L3", "L4")
if (all(ret < 0))
stop("platform not supported at this time")
else if (any(ret < 0))
ret <- ret[which(ret > 0)]
ret <- sapply(ret, mu)
class(ret) <- "sysinfo"
ret
}
#' Cache Sizes and Linesize
#'
#' Shows the size of the cache line.
#'
#' \code{Sys.cachelinesize()} will return the cache linesize. It's almost
#' certainly 32 or 64 bytes.
#'
#' @return
#' Returns a list, whose values are platform dependent.
#'
#' @examples
#' \dontrun{
#' library(memuse)
#'
#' Sys.cachelinesize()
#' }
#'
#' @seealso \code{\link{meminfo}}
#' @name cachelinesize
#' @rdname cachelinesize
#' @export
Sys.cachelinesize <- function()
{
ret <- .Call(R_meminfo_cacheinfo_linesize)
if (ret < 0)
stop("platform not supported at this time")
ret <- list(Linesize=mu(ret))
class(ret) <- "sysinfo"
ret
}
# ---------------------------------------------------------
# File sizes
# ---------------------------------------------------------
#' filesize
#'
#' Returns size of a file as reported by the file system (the
#' file is not scanned).
#'
#' All of the C-level source code for these methods (in src/meminfo of the root
#' directory of the memuse source tree) is licensed under the permissive
#' 2-Clause BSD license.
#'
#' @param filename,dirname
#' Location of the file/directory (as a string).
#'
#' @return
#' A memuse class object.
#'
#' @examples
#' \dontrun{
#' library(memuse)
#'
#' x <- rnorm(1e5)
#' memuse(x) ### size in ram
#'
#' tmp <- tempfile()
#' saveRDS(x, file=tmp)
#' Sys.filesize(tmp) ### size on disk
#' unlink(tmp)
#' }
#'
#' @name filesize
#' @rdname filesize
NULL
#' @rdname filesize
#' @export
Sys.filesize <- function(filename)
{
filename = tools::file_path_as_absolute(filename)
bytes = .Call(R_meminfo_filesize, filename)
mu(bytes)
}
#' @rdname filesize
#' @export
Sys.dirsize = function(dirname)
{
sz = function(filename) .Call(R_meminfo_filesize, filename)
files = dir(dirname, full.names=TRUE, all.files=TRUE, recursive=TRUE)
bytes = sum(sapply(files, sz))
mu(bytes)
}
# ---------------------------------------------------------
# printing
# ---------------------------------------------------------
title_case <- function(x) gsub(x, pattern="(^|[[:space:]])([[:alpha:]])", replacement="\\1\\U\\2", perl=TRUE)
#' @title Print \code{sysinfo} objects
#' @description Printing for \code{sysinfo} objects.
#' @param x \code{sysinfo} object
#' @param ... unused
#' @name print-sysinfo
#' @rdname print-sysinfo
#' @method print sysinfo
#' @export
print.sysinfo <- function(x, ...)
{
# So ugly it's beautiful
maxlen <- max(sapply(names(x), nchar))
names <- gsub(names(x), pattern="_", replacement=" ")
names <- title_case(x=names)
spacenames <- simplify2array(lapply(names, function(str) paste0(str, ":", paste0(rep(" ", maxlen-nchar(str)), collapse=""))))
maxlen <- max(sapply(x, function(y) nchar(paste(y))))
prespaces <- simplify2array(lapply(x, function(y) paste0(rep(" ", maxlen-nchar(paste(y))), collapse="")))
lapply(1:length(x), function(i) cat(paste(spacenames[i], prespaces[i], x[[i]], sep=" ", collapse="\n"), "\n"))
# cat("\n")
invisible()
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.