# what about
gensym <- function(root="GeneratedSymbolname", pool=c(letters,
LETTERS,
0:1), n=16, sep="_")
{
todo <- TRUE
while (todo){
symbolname <- paste(root, paste(sample(pool, n, TRUE),
collapse=""),
sep=sep)
todo <- length(getAnywhere(symbolname)$objs)
}
symbolname
}
# but this requires a slightly changed version of getAnywhere()
# which currently finds: getAnywhere("find")
# but does not find: symbolname <- "find"; getAnywhere(symbolname)
# (BTW current getAnywhere() has returnvalue$objs whereas the documentation
says returnvalue$funs)
# the following patch avoids this problem and is more aligned with get()
getAnywhere <- function(x)
{
stopifnot(is.character(x))
objs <- list()
where <- character(0)
visible <- logical(0)
if (length(pos <- find(x, numeric = TRUE))) {
objs <- lapply(pos, function(pos, x) get(x, pos = pos),
x = x)
where <- names(pos)
visible <- rep.int(TRUE, length(pos))
}
if (length(grep(".", x, fixed = TRUE))) {
np <- length(parts <- strsplit(x, ".", fixed =
TRUE)[[1]])
for (i in 2:np) {
gen <- paste(parts[1:(i - 1)], collapse = ".")
cl <- paste(parts[i:np], collapse = ".")
if (!is.null(f <- getS3method(gen, cl, TRUE))) {
ev <- topenv(environment(f), NULL)
nmev <- if (isNamespace(ev))
getNamespaceName(ev)
else NULL
objs <- c(objs, f)
msg <- paste("registered S3 method for", gen)
if (!is.null(nmev))
msg <- paste(msg, "from namespace", nmev)
where <- c(where, msg)
visible <- c(visible, FALSE)
}
}
}
for (i in loadedNamespaces()) {
ns <- asNamespace(i)
if (exists(x, envir = ns, inherits = FALSE)) {
f <- get(x, envir = ns, inherits = FALSE)
objs <- c(objs, f)
where <- c(where, paste("namespace", i, sep =
":"))
visible <- c(visible, FALSE)
}
}
ln <- length(objs)
dups <- rep.int(FALSE, ln)
objs2 <- lapply(objs, function(x) {
if (is.function(x))
environment(x) <- NULL
x
})
if (ln > 1)
for (i in 2:ln) for (j in 1:(i - 1)) if (identical(objs2[[i]],
objs2[[j]])) {
dups[i] <- TRUE
break
}
res <- list(name = x, objs = objs, where = where, visible = visible,
dups = dups)
class(res) <- "getAnywhere"
res
}
--
Ab sofort DSL-Tarif ohne Grundgeb??hr: http://www.gmx.net/info