R语言-S4系统

不念不忘少年蓝@ 2022-06-11 01:59 388阅读 0赞

本文参考[R语言基于S4的面向对象编程][R_S4]  
想要学习S3相关内容的，请看[R语言-S3系统][R_-S3]

S4对象系统具有明显的结构化特征，更适合面向对象的程序设计。

### **1.S4对象介绍**    ###

S4对象系统是一种标准的R语言面向对象实现方式，S4对象有明确的类定义，参数定义，参数检查，继承关系，实例化等的面向对象系统的特征。

### **2.创建S4对象**    ###

**2.1 如何创建S4对象**  
由于S4对象是标准的面向对象实现方式， 有专门的类定义函数 setClass() 和类的实例化函数new() ，我们看一下setClass()和new()是如何动作的。

**setClass**函数定义如下：

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

*  Class: 定义类名
 *  slots: 定义属性和属性类型
 *  prototype: 定义属性的默认值
 *  contains=character(): 定义父类，继承关系
 *  validity: 定义属性的类型检查
 *  where: 定义存储空间
 *  sealed: 如果设置TRUE，则同名类不能被再次定义
 *  package: 定义所属的包
 *  S3methods: R3.0.0以后不建议使用
 *  representation R3.0.0以后不建议使用
 *  access R3.0.0以后不建议使用
 *  version R3.0.0以后不建议使用

**2.2 创建一个S4对象实例**

# 定义一个S4对象
    > setClass("Person",slots=list(name="character",age="numeric"))
    
    # 实例化一个Person对象
    > father<-new("Person",name="F",age=44)
    
    # 查看father对象，有两个属性name和age
    > father
    An object of class "Person"
    Slot "name":
    [1] "F"
    
    Slot "age":
    [1] 44
    
    # 查看father对象类型，为Person
    > class(father)
    [1] "Person"
    attr(,"package")
    [1] ".GlobalEnv"
    
    # 查看father对象为S4的对象
    > otype(father)
    [1] "S4"

**2.3 创建一个有继承关系的S4对象**

# 创建一个S4对象Person
    > setClass("Person",slots=list(name="character",age="numeric"))#用向量表示slot也不会报错
    
    # 创建Person的子类
    > setClass("Son",slots=list(father="Person",mother="Person"),contains="Person")
    
    # 实例化Person对象
    > father<-new("Person",name="F",age=44)
    > mother<-new("Person",name="M",age=39)
    
    # 实例化一个Son对象
    > son<-new("Son",name="S",age=16,father=father,mother=mother)
    
    # 查看son对象的name属性
    > son@name
    [1] "S"
    
    # 查看son对象的father属性
    > son@father
    An object of class "Person"
    Slot "name":
    [1] "F"
    
    Slot "age":
    [1] 44
    
    # 检查son类型
    > otype(son)
    [1] "S4"
    
    # 检查son@name属性类型
    > otype(son@name)
    [1] "base"
    
    # 用isS4()，检查S4对象的类型
    > isS4(son)
    [1] TRUE
    > isS4(son@name)
    [1] FALSE
    > isS4(son@mother)
    [1] TRUE

**2.4 S4对象的默认值**

> setClass("Person",slots=list(name="character",age="numeric"))
    
    # 属性age为空
    > a<-new("Person",name="a")
    > a
    An object of class "Person"
    Slot "name":
    [1] "a"
    
    Slot "age":
    numeric(0)
    
    # 设置属性age的默认值20
    > setClass("Person",slots=list(name="character",age="numeric"),prototype = list(age = 20))
    
    # 属性age为空
    > b<-new("Person",name="b")
    
    # 属性age的默认值是20
    > b
    An object of class "Person"
    Slot "name":
    [1] "b"
    
    Slot "age":
    [1] 20
    2.5 S4对象的类型检查

**2.5 S4对象的类型检查**

> setClass("Person",slots=list(name="character",age="numeric"))
    
    # 传入错误的age类型
    > bad<-new("Person",name="bad",age="abc")
    Error in validObject(.Object) :
      invalid class “Person” object: invalid object for slot "age" in class "Person": got class "character", should be or extend class "numeric"
    
    # 设置age的非负检查
    > setValidity("Person",function(object) {
    +     if (object@age <= 0) stop("Age is negative.")
    + })
    Class "Person" [in ".GlobalEnv"]
    
    Slots:
    Name:       name       age
    Class: character   numeric
    
    # 修传入小于0的年龄
    > bad2<-new("Person",name="bad",age=-1)
    Error in validityMethod(object) : Age is negative.

**2.6 从一个已经实例化的对象中创建新对象**  
S4对象，还支持从一个已经实例化的对象中创建新对象，创建时可以覆盖旧对象的值

> setClass("Person",slots=list(name="character",age="numeric"))
    
    # 创建一个对象实例n1
    > n1<-new("Person",name="n1",age=19);n1
    An object of class "Person"
    Slot "name":
    [1] "n1"
    
    Slot "age":
    [1] 19
    
    # 从实例n1中，创建实例n2，并修改name的属性值
    > n2<-initialize(n1,name="n2");n2
    An object of class "Person"
    Slot "name":
    [1] "n2"
    
    Slot "age":
    [1] 19

### **3.访问对象的属性**    ###

在S3对象中，一般使用$来访问一个对象的属性，但在S4对象中，我们只能使用@来访问一个对象的属性

> setClass("Person",slots=list(name="character",age="numeric"))
    > a<-new("Person",name="a")
    
    # 访问S4对象的属性
    > a@name
    [1] "a"
    > slot(a, "name")
    [1] "a"
    
    # 错误的属性访问
    > a$name
    Error in a$name : $ operator not defined for this S4 class
    > a[1]
    Error in a[1] : object of type 'S4' is not subsettable
    > a[[1]]
    Error in a[[1]] : this S4 class is not subsettable

### **4.S4的泛型函数**    ###

S4的泛型函数实现有别于S3的实现，S4分离了方法的定义和实现，如在其他语言中我们常说的接口和实现分离。通过setGeneric()来定义接口，通过setMethod()来定义实现类。这样可以让S4对象系统，更符合面向对象的特征。  
让我来看看如何用R分离接口和实现

# 定义Person对象
    > setClass("Person",slots=list(name="character",age="numeric"))
    
    # 定义泛型函数work，即接口
    > setGeneric("work",function(object) standardGeneric("work"))
    [1] "work"
    
    # 定义work的现实，并指定参数类型为Person对象
    > setMethod("work", signature(object = "Person"), function(object) cat(object@name , "is working") )
    [1] "work"
    
    # 创建一个Person对象a
    > a<-new("Person",name="Conan",age=16)
    
    # 把对象a传入work函数
    > work(a)
    Conan is working

通过S4对象系统，把原来的函数定义和调用2步，为成了4步进行：

*  定义数据对象类型
 *  定义接口函数
 *  定义实现函数
 *  把数据对象以参数传入到接口函数，执行实现函数

通过S4对象系统，是一个结构化的，完整的面向对象实现。

### **5.查看S4对象的函数**    ###

当我们使用S4对象进行面向对象封装后，我们还需要能查看到S4对象的定义和函数定义。  
还以上节中Person和work的例子

# 检查work的类型
    > ftype(work)
    [1] "s4"      "generic"
    
    # 直接查看work函数
    > work
    standardGeneric for "work" defined from package ".GlobalEnv"
    function (object)
    standardGeneric("work")
    <environment: 0x2aa6b18>
    Methods may be defined for arguments: object
    Use  showMethods("work")  for currently available ones.
    
    # 查看work函数的现实定义
    > showMethods(work)
    Function: work (package .GlobalEnv)
    object="Person"
    
    # 查看Person对象的work函数现实
    > getMethod("work", "Person")
    Method Definition:
    function (object)
    cat(object@name, "is working")
    Signatures:
            object
    target  "Person"
    defined "Person"
    
    > selectMethod("work", "Person")
    Method Definition:
    function (object)
    cat(object@name, "is working")
    Signatures:
            object
    target  "Person"
    defined "Person"
    
    # 检查Person对象有没有work函数
    >  existsMethod("work", "Person")
    [1] TRUE
    > hasMethod("work", "Person")
    [1] TRUE

### **6.S4对象的使用**    ###

我们接下用S4对象做一个例子，定义一组图形函数的库。  
**6.1 任务一：定义图形库的数据结构和计算函数**  
假设最Shape为图形的基类，包括圆形(Circle)和椭圆形(Ellipse)，并计算出它们的面积(area)和周长(circum)。

*  定义图形库的数据结构
 *  定义圆形的数据结构，并计算面积和周长
 *  定义椭圆形的数据结构，并计算面积和周长

如图所示结构  
![这里写图片描述][SouthEast]  
定义基类Shape 和 圆形类Circle

# 定义基类Shape
    > setClass("Shape",slots=list(name="character"))
    
    # 定义圆形类Circle，继承Shape，属性radius默认值为1
    > setClass("Circle",contains="Shape",slots=list(radius="numeric"),prototype=list(radius = 1))
    
    # 验证radius属性值要大等于0
    > setValidity("Circle",function(object) {
    +     if (object@radius <= 0) stop("Radius is negative.")
    + })
    Class "Circle" [in ".GlobalEnv"]
    Slots:
    Name:     radius      name
    Class:   numeric character
    Extends: "Shape"
    
    # 创建两个圆形实例
    > c1<-new("Circle",name="c1")
    > c2<-new("Circle",name="c2",radius=5)

定义计算面积的接口和现实

# 计算面积泛型函数接口
    > setGeneric("area",function(obj,...) standardGeneric("area"))
    [1] "area"
    
    # 计算面积的函数现实
    > setMethod("area","Circle",function(obj,...){
    +     print("Area Circle Method")
    +     pi*obj@radius^2
    + })
    [1] "area"
    
    # 分别计算c1和c2的两个圆形的面积
    > area(c1)
    [1] "Area Circle Method"
    [1] 3.141593
    > area(c2)
    [1] "Area Circle Method"
    [1] 78.53982

定义计算周长的接口和现实

# 计算周长泛型函数接口
    > setGeneric("circum",function(obj,...) standardGeneric("circum"))
    [1] "circum"
    
    # 计算周长的函数现实
    > setMethod("circum","Circle",function(obj,...){
    +     2*pi*obj@radius
    + })
    
    # 分别计算c1和c2的两个圆形的面积
    [1] "circum"
    > circum(c1)
    [1] 6.283185
    > circum(c2)
    [1] 31.41593

上面的代码，我们实现了圆形的定义，下来我们实现椭圆形。

# 定义椭圆形的类，继承Shape，radius参数默认值为c(1,1)，分别表示椭圆形的长半径和短半径
    > setClass("Ellipse",contains="Shape",slots=list(radius="numeric"),prototype=list(radius=c(1,1)))
    
    # 验证radius参数
    > setValidity("Ellipse",function(object) {
    +     if (length(object@radius) != 2 ) stop("It's not Ellipse.")
    +     if (length(which(object@radius<=0))>0) stop("Radius is negative.")
    + })
    Class "Ellipse" [in ".GlobalEnv"]
    Slots:
    Name:     radius      name
    Class:   numeric character
    Extends: "Shape"
    
    # 创建两个椭圆形实例e1,e2
    > e1<-new("Ellipse",name="e1")
    > e2<-new("Ellipse",name="e2",radius=c(5,1))
    
    # 计算椭圆形面积的函数现实
    > setMethod("area", "Ellipse",function(obj,...){
    +     print("Area Ellipse Method")
    +     pi * prod(obj@radius)
    + })
    [1] "area"
    
    # 计算e1,e2两个椭圆形的面积
    > area(e1)
    [1] "Area Ellipse Method"
    [1] 3.141593
    > area(e2)
    [1] "Area Ellipse Method"
    [1] 15.70796
    
    # 计算椭圆形周长的函数现实
    > setMethod("circum","Ellipse",function(obj,...){
    +     cat("Ellipse Circum :\n")
    +     2*pi*sqrt((obj@radius[1]^2+obj@radius[2]^2)/2)
    + })
    [1] "circum"
    
    # 计算e1,e2两个椭圆形的周长
    > circum(e1)
    Ellipse Circum :
    [1] 6.283185
    > circum(e2)
    Ellipse Circum :
    [1] 22.65435

**6.1 任务二：重构原型和椭圆形的设计**  
上一步，我们已经完成了 圆形和椭圆形 的数据结构定义，以及计算面积和周长的方法现实。不知大家有没有发现，圆形是椭圆形的一个特例呢？

当椭圆形的长半径和短半径相等时，即radius的两个值相等，形成的图形为圆形。利用这个特点，我们就可以重新设计 圆形和椭圆形 的关系。椭圆形是圆形的父类，而圆形是椭圆形的子类。  
![这里写图片描述][SouthEast 1]

# 基类Shape
    > setClass("Shape",slots=list(name="character",shape="character"))
    
    # Ellipse继承Shape
    > setClass("Ellipse",contains="Shape",slots=list(radius="numeric"),prototype=list(radius=c(1,1),shape="Ellipse"))
    
    # Circle继承Ellipse
    > setClass("Circle",contains="Ellipse",slots=list(radius="numeric"),prototype=list(radius = 1,shape="Circle"))
    
    # 定义area接口
    > setGeneric("area",function(obj,...) standardGeneric("area"))
    [1] "area"
    
    # 定义area的Ellipse实现
    > setMethod("area","Ellipse",function(obj,...){
        +     cat("Ellipse Area :\n")
        +     pi * prod(obj@radius)
        + })
    [1] "area"
    
    # 定义area的Circle实现
    > setMethod("area","Circle",function(obj,...){
        +     cat("Circle Area :\n")
        +     pi*obj@radius^2
        + })
    [1] "area"
    
    # 定义circum接口
    > setGeneric("circum",function(obj,...) standardGeneric("circum"))
    [1] "circum"
    
    # 定义circum的Ellipse实现
    > setMethod("circum","Ellipse",function(obj,...){
        +     cat("Ellipse Circum :\n")
        +     2*pi*sqrt((obj@radius[1]^2+obj@radius[2]^2)/2)
        + })
    [1] "circum"
    
    # 定义circum的Circle实现
    > setMethod("circum","Circle",function(obj,...){
        +     cat("Circle Circum :\n")
        +     2*pi*obj@radius
        + })
    [1] "circum"
    
    # 创建实例
    > e1<-new("Ellipse",name="e1",radius=c(2,5))
    > c1<-new("Circle",name="c1",radius=2)
    
    # 计算椭圆形的面积和周长
    > area(e1)
    Ellipse Area :
        [1] 31.41593
    > circum(e1)
    Ellipse Circum :
        [1] 23.92566
    
    # 计算圆形的面积和周长
    > area(c1)
    Circle Area :
        [1] 12.56637
    > circum(c1)
    Circle Circum :
        [1] 12.56637

**6.3 任务三：增加矩形的图形处理**

我们的图形库，进一步扩充，需要加入矩形和正方形。

*  定义矩形的数据结构，并计算面积和周长
 *  定义正方形的数据结构，并计算面积和周长
 *  正方形是矩形的特例，定义矩形是正方形的父类，而正方形是矩形的子类。

如图所示结构：  
![这里写图片描述][SouthEast 2]

# 定义矩形Rectangle，继承Shape
    > setClass("Rectangle",contains="Shape",slots=list(edges="numeric"),prototype=list(edges=c(1,1),shape="Rectangle"))
    
    # 定义正方形Square，继承Rectangle
    > setClass("Square",contains="Rectangle",slots=list(edges="numeric"),prototype=list(edges=1,shape="Square"))
    
    # 定义area的Rectangle实现
    > setMethod("area","Rectangle",function(obj,...){
    +     cat("Rectangle Area :\n")
    +     prod(obj@edges)
    + })
    [1] "area"
    
    # 定义area的Square实现
    > setMethod("area","Square",function(obj,...){
    +     cat("Square Area :\n")
    +     obj@edges^2
    + })
    [1] "area"
    
    # 定义circum的Rectangle实现
    > setMethod("circum","Rectangle",function(obj,...){
    +     cat("Rectangle Circum :\n")
    +     2*sum(obj@edges)
    + })
    [1] "circum"
    
    # 定义circum的Square实现
    > setMethod("circum","Square",function(obj,...){
    +     cat("Square Circum :\n")
    +     4*obj@edges
    + })
    [1] "circum"
    
    # 创建实例
    > r1<-new("Rectangle",name="r1",edges=c(2,5))
    > s1<-new("Square",name="s1",edges=2)
    
    # 计算矩形形的面积和周长
    > area(r1)
    Rectangle Area :
    [1] 10
    > area(s1)
    Square Area :
    [1] 4
    
    # 计算正方形的面积和周长
    > circum(r1)
    Rectangle Circum :
    [1] 14
    > circum(s1)
    Square Circum :
    [1] 8

这样，我们的图形库，已经支持了4种图形了！用面向对象的结构来设计，是不是结构化思路很清晰呢！！

**6.4 任务四：在基类Shape中，增加shape属性和getShape方法**

这个需求，如果没有面向对象的结构，那么你需要在所有图形定义的代码中，都增加一个参数和一个判断，如果有100图形，改起来还是挺复杂的。而面向对象的程序设计，就非常容易解决这个需求。我们只需要在基类上改动代码就可以实现了。

如图所示结构：  
![这里写图片描述][SouthEast 3]

# 重新定义基类Shape，增加shape属性
    > setClass("Shape",slots=list(name="character",shape="character"))
    
    # 定义getShape接口
    > setGeneric("getShape",function(obj,...) standardGeneric("getShape"))
    [1] "getShape"
    
    # 定义getShape实现
    > setMethod("getShape","Shape",function(obj,...){
    +     cat(obj@shape,"\n")
    + })
    [1] "getShape"

其实，这样改动一个就可以了，我们只需要重实例化每个图形的对象就行了。

# 实例化一个Square对象，并给shape属性赋值
    > s1<-new("Square",name="s1",edges=2, shape="Square")
    
    # 调用基类的getShape()函数
    > getShape(r1)
    Rectangle

这样的一个比较完整的例子就可以基本上说明S4类系统的使用了

[R_S4]: http://blog.fens.me/r-class-s4/
[R_-S3]: http://blog.csdn.net/xiaohukun/article/details/76187122
[SouthEast]: /images/20220611/322c0e2817124e75abc8d55e1ad94151.png
[SouthEast 1]: /images/20220611/5fe57e270d104472be1458b830a08942.png
[SouthEast 2]: /images/20220611/d6db856facff4a34adff2801a4e9123d.png
[SouthEast 3]: /images/20220611/f65720990fa443f194de545ef55f874b.png