S4Objects.R

Code snipits and programs written in R, S or S-PLUS library(methods) setClass("foo", representation(a = "character", b = "numeric")) setClass("bar", representation(d = "numeric", c = "numeric")) setClass("baz", contains = c("foo", "bar"))

isClass("baz") getClass("baz") getExtends("baz") getSlots("baz")

x <- new("baz", a = "xxx", b = 5, c=10)

1. Virtual classes

getClass("vector")

setClass("dendNode")

setClass("dnode", representation(left = "dendNode", right = "dendNode", height = "numeric"), contains = "dendNode")

setClass("tnode", representation(height = "numeric", value = "numeric", label = "character"), contains = "dendNode")

setClassUnion("listOrNULL", c("list", "NULL"))

setClass("c1", representation(value = "listOrNULL")) y <- new("c1", value = NULL) y y2 <- new("c1", value = list(a = 10)) y2

setClass("myVclass", representation(a = "character"), contains = ("VIRTUAL")) getClass("myVclass")

setClass("xx", representation(a = "numeric", b = "character"), prototype(a = 3, b = "hi there")) new("xx")

setMethod("initialize", "xx", function(.Object, b) {

 .Object@b <- b
 .Object@a <- nchar(b)
 .Object})

new("xx", b = "yowser")

setClass("lgtdl", representation(times = "numeric", values = "numeric")) setClass("xlgtdl", representation(number = "numeric"), contains = "lgtdl")

x1 <- new("lgtdl", times = 1:5, values = rnorm(5)) y1 <- new("xlgtdl", number = 5, x1) setMethod("show", "lgtdl", function(object) { cat("times:", object@times, "\n")

                                             cat("values:", object@values, "\n")})

setMethod("show", "xlgtdl", function(object) {callNextMethod()

                                             cat("of length", object@number, "\n")})

grub <- local({y <- 1

              function(x) x + y})

grub(1)

setGeneric("foo", function(x) standardGeneric("foo")) local({y <- 1

      setMethod("foo", "numeric", function(x) x + y)})

foo(1)

setGeneric("bar", function(x){y <- 1; standardGeneric("bar")}) setMethod("bar", "numeric", function(x) x + y) bar(1)

setClass("foo", representation(a = "ANY")) setGeneric("a", function(object) standardGeneric("a")) setMethod("a", "foo", function(object) object@a) b <- new("foo", a = 10) a(b)

setGeneric("a<-", function(x, value) standardGeneric("a<-")) setReplaceMethod("a", "foo", function(x, value) {x@a <- value + x }) a(b) <- 32 c