Multiple acceptable classes in reference class field list - r

For example:
Mycls = setRefClass(
"Mycls",
fields = list(
# this is just a mock up
colorvec = "numeric" | "factor" | "matrix"
)
)
In this example, I want to allow colorvec to be numeric or factor or matrix.
Is there a way to do this?

Three possibilities.
Use the ANY type.
m2 = setRefClass("m2",
fields = list(x="ANY")
)
which, as the name, suggests allows you to have any type.
Create another class that only accepts numerics/factors/matrices:
setClass("mult", representation(x="ANY"))
setValidity("mult",
function(object)
is.numeric(object#x) || is.factor(object#x) || is.matrix(object#x)
)
m3 = setRefClass("m3", fields = list(x="mult"))
So
bit = new("mult", x=10)
m3$new(x=bit)
Have a function as your input and check the types. Notice that the x field doesn't actually store any data, it just checks and returns the internal value. You could create a simple show method to hide the internal field.
m4 = setRefClass("m4",
fields=list(x = function(y){
if(!missing(y) && !is.null(y)) {
if(!(is.numeric(y))){
stop("Wrong type")
}
internal <<- y
} else internal}
,
internal="ANY"
))
m4$new(x=10)
m4$new(x="10")

Related

How can you chain active fields in R6 classes that are field wrappers?

I'm looking at the code example provided in the R6 class documentation here.
This is the class definition:
Person <- R6Class("Person",
private = list(
.age = NA,
.name = NULL
),
active = list(
age = function(value) {
if (missing(value)) {
private$.age
} else {
stop("`$age` is read only", call. = FALSE)
}
},
name = function(value) {
if (missing(value)) {
private$.name
} else {
stopifnot(is.character(value), length(value) == 1)
private$.name <- value
self
}
}
),
public = list(
initialize = function(name, age = NA) {
private$.name <- name
private$.age <- age
}
)
)
The important part is how the age field is wrapped to be read-only, and the name field is wrapped to perform a validation check before making the assignment.
In my own usecase, I'm not interested in the read-only part, but I am implementing the validation logic. So, focus on the active field for name.
I do not understand why they are following the pattern to return self after the call. How can you chain together assignments? Assuming age wasn't read only, how would it look to try to assign age and name in a chain? I've tried a number of ways, and it never seems to work:
p <- Person$new();
p$age <- 10$name <- "Jill" # obviously doesn't work because how can you reference the name field of 10?
(p$age <- 10)$name <- "Jill" # this looks more likely to work but the parens don't help
p$age(10)$name("Jill") # Does not work, you can't invoke active fields as if they were functions.
# other syntax options?
So, the heart of my question is: if you're using active fields in R6 classes to facilitate some type-checking prior to assignment, you can't really chain those operations together, so why does the official documentation show returning self in the field accessors?

Save A Class Instance As JSON

Problem
I am working on project with RC various custom made classes. I would like to save certain class instances at the end of my program in order to export them to a data base. I tried using jsonlite::toJSON(account) but I received the error message
Error: No method for S4 class:BankAccount
Class
I have the following class
BankAccount <- setRefClass('BankAccount',
fields = list(
balance = 'numeric',
ledger = 'data.frame'
),
methods = list(
deposit = function (x) {
x <- max(x,0)
balance <<- balance + x
ledger <<- data.frame(
Date = c(ledger$Date, as.character(Sys.time())),
Type = c(ledger$Type, 'Deposit'),
Amount = c(ledger$Amount, x),
stringsAsFactors = FALSE
)
},
withdraw = function (x) {
x <- max(x,0)
balance <<- balance - x
ledger <<- data.frame(
Date = c(ledger$Date, as.character(Sys.time())),
Type = c(ledger$Type, 'Withdrawal'),
Amount = c(ledger$Amount, x),
stringsAsFactors = FALSE
)
}
))
Instance
And here is an instance of that class
account <- BankAccount$new(balance = 100)
account$deposit(1000)
Sys.sleep(5)
account$withdraw(97.89)
account
Reference class object of class "BankAccount"
Field "balance":
[1] 1002.11
Field "ledger":
Date Type Amount
1 2018-12-31 16:21:20 Deposit 1000.00
2 2018-12-31 16:21:26 Withdrawal 97.89
JSON
Now I would like to save it to as a JSON file of the form (there might be a typo in the JSON - not that familiar with the format)
{
"balance": "double",
"ledger": {
"Date": "string",
"Type": "string",
"Amount": "double"
}
}
PS
I also tried without the field ledger (which is of class data.frame) but it still did not work.
Edit
Here is the output of jsonlite::serializeJSON(account)
{"type":"S4","attributes":{".xData":{"type":"environment","attributes":{},"value":{}}},"value":{"class":"BankAccount","package":".GlobalEnv"}}
As you can see it seems to only save information about the class BankAccount but not about the instance account (balance value etc. missing).
Here is a workaround (as indicated by #StefanF). One can add methods to classes
# converts to JSON
toJSON = function (prettifyy = TRUE) {
instanceJSON <- jsonlite::toJSON(list(balance = balance,ledger = ledger))
if (prettifyy) instanceJSON <- jsonlite::prettify(instanceJSON)
instanceJSON
}
# saves as .json, e.g. path = 'C:/Test/instance.json'
saveJSON = function (path) {
instanceJSON <- toJSON()
writeLines(instanceJSON, path)
}
The solution is not ideal as
there is a bit of labor as one needs to specify which of the fields should be incorporated
also, if a field of BankAccount is of class MyClass (another custom class), then you need to either specify which fields of MyClass are of relevance or create a toJSON as well for MyClass

How to use S4 object programming in R

What's wrong with my R script? I'm trying to use a vector of user-defined objects (here a vector of "Page" objects) within another user-defined object (here a "Book" object)
setClass("Page",
slots = c(PageNo = "numeric", #scalar
Contents = "character") #vector of strings
)
setClass("Book",
slots = c(Pages = "vector", # Something wrong here? vector of pages ? "Page" or vector" or "list"
Title = "character") #vector of strings
)
setGeneric(name="AddPage", def=function(aBook, pageNo){standardGeneric("AddPage")})
setMethod(f="AddPage", signature="Book",
definition=function(aBook, pageNo)
{
page1 = new("Page")
page1#PageNo = pageNo
aBook#Pages = c(aBook#Pages, page1) # Something wrong here?
}
)
book1 = new("Book")
book1#Title = "Sample Book"
book1
book1#Pages
AddPage(book1, 1)
AddPage(book1, 2)
book1#Pages
Remember that R does not use reference semantics, so AddPage(book1, 1) creates a copy of book1, and updates that. In the method you don't return the updated object, and book1 remains unchanged.
Update the method so that it returns the modified object
setMethod(f="AddPage", signature="Book",
definition=function(aBook, pageNo)
{
page1 = new("Page")
page1#PageNo = pageNo
aBook#Pages = c(aBook#Pages, page1) # Something wrong here?
aBook
}
)
and assign the return value to the old variable
book1 = AddPage(book1, 1)
But this is a very inefficient approach -- the line aBook#Pages = c(aBook#Pages, page1) makes a copy of all existing pages (on the right-hand side, to create a longer vector; this will scale with the square of the number of Pages added to the book) and then copies the entire Book (for the assignment). In addition, creating individual objects is expensive and does not exploit R's 'vectorization'. A first step is to think of the object 'Page' as instead 'Pages', where the object models the columns rather than rows of a data frame. 'Book' then doesn't have vector of Page objects, but a single Pages object. This also implies a different approach to creating your 'book'.

Using a closure to generate an R6 binding

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)
),
)

Avoiding consideration of enclosing frames when retrieving field value of a S4 Reference Class

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?

Resources