R 面向对象编程（二）

S4

2.1 介绍

S4 是标准的 R 语言面向对象实现方式，比 S3 的定义更加严格，S4 对象有专门的函数用于定义类（setClass）、泛型函数（setGeneric）、方法（setMethod）以及实例化对象（new），提供了参数检查，多重继承功能。

S4 有一个重要的组件 slot，它是对象的属性组件，可以使用专门的运算符 @（发音为 at）来访问。

Bioconductor 社区是以 S4 对象作为基础框架，只接受 S4 定义的 R 包。所以，学习 S4 是非常有必要的

2.2 创建对象

我们需要使用 setClass 来定义一个类，setClass 的参数为

setClass(Class, representation, prototype, contains=character(),
         validity, access, where, version, sealed, package,
         S3methods = FALSE, slots)

• Class: 指定类名
• slots: 定义属性和属性类型，list 或命名向量
• prototype: 设置属性的默认值
• contains=character(): 指定父类（继承）
• validity: 定义属性的类型检查器
• where: 设置存储空间
• sealed: 如果为 TRUE,则不能使用 setClass 定义相同的类名
• package: 定义所属的包

version, package, representation, S3methods 这四个参数在 R-3.0.0 之后不推荐使用

首先，定义一个对象

setClass("Person",slots=list(name="character",age="numeric"))

然后，初始化一个实例

> tom <- new("Person",name="tom",age=18)
> tom
An object of class "Person"
Slot "name":
[1] "tom"

Slot "age":
[1] 18

也可以使用另一种方式

> Person <- setClass("Person",slots=list(name="character",age="numeric"))
> tom <- Person(name="tom", age=18)
> tom
An object of class "Person"
Slot "name":
[1] "tom"

Slot "age":
[1] 18

我们可以初始化的对象实例包含两个属性（slot） name 和 age

> class(tom)
[1] "Person"
attr(,"package")
[1] ".GlobalEnv"
> otype(tom)
[1] "S4"

tom 是一个 S4 对象，类型为 Person

那如何访问属性值呢？

我们可以使用 slotNames 获取对象的属性，接受一个 S4 对象变量或字符串类名

> slotNames(tom)
[1] "name" "age" 
> slotNames("Person")
[1] "name" "age"

getSlots 与 slotNames 类似，传入字符串类名，返回属性及其类型的字符串向量

> getSlots("Person")
       name         age 
"character"   "numeric" 

获取属性值

> tom@name
[1] "tom"
> tom@age
[1] 18
> slot(tom, "name")
[1] "tom"
> slot(tom, "age")
[1] 18

不同于 S3 使用 $ 来访问对象的属性，在 S4 中使用 @ 来获取对象的属性，或者使用 slot 函数

当然，我们也可以更改属性的值

> tom@age <- 28
> tom
An object of class "Person"
Slot "name":
[1] "tom"

Slot "age":
[1] 28

> slot(tom, "age") <- 21
> tom
An object of class "Person"
Slot "name":
[1] "tom"

Slot "age":
[1] 21

getClass 也接受一个 S4 对象变量，返回包含属性及其对应的值的 list；或字符串类名，返回属性名称及对应的类型

> getClass(tom)
An object of class "Person"
Slot "name":
[1] "tom"

Slot "age":
[1] 18

> getClass("Person")
Class "Person" [in ".GlobalEnv"]

Slots:
                          
Name:       name       age
Class: character   numeric

2.3 设置默认值

当我们不设置属性值时，其默认值为空（不同类型的空值），比如

> tom <- new("Person")
> tom
An object of class "Person"
Slot "name":
character(0)

Slot "age":
numeric(0)

那如何设置属性的默认值呢？

我们可以在 setClass 中指定 prototype 参数，让我们重新定义我们的 Person 类

setClass("Person",slots=list(name="character",age="numeric"),
         prototype = list(name='Unknow', age=18))

我们在初始化实例时，不指定属性值会返回默认的值，如

> new("Person")
An object of class "Person"
Slot "name":
[1] "Unknow"

Slot "age":
[1] 18

> sam <- new("Person",name="sam")
> sam
An object of class "Person"
Slot "name":
[1] "sam"

Slot "age":
[1] 18

2.4 类型检查

在上面 Person 类的定义中，我们指定了属性值的类型，如果我们传入的类型不一致会是什么结果呢?

> new("Person", name="tom", age="0")
Error in validObject(.Object) : 
  类别为“Person”的对象不对: invalid object for slot "age" in class "Person": got class "character", should be or extend class "numeric"

会抛出异常。

但是对于 age 参数应该是非负值，这种非类型错误可以进行额外的检查

setClass("Person",
         slots=list(name="character",age="numeric"),
         prototype = list(name='Unknow', age=18),
         validity = function(object) {
           if(object@age <= 0) 
             return("Age is negative.")
           return(TRUE)
         })

测试

> new("Person", name="tom", age=-1)
Error in validObject(.Object) : 
  类别为“Person”的对象不对: Age is negative.

或者在 setClass 外部使用 setValidity 设置检查

setClass("Person",slots=list(name="character",age="numeric"),
         prototype = list(name='Unknow', age=18))

setValidity("Person", function(object) {
  if(object@age <= 0) 
    return("Age is negative.")
  return(TRUE)
})

2.5 使用已有实例创建新实例

S4 对象还支持使用已经实例化的对象来创建新的实例化对象

> setClass("Person",slots=list(name="character",age="numeric"))
> tom <- new("Person",name="tom",age=18)
> jay <- initialize(tom, name="jay", age=20)
> jay
An object of class "Person"
Slot "name":
[1] "jay"

Slot "age":
[1] 20

> tom
An object of class "Person"
Slot "name":
[1] "tom"

Slot "age":
[1] 18

2.6 创建函数

在定义了类及其属性之后，我们就可以定义与类相关联的方法了

S4 的函数定义不同于 S3，S4 将函数的定义和实现分开了，即接口和实现分离。

先通过 setGeneric() 来定义函数的接口，然后通过 setMethod() 来实现函数功能。

我们先定义一个函数接口

setGeneric(name = "getName",def = function(object) standardGeneric("getName"))

然后，实现函数的功能并指定类型

setMethod(f = "getName",signature = "Person",
          definition = function(object) object@name)

示例

我们定义一个 Person 类，包含了 name 和 age 两个属性，然后分别为这两个属性定义 get 和 set 方法。

通常，我们在面向对象的程序设计中，会将数据进行封装，而不是直接把数据暴露出来。如

setClass("Person",slots=list(name="character",age="numeric"),
         prototype = list(name='Unknow', age=18))

setGeneric(name = "getName",def = function(object) standardGeneric("getName"))
setMethod(f = "getName",signature = "Person",
          definition = function(object) object@name)

setGeneric(name = "setName",def = function(object, name) standardGeneric("setName"))
setMethod(f = "setName",signature = "Person",
          definition = function(object, name) {
            object@name <- name
            return(object)
          })

setGeneric(name = "getAge",def = function(object) standardGeneric("getAge"))
setMethod(f = "getAge",signature = "Person",
          definition = function(object) object@age)

setGeneric(name = "setAge",def = function(object, age) standardGeneric("setAge"))
setMethod(f = "setAge",signature = "Person",
          definition = function(object, age) {
            object@age <- age
            return(object)
          })

使用方法

> tom <- new("Person",name="tom",age=18)
> getName(tom)
[1] "tom"
> getAge(tom)
[1] 18
> setName(tom, "tomi")
An object of class "Person"
Slot "name":
[1] "tomi"

Slot "age":
[1] 18

> setAge(tom, 22)
An object of class "Person"
Slot "name":
[1] "tom"

Slot "age":
[1] 22

查看函数的类型

> ftype(getName)
[1] "S4"      "generic"

查看函数的信息

> getMethod("getAge", "Person")
Method Definition:

function (object) 
object@age

Signatures:
        object  
target  "Person"
defined "Person"

> existsMethod("getAge", "Person")
[1] TRUE
> hasMethod("getAge", "Person")
[1] TRUE

2.7 继承

S4 对象的继承是通过 contains 参数来设置的，可接受字符串类名或字符串向量

例如，我们定义 chinese 类并继承自 Person

Person <- setClass("Person",
         slots=list(name="character",age="numeric"),
         prototype = list(name='Unknow', age=18),
         validity = function(object) {
           if(object@age <= 0) 
             return("Age is negative.")
           return(TRUE)
         })
chinese <- setClass("chinese", contains = "Person")

创建实例

> chinese(name="lisin", age = 38)
An object of class "chinese"
Slot "name":
[1] "lisin"

Slot "age":
[1] 38

2.8 实例

我们举个例子来加深对 S4 实现面向对象编程的理解

1. 我们先定义一个顶层的类：Shape
2. 然后定义两个继承自 Shape 的子类：Circle、Rectangle
3. 并添加对应的计算面积和周长的函数：area、circum

我们定义如下

# 设置父类
Shape <- setClass("Shape", slots = c(shape="character"))
# 定义父类方法，获取 shape 属性的值
setGeneric("getShape",function(object, ...){
  standardGeneric("getShape")
})

setMethod("getShape", "Shape", function(object, ...) {
  return(object@shape)
})
# 定义 area 函数的接口
setGeneric("area",function(object, ...){
  standardGeneric("area")
})
# 定义 circum 函数的接口
setGeneric("circum",function(object, ...){
  standardGeneric("circum")
})
# 定义 Circle 类
Circle <- setClass("Circle", slots = c(radius="numeric"), 
                   contains = "Shape", prototype = list(radius=1, shape="circle"),
                   validity = function(object) {
                     if(object@radius <= 0) stop("Radius is negative")
                   })
# area 函数对 Circle 类的实现
setMethod("area", "Circle", function(object, ...){
  return(pi * object@radius^2)
})
# circum 函数对 Circle 类的实现
setMethod("circum", "Circle", function(object, ...){
  return(2 * pi * object@radius)
})
# 定义 Rectangle 类
Rectangle <- setClass("Rectangle", slots = c(height="numeric", width="numeric"), 
                   contains = "Shape", prototype = list(height=1, width=1, shape="rectangle"),
                   validity = function(object) {
                     if(object@height <= 0 | object@width <= 0) stop("Radius is negative")
                   })
# area 函数对 Rectangle 类的实现
setMethod("area", "Rectangle", function(object, ...){
  return(object@height * object@width)
})
# circum 函数对 Rectangle 类的实现
setMethod("circum", "Rectangle", function(object, ...){
  return(2 * (object@height + object@width))
})

使用

> a <- Circle(radius = 3)
> area(a)
[1] 28.27433
> circum(a)
[1] 18.84956
> 
> b <- Rectangle(height = 3, width = 4)
> area(b)
[1] 12
> circum(b)
[1] 14

使用 getShape 获取 shape 属性

> getShape(a)
[1] "circle"
> getShape(b)
[1] "rectangle"