Nothing
#' Class aoos
#'
#' This is an environment with some methods. Every class defined by \code{defineClass} will inherit from aoos. Summary will show a list of public and private members with approximated memory usage.
#'
#' @exportClass aoos
#' @rdname aoos
setClass("aoos", contains = c("environment", "VIRTUAL"))
#' @rdname aoos
#' @export
setMethod("show", signature = c(object = "aoos"),
function(object) {
cat("Class: ", class(object), "\n", sep = "")
cat("public member:\n")
lapply(ls(object), function(n) cat(" ", n, "\n"))
})
#' @rdname aoos
#' @export
#' @param x object
#' @param name member name
setMethod("$", signature = c(x = "aoos"),
function(x, name) {
privacy <- !any(sapply(envirSearch(list(parent.frame())),
identical, y = parent.env(x)))
getMember(name, x, privacy)
})
envirSearch <- function(envList = list(environment())) {
if(any(sapply(envList, identical, y = emptyenv()))) {
envList
} else {
envirSearch(c(envList, list(parent.env(envList[[length(envList)]]))))
}
}
getMember <- function(name, object, privacy = FALSE) {
if(!privacy) {
getPublicRepresentation(get(name, envir = parent.env(object)))
} else {
if(exists(name, envir = object, inherits = FALSE)) {
getPublicRepresentation(get(name, envir = parent.env(object)))
} else {
stop(paste(name, "is not a public member."))
}
}
}
#' @rdname aoos
#' @export
#' @param value value to assign to. Will throw an error.
setMethod("$<-", signature = c(x = "aoos"),
function(x, name, value) {
privacy <- !any(sapply(envirSearch(list(parent.frame())),
identical, y = parent.env(x)))
if (privacy) {
stop("If you need to extend object, modify class definition.")
} else {
assign(name, value = value, envir = parent.env(x))
}
x
})
#' @rdname aoos
#' @param object object
#' @param ... arguments passed to method (not used).
#' @export
summary.aoos <- function(object, ...) {
out <- envSize(parent.env(object))
rownames(out) <- NULL
out
}
envSize <- function(env) {
napply <- function(names, fn) sapply(names, function(x) fn(get(x, pos = env)))
names <- ls(env, all.names = TRUE)
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 <- napply(names, object.size)
obj.subsizes <- napply(names, function(x) {
if (inherits(x, "publicFunction") && !identical(environment(x), env))
envSize(environment(x))
})
obj.subsizes <- do.call(rbind, obj.subsizes)
obj.subsizes$Name <- rownames(obj.subsizes)
out <- rbind(data.frame(
Name = names(obj.type),
Type = obj.type,
"Size.Mib" = round(obj.size / (1024^2), 1),
stringsAsFactors = FALSE),
obj.subsizes)
out[order(out$Name, out$Type), ]
}
#' @rdname aoos
#' @export
setMethod("as.environment", "aoos", function(x) parent.env(x))
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.