How can I sort/order R6 objects based on an own function value or a compare function value?
I have made up a little example with rectangles that I would like to sort by their area:
library('R6')
Rectangle <- R6Class(
"Rectangle",
public = list(
initialize = function(width, height) {
private$width = width
private$height = height
},
get_area = function(){
private$width*private$height
}
),
private = list(
width = NULL,
height = NULL
)
)
array_of_rects = c( Rectangle$new(7,3), Rectangle$new(5,2), Rectangle$new(3,4))
I would like to sort array_of_rects by their area given by the get_area() function.
I tried different things like:
`>.Rectangle` <- function(e1, e2) { e1[[1]]$get_area() > e2[[1]]$get_area() }
`==.Rectangle` <- function(e1, e2) { e1[[1]]$get_area() == e2[[1]]$get_area() }
sort(array_of_rects)
but without luck (I get an 'x' must be atomic error message).
I tried without the [[1]] (like this e1$get_area()) but this didn't work either.
Searched around but haven't found anything leading me to a solution.
Any suggestions? Thanks in advance!
Well, inspired by https://stackoverflow.com/a/23647092/1935801
I found the following nice and elegant solution
area = function(rect){ rect$get_area() }
sorted_rects = array_of_rects[ order( sapply(array_of_rects, FUN = area) ) ]
At the end of the day works with R6 like with any other class/object.
Related
I am trying to extend websocket::Websocket with a method that sends some data and returns the message, so that I can assign it to an object. My question is pretty much identical to https://community.rstudio.com/t/capture-streaming-json-over-websocket/16986. Unfortunately, the user there never revealed how they solved it themselves. My idea was to have the onMessage method return the event$data, i.e. something like:
my_websocket <- R6::R6Class("My websocket",
inherit = websocket::WebSocket,
public = list(
foo = function(x) {
msg <- super$send(paste("x"))
return(msg)
} )
)
load_websocket <- function(){
ws <- my_websocket$new("ws://foo.local")
ws$onMessage(function(event) {
return(event$data)
})
return(ws)
}
my_ws <- load_websocket()
my_ws$foo("hello") # returns NULL
but after spending a good hour on the Websocket source code, I am still completely in the dark as to where exactly the callback happens, "R environment wise".
You need to use super assignment operator <<-. <<- is most useful in conjunction with closures to maintain state. Unlike the usual single arrow assignment (<-) that always works on the current level, the double arrow operator can modify variables in parent levels.
my_websocket <- R6::R6Class("My websocket",
inherit = websocket::WebSocket,
public = list(
foo = function(x) {
msg <<- super$send(paste("x"))
return(msg)
} )
)
load_websocket <- function(){
ws <- my_websocket$new("ws://foo.local")
ws$onMessage(function(event) {
return(event$data)
})
return(ws)
}
my_ws <- load_websocket()
my_ws$foo("hello")
I'm using active bindings in an R6 class to check values before assignment to fields. I thought I could use a closure to generate the bindings as below, but this doesn't work.
The binding isn't evaluated in the way I expect (at all?) because the error shows the closure's name argument. What am I missing?
library(R6)
library(pryr)
# pass a field name to create its binding
generate_binding <- function(name) {
function(value) {
if (!missing(value) && length(value) > 0) {
private$name <- value
}
private$name
}
}
bind_x = generate_binding(x_)
# created as intended:
unenclose(bind_x)
# function (value)
# {
# if (!missing(value) && length(value) > 0) {
# private$x_ <- value
# }
# private$x_
# }
MyClass <- R6::R6Class("MyClass",
private = list(
x_ = NULL
),
active = list(
x = bind_x
),
)
my_class_instance <- MyClass$new()
my_class_instance$x <- "foo"
# Error in private$name <- value :
# cannot add bindings to a locked environment
I think you’re misunderstanding how closures work. unenclose is a red herring here (as it doesn’t actually show you what the closure looks like). The closure contains the statement private$name <- value — it does not contain the statement private$x_ <- value.
The usual solution to this problem would be to rewrite the closure such that the unevaluated name argument is deparsed into its string representation, and then used to subset the private environment (private[[name]] <- value). However, this doesn’t work here since R6 active bindings strip closures of their enclosing environment.
This is where unenclose comes in then:
MyClass <- R6::R6Class("MyClass",
private = list(
x_ = NULL
),
active = list(
x = pryr::unenclose(bind_x)
),
)
Now my code is as follows:
common_timestamps = NULL
tapply(data$timestamps, data$date,
function(x, common_timestamps ) {
if(length(common_timestamps ) == 0) {
common_timestamps = x
} else {
date_time = intersect(common_timestamps, x)
}
return(common_timestamps)
},
common_timestamps
)
I want to get the common timestamps from the code in the above. I found each time in the loop, the common_timestamp is null and it did not return common_timestamp. What is wrong with code? I think my concept about passing
variables into function for R language might be right.
Could you correct my error and explain my error?
Thank you very much for your help.
There is one thing I really don't like about R reference class: the order you write the methods matters. Suppose your class goes like this:
myclass = setRefClass("myclass",
fields = list(
x = "numeric",
y = "numeric"
))
myclass$methods(
afunc = function(i) {
message("In afunc, I just call bfunc...")
bfunc(i)
}
)
myclass$methods(
bfunc = function(i) {
message("In bfunc, I just call cfunc...")
cfunc(i)
}
)
myclass$methods(
cfunc = function(i) {
message("In cfunc, I print out the sum of i, x and y...")
message(paste("i + x + y = ", i+x+y))
}
)
myclass$methods(
initialize = function(x, y) {
x <<- x
y <<- y
}
)
And then you start an instance, and call a method:
x = myclass(5, 6)
x$afunc(1)
You will get an error:
Error in x$afunc(1) : could not find function "bfunc"
I am interested in two things:
Is there a way to work around this nuisance?
Does this mean I can never split a really long class file into multiple files? (e.g. one file for each method.)
Calling bfunc(i) isn't going to invoke the method since it doesn't know what object it is operating on!
In your method definitions, .self is the object being methodded on (?). So change your code to:
myclass$methods(
afunc = function(i) {
message("In afunc, I just call bfunc...")
.self$bfunc(i)
}
)
(and similarly for bfunc). Are you coming from C++ or some language where functions within methods are automatically invoked within the object's context?
Some languages make this more explicit, for example in Python a method with one argument like yours actually has two arguments when defined, and would be:
def afunc(self, i):
[code]
but called like:
x.afunc(1)
then within the afunc there is the self variable which referes to x (although calling it self is a universal convention, it could be called anything).
In R, the .self is a little bit of magic sprinkled over reference classes. I don't think you could change it to .this even if you wanted.
I'm a huge fan of S4 Reference Classes as they allow for a hybrid programming style (functional/pass-by-value vs. oop/pass-by-reference; example) and thus increase flexibility dramatically.
However, I think I just came across an undesired behavior with respect to the way R scans through environments/frames when you ask it to retrieve a certain field value via method $field() (see help page). The problem is that R also seems to look in enclosing environments/frames if the desired field is not found in the actual local/target environment (which would be the environment making up the S4 Reference Class), i.e. it's just like running get(<objname>, inherits=TRUE) (see help page).
Actual question
In order to have R just look in the local/target environment, I was thinking something like $field(name="<fieldname>", inherits=FALSE) but $field() doesn't have a ... argument that would allow me to pass inherits=FALSE along to get() (which I'm guessing is called somewhere along the way). Is there a workaround to this?
Code Example
For those interested in more details: here's a little code example illustrating the behavior
setRefClass("A", fields=list(a="character"))
x <- getRefClass("A")$new(a="a")
There is a field a in class A, so it's found in the target environment and the value is returned:
> x$field("a")
[1] "a"
Things look differently if we try to access a field that is not a field of the reference class but happens to have a name identical to that of some other object in the workspace/searchpath (in this case "lm"):
require("MASS")
> x$field("lm")
function (formula, data, subset, weights, na.action, method = "qr",
model = TRUE, x = FALSE, y = FALSE, qr = TRUE, singular.ok = TRUE,
contrasts = NULL, offset, ...)
{
ret.x <- x
ret.y <- y
[omitted]
if (!qr)
z$qr <- NULL
z
}
<bytecode: 0x02e6b654>
<environment: namespace:stats>
Not really what I would expect at this point. IMHO an error or at least a warning would be much better. Or opening method $field() for arguments that can be passed along to other functions via .... I'm guessing somewhere along the way get() is called when calling $field(), so something like this could prevent the above behavior from occurring:
x$field("digest", inherits=FALSE)
Workaround: own proposal
This should do the trick, but maybe there's something more elegant that doesn't involve the specification of a new method on top of $field():
setRefClass("A", fields=list(a="character"),
methods=list(
myField=function(name, ...) {
# VALIDATE NAME //
if (!name %in% names(getRefClass(class(.self))$fields())) {
stop(paste0("Invalid field name: '", name, "'"))
}
# //
.self$field(name=name)
}
)
)
x <- getRefClass("A")$new(a="a")
> x$myField("a")
[1] "a"
> x$myField("lm")
Error in x$myField("lm") : Invalid field name: 'lm'
The default field() method can be replaced with your own. So adding an inherits argument to avoid the enclosing frames is simply a matter of grabbing the existing x$field definition and adding it...
setRefClass( Class="B",
fields= list( a="character" ),
methods= list(
field = function(name, value, inherits=TRUE ) {
if( missing(value) ) {
get( name, envir=.self, inherits=inherits )
} else {
if( is.na( match( name, names( .refClassDef#fieldClasses ) ) ) ) {
stop(gettextf("%s is not a field in this class", sQuote(name)), domain = NA)
}
assign(name, value, envir = .self)
}
}
),
)
Or you could have a nice error message with a little rearranging
setRefClass( Class="C",
fields= list( a="character" ),
methods= list(
field = function(name, value, inherits=TRUE ) {
if( is.na( match( name, names( .refClassDef#fieldClasses ) ) ) &&
( !missing(value) || inherits==FALSE) ) {
stop(gettextf("%s is not a field in this class", sQuote(name)), domain = NA)
}
if( missing(value) ) {
get( name, envir=.self, inherits=inherits )
} else {
assign(name, value, envir = .self)
}
}
),
)
Since you can define any of your own methods to replace the defaults pretty much any logic you want can be implemented for your refclasses. Perhaps an error if the variable is acquired using inheritance but the mode matches to c("expression", "name", "symbol", "function") and warning if it doesn't directly match the local refClass field names?