I have some experience working with S4 objects and their slots, so I know how to access specific slots and sub-slots. What I'd like to learn is how to "de-slotify" an object in the way that unlist takes apart an S3 list.
My immediate goal is to have an S4 counterpart to one of my toys which returns the number of elements of an object:
lssize<-function(items){
if (any(sapply(sapply(items,get),typeof)=='closure')){
warning('Closures in list, will ignore.')
items<-items[(sapply(sapply(bar,get),typeof)=='closure')!=TRUE]
}
sizes<-sapply(sapply(sapply(sapply(items,get,simplify=F), unlist,simplify=F), as.vector,simplify=F), length)
return(sizes)
}
(no fair laughing at my code :-) ). I am hoping not to have to write some recursion routine which extracts slots one at a time to convert them.
Edit: I know object.size will return the bytecount; not what I'm after here.
(This is revised to be closer to a previous, deleted answer, using slotName and slot rather than relying on attributes). We could write a function that tests whether an instance is an S4 object, and if so extracts all the slots as a list and recurses
f = function(x) {
if (isS4(x)) {
nms <- slotNames(x)
names(nms) <- nms
lapply(lapply(nms, slot, object=x), f)
} else x
}
and then
A = setClass("A", representation(x="numeric"))
B = setClass("B", representation(a="A", b="numeric"))
f(B())
to arrive at a plain old list that we could use for whatever purposes we want.
$a
$a$x
numeric(0)
$a$class
[1] "A"
attr(,"package")
[1] ".GlobalEnv"
$b
numeric(0)
$class
[1] "B"
attr(,"package")
[1] ".GlobalEnv"
f might need to be enhanced, e.g., to handle NULL values or S4 classes made from S3 classes via setOldClass. The code to validObject would be my choice of places to look for a more comprehensive traversal.
A generalization might make a visitor, along the lines of
visitLeavesWith <-
function(object, FUN, ...)
{
f = function(x) {
if (isS4(x)) {
slots <- setNames(slotNames(x), slotNames(x))
lapply(lapply(slots, slot, object=x), f)
} else FUN(x, ...)
}
f(object)
}
e.g.,
visitLeavesWith(B(), length)
Related
I need to build a lot of functions with lots of different arguments, though they otherwise share a lot of code and structure.
To avoid duplication, I thought I'd be clever and build myself a function factory (aka closure).
I can't figure out how to pass the function arguments inside the function factory.
My use case is a bunch of S3 constructor functions, all of which share the same validation mechanism.
So I'll use that as an example to explain my problem.
Say, I have a ClassA and ClassB, each of which require their own arguments in the respective constructor functions:
ClassA <- function(A_arg1, A_arg2) {
# some class-SPECIFIC construction magic happens, say
out <- list(A_arg1, A_arg2)
# some GENERAL construction magic happens
class(out) <- "ClassA"
return(out)
}
ClassB <- function(B_arg1, B_arg2) {
# some class-SPECIFIC construction magic happens, say
out <- B_arg1 + B_arg2
# some GENERAL construction magic happens
class(out) <- "ClassB"
return(out)
}
Obviously, I'd love to avoid the duplication in the general part of the constructor functions, so a function factory that could be used like so would be nice:
ClassA <- produce_class_constructor(classname = "ClassA", fun = function(A_arg1, A_arg2) {return(list(A_arg1, A_arg2))})
This should, ideally, yield the exact same function as the above manually constructed ClassA function, with the general part factored out.
Here's my attempt at building that function factory:
produce_class_constructor <- function(classname, fun) {
class_specific_arguments <- formals(fun = fun) # this works just fine on the console
construct_class <- function(class_specific_arguments) {
# here runs the class-specific stuff
out <- fun(class_specific_arguments)
# here runs the general stuff
class(out) <- classname
}
}
This however, does not work, because the resulting constructor function only has a class_specific_arguments-argument, not the, well, actual A_arg1, and A_arg2.
Is there way to do this?
Am I doing this wrong?
(It's really important to me that the resulting class constructor functions have properly named arguments, so a ... approach won't work).
Here's my attempt:
produce_class_constructor <- function(classname, fun) {
out_fun <- function() {
out_obj <- do.call(fun, as.list(environment()))
class(out_obj) <- classname
out_obj
}
formals(out_fun) <- formals(fun)
out_fun
}
ClassA <- produce_class_constructor(classname = "ClassA",
fun = function(A_arg1, A_arg2) {list(A_arg1, A_arg2)})
ClassA(1, 2)
#[[1]]
#[1] 1
#
#[[2]]
#[1] 2
#
#attr(,"class")
#[1] "ClassA"
ClassB <- produce_class_constructor(classname = "ClassB",
fun = function(B_arg1, B_arg2) {B_arg1 + B_arg2})
ClassB(B_arg2 = 2, 1)
#[1] 3
#attr(,"class")
#[1] "ClassB"
Idea with as.list(environment()) taken from this question. Note that you should be extra careful along that path, as ?formals says, "this is
advanced, dangerous coding".
This question already has answers here:
Explain a lazy evaluation quirk
(2 answers)
Closed 7 years ago.
In R, I wanted to create a class (R6Class) that when calling initialize creates few dynamic methods (the number of methods and its names depends on parameters in initialize). But I get into strange problem with environments.
Here is a simplified version of code that doesn't work.
library(R6)
ffactory <- function(i) {
function() i
}
A <- R6Class(
lock_objects=FALSE,
public=list(
initialize=function(args) {
for (i in args) {
self[[i]] <- ffactory(i)
}
}
)
)
a <- A$new(c('a', 'b', 'c'))
Now:
> a$a()
[1] "c"
> a$b()
[1] "c"
> a$c()
[1] "c"
In order to find what was wrong I had added a line that prints environment in ffactory function. That is
ffactory <- function(i) {
print(ls.str())
function() i
}
And now it has started to work!!!
> a$a()
[1] "a"
> a$b()
[1] "b"
> a$c()
[1] "c"
So why? There should be something I don't understand. Observer effect or what? :)
What is the magic of the line print(ls.str())? Actually I cannot remove neither print nor str from this line. Of course it is so silly to have a line like that. Not to mention garbage on the screen.
You have encountered lazy evaluation - R waits as long as it is able to before evaluating i - and in the former case, i will be evaluated at its last value in all instances. There's nothing really special about the combination of print and ls.str; anything that forces i to be evaluated prior to your method calls (a$a(), a$b(), etc...) will do the same.
Formally, this is what force is used for:
ffactory <- function(i) {
force(i);
function() i
}
R> a$a()
#[1] "a"
R> a$b()
#[1] "b"
R> a$c()
#[1] "c"
However, this also happens to do the job:
ffactory <- function(i) {
#force(i);
.z <- capture.output(cat(i, "\n"))
function() i
}
R> a$a()
#[1] "a"
R> a$b()
#[1] "b"
R> a$c()
#[1] "c"
There are presumably countless ways to force evaluation; I would argue that using force makes your intention most clear, though.
Quoting the help file directly,
force forces the evaluation of a formal argument. This can be useful
if the argument will be captured in a closure by the lexical scoping
rules and will later be altered by an explicit assignment or an
implicit assignment in a loop or an apply function.
and subsequently,
This is semantic sugar: just evaluating the symbol will do the same
thing (see the examples).
In fact, looking at how force is defined,
R> force
#function (x)
# x
#<bytecode: 0x3b7b528>
#<environment: namespace:base>
You could even get away with
ffactory <- function(i) {
i; function() i
}
But as noted, I think the explicitly calling force will make your code more readable.
I am trying to write an rbind method for a particular class. Here's a simple example where it doesn't work (at least for me):
rbind.character <- function(...) {
do.call("paste", list(...))
}
After entering this function, I seemingly can confirm that it is a valid method that R knows about:
> methods("rbind")
[1] rbind.character rbind.data.frame rbind.rootogram* rbind.zoo*
see '?methods' for accessing help and source code
However, it is not recognized if I try to use it:
> rbind("abc", "xyz")
[,1]
[1,] "abc"
[2,] "xyz"
> #### compared with ####
> rbind.character("abc", "xyz")
[1] "abc xyz"
The help page says that dispatch is performed internally as follows:
For each argument we get the list of possible class memberships from
the class attribute.
We inspect each class in turn to see if there is an applicable
method.
If we find an applicable method we make sure that it is identical to
any method determined for prior arguments. If it is identical, we
proceed, otherwise we immediately drop through to the default code.
With rbind("abc", "xyz"), I believe all these criteria are satisfied. What gives, and how can I fix it?
attributes("abc")
#NULL
A character vector doesn't have a class attribute. I don't think a method can be dispatched by rbind for the implicit classes.
A workaround would be to define your own class:
b <- "abc"
class(b) <- "mycharacter"
rbind.mycharacter <- function(...) {
do.call("paste", list(...))
}
rbind(b, b)
# [1] "abc abc"
The reason why it does not work with character was nicely explained by Roland in his comment.
rbind is not a standard S3 function, so you cannot "intercept" it for character.
Luckily, you can override the default implementation. Try:
rbind.character <- function(...) {
print("hello from rbind.character")
}
rbind <- function(...) {
args <- list(...)
if (all(vapply(args, is.character, logical(1)))) {
rbind.character(...)
} else {
base::rbind(...)
}
}
Basically, we check if the arguments are all characters. If so, we call our character function. If not, we call the default implementation.
I'm working on an R package that has a number of functions that follow a non-R-standard practice of modifying in place the object passed in as an argument. This normally works OK, but fails when the object to be modified is on a list.
An function to give an example of the form of the assignments:
myFun<-function(x){
xn <- deparse(substitute(x))
ev <- parent.frame()
# would do real stuff here ..
# instead set simple value to modify local copy
x[[1]]<-"b"
# assign in parent frame
if (exists(xn, envir = ev))
on.exit(assign(xn, x, pos = ev))
# return invisibly
invisible(x)
}
This works:
> myObj <-list("a")
> myFun(myObj)
> myObj
[[1]]
[1] "b"
But it does not work if the object is a member of a list:
> myObj <-list("a")
> myList<-list(myObj,myObj)
> myFun(myList[[1]])
> myList
[[1]]
[[1]][[1]]
[1] "a"
[[2]]
[[2]][[1]]
[1] "a"
After reading answers to other questions here, I see the docs for assign clearly state:
assign does not dispatch assignment methods, so it cannot be used to set elements of vectors, names, attributes, etc.
Since there is an existing codebase using these functions, we cannot abandon the modify-in-place syntax. Does anyone have suggestions for workarounds or alternative approaches for modifying objects which are members of a list in a parent frame?
UPDATE:
I've considered trying to roll my own assignment function, something like:
assignToListInEnv<-function(name,env,value){
# assume name is something like "myList[[1]]"
#check for brackets
index<-regexpr('[[',name,fixed=TRUE)[1]
if(index>0){
lname<-substr(name,0,index-1)
#check that it exists
if (exists(lname,where=env)){
target<-get(lname,pos=env)
# make sure it is a list
if (is.list(target)){
eval(parse(text=paste('target',substr(name,index,999),'<-value',sep='')))
assign(lname, target, pos = env)
} else {
stop('object ',lname,' is not a list in environment ',env)
}
} else {
stop('unable to locate object ',lname,' in frame ',env)
}
}
}
But it seems horrible brittle, would need to handle many more cases ($ and [ as well as [[) and would probably still fail for [[x]] because x would be evaluated in the wrong frame...
Since it was in the first search results to my query, here's my solution :
You can use paste() with "<<-" to create an expression which will assign the value to your list element when evaluated.
assignToListInEnv<-function(name, value, env = parent.frame()){
cl <- as.list(match.call())
lang <- str2lang(paste(cl["name"], "<<-", cl["value"]))
eval(lang, envir = env)
}
EDIT : revisiting this answer because it got a vote up
I'm not sure why I used <<- instead of <-. If using the 'env' argument, <<-with assign to the parent.frame of that env.
So if you always want it to be the first parent.frame it can just be :
assignToListInParentFrame<-function(name, value){
cl <- as.list(match.call())
paste(cl["name"], "<<-", cl["value"]) |>
str2lang() |>
eval()
}
and if you want to precise in which env to modify the list :
assignToListInEnv<-function(name, value, env){
cl <- as.list(match.call())
paste(cl["name"], "<-", cl["value"]) |>
str2lang() |>
eval(envir = env)
}
While experimenting with the new reference classes in R I noticed some odd behaviour if you use the "[[ ]]" notation for methods (X[["doSomething"]] instead of X$doSomething). This notation works for fields, but I initially thought it wouldn't work for methods until I found that if you execute "class(X$doSomething)" you can then use "[[ ]]" afterwards. The simple example below illustrates the point.
setRefClass("Number",
fields = list(
value = "numeric"
),
methods = list(
addOne = function() {
value <<- value + 1
}
)
)
X <- new("Number", value = 1)
X[['value']] # 1
X[["addOne"]]() # Error: attempt to apply non-function
class(X[["addOne"]]) # NULL
class(X$addOne) # "refMethodDef"
# Now the following works!
X[["addOne"]]() # sets X$value = 2
class(X[["addOne"]]) # "refMethodDef"
The reason I encountered this is because I want to group my objects together in a list and create an "applyMethod" function which applies a specified method on each of the objects within. Therefore, I need to specify the method as a string. Does anyone have any ideas how I can achieve this?
Here's a class
.A <-
setRefClass("A",
fields=list(x="numeric"),
methods=list(foo=function() x))
If I had an instance a and wanted to construct a call to the 'foo' method using '$' I could
eval(substitute(a$FUN(), list(FUN="foo")))
So I'll create a class Alist that is meant to have a list of elements of class A (this could be enforced programmatically), and that has a .delegate method that'll apply an arbitrary method to all elements of the list. I'll then add a method that delegates foo.
.delegate <- function(FUN, ...)
{
lapply(elts, function(elt, ...) {
eval(substitute(elt$FUN(...), list(FUN=FUN, ...)))
})
}
.Alist <-
setRefClass("Alist",
fields=list(elts="list"),
methods=list(
initialize = function(...) callSuper(elts=list(...)),
.delegate = .delegate,
foo=function() .delegate("foo")))
And then use it
> aList <- .Alist$new(.A$new(x=1), .A$new(x=2))
> aList$foo()
[[1]]
[1] 1
[[2]]
[1] 2
basically R5 ref class does not cache the method until it is necessary. This is probably a kind of delayed evaluation.
And the caching takes place when you access the method via $.
So, AFAIK, there is no way to access the method via [[string]]
But you can find a workaround using .dollarForEnvRefClass like this:
> X <- new("Number", value = 1)
> ls(X#.xData)
[1] "value" # no methods named "addOne" before caching
> X[["addOne"]]
NULL
> methods:::.dollarForEnvRefClass(X, "addOne") # cache it
Class method definition for method addOne()
function ()
{
value <<- value + 1
}
<environment: 0x116a4aa00>
> ls(X#.xData)
[1] "addOne" "value" # you can find it
> X$value # value is 1
[1] 1
> X[["addOne"]]() # call the method
> X$value # the method works
[1] 2
if you are interested in more detail, see the implementation:
http://svn.r-project.org/R/trunk/src/library/methods/R/refClass.R
Maybe there is more straightforward way.
Report as bug on r-devel so John Chambers can fix it.