subvert external function's `deparse(substitute())` without `eval` - r

I'd like to wrap around the checkmate library's qassert to check multiple variable's specification at a time. Importantly, I'd like assertion errors to still report the variable name that's out of spec.
So I create checkargs to loop through input arguments. But to get the variable passed on to qassert, I use the same code for each loop -- that ambigious code string gets used for for the error message instead of the problematic variable name.
qassert() (via vname()) is getting what to display in the assertion error like deparse(eval.parent(substitute(substitute(x))). Is there any way to box up get(var) such that that R will see e.g. 'x' on deparse instead?
At least one work around is eval(parse()). But something like checkargs(x="n', system('echo malicious',intern=T),'") has me hoping for an alternative.
checkargs <- function(...) {
args<-list(...)
for(var in names(args))
checkmate::qassert(get(var,envir=parent.frame()),args[[var]])
# scary string interpolation alternative
#eval(parse(text=paste0("qassert(",var,",'",args[[var]], "')")),parent.frame())
}
test_checkargs <- function(x, y) {checkargs(x='b',y='n'); print(y)}
# checkargs is working!
test_checkargs(T, 1)
# [1] 1
# but the error message isn't helpful.
test_checkargs(1, 1)
# Error in checkargs(x = "b", y = "n") :
# Assertion on 'get(var, envir = parent.frame())' failed. Must be of class 'logical', not 'double'.
#
# want:
# Assertion on 'x' failed. ...

substitute() with as.name seems to do the trick. This still uses eval but without string interpolation.
eval(substitute(
qassert(x,spec),
list(x=as.name(var),
spec=args[[var]])),
envir=parent.frame())

Related

How to create a derivative function?

I was trying to create a function to derive an expression and the command gives the error below.
Can anybody help me ?
derivada<- function(x){
expression(x)
z <- D(x,"x")
print(z)
}
derivada(x^2)
Error in D(x, "x") : object 'x' not found
Something like
derivada <- function(x) D(substitute(x), "x")
derivada(x^2)
## 2 * x
the main point here is that substitute(x) captures the expression that was passed as an argument without attempting to evaluate it. (Dealing with expressions and controlling when they get evaluated is tricky.)
I had the function return an expression (which then gets auto-printed) rather than printing the result
I didn't use curly brackets because the function only takes one expression (although arguably using curly brackets anyway would be better practice)

What is the effect of including "<-" assignment operator as part of a custom R function name?

Below I define an R function that includes <- as part of its name. I realize, without understanding, that this function uses the value of the right hand side of <-.
Whilst R says that object myfun is not found whilst myfun<- is a function, I cannot understand how I am still able to wrap myx in myfun. In doing so, am I actually calling the myfun<- function? Any insights and guidance from the stackoverflow experts would be appreciated!
'myfun<-' <- function (x,value) x <- paste0(value, " says hello")
myx <- "my_x"
myy <- "my_y"
myfun(myx) <- myy
myx
[1] "my_y says hello"
myfun
Error: object 'myfun' not found
`myfun<-`
function (x,value) x <- paste0(value, " says hello")
As #akrun says, a myfun and amyfun<- would be two different functions, the first one for accessing a value from the symbol table, and the other for assigning a value to a symbol. Looking at the "R Language Definition" in the Function Calls" section we see that:
A special type of function calls can appear on the left hand side of the assignment operator as in
class(x) <- "foo"
What this construction really does is to call the function class<- with the original object and the right hand side. This function performs the modification of the object and returns the result which is then stored back into the original variable.
Your definition of the function also has a aspect that exposes a further misconception. The assignment operation inside the body of that function is entirely unnecessary. The value of the <- function is in fact the RHS's value, so unless you had return()-ed the x, the assignment to x would not be needed. Let's leave the assignment out of the function body and try to make the assignment without first creating an entry in the symbol table for myx:
'myfun<-' <- function (x,value) paste0(value, " says hello")
myy <- "my_y"
myfun(myx) <- myy
#Error in myfun(myx) <- myy : object 'myx' not found
The usual way of creating an entry in the symbol table for an item is to use one of the empty class constructors:
myx <- character(0)
myfun(myx) <- myy
myx
#[1] "my_y says hello" # Success
Note that the assignment operator in the function name directs that the symbol myx be used as the "target", so there is no need for it to have to be a value of "my_x" or anything resembling it's character value. You could have used numeric(0) and you would have only been confusing yourself when you went back later to read your code, but the interpreter would have simply coerced the class of the target symbol to character. R is very weakly typed.

Capture output of next method

I'm creating an S3 method for a generic defined in another package. An earlier method for the generic produces some console output that's not returned as part of the function return value, it's only printed to the console. I'd like to capture that output for use in my own method.
I tried using capture.output() on NextMethod(), but that just results in a bizarre error:
foo <- function(x, ...) UseMethod("foo")
foo.bar <- function(x, ...) cat(x, "\n")
foo.baz <- function(x, ...) capture.output(NextMethod())
foo(structure(1, class = "bar"))
#> 1
foo(structure(1, class = c("baz", "bar")))
#> Error: 'function' is not a function, but of type 8
Is this expected behaviour, a known limitation, or a bug? I couldn't find anything matching this error with a quick search.
How can I capture the output of the next S3 method in another S3 method?
This is... "expected behavior." I say that because I believe it's technically true, but there's probably no way for a user to expect it necessarily. If you don't care why it happens, but just want to see how to work around it, skip down to the heading "The Fix", because the following explanation of the error is a little involved.
What does 'function' is not a function, but of type 8 mean?
type 8 refers to a type 8 SEXP. From Section one of the R Internals Manual:
What R users think of as variables or objects are symbols which are
bound to a value. The value can be thought of as either a SEXP (a
pointer), or the structure it points to, a SEXPREC...
Currently SEXPTYPEs 0:10 and 13:25 are in use....
no SEXPTYPE Description
...
3 CLOSXP closures
...
8 BUILTINSXP builtin functions
NextMethod() expects a CLOSXP, not a BUILTINSXP. We can see this if we look at the source code (around line 717) of do_nextmethod(), the C function underlying NextMethod()
SEXP attribute_hidden do_nextmethod(SEXP call, SEXP op, SEXP args, SEXP env)
{
// Some code omitted
if (TYPEOF(s) != CLOSXP){ /* R_LookupMethod looked for a function */
if (s == R_UnboundValue)
error(_("no calling generic was found: was a method called directly?"));
else
errorcall(R_NilValue,
_("'function' is not a function, but of type %d"),
TYPEOF(s));
}
So why did that happen here? This is where it gets tricky. I believe it's because by passing NextMethod() through capture.output(), it gets called using eval(), which is a built-in (see builtins()).
So how can we deal with this? Read on...
The Fix
We can simulate capture output with clever use of sink(), cat(), and tempfile():
foo.baz <- function(x, ...) {
# Create a temporary file to store the output
tmp <- tempfile("tmp.txt")
# start sink()
sink(tmp)
# call NextMethod() just for the purpose of capturing output
NextMethod()
# stop sink'ing
sink()
# store the output in an R object
y <- readLines(tmp)
# here we'll cat() the output to make sure it worked
cat("The output was:", y, "\n")
# destroy the temporary file
unlink(tmp)
# and call NextMethod for its actual execution
NextMethod()
}
foo(structure(1, class = c("baz", "bar")))
# 1
I'm not sure if what you saw is documented or not: the documentation ?NextMethod makes clear that it isn't a regular function, but I didn't follow all the details to see if your usage would be allowed.
One way to do what you want would be
foo.baz <- function(x, ...) {class(x) <- class(x)[-1]; capture.output(foo(x, ...))}
This assumes that the method was called directly from a call to the generic; it won't work if there's a third level, and foo.baz was itself invoked by NextMethod().

Why subset doesn't mind missing subset argument for dataframes?

Normally I wonder where mysterious errors come from but now my question is where a mysterious lack of error comes from.
Let
numbers <- c(1, 2, 3)
frame <- as.data.frame(numbers)
If I type
subset(numbers, )
(so I want to take some subset but forget to specify the subset-argument of the subset function) then R reminds me (as it should):
Error in subset.default(numbers, ) :
argument "subset" is missing, with no default
However when I type
subset(frame,)
(so the same thing with a data.frame instead of a vector), it doesn't give an error but instead just returns the (full) dataframe.
What is going on here? Why don't I get my well deserved error message?
tl;dr: The subset function calls different functions (has different methods) depending on the type of object it is fed. In the example above, subset(numbers, ) uses subset.default while subset(frame, ) uses subset.data.frame.
R has a couple of object-oriented systems built-in. The simplest and most common is called S3. This OO programming style implements what Wickham calls a "generic-function OO." Under this style of OO, an object called a generic function looks at the class of an object and then applies the proper method to the object. If no direct method exists, then there is always a default method available.
To get a better idea of how S3 works and the other OO systems work, you might check out the relevant portion of the Advanced R site. The procedure of finding the proper method for an object is referred to as method dispatch. You can read more about this in the help file ?UseMethod.
As noted in the Details section of ?subset, the subset function "is a generic function." This means that subset examines the class of the object in the first argument and then uses method dispatch to apply the appropriate method to the object.
The methods of a generic function are encoded as
< generic function name >.< class name >
and can be found using methods(<generic function name>). For subset, we get
methods(subset)
[1] subset.data.frame subset.default subset.matrix
see '?methods' for accessing help and source code
which indicates that if the object has a data.frame class, then subset calls the subset.data.frame the method (function). It is defined as below:
subset.data.frame
function (x, subset, select, drop = FALSE, ...)
{
r <- if (missing(subset))
rep_len(TRUE, nrow(x))
else {
e <- substitute(subset)
r <- eval(e, x, parent.frame())
if (!is.logical(r))
stop("'subset' must be logical")
r & !is.na(r)
}
vars <- if (missing(select))
TRUE
else {
nl <- as.list(seq_along(x))
names(nl) <- names(x)
eval(substitute(select), nl, parent.frame())
}
x[r, vars, drop = drop]
}
Note that if the subset argument is missing, the first lines
r <- if (missing(subset))
rep_len(TRUE, nrow(x))
produce a vector of TRUES of the same length as the data.frame, and the last line
x[r, vars, drop = drop]
feeds this vector into the row argument which means that if you did not include a subset argument, then the subset function will return all of the rows of the data.frame.
As we can see from the output of the methods call, subset does not have methods for atomic vectors. This means, as your error
Error in subset.default(numbers, )
that when you apply subset to a vector, R calls the subset.default method which is defined as
subset.default
function (x, subset, ...)
{
if (!is.logical(subset))
stop("'subset' must be logical")
x[subset & !is.na(subset)]
}
The subset.default function throws an error with stop when the subset argument is missing.

In R, getting the following error: "attempt to replicate an object of type 'closure'"

I am trying to write an R function that takes a data set and outputs the plot() function with the data set read in its environment. This means you don't have to use attach() anymore, which is good practice. Here's my example:
mydata <- data.frame(a = rnorm(100), b = rnorm(100,0,.2))
plot(mydata$a, mydata$b) # works just fine
scatter_plot <- function(ds) { # function I'm trying to create
ifelse(exists(deparse(quote(ds))),
function(x,y) plot(ds$x, ds$y),
sprintf("The dataset %s does not exist.", ds))
}
scatter_plot(mydata)(a, b) # not working
Here's the error I'm getting:
Error in rep(yes, length.out = length(ans)) :
attempt to replicate an object of type 'closure'
I tried several other versions, but they all give me the same error. What am I doing wrong?
EDIT: I realize the code is not too practical. My goal is to understand functional programming better. I wrote a similar macro in SAS, and I was just trying to write its counterpart in R, but I'm failing. I just picked this as an example. I think it's a pretty simple example and yet it's not working.
There are a few small issues. ifelse is a vectorized function, but you just need a simple if. In fact, you don't really need an else -- you could just throw an error immediately if the data set does not exist. Note that your error message is not using the name of the object, so it will create its own error.
You are passing a and b instead of "a" and "b". Instead of the ds$x syntax, you should use the ds[[x]] syntax when you are programming (fortunes::fortune(312)). If that's the way you want to call the function, then you'll have to deparse those arguments as well. Finally, I think you want deparse(substitute()) instead of deparse(quote())
scatter_plot <- function(ds) {
ds.name <- deparse(substitute(ds))
if (!exists(ds.name))
stop(sprintf("The dataset %s does not exist.", ds.name))
function(x, y) {
x <- deparse(substitute(x))
y <- deparse(substitute(y))
plot(ds[[x]], ds[[y]])
}
}
scatter_plot(mydata)(a, b)

Resources