is there a way to dynamically coerce an object in R?
Background
I am trying to create a function factory for summary which can return the specific method based on the class of the object passed. Particularly, this is for one of the questions in http://adv-r.had.co.nz/Functional-programming.html#lists-of-functions
Implement a summary function that works like base::summary(), but uses a list of functions. Modify the function so it returns a closure, making it possible to use it as a function factory.
I have tried a few variations all of which are incorrect/ incomplete, for ex.
object.list = list(df = data.frame(),fr=factor(), mx = matrix())
summary.new = function(y){
function(x,...){
UseMethod(summary,x)
}
}
summary.new.list = lapply(object.list, summary.new)
I am wondering if there is a way to dynamically coerce an object - something like as.() and use this to return the appropriate method from the generic object.
summary.new.list function
> summary.new.list
$df
function (x, ...)
{
UseMethod("summary", x)
}
<environment: 0x108b5edc>
$fr
function (x, ...)
{
UseMethod("summary", x)
}
<environment: 0x108b5de0>
$mx
function (x, ...)
{
UseMethod("summary", x)
}
<environment: 0x108b5ce4>
I want to call the function based on the object, for ex. for dataframes I want to call summary.new.list$df(data.frame(1:12,3,4)). Though it works now as $df function is still generic - I wish to call the base summary.data.frame function from inside there instead of UseMethod
I don't exactly understand this example's intended purpose, but here's something to chew on:
summary2 <- function(x){ switch( class(x)[1], "data.frame"= summary.data.frame,
"list"=summary.list ,
"factor"=summary.factor,
"matrix"=summary.matrix,
"numeric" = summary.default) }
summary.new.list = lapply(object.list, summary2)
# Application of that list of functions matched to object classes
> mapply( function(x,y) { do.call(x, list(y) )}, summary.new.list, object.list)
$df
< table of extent 0 x 0 >
$fr
integer(0)
$mx
V1
Mode:logical
NA's:1
You are basically reinventing class dispatch of functions. The question asked for "coercion" but the problem didn't seem to require any coercion, at least as I read it.
Related
I'm studying S4 classes and methods and I got confused to know when to use .Object and object (using as an argument to functions on classes). I don't understand if is there any difference between them.
For example, Would be correct:
setGeneric("getTimes",function(object){standardGeneric ("getTimes")})
setMethod("getTimes","Trajectories",
function(object){
return(object#times)
}
)
or:
setGeneric("getTimes",function(.Object){standardGeneric ("getTimes")})
setMethod("getTimes","Trajectories",
function(.Object){
return(.Object#times)
}
)
First, you should avoid the curly braces around {standardGeneric("getTimes")}.
The short answer for your question: there is no difference between the 2 code in your example. You were defining getTimes as a brand new generic function of your own. You can specify its arguments name whatever you like (object, x, xobject, .Object). Then, when you write the methods for the generic function, your methods' arguments name must match with the generic function's arguments name. For example:
setGeneric("getTimes", function(object) standardGeneric("getTimes"))
setMethod("getTimes", "Trajectories", function(object) object#times)
If not follow, there will be error (technically, a warning because R automatically/"silently" correct it. However, in my opinion, R should stop and throw an error in this case):
setGeneric("getTimes", function(object) standardGeneric("getTimes"))
setMethod("getTimes", "Trajectories", function(x) x#times)
# mismatch between `x` argument name in method and `object` argument name in generic
In the case you want to define methods for existing generic, you should use function method.skeleton.
Example 1:
setGeneric("getTimes", function(xobject) standardGeneric("getTimes")) # generic function is defined
getTimes # type function name without parentheses to get a summary of the generic
method.skeleton("getTimes", "Trajectories", stdout())
# copy this method skeleton to your script/source file and modify to your need
Example 2, show is a predefined generic with object as argument (see ?show) or you can type show without parentheses to check. Therefore, setMethod("show", "Trajectories", function(.Object) .Object) will be error. You can proceed using this approach, however, I think method.skeleton is a pretty useful alternative:
> method.skeleton("show", "Trajectories", stdout())
setMethod("show",
signature(object = "Trajectories"),
function (object)
{
stop("need a definition for the method here")
}
)
Example 3, initialize is a generic function and its argument .Object may be defined (type initialize without parentheses to check). From my understanding, the reason .Object is chosen as argument name in this case to invoke the feeling of a prototype object (you can read more at ?initialize). Similarly to Example 2, use the method.skeleton helper function:
> method.skeleton("initialize", "Trajectories", stdout())
setMethod("initialize",
signature(.Object = "Trajectories"),
function (.Object, ...)
{
stop("need a definition for the method here")
}
)
Note: there is a special case for replacement/assignment function (<-), that is its last argument must be named value. Read more. For example:
setClass("Trajectories", slots = c(times = "numeric"))
setGeneric("getTimes", function(x) standardGeneric("getTimes"))
setMethod("getTimes","Trajectories", function(x) x#times)
setGeneric("getTimes<-", function(xobject, value) standardGeneric("getTimes<-"))
setMethod("getTimes<-", c("Trajectories", "ANY"), function(xobject, value) {
xobject#times <- value
xobject
})
# test drive
m <- new("Trajectories", times = 32)
getTimes(m)
getTimes(m) <- 42
getTimes(m)
R will not output any error or warning if you use other name (new_value in below) when defining the generic and accompanying methods. However, when you use it, R will error:
setGeneric("getTimes<-", function(xobject, new_value) standardGeneric("getTimes<-"))
setMethod("getTimes<-", c("Trajectories", "ANY"), function(xobject, new_value) {
xobject#times <- new_value
xobject
})
# test drive
m <- new("Trajectories", times = 32)
getTimes(m)
getTimes(m) <- 42 # error because the right side of <- is always considered as `value` argument
Sometimes in R a function wants a string or sometimes it wants an object.
For example, rm(x); and rm("x"); work the same.
NOTE: In this example x or "x" is NOT a function. I generically call it an OBJECT. In the example below, I am referring to functions as FN.STR or FN.OBJ, but the QUESTION is looking for a general OBJECT MANIPULATOR. Given a thing, determine if it is a string or object, and return a string/object as requested by the Function. A function then serves as a general API to access R objects.
> rm
function (..., list = character(), pos = -1, envir = as.environment(pos),
inherits = FALSE)
{
dots <- match.call(expand.dots = FALSE)$...
if (length(dots) && !all(vapply(dots, function(x) is.symbol(x) ||
is.character(x), NA, USE.NAMES = FALSE)))
stop("... must contain names or character strings")
names <- vapply(dots, as.character, "")
if (length(names) == 0L)
names <- character()
list <- .Primitive("c")(list, names)
.Internal(remove(list, envir, inherits))
}
<bytecode: 0x00000136a0f22d80>
<environment: namespace:base>
This is useful on this function because the USER doesn't have to remember: do I need the string or object. In fact, you can mix: x=1; y=2; rm(x,"y"); The ... dots have been expended to make this happen... Ideally, it would be nice to save the ... dots for passing parameters through to other functions or for lazy loading like sum allows: sum(1,2,3) == sum(c(1,2,3)). [Or maybe ..1 could be reimagined to allow for multiple dots: ...a, ...b, {ldots}, ...z where the name/order of the ...{letter} would allow lots of match.call magic. Regardless, even this magic is happening in the function, not as a standalone VARIADIC external magicFunction]
Objective
Anyway, I am trying to write a few variadic functions that allow the USER to input either the FUN as fn.str or as fn.obj. At the GLOBAL scope, the following will work:
str.fromObjectName = function(objname)
{
res = deparse(substitute(objname));
res = str.replace('"', "", res);
return(res);
}
WHERE str.replace is a extension of gsub, so for simplicity, let's say:
str.replace = function(search, replace, str)
{
gsub(search, replace, str, fixed=TRUE);
}
So if it is an object, I get the string.name of it (whether or not it actually exists, no error thrown). If it is a string, it has an extra " wrapping it, so the str.replace takes care of that.
As a procedural function, I would like to be able to access this in OTHER functions. But with the nature of the R stack (or my lack of understanding), I can't seem to get it to work. I found a solution in some baseR code that I have applied to use the ... dots to TRAP the potential object. But it has some limitations: I have to use the ... dots so I can't use them for other purposes, and if I call a function from a function the evaluation of the original function name gets lost, so I apply the character.only=FALSE when I call the function INTERNALLY to the other function where at some point the FN.OBJ was converted to FN.STR
So if I review the base packages with character.only I believe the help or library uses it to trap the pkg as a string or object. Maybe the solution is trivial which I am missing, but as I review the base code, it seems like it may be a challenge. It appears the function doesn't know what to do automatically without the character.only flag.
> library
function (package, help, pos = 2, lib.loc = NULL, character.only = FALSE,
...
if (!character.only)
package <- as.character(substitute(package))
...
else if (!missing(help)) {
if (!character.only)
help <- as.character(substitute(help))
...
else invisible(.packages())
}
<bytecode: 0x0000013699060b10>
<environment: namespace:base>
An example
Here is a preamble of one function:
function.info = function(..., character.only=FALSE)
{
if(character.only)
{
fn.str = unlist(list(...));
} else {
fn.str = str.fromObjectName(...);
}
}
NOTE: the ... passthrough allows the GLOBAL function to correctly scope.
This allows the function str "sum" or the function object sum to be inputed into the function (making life BETTER for the user). In the spirit of DRY and VARIADIC programming, it would be nice if I could do this as one external function to function.info ... and allow multiple fn objects to be passed in as parameters that are either the str "sum" or the object sum which INTERNALLY for most purposes I just want the resulting str.
Question
Given a function, how to allow a user to pass multiple FUN elements as either obj/string (mix allowed) using an external function (DRY = don't repeat yourself). In the example, I am referring to FUN.OBJ, but the goal would be to return anything that could be called an OBJ in R, not just a function.
magicFunction = function(FUN.OBJ.OR.STR, return="STR")
{
# do something here ... FUN.OBJ could be any R.OBJ
FUN.AS.STR;
# or if return = "OBJ"
FUN.AS.OBJ
}
v.math = function(data=c("#abcdef","#123456"), FUN, param="hi", FUN.pre="hex2dec", FUN.post=dec2hex)
{
# takes input [whether a str/obj] and returns a string/object.
fn.str = magicFunction(FUN);
fn.pre = magicFunction(FUN.pre);
fn.post = magicFunction(FUN.post);
# get to the main event
}
In the above, "hex2dec" is a string (as in "foo") and dec2hex is an object (as in bar): both referring to functions [something akin to match.fun(base::sum) or match.fun("base::sum"); I think currently it only searches the TOP of the stack.]. I can call my function str.fromObjectName on them in the GLOBAL sphere and get what I want, but when placed inside another function, it will return something else. I did a bunch of sys.call VOODOO that I didn't understand fully, and it would allow it to work at one-level deep of function calls (I guess because of the nature of the call stack). And it would only work on have one FUN to evaluate in the v.math where I have 3 functions to evaluate.
Here's a wrapper around match.fun to allow for the user to include :: in a string argument:
as_fun = function(x) {
if(is.character(x) && grepl("::", x)) return(eval(parse(text = x)))
match.fun(x)
}
as_fun(base::sum)
# function (..., na.rm = FALSE) .Primitive("sum")
as_fun("base::sum")
# function (..., na.rm = FALSE) .Primitive("sum")
as_fun(sum)
# function (..., na.rm = FALSE) .Primitive("sum")
as_fun("sum")
# function (..., na.rm = FALSE) .Primitive("sum")
I'm trying to write a function that captures the arguments of the function it is called from. For example,
get_args <- function () as.list( sys.call(sys.parent()) )[-1]
caller <- function (x, y, z) {
get_args()
}
caller(1,2,3)
[[1]]
[1] 1
[[2]]
[1] 2
[[3]]
[1] 3
sys.call() unfortunately does not add match parameter names with argument values, and I'd like to write a similar version of get_args that returns output similar to
caller2 <- function (x, y, z) {
as.list( match.call() )[-1]
}
caller2(1,2,3)
$x
[1] 1
$y
[1] 2
$z
[1] 3
replacing "get_args()" with "match.call()" directly is not the solution I'm looking for, since in reality get_args will do some other things before returning its parent functions arguments.
I've tried to use match.call() with sys.parent() in several ways, but I can't get the function to return the arguments of caller; it just returns the arguments of get_args().
Is there any way to make get_args() return output identical to that of caller2 for the above test case? I know that naming the arguments manually is possible using formals(), but is this guaranteed to be equivelant?
If any clarification is needed, leave a comment below. Thanks.
EDIT 1:
the aim of get_args() is to act as a user-friendly way of getting the arguments with which a function was called. Typing as.list( match.call() )[-1] gets old, but because match.call grabs the nearest function call it just gets the arguments of get_args() at the moment.
get_args() will also get default arguments from the parent function, but this easy to implement.
SOLUTION:
thanks Hong Ooi, the key to using match.call seems to be providing both the call and the definition of the function you want to find out about. A slightly modified, anonymous-friendly version of get_args is below for posterity
get_args <- function () {
as.list( match.call(
def = sys.function( -1 ),
call = sys.call(-1)) )[-1]
}
This version finds the function further up the call stack, grabs its definition and call, and matches parameters to its arguments.
get_args <- function()
{
cl <- sys.call(-1)
f <- get(as.character(cl[[1]]), mode="function", sys.frame(-2))
cl <- match.call(definition=f, call=cl)
as.list(cl)[-1]
}
The key here is to set the definition argument to match.call to be get_arg's calling function. This should (hopefully!) work for the general case where get_args can be called from anywhere.
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)
}
Suppose all of your S4 methods associated to a specific S4 generic function/method share a formal argument that is supposed to have a specific default value. Intuitively, I would state such an argument in the definition of the S4 generic (as opposed to stating it in each method definition which would seem somewhat redundant to me).
However, I noticed that this way I'm running into trouble as it seems that the default value of the formal argument is not dispatched to the methods and thus an error is thrown.
Isn't this somewhat against the idea of having a combination of a generic and methods? Why would I have to state the formal argument in each method separately again when the default value is always the same? Can I explicitly dispatch formal arguments' default values somehow?
Below you'll find a short illustration of the behavior
Generic function
setGeneric(
name="testFoo",
signature=c("x", "y"),
def=function(
x,
y,
do.both=FALSE,
...
) {
standardGeneric("testFoo")
}
)
Method
setMethod(
f="testFoo",
signature=signature(x="numeric", y="numeric"),
definition=function(
x,
y
) {
if (do.both) {
out <- list(x=x, y=y)
} else {
out <- x
}
return(out)
}
)
Error
> testFoo(x=1, y=2)
Error in .local(x, y, ...) : object 'do.both' not found
Redundant statement of do.both fixes it
setMethod(
f="testFoo",
signature=signature(x="numeric", y="numeric"),
definition=function(
x,
y,
do.both=FALSE
) {
if (do.both) {
out <- list(x=x, y=y)
} else {
out <- x
}
return(out)
}
)
> testFoo(x=1, y=2)
[1] 1
When you call testFoo(x=1, y=2), it is processed first by the S4 generic, which looks for a method, finds it, and dispatches to it a call that looks like this: testFoo(x=1, y=2, do.both=FALSE, ...).
In the words of ?standardGeneric:
‘standardGeneric’ dispatches the method defined for a generic
function named ‘f’, using the actual arguments in the frame from
which it is called.
If the method to which it dispatches that call does not take a do.both argument, the method --- just like any other R function --- throws an error. No function can process a call containing an argument foo unless it's function definition contains either (a) a formal argument foo or (b) a "dots" argument, ..., which can absorb arbitrary supplied arguments.
Basically what you've tried is no different than the following, which fails in a similarly but perhaps easier-to-see way:
testFooGeneric <- function(x=1, y=2, do.both=FALSE, ...) {
## The line below does essentially what standardGeneric() does
if(is.numeric(x) & is.numeric(y)) {
testFooMethod(x=x, y=y, do.both=do.both)
}
}
testFooMethod <- function(x, y) {
cat("Success!\n")
}
testFooGeneric(x=1, y=2)
# Error in testFooMethod(x = x, y = y, do.both = do.both) :
# unused argument(s) (do.both = do.both)
To fix the above, you need to redefine testFooMethod() in one of the following two ways, either of which will also remedy your S4 method:
## Option 1
testFooMethod <- function(x, y, do.both) {
cat("Success!\n")
}
testFooGeneric(x=1, y=2)
# Success!
## Option 2
testFooMethod <- function(x, y, ...) {
cat("Success!\n")
}
testFooGeneric(x=1, y=2)
## Success!