src/library/utils/R/object.size.R

#  File src/library/utils/R/object.size.R
#  Part of the R package, https://www.R-project.org
#
#  Copyright (C) 1995-2017 The R Core Team
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  A copy of the GNU General Public License is available at
#  https://www.R-project.org/Licenses/

object.size <- function(x)
    structure(.Call(C_objectSize, x), class = "object_size")

format.object_size <- function(x, units = "b", standard = "auto", digits = 1L, ...)
{
    known_bases <- c(legacy = 1024, IEC = 1024, SI = 1000)
    known_units <- list(
	SI     = c("B", "kB",  "MB",  "GB", "TB", "PB",  "EB",  "ZB",  "YB"),
	IEC    = c("B", "KiB", "MiB", "GiB","TiB","PiB", "EiB", "ZiB", "YiB"),
	legacy = c("b", "Kb",  "Mb",  "Gb", "Tb", "Pb"),
	LEGACY = c("B", "KB",  "MB",  "GB", "TB", "PB") # <- only for "KB"
    )

    units <- match.arg(units,
		       c("auto", unique(unlist(known_units), use.names = FALSE)))
    standard <- match.arg(standard, c("auto", names(known_bases)))
    if(is.null(digits)) digits <- 1L # (default is NULL in other places)

    if (standard == "auto") { ## infer 'standard' from 'units':
	standard <- "legacy" # default; may become "SI"
	if (units != "auto") {
	    if (endsWith(units, "iB"))
		standard <- "IEC"
	    else if (endsWith(units, "b"))
		standard <- "legacy"   ## keep when "SI" is the default
	    else if (units == "kB")
		## SPECIAL: Drop when "SI" becomes the default
		stop("For SI units, specify 'standard = \"SI\"'")
	}
    }
    base      <- known_bases[[standard]]
    units_map <- known_units[[standard]]

    if (units == "auto") {
	power <- if (x <= 0) 0L else min(as.integer(log(x, base = base)),
					 length(units_map) - 1L)
    } else {
	power <- match(toupper(units), toupper(units_map)) - 1L
	if (is.na(power))
	    stop(gettextf("Unit \"%s\" is not part of standard \"%s\"",
			  sQuote(units), sQuote(standard)), domain = NA)
    }
    unit <- units_map[power + 1L]
    ## SPECIAL: Use suffix 'bytes' instead of 'b' for 'legacy' (or always) ?
    if (power == 0 && standard == "legacy") unit <- "bytes"

    paste(round(x / base^power, digits=digits), unit)
}

print.object_size <-
    function(x, quote = FALSE, units = "b", standard = "auto", digits = 1L, ...)
{
    y <- format.object_size(x, units=units, standard=standard, digits=digits)
    if(quote) print.default(y, ...) else cat(y, "\n", sep = "")
    invisible(x)
}