download code
## Chunk 1
library("RBioinf")
library("graph")
library("Rgraphviz")
library("methods")
## Chunk 2
setClass("Passenger", representation(name="character",
                                     origin="character", 
                                     destination="character"))
setClass("FreqFlyer", representation(ffnumber = "numeric"),
   contains = "Passenger")
getClass("FreqFlyer")
subClassNames("Passenger")
superClassNames("FreqFlyer")
  (solution chunk)
  (solution chunk)
## Chunk 5
setClass("Rectangle", 
   representation(h="numeric", w="numeric", area="numeric"))
myr = new("Rectangle", h=10, w=20, area=200)
setGeneric("area", function(shape) standardGeneric("area"))
setMethod("area", signature(shape = "Rectangle"), function(shape) shape@area)
myr@area
area(myr)
## Chunk 6
setClass("Rectangle", representation(h="numeric", w="numeric"))
setMethod("area", "Rectangle", function(shape) shape@h * shape@w)
## Chunk 7
 x = 1:10
 class(x)
 dim(x) = c(2,5)
 class(x)
 attr(x, "class")
 inherits(x, "integer")
## Chunk 8
 x=list(name="Josephine Biologist",
    origin = "SEA", destination = "YXY")
 class(x) = "Passenger"
 y = list(name="Josephine Physicist",
    origin = "SEA", destination = "YVR", ffnumber = 10)
 class(y) = c("FreqFlyer", "Passenger")
 inherits(x, "Passenger")
 inherits(x, "FreqFlyer")
 inherits(y, "Passenger")
## Chunk 9
x = 1:10
is.object(x)
class(x) = "myint"
is.object(x)
## Chunk 10
x = matrix(1:10, nc=2)
class(x) = "matrix"
x
is.object(x)
oldClass(x) = "matrix"
x
is.object(x)
  (solution chunk)
  (solution chunk)
## Chunk 13
 ex1VL = c("Sex, M=MALE, F=FEMALE", "Age in years")
 names(ex1VL) = c("Sex", "Age")
 class(ex1VL) = "VARLS3"
## Chunk 14
 set.seed(123)
 simExprs = matrix(rgamma(10000, 500), nc=10, nr=100)
 simS = sample(c("M", "F"), 10, rep=TRUE)
 simA = sample(30:45, 10, rep=TRUE)
 simPD = data.frame(Sex=simS, Age=simA)
## Chunk 15
 new.EXPRS3 = function(Class, eData, pData, cDesc) {
     if(!is.matrix(eData) )
         stop("invalid expression data")
     if(!is.data.frame(pData) )
         stop("invalid phenotypic data")
     if(!inherits(cDesc, "VARLS3"))
         stop("invalid cov description")
     ncE = ncol(eData)
     nrP = nrow(pData)
     if( ncE != nrP )
         stop("incorrect dimensions")
     pD = list(pData=pData, varLabels=cDesc)
     class(pD) = "PHENODS3"
     ans = list(exprs=eData, phenoData = pD)
     class(ans) = class(Class)
     ans
}
## Chunk 16
 myES3 = new.EXPRS3("EXPRS3", simExprs, simPD, ex1VL)
## Chunk 17
fun = function(x, ...) UseMethod("fun")
fun.default = function(x, ...) print("In the default method")
fun(2)
## Chunk 18
fun.Foo = function(x) {
    print("start of fun.Foo")
    NextMethod()
    print("end of fun.Foo")
}
fun.Bar = function(x) {
    print("start of fun.Bar")
    NextMethod()
    print("end of fun.Bar")
}
## Chunk 19
x = 1
class(x) = c("Foo", "Bar")
fun(x)
  (solution chunk)
## Chunk 21
methods("mean")
## Chunk 22
 methods(class="glm")
## Chunk 23
 fun.Foo = function(x, ...) print(ls(all=TRUE))
 y=1
 class(y) = c("Foo", "Zip", "Zoom")
 fun(y)
## Chunk 24
 fun.Foo = function(x, ...) {
  print(paste(".Generic =", .Generic))
  print(paste(".Class =", paste(.Class, collapse=", ")))
  print(paste(".Method =", .Method))
}
 fun(y)
## Chunk 25
methods("$<-")
  (solution chunk)
  (solution chunk)
## Chunk 28
  setClass("A", representation(s1="numeric"), 
               prototype=prototype(s1=0))
  myA = new("A")
  myA
  m2 = new("A", s1=10)
  m2
## Chunk 29
   setClass("B", contains="A", representation(s2="character"),
          prototype=list(s2="hi"))
   myB = new("B")
   myB
## Chunk 30
setClass("Ohno", representation(y="numeric"))
getClass("Ohno")
removeClass("Ohno")
tryCatch(getClass("Ohno"), error=function(x) "Ohno is gone")
## Chunk 31
getSlots("A")
slotNames("A")
## Chunk 32
extends("B")
extends("B", "A")
extends("A", "B")
superClassNames("B")
subClassNames("A")
## Chunk 33
## getClass("matrix")
## Chunk 34
extends("matrix")
## Chunk 35
myb = new("B")
as(myb, "A")
## Chunk 36
mya = new("A", s1 = 20)
as(myb, "A") <- mya
myb
## Chunk 37
## setAs(from="graphAM", to="matrix",
##       function(from) {
##           if ("weight" %in% names(edgeDataDefaults(from))) {
##               tm <- t(from@adjMat)
##               tm[tm != 0] <- unlist(edgeData(from, attr="weight"))
##               m <- t(tm)
##           } else {
##               m <- from@adjMat         
##           }
##           rownames(m) <- colnames(m)
##           m
##       })
## Chunk 38
  setClass("Ex1", representation(s1="numeric"),
           prototype=prototype(s1=rnorm(10)))
  b = new("Ex1")
  b
  (solution chunk)
  (solution chunk)
## Chunk 41
bb = getClass("B")
bb@prototype
## Chunk 42
setClass("W", representation(c1 = "character"))
setClass("WA", contains=(c("A", "W")))
a1 = new("A", s1=20)
w1 = new("W", c1 = "hi")
new("WA", a1, w1)
## Chunk 43
setClass("XX", representation(a1 = "numeric", 
    b1 = "character"), 
    prototype(a1 = 8, b1 = "hi there"))
new("XX")
setMethod("initialize", "XX", function(.Object, ..., b1) {
   callNextMethod(.Object, ..., b1 = b1, a1 = nchar(b1))
})
 new("XX", b1="yowser")
## Chunk 44
 setClass("Capital",
          representation=representation(
            string="character"))
 setClass("CountedCapital",
          contains="Capital",
          representation=representation(
            length="numeric"))
 setMethod("initialize",
           "Capital", 
           function(.Object, ..., string=character(0)) {
             string <- toupper(string)
             callNextMethod(.Object, ..., string=string)
           })
 setMethod("initialize",
           "CountedCapital",
           function(.Object, ...) {
             .Object <- callNextMethod()
             .Object@length <- nchar(.Object@string)
             .Object
           })
 new("Capital", string="MiXeD")
 new("CountedCapital", string="MiXeD")
 new("CountedCapital", string=c("MiXeD", "MeSsaGe"))
## Chunk 45
setClass("seq", contains="numeric", 
         prototype=prototype(numeric(3)))
s1 = new("seq")
s1
slotNames(s1)
## Chunk 46
 setMethod("initialize", "seq", function(.Object) {
   .Object[1]=10; .Object})
 new("seq")
## Chunk 47
tryCatch(setMethod("[", signature("integer"), 
                   function(x, i, j, drop) print("howdy")), 
         error = function(e)
         print("we failed"))
setClass("Myint", representation("integer"))
setMethod("[", signature("Myint"), 
                   function(x, i, j, drop) print("howdy"))
x = new("Myint", 4:5)
x[3]
## Chunk 48
setClass("DBFunc", "function")
setMethod("$", signature = c("DBFunc", "character"),
  function(x, name) x(name))
## Chunk 49
mytestFun = function(arg) print(arg)
mtF = new("DBFunc", mytestFun)
mtF$y
is(mtF, "function")
## Chunk 50
mya = new("A", s1 = 20)
class(mya)
attributes(mya)
## Chunk 51
attr(mya, "s1") <- "L" 
mya
## Chunk 52
setClassUnion("lorN", c("list", "NULL"))
subClassNames("lorN")
superClassNames("lorN")
isVirtualClass("lorN")
isClassUnion("lorN")
## Chunk 53
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)
## Chunk 54
setOldClass("mymatrix")
getClass("mymatrix")
## Chunk 55
setClass("myS4mat", representation(m = "mymatrix"))
x=matrix(1:10, nc=2)
class(x) = "mymatrix"
m4 = new("myS4mat", m=x)
## Chunk 56
head(subClassNames(getClass("oldClass")))
## Chunk 57
 setGeneric("foo", 
   function(object, x) standardGeneric("foo") )
 setMethod("foo", signature("numeric", "character"),
   function(object, x) print("Hi, I'm method one"))
## Chunk 58
  setGeneric("genSig", signature=c("x"), 
             function(x, y=1) standardGeneric("genSig"))
   
  setMethod("genSig", signature("numeric"), 
            function(x, y=20) print(y))
  genSig(10)
## Chunk 59
 setGeneric("foo", function(x,y,...) {
  y = standardGeneric("foo")
   print("I'm back")
  y
 })
 setMethod("foo", "numeric", function(x,y,...) {print("I'm gone")}
 )
 foo(1)
## Chunk 60
library("Biobase")
allG = getGenerics()
allGs = split(allG@.Data, allG@package)
allGBB = allGs[["Biobase"]]
length(allGBB)
## Chunk 61
allGbb = getGenerics("package:Biobase")
length(allGbb)
## Chunk 62
 setGeneric("bar", function(x, y, ...) standardGeneric("bar"))
 setMethod("bar", signature("numeric", "numeric"),
    function(x, y, d) print("Method1"))
 ##removes the method above
 setMethod("bar", signature("numeric", "numeric"),
    function(x, y, z) print("Method2"))
 bar(1,1,z=20)
 bar(2,2,30)
 tryCatch(bar(2,4,d=20), error=function(e) 
          print("no method1"))
## Chunk 63
 setGeneric("a<-", function(x, value)
            standardGeneric("a<-"))
 setReplaceMethod("a", "Foo",
  function(x, value) {
    x@a = value
    x
  })
  a(b) = 32
  b
## Chunk 64
## setMethod("$", "eSet", function(x, name) {
##     eval(substitute(phenoData(x)$NAME_ARG, 
##                     list(NAME_ARG = name)))
## })
## Chunk 65
 cnew = function(x, ...) {
   if(nargs() < 3)
    c2(x, ...)
   else
    c2(x, cnew(...))
 }
## Chunk 66
setGeneric("c2", function(x, y) standardGeneric("c2"))
## Chunk 67
setMethod("c2", signature("numeric", "numeric"), function(x, y) x + y) 
cnew(1,2,3,4)
## Chunk 68
x = 1
class(x) = c("C1", "C2")
is(x, "C2")
inherits(x, "C2")
  (solution chunk)
## Chunk 70
setOldClass(c("C1", "C2"))
is(x, "C2")
## Chunk 71
x = 1
setClass("A", representation(s1="numeric"))
setMethod("+", c("A", "A"), function (e1, e2) print("howdy"))
class(x) = "A"
x + x
asS4(x) + x
## Chunk 72
## setMethod("foo", "myclass", myS3Method)
## setMethod("foo", "myclass", function(x, y, ...) myS3Method(x, y, ...))
## Chunk 73
 testG  = function(x, ...) UseMethod("testG")
 setGeneric("testG")
 getMethod("testG", signature="ANY")
## Chunk 74
library("graph")
library("Rgraphviz")
library("RBGL")
## Chunk 75
graphClasses = getClasses("package:graph")
head(graphClasses)
## Chunk 76
graphClassgraph = classList2Graph(graphClasses)
## Chunk 77
ccomp = connectedComp(graphClassgraph)
complens = sapply(ccomp, length)
length(ccomp)
table(complens)
## Chunk 78
unlist(ccomp[complens==1], use.names=FALSE)
## Chunk 79
subGnodes = ccomp[[which.max(complens)]]
subG = subGraph(subGnodes, graphClassgraph)
nodeRenderInfo(subG) <- list(shape="ellipse")
attrs = list(node=list(fixedsize = FALSE))
x = layoutGraph(subG, attrs = attrs)
renderGraph(x)
  (solution chunk)