Converting object of class function into function - r

In R, assume an object of type 'closure' called my_object that contains both a likelihood function and the associated parameters.
Assume further that I would now like to extract specifically the likelihood function from said object and pass it on to a different R command, which needs a likelihood function as its first argument. I can extract said function via command unenclose in library pryr.
> library(pryr)
> lik_func = unenclose(my_object)
> lik_func
function (pars, condition.surv = TRUE, root = ROOT.OBS, root.p = NULL,
intermediates = FALSE)
{ #function_specifics_here# }
<environment: namespace:diversitree>
However, what I apparently extract is just an object of class 'function', and not the likelihood function itself, as the next R command complains that it does not actually receive a function, but an object:
> asr.marginal(lik=lik_func, pars=my_pars)
Error in UseMethod("make.asr.marginal") :
no applicable method for 'make.asr.marginal' applied to an object of class "function"
How do I convert this object of class 'function' into a plain function, assuming such a distinction actually exists?
Note: I am uncertain if or why a distinction between an object of class 'function' and a plain function actually exists. Maybe someone answering this question could share some light on this too.

“Objects of class "function"” are, generally1, functions. In particular, they are objects of type "closure" and class "function".
Using pryr::unenclose doesn’t have any useful effect here. Its only effect is to take a function and replace all references to objects in an enclosing environment with their value. So if I have, say:
x = 1
f = function () x
… then unenclose(f) will yield:
function () 1
This doesn’t make f any more or less of a function.
Your error message seems to be fundamentally unrelated to that. Instead, asr.marginal specifically expects a likelihood function, which apparently needs to be created by one of the make.* functions in the package. A likelihood function in the context of ‹diversitree› is a function of class "dtlik".
1 The exception is if you are prone to shenanigans:
x = 42
class(x) = "function"
Now x has class function but obviously isn’t a function.

Related

Circular definition of function

I read a question on function arguments which included the formals function and I was eager to find out how the function is defined. I used base:::formals and it gives:
function (fun = sys.function(sys.parent()))
{
if (is.character(fun))
fun <- get(fun, mode = "function", envir = parent.frame())
.Internal(formals(fun))
}
To me it is unclear how this works because inside the definition of the formals function the formals function is used. That seems paradox to me.
.Internal(formals(fun)) calls an internal R function, coded in C. It just happens that this C internal function is also named formals.
So it does not call the same function, just an internal one that happens to be internally named "formals".
cf https://stat.ethz.ch/R-manual/R-devel/library/base/html/Internal.html

S4 class constructor and validation

I present a short code to create a S4 class myclass and ensure that objects are created if they verify a condition given by a parameter param
setClass("myclass", slot = c(x = "numeric"))
#constructor
ValidmyClass<- function(object, param = 1)
{
if(object#x == param) return(TRUE)
else return("problem")
}
setValidity("myclass", ValidmyClass)
setMethod("initialize","myclass", function(.Object,...){
.Object <- callNextMethod()
validObject(.Object,...)
.Object
})
For which I get the following error message Error in substituteFunctionArgs(validity, "object", functionName = sprintf("validity method for class '%s'", :
trying to change the argument list of for validity method for class 'myclass' with 2 arguments to have arguments (object)
I understand the issue with the arguments but I cannot find a way to solve this. The document about setValidity mentions that the argument method should be "validity method; that is, either NULL or a function of one argument (object)". Hence from my understanding excluding more than one argument.
Nevertheless, the idea behind this example is that I want to be able to test the construction of a myclass object based on the value of an external given parameter. If more conditions were to be added, I would like enough flexibility so only the function ValidmyClass needs to be updated, without necessarily adding more slots.
The validity function has to have one argument named object. When I need to create one argument functions but really have more arguments or data to pass in I often fall back to using closures. Here the implementation of your ValidmyClass changes in that it will now return the actual validity function. The argument of the enclosing function is then the set of additional arguments you are interested in.
setClass("myclass", slot = c(x = "numeric"))
#constructor
ValidmyClass <- function(param) {
force(param)
function(object) {
if (object#x == param) TRUE
else "problem"
}
}
setValidity("myclass", ValidmyClass(1))
Also the validity function is called automatically on init; however not when the slot x is changed after the object is created.
setMethod("initialize", "myclass", function(.Object,...) {
.Object <- callNextMethod()
.Object
})
new("myclass", x = 2)
new("myclass", x = 1)
For more information on closures see adv-R. Although I think this answers your question, I do not see how this implementation is actually helpful. When you define your class, you basically also fix the additional parameters which the validity function knows about. If you have several classes for which you can abstract the validity function then I would use the closure. If you have one class with changing parameters at runtime, I would consider to add a slot to the class. If you do not want to alter the class definition you can add a slot of class list where you the can pass in an arbitrary number of values to test against.

Trying to use setClass to pass a train function from caret of type "train"

I am attempting to use custom class builder setClass() to return results from a train function (caret package).
setClass(Class="TrainResults",
representation(
successrate="numeric",
plsFit="train"
)
)
This is how I create TrainResults in my function:
return(new("Trainresults",
successrate=successrate,
plsFit=plsFit))
"successrate" works fine as it is of numeric type, but plsFit (of type train {caret}) complains that:
Error in validObject(.Object) :
invalid class “Trainresults” object: undefined class for slot "plsFit" ("train")
Any idea how to get it to pass the object of type train properly? Thanks!
I suspect the return value of caret::train is not an S4 object, rather an S3 object. Use setOldClass("train"), which should then register the train class for use with S4 slots. This works:
setOldClass("train")
trn <- train(data.frame(x=1:3, y=1:3), 1:3)
isS4(trn)
# [1] FALSE
new("TrainResults", successrate=1, plsFit=trn)
# An object of class "TrainResults"
# ... omitted a bunch of output
The basic data types (e.g. numeric, etc.) are all already pre-registered as S4 classes so you don't need to do that for those to work as S4 slots.
Note you have a typo in your code as well (lower case R in Train*r*esulsts).

Is 'show' a normal S4 generic function?

I'm trying to create a method for my class, which inherits from data.frame. I was originally hoping just to inherit the 'show' method from data.frame as well, but I'm also fine with writing my own. I defined my class and 'show' method as follows:
setClass("SCvec", representation(auth = "character",
dev = "character",
sensor = "character",
channel = "character",
starttime = "character",
endtime = "character"),
contains="data.frame")
setMethod("show", signature(x="SCvec"), function(x) print(x))
when I type show in the R console, it prints out:
standardGeneric for "show" defined from package "methods"
function (object)
standardGeneric("show")
<bytecode: 0x0396bee8>
<environment: 0x0393ab60>
Methods may be defined for arguments: object
Use showMethods("show") for currently available ones.
(This generic function excludes non-simple inheritance; see ?setIs)
So it sure looks like I don't need to turn it into a generic using StandardGeneric() myself. but when I run my setMethod("show", signature(x="SCvec"), function(x) print(x)) line, I get the error
Error in match.call(definition, call, expand.dots) :
unused argument(s) (x = c("SCvec", ""))
I've defined this method just like I would define any other one. Why does this method definition not work? Is 'show' different than other generic functions?
The function show takes an argument object, so you would need to define your signature and function definition with respect to that formal argument:
setMethod("show", signature(object="SCvec"), function(object) print(object))
You can also see other methods that are defined for show by typing in
showMethods(show)
And this shows you that all the other methods are defined in terms of the class of object as well.

Environment chaining in R

In my R development I need to wrap function primitives in proto objects so that a number of arguments can be automatically passed to the functions when the $perform() method of the object is invoked. The function invocation internally happens via do.call(). All is well, except when the function attempts to access variables from the closure within which it is defined. In that case, the function cannot resolve the names.
Here is the smallest example I have found that reproduces the behavior:
library(proto)
make_command <- function(operation) {
proto(
func = operation,
perform = function(., ...) {
func <- with(., func) # unbinds proto method
do.call(func, list(), envir=environment(operation))
}
)
}
test_case <- function() {
result <- 100
make_command(function() result)$perform()
}
# Will generate error:
# Error in function () : object 'result' not found
test_case()
I have a reproducible testthat test that also outputs a lot of diagnostic output. The diagnostic output has me stumped. By looking up the parent environment chain, my diagnostic code, which lives inside the function, finds and prints the very same variable the function fails to find. See this gist..
How can the environment for do.call be set up correctly?
This was the final answer after an offline discussion with the poster:
make_command <- function(operation) {
proto(perform = function(.) operation())
}
I think the issue here is clearer and easier to explore if you:
Replace the anonymous function within make_command() with a named one.
Make that function open a browser() (instead of trying to get result). That way you can look around to see where you are and what's going on.
Try this, which should clarify the cause of your problem:
test_case <- function() {
result <- 100
myFun <- function() browser()
make_command(myFun)$perform()
}
test_case()
## Then from within the browser:
#
parent.env(environment())
# <environment: 0x0d8de854>
# attr(,"class")
# [1] "proto" "environment"
get("result", parent.env(environment()))
# Error in get("result", parent.env(environment())) :
# object 'result' not found
#
parent.frame()
# <environment: 0x0d8ddfc0>
get("result", parent.frame()) ## (This works, so points towards a solution.)
# [1] 100
Here's the problem. Although you think you're evaluating myFun(), whose environment is the evaluation frame of test_case(), your call to do.call(func, ...) is really evaluating func(), whose environment is the proto environment within which it was defined. After looking for and not finding result in its own frame, the call to func() follows the rules of lexical scoping, and next looks in the proto environment. Neither it nor its parent environment contains an object named result, resulting in the error message you received.
If this doesn't immediately make sense, you can keep poking around within the browser. Here are a few further calls you might find helpful:
environment(get("myFun", parent.frame()))
ls(environment(get("myFun", parent.frame())))
environment(get("func", parent.env(environment())))
ls(environment(get("func", parent.env(environment()))))

Resources