I have been playing around with R6 ab bit and tried to implement a replacement function (similar in spirit to base::`diag<-`()). I wasn't hugely surprised to learn that the following does not work
library(R6)
r6_class <- R6Class("r6_class",
public = list(
initialize = function(x) private$data <- x,
elem = function(i) private$data[i],
`elem<-` = function(i, val) private$data[i] <- val
),
private = list(
data = NULL
)
)
test <- r6_class$new(1:5)
test$elem(2)
#> [1] 2
test$elem(2) <- 3
#> Error in test$elem(2) <- 3 :
#> target of assignment expands to non-language object
What does this correspond to in prefix notation? All of the following work as expected, so I guess it's none of these
test$`elem<-`(2, 3)
`$`(test, "elem<-")(2, 3)
I'm less interested in possible workarounds, but more in understanding why the above is invalid.
You are allowed to have nested complex assignments, e.g.
names(x)[3] <- "c"
but
test$elem(2) <- 3
is not of that form. It would be legal syntax as
elem(test,2) <- 3
which would expand to
*tmp* <- test
test <- `elem<-`(*tmp*, 2, 3)
but in the original form it would have to expand to
*tmp* <- 2
2 <- `test$elem<-`(*tmp*, 3)
(I've used test$elem<- in backticks to suggest it's the assignment version of the function returned by test$elem. That's not really right, there is no such thing.) The main problem is that the object being modified is 2, so you get the error message you saw: you're not allowed to modify 2.
If you want to do this in R6, I think you could do it something like this. Define a global function
`elem<-` <- function(x, arg, value) x$`elem<-`(arg, value)
and change the definition of your class elem<- method to
`elem<-` = function(i, val) { private$data[i] <- val; self }
Not all that convenient to need two definitions for every assignment method, but it appears to work.
Related
Using base R, is it possible to construct a closure from its 3 components directly? All I could manage so far was the slightly verbose
val <- 3L
fun_a <- function(x = 1L) val + x
fun_b <- function(x = 2L) val * x
fun_c <- function(){}
formals(fun_c) <- formals(fun_a)
body(fun_c) <- body(fun_b)
environment(fun_c) <- list2env(list(val = 5L))
fun_c()
#> [1] 5
Additionally, I cannot seem to figure out how to call function(). Some of the things I have tried:
`function`(formals(fun_a), body(fun_b))
#> Error: invalid formal argument list for "function"
`function`(as.pairlist(formals(fun_a)), body(fun_b))
#> Error: invalid formal argument list for "function"
do.call(`function`, c(formals(fun_a), body(fun_b)))
#> Error in do.call("function", c(formals(fun_a), body(fun_b))) :
#> invalid formal argument list for "function"
I'm aware of rlang::new_function() but here I'm looking for base R solutions.
I don't think you can do it in R code. The function implementing function is meant to be called from the parser, where
function(x = 3) { x }
is translated into something like
`function`( pairlist(as.name(x) = 3), quote({ x }))
but the line above is not legal in R: there's no way to say that the tag on an element of a list should be a name instead of a character value. You could write your function in C, or stick with your verbose solution of creating a template and replacing parts of it one at a time.
How to call the function with() within a function?
This example seems useless but point out the problem.
While this work fine:
dfTest <- data.frame( a = 1:10)
with(dfTest, lapply(dfTest, FUN = function(i){a}))
$a
[1] 1 2 3 4 5 6 7 8 9 10
Embedded within a function does not:
withLapply = function(x, FUN){
with(x,
lapply(x, FUN))
}
withLapply(dfTest, FUN = function(i){a})
Error in FUN(X[[i]], ...) : object 'a' not found
In the first case the function is defined within the with so free variables in it will refer to the with but in the second case the function is defined outside the with so free variables will refer to objects in the environment where it is defined, not to those of the with. In general, it is best just not to do this in the first place but if you must then this redefines the environment of FUN so that it will work.
# not recommended but it will make the code work
withLapply = function(x, FUN){
with(x,
lapply(x, {environment(FUN) <- environment(); FUN}))
}
withLapply(dfTest, function(i){a})
proto
This also works since proto resets the environment of functions passed to it. Again it is probably better just to avoid all these complications.
library(proto)
withLapply = function(x, FUN){
with(x,
lapply(x, proto(FUN = FUN)[["FUN"]]))
}
withLapply(dfTest, function(i){a})
I would like to have a function accept arguments in the usual R way, most of which will have defaults. But I would also like it to accept a list of named arguments corresponding to some or some or all of the formals. Finally, I would like arguments supplied to the function directly, and not through the list, to override the list arguments where they conflict.
I could do this with a bunch of nested if-statements. But I have a feeling there is some elegant, concise, R-ish programming-on-the-language solution -- probably multiple such solutions -- and I would like to learn to use them. To show the kind of solution I am looking for:
> arg_lst <- list(x=0, y=1)
> fn <- function(a_list = NULL, x=2, y=3, z=5, ...){
<missing code>
print(c(x, y, z))
}
> fn(a_list = arg_list, y=7)
Desired output:
x y z
0 7 5
I like a lot about #jdobres's approach, but I don't like the use of assign and the potential scoping breaks.
I also don't like the premise, that a function should be written in a special way for this to work. Wouldn't it be better to write a wrapper, much like do.call, to work this way with any function? Here is that approach:
Edit: solution based off of purrr::invoke
Thinking a bit more about this, purrr::invoke almost get's there - but it will result in an error if a list argument is also passed to .... But we can make slight modifications to the code and get a working version more concisely. This version seems more robust.
library(purrr)
h_invoke = function (.f, .x = NULL, ..., .env = NULL) {
.env <- .env %||% parent.frame()
args <- c(list(...), as.list(.x)) # switch order so ... is first
args = args[!duplicated(names(args))] # remove duplicates
do.call(.f, args, envir = .env)
}
h_invoke(fn, arg_list, y = 7)
# [1] 0 7 5
Original version borrowing heavily from jdobres's code:
hierarchical_do_call = function(f, a_list = NULL, ...){
formal_args = formals() # get the function's defined inputs and defaults
formal_args[names(formal_args) %in% c('f', 'a_list', '...')] = NULL # remove these two from formals
supplied_args <- as.list(match.call())[-1] # get the supplied arguments
supplied_args[c('f', 'a_list')] = NULL # ...but remove the argument list and the function
a_list[names(supplied_args)] = supplied_args
do.call(what = f, args = a_list)
}
fn = function(x=2, y=3, z=5) {
print(c(x, y, z))
}
arg_list <- list(x=0, y=1)
hierarchical_do_call(f = fn, a_list = arg_list, y=7)
# x y z
# 0 7 5
I'm not sure how "elegant" this is, but here's my best attempt to satisfy the OP's requirements. The if/else logic is actually pretty straightforward (no nesting needed, per se). The real work is in collecting and sanitizing the three different input types (formal defaults, the list object, and any supplied arguments).
fn <- function(a_list = NULL, x = 2, y = 3, z = 5, ...) {
formal_args <- formals() # get the function's defined inputs and defaults
formal_args[names(formal_args) %in% c('a_list', '...')] <- NULL # remove these two from formals
supplied_args <- as.list(match.call())[-1] # get the supplied arguments
supplied_args['a_list'] <- NULL # ...but remove the argument list
# for each uniquely named item among the 3 inputs (argument list, defaults, and supplied args):
for (i in unique(c(names(a_list), names(formal_args), names(supplied_args)))) {
if (!is.null(supplied_args[[i]])) {
assign(i, supplied_args[[i]])
} else if (!is.null(a_list[[i]])) {
assign(i, a_list[[i]])
}
}
print(c(x, y, z))
}
arg_lst <- list(x = 0, y = 1)
fn(a_list = arg_lst, y=7)
[1] 0 7 5
With a little more digging into R's meta-programming functions, it's actually possible to pack this hierarchical assignment into its own function, which is designed to operate on the function environment that called it. This makes it easier to reuse this functionality, but it definitely breaks scope and should be considered dangerous.
The "hierarchical assignment" function, mostly the same as before:
hierarchical_assign <- function(a_list) {
formal_args <- formals(sys.function(-1)) # get the function's defined inputs and defaults
formal_args[names(formal_args) %in% c('a_list', '...')] <- NULL # remove these two from formals
supplied_args <- as.list(match.call(sys.function(-1), sys.call(-1)))[-1] # get the supplied arguments
supplied_args['a_list'] <- NULL # ...but remove the argument list
# for each uniquely named item among the 3 inputs (argument list, defaults, and supplied args):
for (i in unique(c(names(a_list), names(formal_args), names(supplied_args)))) {
if (!is.null(supplied_args[[i]])) {
assign(i, supplied_args[[i]], envir = parent.frame())
} else if (!is.null(a_list[[i]])) {
assign(i, a_list[[i]], envir = parent.frame())
}
}
}
And the usage. Note that the the calling function must have an argument named a_list, and it must be passed to hierarchical_assign.
fn <- function(a_list = NULL, x = 2, y = 3, z = 5, ...) {
hierarchical_assign(a_list)
print(c(x, y, z))
}
[1] 0 7 5
I think do.call() does exactly what you want. It accepts a function and a list as arguments, the list being arguments for the functions. I think you will need a wrapper function to create this behavior of "overwriting defaults"
I'm trying to read a function call as a string and evaluate this function within another function. I'm using eval(parse(text = )) to evaluate the string. The function I'm calling in the string doesn't seem to have access to the environment in which it is nested. In the code below, my "isgreater" function finds the object y, defined in the global environment, but can't find the object x, defined within the function. Does anybody know why, and how to get around this? I have already tried adding the argument envir = .GlobalEnv to both of my evals, to no avail.
str <- "isgreater(y)"
isgreater <- function(y) {
return(eval(y > x))
}
y <- 4
test <- function() {
x <- 3
return(eval(parse(text = str)))
}
test()
Error:
Error in eval(y > x) : object 'x' not found
Thanks to #MrFlick and #r2evans for their useful and thought-provoking comments. As far as a solution, I've found that this code works. x must be passed into the function and cannot be a default value. In the code below, my function generates a list of results with the x variable being changed within the function. If anyone knows why this is, I would love to know.
str <- "isgreater(y, x)"
isgreater <- function(y, x) {
return(eval(y > x))
}
y <- 50
test <- function() {
list <- list()
for(i in 1:100) {
x <- i
bool <- eval(parse(text = str))
list <- append(list, bool)
}
return(list)
}
test()
After considering the points made by #r2evans, I have elected to change my approach to the problem so that I do not arrive at this string-parsing step. Thanks a lot, everyone.
I offer the following code, not as a solution, but rather as an insight into how R "works". The code does things that are quite dangerous and should only be examined for its demonstration of how to assert a value for x. Unfortunately, that assertion does destroy the x-value of 3 inside the isgreater-function:
str <- "isgreater(y)"
isgreater <- function(y) {
return(eval( y > x ))
}
y <- 4
test <- function() {
environment(isgreater)$x <- 5
return(eval(parse(text = str) ))
}
test()
#[1] FALSE
The environment<- function is used in the R6 programming paradigm. Take a look at ?R6 if you are interested in working with a more object-oriented set of structures and syntax. (I will note that when I first ran your code, there was an object named x in my workspace and some of my efforts were able to succeed to the extent of not throwing an error, but they were finding that length-10000 vector and filling up my console with logical results until I escaped the console. Yet another argument for passing both x and y to isgreater.)
I have been trying to get my ahead around validity of objects. I have read Hadley's advanced programming and get what he says about aiming at your feet (with a gun):
R doesn't protect you from yourself: you can easily shoot yourself in the foot, but if you don't aim the gun at your foot and pull the trigger, you won't have a problem.
So this holds for S3. Looking for a more rigorous implementation I looked into S4.
The man page to setValidity brought up the following:
setClass("track",
representation(x="numeric", y = "numeric"))
t1 <- new("track", x=1:10, y=sort(stats::rnorm(10)))
## A valid "track" object has the same number of x, y values
validTrackObject <- function(object) {
if(length(object#x) == length(object#y)) TRUE
else paste("Unequal x,y lengths: ", length(object#x), ", ",
length(object#y), sep="")
}
## assign the function as the validity method for the class
setValidity("track", validTrackObject)
## t1 should be a valid "track" object
validObject(t1)
## Now we do something bad
t2 <- t1
t2#x <- 1:20
## This should generate an error
## Not run: try(validObject(t2))
Bottom line: If I do not add validObject to the initializer or constructor there's little I can do. Also this post from Martin Morgan and bioconductor's Seth Falcon was interesting, still though I could always t2#x <- 1:1111.
I guess there's not much I can do about this? Though the matrix class for example makes me wonder if there's an option.
a <- matrix(c(1:12),3,4)
cbind(a,"somechar")
# or similarily
a[1,1] <- "b"
Obviously all elements of a matrix have to be of the same class. So that's why once a character is added all elements are coerced to the common denominator, which is class character.
So my question is: How is this possible? In which way is the matrix class defined, that it can protect the restriction "some class for all elements" by any means? And is there a way to implement such a restriction to a custom class, too?
E.g.: class of class 'customlist' that has to be a named list and names being restricted to only be two chars long.
AFAIK, there isn't a way to prevent you (or your users) doing silly things with assignment, short of possibly overriding <-. Since that is primitive, and quite fundamental to R, there is a danger of breaking other things if you go down that route.
If you use reference classes then you can include accessors which allow checks before assignments are made.
trackFactory <- setRefClass(
"track",
fields = list(
x = "numeric",
y = "numeric"
),
methods = list(
initialize = function(x, y)
{
assertIsValid(x, y)
x <<- x
y <<- y
},
assertIsValid = function(x, y)
{
if(length(x) != length(y))
{
stop(
"Unequal x,y lengths: ",
toString(c(length(x), length(y)))
)
}
},
setX = function(x)
{
assertIsValid(x, .self$y)
x <<- x
},
setY = function(y)
{
assertIsValid(.self$x, y)
y <<- y
}
)
)
track1 <- trackFactory$new(1:10, runif(10))
track1$setX(1:5)
## Error in assertIsValid(x, .self$y) : Unequal x,y lengths: 5, 10
Unfortunately, you can still use direct assignment to skip the checks.
track1$x <- 1:7