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 实现面向对象编程的理解
- 我们先定义一个顶层的类：
Shape - 然后定义两个继承自
Shape的子类：Circle、Rectangle - 并添加对应的计算面积和周长的函数：
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"
