I am new in language R,I found something special with it.
When using the method rm(),I wonder why I can't pass ls() as a parameter.
while using rm(list = ls()) will pass the compilation.
The method ls() will return a data whose type is List,won't it ?
It is the first time that I ask a question at foreign website, and my English is terrible, sorry! Waiting for your answers!
It has to do with the ... special argument in R (AKA "dot-dot-dot" or "ellipsis"). ... captures all unnamed arguments (as well as undocumented named arguments), "positionnally".
See ?rm for its arguments: rm(..., list = character(), pos = -1, envir = as.environment(pos), inherits = FALSE).
Since ... is the first argument, it captures ls() in rm(ls()).
But there are expectations on ... as you can see in the source code of rm (simply type rm at the command line):
function (..., list = character(), pos = -1, envir = as.environment(pos),
inherits = FALSE)
{
dots <- match.call(expand.dots = FALSE)$...
if (length(dots) && !all(vapply(dots, function(x) is.symbol(x) ||
is.character(x), NA, USE.NAMES = FALSE)))
stop("... must contain names or character strings")
names <- vapply(dots, as.character, "")
if (length(names) == 0L)
names <- character()
list <- .Primitive("c")(list, names)
.Internal(remove(list, envir, inherits))
}
Here it is is.symbol() that fails.
Maybe it will be easier with an example:
foo <- 1L
bar <- 2L
rm(ls())
# Error
ls()
# [1] "bar" "foo"
rm(c("foo", "bar"))
# Same error
rm("foo", "bar")
# OK
If you want to investigate further, I suggest: debugonce(rm) then rm(ls()) then step by step execution (easier in an IDE like RStudio).
Related
I wrote a wrapper around ftable because I need to compute flat tables with frequency and percentage for many variables. As ftable method for class "formula" uses non-standard evaluation, the wrapper relies on do.call and match.call to allow the use of the subset argument of ftable (more details in my previous question).
mytable <- function(...) {
do.call(what = ftable,
args = as.list(x = match.call()[-1]))
# etc
}
However, I cannot use this wrapper with lapply nor with:
# example 1: error with "lapply"
lapply(X = warpbreaks[c("breaks",
"wool",
"tension")],
FUN = mytable,
row.vars = 1)
Error in (function (x, ...) : object 'X' not found
# example 2: error with "with"
with(data = warpbreaks[warpbreaks$tension == "L", ],
expr = mytable(wool))
Error in (function (x, ...) : object 'wool' not found
These errors seem to be due to match.call not being evaluated in the right environment.
As this question is closely linked to my previous one, here is a sum up of my problems:
The wrapper with do.call and match.call cannot be used with lapply or with.
The wrapper without do.call and match.call cannot use the subset argument of ftable.
And a sum up of my questions:
How can I write a wrapper which allows both to use the subset argument of ftable and to be used with lapply and with? I have ideas to avoid the use of lapply and with, but I am looking to understand and correct these errors to improve my knowledge of R.
Is the error with lapply related to the following note from ?lapply?
For historical reasons, the calls created by lapply are unevaluated,
and code has been written (e.g., bquote) that relies on this. This
means that the recorded call is always of the form FUN(X[[i]], ...),
with i replaced by the current (integer or double) index. This is not
normally a problem, but it can be if FUN uses sys.call or match.call
or if it is a primitive function that makes use of the call. This
means that it is often safer to call primitive functions with a
wrapper, so that e.g. lapply(ll, function(x) is.numeric(x)) is
required to ensure that method dispatch for is.numeric occurs
correctly.
The problem with using match.call with lapply is that match.call returns the literal call that passed into it, without any interpretation. To see what's going on, let's make a simpler function which shows exactly how your function is interpreting the arguments passed into it:
match_call_fun <- function(...) {
call = as.list(match.call()[-1])
print(call)
}
When we call it directly, match.call correctly gets the arguments and puts them in a list that we can use with do.call:
match_call_fun(iris['Species'], 9)
[[1]]
iris["Species"]
[[2]]
[1] 9
But watch what happens when we use lapply (I've only included the output of the internal print statement):
lapply('Species', function(x) match_call_fun(iris[x], 9))
[[1]]
iris[x]
[[2]]
[1] 9
Since match.call gets the literal arguments passed to it, it receives iris[x], not the properly interpreted iris['Species'] that we want. When we pass those arguments into ftable with do.call, it looks for an object x in the current environment, and then returns an error when it can't find it. We need to interpret
As you've seen, adding envir = parent.frame() fixes the problem. This is because, adding that argument tells do.call to evaluate iris[x] in the parent frame, which is the anonymous function in lapply where x has it's proper meaning. To see this in action, let's make another simple function that uses do.call to print ls from 3 different environmental levels:
z <- function(...) {
print(do.call(ls, list()))
print(do.call(ls, list(), envir = parent.frame()))
print(do.call(ls, list(), envir = parent.frame(2)))
}
When we call z() from the global environment, we see the empty environment inside the function, then the Global Environment:
z()
character(0) # Interior function environment
[1] "match_call_fun" "y" "z" # GlobalEnv
[1] "match_call_fun" "y" "z" # GlobalEnv
But when we call from within lapply, we see that one level of parent.frame up is the anonymous function in lapply:
lapply(1, z)
character(0) # Interior function environment
[1] "FUN" "i" "X" # lapply
[1] "match_call_fun" "y" "z" # GlobalEnv
So, by adding envir = parent.frame(), do.call knows to evaluate iris[x] in the lapply environment where it knows that x is actually 'Species', and it evaluates correctly.
mytable_envir <- function(...) {
tab <- do.call(what = ftable,
args = as.list(match.call()[-1]),
envir = parent.frame())
prop <- prop.table(x = tab,
margin = 2) * 100
bind <- cbind(as.matrix(x = tab),
as.matrix(x = prop))
margin <- addmargins(A = bind,
margin = 1)
round(x = margin,
digits = 1)
}
# This works!
lapply(X = c("breaks","wool","tension"),
FUN = function(x) mytable_envir(warpbreaks[x],row.vars = 1))
As for why adding envir = parent.frame() makes a difference since that appears to be the default option. I'm not 100% sure, but my guess is that when the default argument is used, parent.frame is evaluated inside the do.call function, returning the environment in which do.call is run. What we're doing, however, is calling parent.frame outside do.call, which means it returns one level higher than the default version.
Here's a test function that takes parent.frame() as a default value:
fun <- function(y=parent.frame()) {
print(y)
print(parent.frame())
print(parent.frame(2))
print(parent.frame(3))
}
Now look at what happens when we call it from within lapply both with and without passing in parent.frame() as an argument:
lapply(1, function(y) fun())
<environment: 0x12c5bc1b0> # y argument
<environment: 0x12c5bc1b0> # parent.frame called inside
<environment: 0x12c5bc760> # 1 level up = lapply
<environment: R_GlobalEnv> # 2 levels up = globalEnv
lapply(1, function(y) fun(y = parent.frame()))
<environment: 0x104931358> # y argument
<environment: 0x104930da8> # parent.frame called inside
<environment: 0x104931358> # 1 level up = lapply
<environment: R_GlobalEnv> # 2 levels up = globalEnv
In the first example, the value of y is the same as what you get when you call parent.frame() inside the function. In the second example, the value of y is the same as the environment one level up (inside lapply). So, while they look the same, they're actually doing different things: in the first example, parent.frame is being evaluated inside the function when it sees that there is no y= argument, in the second, parent.frame is evaluated in the lapply anonymous function first, before calling fun, and then is passed into it.
As you only want to pass all the arguments passed to ftable u do not need the do.call().
mytable <- function(...) {
tab <- ftable(...)
prop <- prop.table(x = tab,
margin = 2) * 100
bind <- cbind(as.matrix(x = tab),
as.matrix(x = prop))
margin <- addmargins(A = bind,
margin = 1)
return(round(x = margin,
digits = 1))
}
The following lapply creates a table for every Variable separatly i don't know if that is what you want.
lapply(X = c("breaks",
"wool",
"tension"),
FUN = function(x) mytable(warpbreaks[x],
row.vars = 1))
If you want all 3 variables in 1 table
warpbreaks$newVar <- LETTERS[3:4]
lapply(X = cbind("c(\"breaks\", \"wool\", \"tension\")",
"c(\"newVar\", \"tension\",\"wool\")"),
FUN = function(X)
eval(parse(text=paste("mytable(warpbreaks[,",X,"],
row.vars = 1)")))
)
Thanks to this issue, the wrapper became:
# function 1
mytable <- function(...) {
do.call(what = ftable,
args = as.list(x = match.call()[-1]),
envir = parent.frame())
# etc
}
Or:
# function 2
mytable <- function(...) {
mc <- match.call()
mc[[1]] <- quote(expr = ftable)
eval.parent(expr = mc)
# etc
}
I can now use the subset argument of ftable, and use the wrapper in lapply:
lapply(X = warpbreaks[c("wool",
"tension")],
FUN = function(x) mytable(formula = x ~ breaks,
data = warpbreaks,
subset = breaks < 15))
However I do not understand why I have to supply envir = parent.frame() to do.call as it is a default argument.
More importantly, these methods do not resolve another issue: I can not use the subset argument of ftable with mapply.
I know about methods(), which returns all methods for a given class. Suppose I have x and I want to know what method will be called when I call foo(x). Is there a oneliner or package that will do this?
The shortest I can think of is:
sapply(class(x), function(y) try(getS3method('foo', y), silent = TRUE))
and then to check the class of the results... but is there not a builtin for this?
Update
The full one liner would be:
fm <- function (x, method) {
cls <- c(class(x), 'default')
results <- lapply(cls, function(y) try(getS3method(method, y), silent = TRUE))
Find(function (x) class(x) != 'try-error', results)
}
This will work with most things but be aware that it might fail with some complex objects. For example, according to ?S3Methods, calling foo on matrix(1:4, 2, 2) would try foo.matrix, then foo.numeric, then foo.default; whereas this code will just look for foo.matrix and foo.default.
findMethod defined below is not a one-liner but its body has only 4 lines of code (and if we required that the generic be passed as a character string it could be reduced to 3 lines of code). It will return a character string representing the name of the method that would be dispatched by the input generic given that generic and its arguments. (Replace the last line of the body of findMethod with get(X(...)) if you want to return the method itself instead.) Internally it creates a generic X and an X method corresponding to each method of the input generic such that each X method returns the name of the method of the input generic that would be run. The X generic and its methods are all created within the findMethod function so they disappear when findMethod exits. To get the result we just run X with the input argument(s) as the final line of the findMethod function body.
findMethod <- function(generic, ...) {
ch <- deparse(substitute(generic))
f <- X <- function(x, ...) UseMethod("X")
for(m in methods(ch)) assign(sub(ch, "X", m, fixed = TRUE), "body<-"(f, value = m))
X(...)
}
Now test it. (Note that the one-liner in the question fails with an error in several of these tests but findMethod gives the expected result.)
findMethod(as.ts, iris)
## [1] "as.ts.default"
findMethod(print, iris)
## [1] "print.data.frame"
findMethod(print, Sys.time())
## [1] "print.POSIXct"
findMethod(print, 22)
## [1] "print.default"
# in this example it looks at 2nd component of class vector as no print.ordered exists
class(ordered(3))
## [1] "ordered" "factor"
findMethod(print, ordered(3))
## [1] "print.factor"
findMethod(`[`, BOD, 1:2, "Time")
## [1] "[.data.frame"
I use this:
s3_method <- function(generic, class, env = parent.frame()) {
fn <- get(generic, envir = env)
ns <- asNamespace(topenv(fn))
tbl <- ns$.__S3MethodsTable__.
for (c in class) {
name <- paste0(generic, ".", c)
if (exists(name, envir = tbl, inherits = FALSE)) {
return(get(name, envir = tbl))
}
if (exists(name, envir = globalenv(), inherits = FALSE)) {
return(get(name, envir = globalenv()))
}
}
NULL
}
For simplicity this doesn't return methods defined by assignment in the calling environment. The global environment is checked for convenience during development. These are the same rules used in r-lib packages.
NB: This question is not a duplicate of How to use R's ellipsis feature when writing your own function?. That question asks how to use ellipses, and in particular, "how can [one] convert the ellipsis from the function's signature into, for example, a list?" Below I don't ask anything of the sort. I am asking why my use of ellipses fails to produce the expected result.
As an example, the function my.ls below is meant to be a wrapper around base::ls that makes all.names = TRUE the default:
my.ls <- function (...) base::ls(..., all.names = TRUE)
I had expected that, with this definition, my.ls() would produce the same value as base::ls(all.names = TRUE) does. To my surprise, the values from these two expressions are not even close.
For example:
% /usr/bin/R --quiet --vanilla
> x <- 3; .y <- 1; z <- 4
> base::ls(all.names = TRUE)
[1] "x" ".y" "z"
> my.ls <- function (...) base::ls(..., all.names = TRUE)
> my.ls()
[1] "..."
What am I doing wrong?
Is it because the default argument for envir in base::ls is as.environement(pos)?
Adding envir = gloal.env() seems to work for me, assuming you are working from the global environment.
OK, I figured out the problem. The following implementation of my.ls is closer to what I'm after:
my.ls <- function (name, all.names = TRUE, ...) {
if (missing(name))
return(my.ls(parent.frame(1), all.names = all.names, ...))
base::ls(name, all.names = all.names, ...)
}
How can I drop data frames with less than 3 variables? I tried this:
`1001.AFG.1.A`<-data.frame(x = 1, y = 1:10)
apply(ls(), function(x) {if (dim(x)[2]<3) rm(x)})
The error message is:
Error in match.fun(FUN) : argument "FUN" is missing, with no default
1) The first line produces a named logical vector, to.rm with a component for each object which is TRUE if that object should be removed and FALSE otherwise. Thus names(to.rm)[to.rm] are the objects to be removed so feed that into rm. By splitting it into two steps, this lets one review to.rm before actually performing the rm.
to.rm <- unlist(eapply(.GlobalEnv, function(x) is.data.frame(x) && ncol(x) < 3))
rm(list = names(to.rm)[to.rm], envir = .GlobalEnv)
If this is entered directly into the global environment (i.e. not placed in a fucntion) then envir = .GlobalEnv in the last line is the default and can be omitted.
2) Another way is to iterate through the object names of env as shown. We have provided a verbose argument to show what it is doing and a dryrun argument to show what it would remove without actually removing anything.
rm2 <- function(env = .GlobalEnv, verbose = FALSE, dryrun = FALSE, all.names = FALSE) {
for(nm in ls(env, all.names = all.names)) {
obj <- get(nm, env)
if (is.data.frame(obj) && ncol(obj) < 3) {
if (verbose || dryrun) cat("removing", nm, "\n")
if (!dryrun) rm(list = nm, envir = env)
}
}
}
rm2(dryrun = TRUE)
rm2(verbose = TRUE)
Update Added envir argument to rm in (1). It was already in (2).
Update 2 Minor imrovements to (2).
You may want to try :
sapply(ls(), function(x) {
if (is.data.frame(get(x)) && dim(get(x))[2]<3) rm(list=x,envir=.GlobalEnv)
})
I you want to suppress the printings, you can do :
invisible(sapply(ls(), function(x) {
if (is.data.frame(get(x)) && dim(get(x))[2]<3) rm(list=x,envir=.GlobalEnv)
}))
I have a series of objects storing the results of some statistical models in my workspace. Call them "model1", "model2", etc. Each of these models has the same set of named elements attached, $coef, for example. I would like to extract into a list or vector the values stored in a particular element from all objects containing the string "model".
The following code entered at the command line does what I want:
unlist(lapply(parse(text = paste0(ls()[grep("model", ls() )], "$", "coef")), eval))
From this, I've created the following generic function:
get.elements <- function(object, element) {
unlist(lapply(parse(text = paste0(ls()[grep(object, ls() )], "$", element)), eval))
}
However, when I run this function I get the following error:
Error in parse(text = paste0(ls()[grep(object, ls() )], "$", element)) :
<text>:1:1: unexpected '$'
1: $
^
Q1. Why does this code work when run from the command line but not as a function, and more importantly, how do I fix it?
Q2. Even better, is there a simpler method that will accomplish the same thing? This seems like such a common task for statisticians and simulation modelers that I would expect some kind of command in the base package, yet I've been unable to find anything. Surely there must be a more elegant way to do this than my cumbersome method.
Thanks for all help.
--Dave
Q1) The code fails because ls() looks in the environment of the function and since there are no matching objects there,
paste0(ls()[grep(object, ls() )], "$", element)
is equivalent to
paste0("$", element)
To get ls() to look in your workspace, you'd need ls(pos = 1).
Q2) This is a common task, but as far as know there isn't a function to do this because where the models are, what they are called, what objects you want to extract and how you want them returned will depend on your requirements. A slightly neater version of what you propose above would be
nm <- paste0("model", 1:2) # adjust numbers as required
unlist(lapply(nm, function(x) get(nm)$coef))
Alternatively you could put your models in a list and use
modList <- list(model1, model2)
unlist(lapply(modList, "[[", "coefficients"))
You can use map from the purrr package.
l1 <- list(a1 = 3, a2 = 2)
l2 <- list(a1 = 334, a2 = 34)
l3 <- list(a1 = 90, a2 = 112)
l <- list(l1, l2, l3)
purrr::map(l, "a1")
this gives:
### Result
[[1]]
[1] 3
[[2]]
[1] 334
[[3]]
[1] 90
This is a way to obtain the desired output:
get.elements <- function(object, element) {
unlist(lapply(ls(pattern = object, .GlobalEnv),
function(x) get(x, .GlobalEnv)[[element, exact = FALSE]]))
}
Both element and object are character strings.
Note that I used the argument exact = FALSE, since the element is named coefficients, not coef. In this way, you can still use element = "coef".