How can I implement the generic function names for my S3 class so I can "set" the names of my object.
To retrieve the names I simply implemented it as:
names.myobject <- function(x, ...){
x$y
}
and then I can do:
names(myobject)
But I can't use it to set the names in the form of:
names(myobject) <- "a"
I'm thinking to something like:
names.myobject <- function(x, newname){
x$y <- newnames
}
How can implement the "set" form of names?
Figure out the signatures of the generics from the functions; the 'setter' is names<-.
> names
function (x) .Primitive("names")
> `names<-`
function (x, value) .Primitive("names<-")
names and names<- are so-called primitive functions, with method dispatch implemented in C, so the usual indication that you're working with an S3 generic (UseMethod("foo") in the body of the generic) is not present.
Implement methods following the pattern generic.class = function.... Remember that the return value of the setter method needs to be the object that you've updated
names.myobject <- function(x) x$y
`names<-.myobject` <- function(x, value) { x$y = value; x }
Related
How could I use some of the arguments passed to a function using the ellipsis to create a new object of an S4 class, while naming the arguments?
Example:
foo <- function(a, ...){
cur_args <- lapply(match.call(expand.dots=TRUE)[-1], deparse)
args_to_keep <- names(cur_args) %in% slotNames("myClass1")
newClassObj <- new("myClass1", what can go here??? )
}
Is there any way to use do.call and comply with the types of the slots of the class / retain the type as it was passed to foo?
newClassObj <- do.call( "new", as.list( c("Class"="myClass1", cur_args[args_to_keep] )) )
You have the right idea,
you just have to create the list of arguments passed to new correctly:
setClass("A", slots=c(x="numeric"))
foo <- function(...) {
dots <- list(...)
valid_slots <- dots[intersect(names(dots), slotNames("A"))]
do.call(new, c(list(Class="A"), valid_slots))
}
> foo(x=1, y=2)
An object of class "A"
Slot "x":
[1] 1
c can be used to append lists to each other,
so you just need to wrap Class="A" in a list.
I need to build a lot of functions with lots of different arguments, though they otherwise share a lot of code and structure.
To avoid duplication, I thought I'd be clever and build myself a function factory (aka closure).
I can't figure out how to pass the function arguments inside the function factory.
My use case is a bunch of S3 constructor functions, all of which share the same validation mechanism.
So I'll use that as an example to explain my problem.
Say, I have a ClassA and ClassB, each of which require their own arguments in the respective constructor functions:
ClassA <- function(A_arg1, A_arg2) {
# some class-SPECIFIC construction magic happens, say
out <- list(A_arg1, A_arg2)
# some GENERAL construction magic happens
class(out) <- "ClassA"
return(out)
}
ClassB <- function(B_arg1, B_arg2) {
# some class-SPECIFIC construction magic happens, say
out <- B_arg1 + B_arg2
# some GENERAL construction magic happens
class(out) <- "ClassB"
return(out)
}
Obviously, I'd love to avoid the duplication in the general part of the constructor functions, so a function factory that could be used like so would be nice:
ClassA <- produce_class_constructor(classname = "ClassA", fun = function(A_arg1, A_arg2) {return(list(A_arg1, A_arg2))})
This should, ideally, yield the exact same function as the above manually constructed ClassA function, with the general part factored out.
Here's my attempt at building that function factory:
produce_class_constructor <- function(classname, fun) {
class_specific_arguments <- formals(fun = fun) # this works just fine on the console
construct_class <- function(class_specific_arguments) {
# here runs the class-specific stuff
out <- fun(class_specific_arguments)
# here runs the general stuff
class(out) <- classname
}
}
This however, does not work, because the resulting constructor function only has a class_specific_arguments-argument, not the, well, actual A_arg1, and A_arg2.
Is there way to do this?
Am I doing this wrong?
(It's really important to me that the resulting class constructor functions have properly named arguments, so a ... approach won't work).
Here's my attempt:
produce_class_constructor <- function(classname, fun) {
out_fun <- function() {
out_obj <- do.call(fun, as.list(environment()))
class(out_obj) <- classname
out_obj
}
formals(out_fun) <- formals(fun)
out_fun
}
ClassA <- produce_class_constructor(classname = "ClassA",
fun = function(A_arg1, A_arg2) {list(A_arg1, A_arg2)})
ClassA(1, 2)
#[[1]]
#[1] 1
#
#[[2]]
#[1] 2
#
#attr(,"class")
#[1] "ClassA"
ClassB <- produce_class_constructor(classname = "ClassB",
fun = function(B_arg1, B_arg2) {B_arg1 + B_arg2})
ClassB(B_arg2 = 2, 1)
#[1] 3
#attr(,"class")
#[1] "ClassB"
Idea with as.list(environment()) taken from this question. Note that you should be extra careful along that path, as ?formals says, "this is
advanced, dangerous coding".
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.
I'm attempting to override base (non-S3) methods to provide colnames methods for a custom R object. I want to do this with S3 not S4.
For the colnames accessor, this can be achieved by setting the base function to be the default method, then providing a method for my class:
colnames <- function(x, ...) UseMethod("colnames")
colnames.default <- base::colnames
colnames.myclass <- function(x, ...) {
# some code here
}
However, how would one override the setter method. I would hope something like this should work?
"colnames<-" <- function(x, value) UseMethod("colnames<-")
"colnames<-.default" <- "base::colnames<-"
"colnames<-.myclass" <- function(x, value) {
print("Setting colnames for myclass")
# Some code
}
However, this seems to fail to call the base function correctly for a regular matrix:
> test <- matrix(1:10, 5)
> colnames(test) <- c("a", "b")
Error in UseMethod("colnames<-") :
no applicable method for 'colnames<-' applied to an object of class "c('matrix', 'integer', 'numeric')"
You set colnames<-.default to a character string (i.e. not a function). That's not going to work.
"colnames<-.default" <- "base::colnames<-"
Use backticks to reference objects with non-syntactic names.
`colnames<-.default` <- base::`colnames<-`
I would like to know if a given object has a particular method.
For example, suppose I want to know whether my mystery object has a specific print method. From reading ?methods, I try something like this:
has.print <- function (mysteryObject) {
'print' %in% attr(methods(class=class(mysteryObject)), 'info')$generic
}
m <- lm(Sepal.Length ~ Species, iris)
class(m) # 'lm'
has.print(m)
This is fine if mysteryObject has just one class. If it has multiple, there are problems in methods. I can get around this by using class(mysteryObject)[1], so that (for example)
library(data.table)
class(test) # data.table, data.frame
test <- data.table(iris)
has.print(test) # TRUE since there's a print.data.table
However, if I have something with multiple classes but the first does not have a print method, this returns false. Example:
mlm <- lm(cbind(Petal.Length, Petal.Width) ~ Species, iris)
class(mlm) # 'mlm', 'lm'. Note there is no print.mlm but there's a print.lm
has.print(mlm) # FALSE
This returns FALSE as there is no print.mlm. However, there is a print.lm, that is used instead, so I would like this to return TRUE.
Speaking as someone who knows very little about S3, S4, etc, is there a "proper" way to see if an object has a 'print' method on any of its classes? Ideally this works for both S3 and S4 objects, though I do not know what this means.
I can vectorise my methods(class=...) over class(mysteryObject), but I bet there's a more appropriate way to do it...
Apply methods on every class, unlist and search for "print":
has.print <- function(object) {
"print" %in%
unlist(
lapply(
class(object),
function(x) attr(methods(class = x), "info")$generic)
)
}
It is possible to start from the other side (searching for a class in all
generic print functions):
has.print <- function(object) {
any( sprintf("print.%s", class(object)) %in%
rownames(attr(methods(generic.function = "print"), "info")))
}
To find the method:
which.print <- function(object) {
print_methods <- rownames(attr(methods(generic.function = "print"), "info"))
print_methods[print_methods %in% sprintf("print.%s", class(object))]
}
# > which.print(mlm)
# [1] "print.lm"
S4
S4 classes are "printed" with show method. If no specialized method exists the showDefault is called. Function showMethods will show if there is any specialized show:
For example:
library(Matrix)
showMethods(f = "show", class = "denseMatrix")
#> Function: show (package methods)
#> object="denseMatrix"
showDefault is also calling print for non S4 members.