The R Project SVN R

R : Copyright 2003, The R Development Core Team
Version 1.7.0 Under development (unstable) (2003-02-01)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type `license()' or `licence()' for distribution details.

R is a collaborative project with many contributors.
Type `contributors()' for more information.

Type `demo()' for some demos, `help()' for on-line help, or
`help.start()' for a HTML browser interface to help.
Type `q()' to quit R.

> #### Testing  UseMethod() and even more NextMethod()
> ####
> 
> ###-- Group methods
> 
> ### Arithmetic "Ops" :
> ">.bar" <- function(...) print(">.bar")
> ">.foo" <- function(...) print(">.foo")
> Ops.foo <- function(...) {
+     print("Ops.foo")
+     NextMethod()
+ }
> Ops.bar <- function(...)
+     print("Ops.bar")
> 
> x <- 2:4 ; class(x) <- c("foo", "bar")
> y <- 4:2 ; class(y) <- c("bar", "foo")
> 
> ## The next 4 give a warning each about incompatible methods:
> x > y
[1] FALSE FALSE  TRUE
Warning message: 
Incompatible methods (">.foo", ">.bar") for ">" 
> y < x # should be the same (warning msg not, however)
[1] FALSE FALSE  TRUE
Warning message: 
Incompatible methods ("Ops.bar", "Ops.foo") for "<" 
> x == y
[1] FALSE  TRUE FALSE
Warning message: 
Incompatible methods ("Ops.foo", "Ops.bar") for "==" 
> x <= y
[1]  TRUE  TRUE FALSE
Warning message: 
Incompatible methods ("Ops.foo", "Ops.bar") for "<=" 
> 
> x > 3 ##[1] ">.foo"
[1] ">.foo"
> 
> rm(list=">.foo")
> x > 3 #-> "Ops.foo" and ">.bar"
[1] "Ops.foo"
[1] ">.bar"
> 
> 
> 
> ### ------------  was ./mode-methods.R till R ver. 1.0.x ----------------
> 
> ###-- Using Method Dispatch on "mode" etc :
> ## Tests S3 dispatch with the class attr forced to be data.class
> ## Not very relevant when S4 methods are around, but kept for historical interest
> abc <- function(x, ...) {
+     if (is.null(oldClass(x))) oldClass(x) <- data.class(x)
+     cat("abc: Before dispatching; x="); str(x)
+     UseMethod("abc", x) ## UseMethod("abc") (as in S) fails
+ }
> 
> abc.default <- function(x, ...) sys.call()
> 
> "abc.(" <- function(x)
+     cat("'(' method of abc:", deparse(sys.call(sys.parent())),"\n")
> abc.expression <- function(x)
+     cat("'expression' method of abc:", deparse(sys.call(sys.parent())),"\n")
> 
> abc(1)
abc: Before dispatching; x=Class 'numeric'  num 1
abc.default(1)
> e0 <- expression((x))
> e1 <- expression(sin(x))
> abc(e0)
abc: Before dispatching; x=Class 'expression'   expression((x))
'expression' method of abc: abc.expression(e0) 
> abc(e1)
abc: Before dispatching; x=Class 'expression'   expression(sin(x))
'expression' method of abc: abc.expression(e1) 
> abc(e0[[1]])
abc: Before dispatching; x=Class '('  language, mode "(": ( x
'(' method of abc: "abc.("(e0[[1]]) 
> abc(e1[[1]])
abc: Before dispatching; x=Class 'call'  language sin(x)
abc.default(e1[[1]])
>