CODEWITHSUNDEEP
r
Brandon Bertelsen
Brandon Bertelsen

Reputation: 44638

Writing methods for classes contained in another class

Let's say I have a structure that looks like this

obj <- list()
obj$title <- "Hello"
obj$data <- data.frame(c(1,2,3,4,5),c(5,4,3,2,1))
class(obj) <- "myclass"

I know I can write methods on the class: 

myfunction <- function(obj,...) { 
    UseMethod("myfunction")
}

myfunction.myclass <- function(obj,...) { 
    # magic
}

But how would I write a method for the data contained within the object on the basis of their class. I mean without having to write it all in the same function. Kind of like...

myfunction.myclass.data.frame <- function(obj,...) { 
    # do something if class(obj$data) == "data.frame"
}

myfunction.myclass.character <- function(obj,...) { 
    # do something if class(obj$data) == "character"
}

myfunction.myclass.numeric <- function(obj,...) { 
    # do something if class(obj$data) == "numeric"
}

Upvotes: 3

Views: 100

Answers (1)

bgoldst
bgoldst

Reputation: 35314

What you can do is make myfunction.myclass() a second-level generic (where myfunction() would be the first-level generic) by calling UseMethod() from it, and instead of omitting the second argument (which is normally done, defaulting to the first argument of the enclosing function) you can pass obj$data to it. This will dispatch to the named function based on the class of obj$data:

## define first-level obj generic
myfunction <- function(obj,...) UseMethod('myfunction');

## define second-level obj$data generic
myfunction.myclass <- function(obj,...) UseMethod('myfunction.myclass',obj$data);

## define obj$data specifics
myfunction.myclass.data.frame <- function(obj,...) { cat('----- class -----\ndata.frame\n----- obj -----\n'); print(obj); cat('----- args -----\n'); print(list(...)); };
myfunction.myclass.character <- function(obj,...) { cat('----- class -----\ncharacter\n----- obj -----\n'); print(obj); cat('----- args -----\n'); print(list(...)); };
myfunction.myclass.numeric <- function(obj,...) { cat('----- class -----\nnumeric\n----- obj -----\n'); print(obj); cat('----- args -----\n'); print(list(...)); };
myfunction.myclass.default <- function(obj,...) { cat('----- class -----\ndefault\n----- obj -----\n'); print(obj); cat('----- args -----\n'); print(list(...)); };

## create test obj
obj <- list();
obj$title <- 'Hello';
class(obj) <- 'myclass';

## demo 1: data.frame
obj$data <- data.frame(a=c(1,2,3,4,5),b=c(5,4,3,2,1));
myfunction(obj,1,'a',T);
## ----- class -----
## data.frame
## ----- obj -----
## $title
## [1] "Hello"
##
## $data
##   a b
## 1 1 5
## 2 2 4
## 3 3 3
## 4 4 2
## 5 5 1
##
## attr(,"class")
## [1] "myclass"
## ----- args -----
## [[1]]
## [1] 1
##
## [[2]]
## [1] "a"
##
## [[3]]
## [1] TRUE

## demo 2: character
obj$data <- letters;
myfunction(obj,2,'b',F);
## ----- class -----
## character
## ----- obj -----
## $title
## [1] "Hello"
##
## $data
##  [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z"
##
## attr(,"class")
## [1] "myclass"
## ----- args -----
## [[1]]
## [1] 2
##
## [[2]]
## [1] "b"
##
## [[3]]
## [1] FALSE

## demo 3: numeric
obj$data <- 1:10;
myfunction(obj,3,'c',T);
## ----- class -----
## numeric
## ----- obj -----
## $title
## [1] "Hello"
##
## $data
##  [1]  1  2  3  4  5  6  7  8  9 10
##
## attr(,"class")
## [1] "myclass"
## ----- args -----
## [[1]]
## [1] 3
##
## [[2]]
## [1] "c"
##
## [[3]]
## [1] TRUE

## demo 4: default (logical)
obj$data <- T;
myfunction(obj,4,'d',F);
## ----- class -----
## default
## ----- obj -----
## $title
## [1] "Hello"
##
## $data
## [1] TRUE
##
## attr(,"class")
## [1] "myclass"
## ----- args -----
## [[1]]
## [1] 4
##
## [[2]]
## [1] "d"
##
## [[3]]
## [1] FALSE

Upvotes: 3

Related Questions