1. 一些S3的铺垫

在博文“Linux安装R语言包”描述了如何查看一个函数的源代码,其中涉及了例如methods()函数,用来查看一个S3泛函(S3 generic)的方法。在pryr包中,提供了更加便捷的查看方法。

pryr check objects and methods
1
2
3
4
5
6
7
library('pryr')

## object is base type, S3, S4 or RC
otype(obj)

## function is genetic or method
ftype(method)

2. 类

2.1 建立新类

1
2
3
setClass(Class, representation, prototype, contains=character(),
         validity, access, where, version, sealed, package,
         S3methods = FALSE, slots)
  • Class:类名。

  • slots:带名字的列表或者字符向量,名字表示slot,内容表示slot对应的类名。

  • contains:父类名,表示继承关系。

  • prototype:带名setGroupGeneric字的列表或prototype(),设定默认值。不建议添加,如果不设定,会自动指定一个符合类型的空值。设定时,要结合validity定义,因为默认值不会被检查,因为即使不符合validity定义,也可以通过validObject()检查。

  • validity:函数,检查创建对象是否符合该类要求。建议添加,也可以使用setValidity()后期添加。

  • where:环境(少用)。

  • sealed:是否封闭,如果设定为TRUE,其他setClass()不能调用该类。

  • package:包名(少用)

  • S3methods/representation/access/version:在3.0.0版本后不建议使用。

例子:

Set new S4 classes
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
## new class
setClass(Class = 'trick',
         slots = c(id = 'character', time = 'matrix'),
         validity = function(object) {
           if (length(object@id) != nrow(object@time)) {
             warns <- paste('length of id is', length(object@id), 'is not equal to row number of time', nrow(object@time))
             return(warns)
           } else {
             return(TRUE)
           }},
         prototype = list(id = character(), time = matrix(0, 0, 0)))

setClass(Class = 'trickNum',
         slots = c(number = 'numeric'),
         contains = 'trick')

setClass(Class = 'trickMult',
         slots = c(trick1 = 'trick', trick2 = 'trick'))

## from setClass() help document, extend from built-in data type
setClass("numWithId",
         slots = c(id = "character"),
         contains = "numeric")

numWI1 <- new('numWithId', 1:10, id = letters[1:10])
## retrieve data of numWI1
numWI1@.Data

## without slots
numNoSlot <- setClass("num", contains = "numeric")

## simplest class
setClass(Class = 'simpleClass')

使用setOldClass()转换S3类型对象,使用getClass('oldClass')查询oldClass。

transfer S3 class to S4
1
2
3
structure(list(), class = 'TestS3Class')

setOldClass('TestS3Class')

2.2 创建、查看和删除对象

创建对象:

1
new(Class, ...)
  • Class:类名。

  • …:各个slot赋值。如果没有赋值,则使用初始化值。

在使用new()建立新的对象之前,会经历“初始化”。初始化可以对新建对象做一些事先固定的操作,比如给某一个slot添加名字等。这需要使用setMethod()重新定义initialize()泛函,考虑使用callNextMethod(),以保证子类也能够继承初始化,同时需要考虑“空对象”问题。由于callNextMethod()是向父类搜索,在有很多继承关系时,搜索结果会变得难以预测,因此尽量减少使用。

initialize
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
## first initialize can not be correctly inherited
setMethod(f = 'initialize',
          signature = 'trick',
          definition = function(.Object, id = character(), time = matrix(0, 0, 0)) {

            colNum <- ncol(time)
            if (colNum > 0) {
              colnames(time) <- paste0(letters[1:colNum], 1:colNum)
            } else {}

            .Object@id <- id
            .Object@time <- time

            return(.Object)
          })
t1 <- new('trick', id = letters[1:3], time = matrix(1:9, ncol = 3))
try(new('trickNum', id = letters[1:3], time = matrix(1:9, ncol = 3), number = 5:6))

## second initialize can not be correctly inherited
setMethod(f = 'initialize',
          signature = 'trick',
          definition = function(.Object, ...) {

            colNum <- ncol(.Object@time)
            if (colNum > 0) {
              colnames(.Object@time) <- paste0(letters[1:colNum], 1:colNum)
            } else {}

            return(.Object)
          })
try(new('trick', id = letters[1:3], time = matrix(1:9, ncol = 3)))
## not as expected, all slots are empty
try(new('trickNum', id = letters[1:3], time = matrix(1:9, ncol = 3), number = 5:6))

## third initialize using callNextMethod() works well
setMethod(f = 'initialize',
          signature = 'trick',
          definition = function(.Object, ...) {

            .Object <- callNextMethod()

            colNum <- ncol(.Object@time)
            if (colNum > 0) {
              colnames(.Object@time) <- paste0(letters[1:colNum], 1:colNum)
            } else {}

            return(.Object)
          })
t1 <- new('trick', id = letters[1:3], time = matrix(1:9, ncol = 3))
tn1 <- new('trickNum', id = letters[1:3], time = matrix(1:9, ncol = 3), number = 5:6)

查看对象和类:

  • getClass('className'):查询一个类的情况,也包括该类的继承情况。返回结果的“Subclasses”表示含有的子类,“Extends”表示父类是什么。

  • getSlots('className'):查询某一个class的slots。

  • slotNames(objName):查询一个对象的slots名称。

  • @slot(objName, 'slotName'):查询一个对象的slot的值。也可以使用objName@slotName <- somValslot(objName, 'slotName') <- someVal赋值,只会检查slot对应的类型,不会检查validity设定。一定不要执行slot(objName, 'slotName', check = FALSE) <- someVal,否则连类型都不检查。@定义在base包,slot()methods包。

  • .hasSlot(objName, 'slotName'):查询一个对象是否有某个slot。

  • is(myObj, 'myClass'):判断某个对象是否属于类,会向上查找父类,如果对象属于父类,也返回TRUEis(MyOb),返回某个对象的类和所有父类。

删除对象:

  • removeClass('className'):删除类,但是会保留这个类的方法和子类。

3. 方法

3.1 建立方法

方法和泛函的关系非常密切,某一个方法必须建立在一个特定泛函下。因此,建立方法时,首先确定该方法是否存在泛函:

  • 如果不存在,首先使用setGeneric()建立泛函;

  • 如果存在,使用setMethod()建立具体方法。

1
2
3
setGeneric(name, def= , group=list(), valueClass=character(),
           where= , package= , signature= , useAsDefault= ,
           genericFunction= , simpleInheritanceOnly = )
  • name:字符串,泛函名称。

  • def:函数,定义新的泛函,比如结合standardGeneric()函数。参数默认值在这里定义,后面的具体方法中参数默认值无效。

  • group:字符串,指示该泛函所属的泛函组。

  • valueClass:字符向量,一个或多个类,强制规定该泛函返回类型必须符合或包括类。

  • where:环境(少用)。

  • package:包名,一般自动识别。

  • signature:名字向量。

  • useAsDefault:推翻默认设置。

  • genericFunction:不建议使用。

  • simpleInheritanceOnly:逻辑值。

1
2
3
setMethod(f, signature=character(), definition,
          where = topenv(parent.frame()),
          valueClass = NULL, sealed = FALSE)
  • f:字符串,泛函名称。

  • signature:字符向量,指定definition中函数变量对应的类名。两个特殊类"missing""ANY",分别表示对应的变量“不能出现在方法调用中”和“可以是任何类”。如果一个变量没有被指定,则默认为"ANY"

  • definition:函数,定义方法。在创建函数时,特别是扩展已有泛函,f(para)中的变量与原始泛函的数量和名称一致。比如在print(x, ...),变量是x...。而在show(object)中,变量是x。可以使用args()查看泛函的参数。同时,函数中可以含有未被定义的变量...,后面setMethod()方法可以添加泛函声明变量之外的变量;如果没有...,后续方法只能操作泛函申明的变量。

  • where:环境(少用)。

  • valueClass:废弃变量。

  • sealed:是否封闭,如果设定为TRUE,其他setMethod()不能重新定义该方法,但可以被删除和重新指定。

对于一个对象,可以用一个泛函处理多个不同情况,比如不同的类(包括"missing""ANY")、父类/子类。同时,子类会自动继承父类的方法。但是,如果子类定义了与父类名称相同的方法,则父类方法不再起作用。需要强制“回溯”父类方法,使用callNextMethod()

Set methods
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
## plot() is initially not a S4 generic function, 
## but was automatically created.
## it is equalt to setGeneric('plot')
setMethod(f = 'plot',
          signature = c(x = 'trick'),
          definition = function(x, y, ...) {
            matplot(x = slot(x, 'time'), pch = slot(x, 'id'))
          })

## set new generic function
setGeneric(name = 'Add', def = function(x, y, ...){standardGeneric('Add')})

## test "missing" class
setMethod(f = 'Add',
          signature = c(x = 'trick', y = 'missing'),
          definition = function(x, y, ...) {
            slot(x, 'time') <- slot(x, 'time') + 1
            return(x)
          })

## another function
setMethod(f = 'Add',
          signature = c(x = 'trick', y = 'numeric'),
          definition = function(x, y, ...) {
            slot(x, 'time') <- slot(x, 'time') + y
            return(x)
          })

## with one more parameter "isabs"
## which is not defined in the generic function
## thank for "..."
setMethod(f = 'Add',
          signature = c(x = 'trick', y = 'numeric'),
          definition = function(x, y, isabs = FALSE, ...) {
            slot(x, 'time') <- slot(x, 'time') + ifelse(isabs, abs(y), y)
            return(x)
          })
## getMethod
getMethod('Add', c('trick', 'numeric'))

Add(t1)
Add(t1, -1)
Add(t1, -1, isabs = TRUE)
Add(tn1, -1, isabs = TRUE)

## test callNextMethod()
setMethod(f = 'Add',
          signature = c(x = 'trickNum', y = 'numeric'),
          definition = function(x, y, callNext = FALSE, ...) {
            if (callNext) {
              x <- callNextMethod()
            } else {}
            slot(x, 'number') <- slot(x, 'number') + y
            return(x)
          })
Add(tn1, -1)
Add(tn1, -1, callNext = TRUE, isabs = TRUE)

3.2 获取和修改对象

重置[[[$获取对象。重置[<-[[<-$<-修改对象(改变原始对象),建议使用validObject()检查修改后的对象。

get and reset
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
## set "[" and "[<-"
setMethod(f = "[",
          signature = c(x = 'trickNum'),
          definition = function(x, i, j, ..., drop) {
            return(slot(x, i))
          })

setMethod(f = "[<-",
          signature = 'trickNum',
          definition = function(x, i, j, ..., value) {
            slot(x, i) <- value
            validObject(x)
            return(x)
          })

tn1['time']
try(tn1['joke'])
tn1['id'] <- LETTERS[1:3]
try(tn1['id'] <- LETTERS[1:4])

## define "numData" and "numData<-"
setGeneric(name = 'numData', def = function(x, ...){standardGeneric('numData')})
setGeneric(name = 'numData<-', def = function(x, value, ...){standardGeneric('numData<-')})

setMethod(f = "numData",
          signature = 'numWithId',
          definition = function(x, ...) {
            return(x@.Data)
          })

setMethod(f = "numData<-",
          signature = c(x = 'numWithId', value = 'numeric'),
          definition = function(x, value, ...) {
            x@.Data = value
            validObject(x)
            return(x)
          })

numData(numWI1)
numData(numWI1) <- 10:1

3.3 泛函组

S4允许将一类方法定义为“泛函组(group generic functions)”。已经定义的泛函组,比如ops,通过?S4groupGeneric查看。使用setGroupGeneric()定义新的泛函组,使用callGeneric()调用泛函组,比如:

group generic functions
1
2
3
4
5
6
7
8
9
10
11
setMethod('Ops',
          signature(e1='trick', e2='trick'),
          function(e1, e2) {
            e1@time <- callGeneric(slot(e1, 'time'), slot(e2, 'time'))
            validObject(e1)
            return(e1)
          })

t1 <- new('trick', id = letters[1:3], time = matrix(1:9, ncol = 3))
t2 <- new('trick', id = letters[1:3], time = matrix(9:1, ncol = 3))
t1 + t2

3.4 查看和删除方法

查看方法:

  • methods('fun'):查看某个函数的具体信息,根据结果判断是否为S4。

  • getGeneric('genfun'):查看某个泛函的定义。

  • findMethods('genfun'):查看某个泛函的代码。

  • showMethods('genfun', classes = 'myClass'):某个泛函的总结信息,可以指定类。也可以只声明classes,从而查看某些类的全部方法。

  • getMethod('myMethod', 'myClass')selectMethod('genfun', 'myClass'):查看某个类的某个方法的具体代码,前者只查找制定的类,后者会向父类查找直到找到为止。

  • existsMethod('myMethod', 'myClass')hasMethod('genfun', 'myClass'):判断某个类是否有某个方法,前者只查找制定的类,后者会向父类查找直到找到为止。

删除方法:

  • removeGeneric('genfun'):删除泛函。

  • removeMethods('myMethod'):删除方法。

4. 确认检查

创建对象时:

  1. 自动检查每个slot赋值类型是否正确,这种检查会一直被子类和slot含有该类的类(简称“slot含有类”)继承。

  2. 如果设定了validity,这种检查将一直被子类继承,但是slot含有类不会去检查slot赋值是否正确。对于这种情况,将validObject(object, test = FALSE, complete = FALSE)函数的complete参数设定为TRUE,可以检查出问题。

  3. 如果自定义了initialize()方法,建议使用callNextMethod()的形式,这样会进行setClass()validity检查。

修改slot时:

使用slot()@,只会检查slot类型是否正确,不会检查validity设定。不建议用户直接使用@

推荐在setClass()建立类时,同时设定好validity,而不是使用setValidity(Class, method, where = topenv(parent.frame()))后续设定。

validate
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
## correct "trick" obj
t1 <- new('trick', id = letters[1:3], time = matrix(1:9, ncol = 3))
## not validated "trick" obj
t2 <- t1
t2@id <- letters[1:4]
## return FALSE
validObject(t2)
## error
try(new('trick', id = letters[1:3], time = 1:4))
try(new('trick', id = letters[1:3], time = matrix(1:8, ncol = 4)))

## correct "trickNum" obj
tn1 <- new('trickNum', id = letters[1:3], time = matrix(1:9, ncol = 3), number = 5:6)
## error because can not pass "trick" validate
try(new('trickNum', id = letters[1:3], time = 1:4, number = 5:6))
try(new('trickNum', id = letters[1:3], time = matrix(1:8, ncol = 4), number = 5:6))

## error
try(new('trickMult', trick1 = new('trick', id = letters[1:3], time = 1:4)))
try(new('trickMult', trick1 = new('trick', id = letters[1:3], time = matrix(1:8, ncol = 4))))

tm1 <- new('trickMult', trick1 = t2)
## return TRUE
validObject(tm1)
## return FALSE
validObject(tm1, complete = TRUE)

5. 继承

5.1 类转换

setClass()contains参数规定了继承的父类,很直接的继承关系(simple inheritance)。使用as()(不改变原始对象的值)和as() <- value进行转换。

as(myObj, 'myClass')分为三种情况:

  • myObj是子类对象,myClass是父类,返回只含有父类的slots(“剪枝”)。

  • myObj是父类对象,myClass是子类,返回多余的子类slots填充默认值。

  • myObjmyClass的一个对象,没有变化。

as(myObj, 'myClass') <- value有四种特殊情况:

  • as(objSon1, 'classFather') <- objSon2行为等同于objSon1 <- objSon2

  • as(objSon, 'classFather') <- objFather父类slots的值“遗传”给子类,返回classSon类的对象。

  • as(objFather1, 'classSon') <- objFather2报错。

  • as(objFather, 'classSon') <- objSon报错。

使用setIs()显示继承(explicit inheritance),尽量少用或使用setAs()代替。但是,setIs()使得class1变成class2的子类,class2的一些方法可能失效。因为,两个类的slots可能有很大的不同。因此,使用as()class1转换成class2,再使class2的方法。

1
2
3
setIs(class1, class2, test=NULL, coerce=NULL, replace=NULL,
      by = character(), where = topenv(parent.frame()), classDef =,
      extensionObject = NULL, doComplete = TRUE)
  • class1:字符串,需要转换的类。

  • class2:字符串,目标类。

  • test:转化检查,不推荐。

  • coerce:函数,一个参数,例如from。目的是从from中提取和处理一些slots,之后用这些处理后的slot建立一个class2的对象并返回。coerce对应的函数就是将class1转化成class2,因此要返回一个class2的对象。这也意味着class1将成为class2的一个子类。使用showMethods(“coerce”)查询内建的coerce函数。

  • replace:函数,目的是实现类似as(obj,"class2") <- value。变量可以设为两个,例如fromvalue,最后返回处理好的from

  • by:不建议使用。

  • where:设定环境。

  • classDef:不建议使用。

  • useAsDefault:推翻默认设置。

  • extensionObject/doComplete:不建议使用。

1
setAs(from, to, def, replace, where = topenv(parent.frame()))
  • from:字符串,需要转换的类。

  • to:字符串,目标类。

  • def:函数,参数fromfromto),目的是将from转化成to

  • replace:函数,参数fromvalue,目的是实现类似as(obj,"to") <- value

  • where:设定环境。

explicit coerce
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
t2 <- new('trick', id = LETTERS[3:1], time = matrix(9:1, ncol = 3))
tn2 <- new('trickNum', id = LETTERS[3:1], time = matrix(10:2, ncol = 3), number = 5:6)

as(tn2, 'trick')
as(t2, 'trickNum')

as(tn2, 'trick') <- tn1
as(tn2, 'trick') <- t2
try(as(t2, 'trickNum') <- tn1)
try(as(t2, 'trickNum') <- t1)

setClass(Class = 'trickNumMat',
         slots = c(number = 'matrix',
                   id = 'character',
                   time = 'matrix'))
setIs(class1 = 'trickNum',
      class2 = 'trickNumMat',
      coerce = function(from) {
        toObj <- new('trickNumMat',
                     number = as.matrix(from@number),
                     id = from@id,
                     time = from@time)
        return(toObj)
      },
      replace = function(from, value) {
        from@number = as.numeric(value@number)
        from@id = value@id
        from@time = value@time

        return(from)
      })
as(tn1, 'trickNumMat')
tnm1 <- new('trickNumMat',
            number = matrix(rnorm(1:9), nrow = 3),
            id = LETTERS[1:3],
            time = matrix(1:9, ncol = 3))
as(tn1, 'trickNumMat') <- tnm1

5.2 虚类

S4允许创建一个称为“虚类”的类。对于虚类,可以构建方法,可以创建子类,但是不能创造一个属于虚类的对象。虚类是为了解决“交集”的问题,即创建的多个新类中可能含有共同的slots。因此,将这些共同的slots处理成虚类,之后建立属于虚类的方法。这样,虚类下属的子类就能顺利继承。创建方法:第一种,setClass()函数的变量contains中加入VIRTUAL;第二种,setClass()函数只含有变量Class

virtual class
1
2
3
4
5
6
7
8
9
10
11
12
setClass(Class = 'trickVirtual',
         contains = c(id = 'character', 'VIRTUAL'))
setClass(Class = 'trickA',
         contains = 'trickVirtual',
         slots = c(number = 'numeric'))
setClass(Class = 'trickB',
         contains = 'trickVirtual',
         slots = c(log = 'logical'))
getClass('trickVirtual')

setClass(Class = 'testVirtual')
getClass('testVirtual')

5.3 类群

类群是为了解决“并集”的问题,即把功能相似的类合成一个“类群”,每次使用时只用其中的一个。因此,创建的“类群”是一个父类。使用isClassUnion(Class)检验某个类是否为类群,使用setClassUnion(name, members, where)创建类群。在使用类群时,默认使用的是第一个定义的类。每一个类群是一个虚类。

1
setClassUnion(name, members, where)
  • name:字符串,类群名。

  • members:字符向量,一个或多个已定义的类。可以后续使用setIs()向类群中添加已定义的类。

  • where:设定环境。

Union
1
2
3
4
setClassUnion("trickUnion", c("logical", "numeric"))
setClass("trickUA", contains = 'trickUnion', slots = c(id = 'numeric'))
new('trickUA', 1:10, id = 1)
getClass('trickUnion')

6. 建立对象注意事项

  1. 把所有对象写入一个文件AllClass.R,所有泛函写入AllGeneric.R

  2. setClass()建立一个类,同时添加validity验证。

  3. 自定义initialize()(可选,建议使用默认设置)。

  4. 自定义构造函数,比如类似类名,MyClass <- function(slot1, ...){new('myClass', slot1 = slot1, ...)}(可选,建议把initialize()内容放入)。

  5. 自定义show(),用于合理展示类。例如,一个大的矩阵,可以只展示一部分。而print()用于展示类的全部信息。

  6. 修改slot后,对返回的对象进行validObject()检查。

参考资料

  1. A (Not So) Short Introduction to S4:详细的S4介绍。

  2. Advance R – S4

  3. S4 System Development in Bioconductor

  4. R Programming for Bioinformatics

更新记录

2017年9月7日

Comments