How to call standardGeneric with a variable function name - r

The following code throws a warning:
test_slot = "testslot"
setGeneric(name = test_slot,
def = function(object){
standardGeneric(test_slot)
},
where = globalenv()
)
[1] "testslot"
Warning message:
In .recursiveCallTest(body, fname) :
the body of the generic function for ‘testslot’ calls 'standardGeneric' to dispatch on a different name ("test_slot")!
I would have expected that it would have been equivalent to:
setGeneric(name = "testslot",
def = function(object){
standardGeneric("testslot")
},
where = globalenv()
)
What happened?

This does not answer why the original block of code failed, but a workaround would be to do:
test_slot = "testslot"
setGeneric(name = test_slot,
def = eval(parse(text = paste0("function(object){",
"standardGeneric('", test_slot, "')",
"}")))
},
where = globalenv()
)
that is, construct the entire def argument to be an evaluated function.

Related

How to know in trace() exit handler if exception was raised by the function

Is there a way to know in the trace() exit handler if the function raised an unhandled exception? Currently I use geterrmessage(), but it catches handled exceptions in other libraries internals, which is not what I need.
other_silent <- function() try(stop("irrelevant", call. = FALSE), silent = TRUE)
other_error <- function() stop("relevant", call. = FALSE)
my_silent <- function() other_silent()
my_error <- function() other_error()
trace(c("my_silent", "my_error"), print = FALSE,
tracer = quote({.Internal(seterrmessage(""))}),
exit = quote({print(geterrmessage())}))
my_silent()
my_error()
The call to my_silent() produces output:
[1] "Error : irrelevant\n"
While I need it to remain silent, because the function itself finished successfully.
I ended up implementing my own version of trace using code from methods as basis.
mytrace <- function(what) {
where <- environment(sys.function())
def <- getFunction(what, where = where)
body(def, envir = environment(def)) <- rlang::expr({
exception <- NA
tryCatch(!!body(def), error = function(e) {
exception <<- e
stop(e)
}, finally = {<log method with or without exception>})
})
assign(what, def, where)
}

Serialization fails with custom Torch class

Serialization can fails with a class object created containing __pairs:
test = torch.class('test')
function test:__init()
self.data = {}
end
function test:__pairs(...)
return pairs(self.data, ...)
end
function test:get_data()
print(self.data)
end
a = test.new()
a.data = {"asdasd"}
b = torch.serialize(a)
c = torch.deserialize(b)
print(torch.typename(c))
print(c:get_data())
The following returns:
test
nil
The engine behind the torch.serialization is located in the File-class. The File:writeObject us the key function. For the above example the action for a Torch class starts at line 201 with the:
elseif typeidx == TYPE_TORCH then
The type is identified in the File:isWritableObject.
One could probably implement the metatable function write but in the above example the problem was non-torch metatable function __pairs that should be __pairs__ (see torch.getmetatable):
test = torch.class('test')
function test:__init()
self.data = {}
end
function test:__pairs__(...)
return pairs(self.data, ...)
end
function test:get_data()
print(self.data)
end
a = test.new()
a.data = {"asdasd"}
b = torch.serialize(a)
c = torch.deserialize(b)
print(torch.typename(c))
print(c:get_data())
This gives the expected:
test
{
1 : "asdasd"
}

With R S4 classes, is it possible to have non-optional constructor parameters

Suppose I have an S4 class Test that has a single slot name. A valid name must be at least one character long, so Test(name = "Bob") should work but Test(name = "") should throw an error. An undefined name should also give an error: Test().
My class is defined as:
Test <- setClass(
"Test",
slots = c(name = "character"),
validity = function(object) {
if (nchar(object#name) == 0) {
return("name must at least one character long")
}
T
})
Testing the class in the console, I find that my validity function is not executed for the unassigned case:
> Test(name = "Bob")
An object of class "Test"
Slot "name":
[1] "Bob"
> Test(name = "")
Error in validObject(.Object) :
invalid class “Test” object: name must at least one character long
> Test()
An object of class "Test"
Slot "name":
character(0)
How can I ensure that an error is always thrown when an invalid object is created?
One way to ensure the validity of an S4 is the use of prototype to initialise the slots like this
Test <- setClass(
"Test",
slots = c(name = "character"),
prototype = prototype(name = 'name_default'),
validity = function(object) {
if (nchar(object#name) == 0) {
return("name must at least one character long")
}
})
Test(name = "Bob")
## An object of class "Test"
## Slot "name":
## [1] "Bob"
Test(name = '')
## Error in validObject(.Object) :
## invalid class "Test" object: name must at least one character long
Test()
## An object of class "Test"
## Slot "name":
## [1] "name_default"
another way would be to create a constructor to test the presence of name:
consTest <- function(name) {
if (missing(name)) {
stop("name is missing")
} else {
new(Class = "Test", name = name)
}
}
consTest(name = "Bob") # similar to Test(...)
consTest(name = '') # similar to Test(...)
consTest()
## Error in consTest() (from Retest.R#13#3) : name is missing

Calling functions passed as arguments in Lua

I have this code
Option = { }
function Option.nothing( )
local self = { isNone = true, isSome = false }
function self:orElse( alt )
return alt
end
function self:map( f )
return Option.nothing( )
end
function self:exec( f )
end
function self:maybe( alt, f )
return alt
end
return self
end
function Option.just( val )
local self = { isNone = false, isSome = true }
local value = val
function self:orElse( alt )
return value
end
function self:map( f )
return Option.just( f(value) )
end
function self:exec( f )
f( value )
end
function self:maybe( alt, f )
return f(value)
end
return self
end
function printOpt( opt )
local str = opt.maybe( "Nothing", function(s) return "Just " .. s end )
print( str )
end
x = Option.nothing( )
y = Option.just( 4 )
printOpt(x)
printOpt(y)
But I keep getting 'attempt to call local 'f' (a nil value)' here:
function self:maybe( alt, f )
return f(value)
end
It seems I'm having trouble calling a function passed as a argument.
You declared the function as self:maybe(), but you're calling it as opt.maybe(). You should call it as opt:maybe().
Declaring it as self:maybe(alt, f) is equivalent to declaring it as self.maybe(self, alt, f). So if you call it with a . you need 3 args. You're passing 2, so self ends up as "Nothing", and alt ends up as the function object.
However, by calling it as opt:maybe("Nothing", f) this is equivalent to saying opt.maybe(opt, "Nothing", f) which provides the required 3 args.

Reference class fields disappearing

I decided to give Reference Classes another shot, but my first hello world is already giving me issues. What is going wrong here?
> memory <- setRefClass(
+ Class = "memory",
+ fields = list(state="vector"),
+ methods = list(
+ get = function() { return(state) },
+ set = function(x) { state <<- x }
+ )
+ )$new()
> memory$set(123)
> print(memory)
Reference class object of class "memory"
Field "state":
[1] 123
> memory$get()
[1] 123
> print(memory)
Reference class object of class "memory"
Field "state":
Error in methods::show(field(fi)) :
error in evaluating the argument 'object' in selecting a method for function 'show': Error in get(name, envir = .self) :
unused argument(s) (name, envir = .self)
I'm not very experienced with Reference Classes but according to the help page (?ReferenceClasses), I think that you have to add a show method to your class to be able to print automaticaly your object.
memory <- setRefClass(
Class = "memory",
fields = list(state="vector"),
methods = list(
get = function() { return(state) },
set = function(x) { state <<- x },
show = function() {methods::show(state)}
)
)$new()
memory$set(123)
print(memory)
#[1] 123
memory$get()
#[1] 123
print(memory)
#[1] 123
Hope this help

Resources