Using s3 to extend summary function - r

Using below code I'm attempting to re-write the summary function so that just the coefficient is returned :
summary <- function(x)
{
UseMethod("GetFirst",x)
}
summary <- function(x)
{
return(x$Coefficient)
}
class(summary) <- "mysum"
tosum = as_tibble(c(1,2,3))
tosum
summary(tosum)
This returns an error :
> summary(tosum)
NULL
Warning message:
Unknown or uninitialised column: 'Coefficient'.
How to read the available properties on the summary function and invoke using s3 ?

summary is already a Generic function so you don't need UseMethod. In order to extend its functionality you need to add another method which will work with the class you want.
See an example:
summary.myclass <- function(x)
{
return(x$Coefficient)
}
tosum = data.frame(Coefficient = c(1,2,3))
class(tosum) <- c('myclass', 'data.frame')
summary(tosum)
#[1] 1 2 3
Here I am defining an extension of summary (called method) for the myclass class. When I use summary on tosum which is of that class then summary.myclass is dispatched and the column Coefficiet is returned.

Related

What is the difference between object and .Object in OOP in R?

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

dataset and UDFs using sapply

I have a dataset (employee) created from a csv, that displays data as given below;
employee[1,]
age name designation
28 Tony Manager
I have created a function that returns a decision based on an input parameter;
loan_eligible_decision <- function(p)
{
if(p$designation == "manager")
{
decision <- "yes"
}
return(decision)
}
when the function is called directly it works fine and gives the result below;
loan_eligible_decision(employee[1,])
gives me output: yes
However when called within an sapply family it throws a reference error;
sapply(data.frame(employee[1,]),loan_eligible_decision(x))
Error in p$marital : $ operator is invalid for atomic vectors
Any suggestions as to what could be a possible workaround/solution?
I have also tried replacing the if condition with;
if(p[[designation]] == "manager")
and called upon the function like so;
sapply(employee['1',],loan_eligible_decision(x))
The error:
Error in loan_eligible_decision(x) : object 'designation' not found
You are calling the function incorrectly. It should be
myfun <- function(x) x^2
sapply(xy, FUN = myfun)
In any case, try inserting a browser() call within the function and inspect what is going on. See ?browser for more info.
myfun <- function(x) {
browser()
x^2
}

Override base assignment function

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<-`

How to see if an object has a particular method?

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.

Using "[[ ]]" notation for reference class methods

While experimenting with the new reference classes in R I noticed some odd behaviour if you use the "[[ ]]" notation for methods (X[["doSomething"]] instead of X$doSomething). This notation works for fields, but I initially thought it wouldn't work for methods until I found that if you execute "class(X$doSomething)" you can then use "[[ ]]" afterwards. The simple example below illustrates the point.
setRefClass("Number",
fields = list(
value = "numeric"
),
methods = list(
addOne = function() {
value <<- value + 1
}
)
)
X <- new("Number", value = 1)
X[['value']] # 1
X[["addOne"]]() # Error: attempt to apply non-function
class(X[["addOne"]]) # NULL
class(X$addOne) # "refMethodDef"
# Now the following works!
X[["addOne"]]() # sets X$value = 2
class(X[["addOne"]]) # "refMethodDef"
The reason I encountered this is because I want to group my objects together in a list and create an "applyMethod" function which applies a specified method on each of the objects within. Therefore, I need to specify the method as a string. Does anyone have any ideas how I can achieve this?
Here's a class
.A <-
setRefClass("A",
fields=list(x="numeric"),
methods=list(foo=function() x))
If I had an instance a and wanted to construct a call to the 'foo' method using '$' I could
eval(substitute(a$FUN(), list(FUN="foo")))
So I'll create a class Alist that is meant to have a list of elements of class A (this could be enforced programmatically), and that has a .delegate method that'll apply an arbitrary method to all elements of the list. I'll then add a method that delegates foo.
.delegate <- function(FUN, ...)
{
lapply(elts, function(elt, ...) {
eval(substitute(elt$FUN(...), list(FUN=FUN, ...)))
})
}
.Alist <-
setRefClass("Alist",
fields=list(elts="list"),
methods=list(
initialize = function(...) callSuper(elts=list(...)),
.delegate = .delegate,
foo=function() .delegate("foo")))
And then use it
> aList <- .Alist$new(.A$new(x=1), .A$new(x=2))
> aList$foo()
[[1]]
[1] 1
[[2]]
[1] 2
basically R5 ref class does not cache the method until it is necessary. This is probably a kind of delayed evaluation.
And the caching takes place when you access the method via $.
So, AFAIK, there is no way to access the method via [[string]]
But you can find a workaround using .dollarForEnvRefClass like this:
> X <- new("Number", value = 1)
> ls(X#.xData)
[1] "value" # no methods named "addOne" before caching
> X[["addOne"]]
NULL
> methods:::.dollarForEnvRefClass(X, "addOne") # cache it
Class method definition for method addOne()
function ()
{
value <<- value + 1
}
<environment: 0x116a4aa00>
> ls(X#.xData)
[1] "addOne" "value" # you can find it
> X$value # value is 1
[1] 1
> X[["addOne"]]() # call the method
> X$value # the method works
[1] 2
if you are interested in more detail, see the implementation:
http://svn.r-project.org/R/trunk/src/library/methods/R/refClass.R
Maybe there is more straightforward way.
Report as bug on r-devel so John Chambers can fix it.

Resources