R 面向对象编程(三)—— RC

RC

3.1 介绍

Reference Classes(RC) 是在 R 2.12 版本开始引入的新一代的面向对象系统,也被称为 R5(这并不是官方的名称,只是为了和 S3S4 保持队形( ̄。。 ̄))。

这个面向对象系统不同于 S3S4 使用泛型函数模型实现类和方法,RC 的方法被封装在类的定义中。

RC 面向对象系统在行为、风格上更像其他面向对象编程语言,如 JavaC++ 等。

RC 使用 $ 符号来调用方法,获取和修改对象的属性,调用方法或设置属性的值会修改对象,这种方式不同于常用的函数式编程模型。

3.2 创建 RC 类

首先,我们可以使用 setRefClass 来定义类,并返回一个生成器对象。

setRefClass(Class, fields = , contains = , methods =,
     where =, inheritPackage =, ...)

参数列表:

  • Class: 字符串类名
  • fields: 定义属性名称与类型,可以是命名字符串向量或命名列表。
  • contains: 定义父类,多重继承传递父类向量。如果父类也是 RC,会继承父类的属性和方法
  • methods: 一个命名列表,定义对象可调用的方法。也可以使用 $methods 方法定义函数
  • where: 类定义的存储空间
  • inheritPackage: 是否继承父类的环境
  • ...: 其他参数类似 setClass

定义一个 RC 类

> Person <- setRefClass("Person", fields = c(name='character',age='numeric',gender='factor'))
> Person
Generator for class "Person":

Class fields:
                                    
Name:       name       age    gender
Class: character   numeric    factor

Class Methods: 
     "sing", "say", "field", "trace", "getRefClass", "initFields", "copy", "callSuper", 
     ".objectPackage", "export", "untrace", "getClass", "show", "usingMethods", ".objectParent", 
     "import"

Reference Superclasses: 
     "envRefClass"

使用 $new 实例化对象,也可以直接使用类名实例化

> genders <- factor(c("F", "M"))
> tom <- Person$new(name="tom", age=19, gender=genders[1])
# tom <- Person(name="tom", age=19, gender=genders[1])
> tom
Reference class object of class "Person"
Field "name":
[1] "tom"
Field "age":
[1] 19
Field "gender":
[1] F
Levels: F M

查看类型

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

3.3 访问属性

我们可以使用 $ 符号,访问及修改属性值

> tom$name
[1] "tom"
> tom$age
[1] 19
> tom$age <- tom$age + 1
> tom$age
[1] 20

赋值给另一个对象

> sam <- tom
> sam
Reference class object of class "Person"
Field "name":
[1] "tom"
Field "age":
[1] 20
Field "gender":
[1] F
Levels: F M
> sam$name <- "sam"
> sam
Reference class object of class "Person"
Field "name":
[1] "sam"
Field "age":
[1] 20
Field "gender":
[1] F
Levels: F M
> tom
Reference class object of class "Person"
Field "name":
[1] "sam"
Field "age":
[1] 20
Field "gender":
[1] F
Levels: F M

以直接赋值的方式,只是传递了对象的引用,而不是重新构建了一个实例。

可以调用内置的 copy() 方式,创建一份拷贝

> sam <- tom$copy()
> sam$age <- 28
> sam
Reference class object of class "Person"
Field "name":
[1] "sam"
Field "age":
[1] 28
Field "gender":
[1] F
Levels: F M
> tom
Reference class object of class "Person"
Field "name":
[1] "sam"
Field "age":
[1] 20
Field "gender":
[1] F
Levels: F M

3.4 定义方法

RC 对象系统中,我们可以在创建类的同时指定对应的方法,而不需要将类和函数的定义分离。

例如,我们定义 Person

Person <- setRefClass("Person", fields = c(name='character',age='numeric',gender='factor'),
                      methods = list(
                        setName = function(x) {
                          name <<- x
                        },
                        setAge = function(x) {
                          age <<- x
                        }
                      ))

然后使用方法,改变属性值

> jay <- Person(name="jay", age=21, gender=genders[2])
> jay$setAge(28)
> jay
Reference class object of class "Person"
Field "name":
[1] "jay"
Field "age":
[1] 28
Field "gender":
[1] M
Levels: F M

注意:我们在函数内部使用了 <<- 赋值方式。

该赋值方式通常在函数中使用,会在其上层环境中搜索该变量,如果找到了,则重新为该变量赋值;否则会创建为一个全局变量

如果我们将上面的代码改为

Person <- setRefClass("Person", fields = c(name='character',age='numeric',gender='factor'),
                      methods = list(
                        setName = function(x) {
                          name <- x
                        },
                        setAge = function(x) {
                          age <- x
                        }
                      ))

执行相同的代码

> jay <- Person(name="jay", age=21, gender=genders[2])
> jay$setAge(28)
> jay
Reference class object of class "Person"
Field "name":
[1] "jay"
Field "age":
[1] 21
Field "gender":
[1] M
Levels: F M

发现 age 的值并没有被修改

为了不让类定义看起来很臃肿,可以将函数的定义剥离出来。

我们可以使用 $methods() 的方式为类定义相应的方法。

Person <- setRefClass("Person", fields = c(name='character',age='numeric',gender='factor'))

Person$methods(
  setName = function(x) {
    name <<- x
  },
  setAge = function(x) {
    age <<- x
  }
)

调用方法

> jay <- Person(name="jay", age=21, gender=genders[2])
> jay$setAge(28)
> jay
Reference class object of class "Person"
Field "name":
[1] "jay"
Field "age":
[1] 28
Field "gender":
[1] M
Levels: F M

3.5 定义构造函数

RC 类在实例化对象时,会自动调用构造器函数 $initialize(),我们可以使用该函数来初始化属性值

Person <- setRefClass("Person", fields = c(name='character',age='numeric',gender='factor'),
                      methods = list(
                        initialize = function(name="Unknown", age=18, gender=genders[1]) {
                          name <<- name
                          age <<- age
                          gender <<- gender
                        }
                      ))

实例化

> Person()
Reference class object of class "Person"
Field "name":
[1] "Unknown"
Field "age":
[1] 18
Field "gender":
[1] F
Levels: F M
> Person(name="tom")
Reference class object of class "Person"
Field "name":
[1] "tom"
Field "age":
[1] 18
Field "gender":
[1] F
Levels: F M

3.6 继承

RC 也是通过 contains 参数来指定父类

User <- setRefClass("User", fields = c(username="character", password="character"))
User$methods(
  getName = function() {
    return(username)
  }
)
VIP <- setRefClass("VIP", contains = "User", fields = c(level="numeric"))

使用

tom <- VIP(username="tom", password="123456", level=3)
> tom
Reference class object of class "VIP"
Field "username":
[1] "tom"
Field "password":
[1] "123456"
Field "level":
[1] 3
> tom$getName()
[1] "tom"

3.7 RC 的内置方法

在我们定义完类之后

> Person
Generator for class "Person":

Class fields:
                                    
Name:       name       age    gender
Class: character   numeric    factor

Class Methods: 
     "initialize", "field", "trace", "getRefClass", "initFields", "copy", "callSuper", 
     ".objectPackage", "export", "untrace", "getClass", "show", "usingMethods", ".objectParent", 
     "import"

Reference Superclasses: 
     "envRefClass"

Class Methods 输出的方法中我们可以看到,很多方法都不是我们定义的,这些都是内置的方法。像我们前面用到的 copyinitialize 也在其中

在这里插入图片描述

我们为上面的继承的例子,添加一些功能

User <- setRefClass("User", fields = c(username="character", password="character"))
User$methods(
  getName = function() {
    return(username)
  }
)

VIP <- setRefClass("VIP", contains = "User", fields = c(level="numeric"))
VIP$methods(
  getName = function() {
    cat("VIP:", callSuper())
  },
  add = function(x, y) {
    return(x+y)
  },
  multiple = function(x, y) {
    return(x*y)
  }
)

我们在子类中重写了 getName 方法,通过 callSuper() 调用父类的 getName 方法获取 name 属性,并在前面添加 VIP 标记

> tom <- VIP(username="tom", password="123456", level=3)
> tom$getName()
VIP: tom

我们重新为 tom 的属性赋值

> tom$initFields(username="sam", password="1234")
Reference class object of class "VIP"
Field "username":
[1] "sam"
Field "password":
[1] "1234"
Field "level":
[1] 3
> tom
Reference class object of class "VIP"
Field "username":
[1] "sam"
Field "password":
[1] "1234"
Field "level":
[1] 3

获取或设置某一属性

> tom$field("username")
[1] "sam"
> tom$field("username", "tom")
> tom
Reference class object of class "VIP"
Field "username":
[1] "tom"
Field "password":
[1] "1234"
Field "level":
[1] 3

获取对象的类的定义

> tom$getClass()
Reference Class "VIP":

Class fields:
                                    
Name:   username  password     level
Class: character character   numeric

Class Methods: 
     "getName#User", "multiple", "add", "import", ".objectParent", "usingMethods", "show", "getClass", 
     "untrace", "export", ".objectPackage", "callSuper", "copy", "initFields", "getRefClass", "trace", 
     "field", "getName"

Reference Superclasses: 
     "User", "envRefClass"

> tom$getRefClass()
Generator for class "VIP":

Class fields:
                                    
Name:   username  password     level
Class: character character   numeric

Class Methods: 
     "getName#User", "multiple", "add", "import", ".objectParent", "usingMethods", "show", "getClass", 
     "untrace", "export", ".objectPackage", "callSuper", "copy", "initFields", "getRefClass", "trace", 
     "field", "getName"

Reference Superclasses: 
     "User", "envRefClass"
# 查看类型
> otype(tom$getClass())
[1] "S4"
> otype(tom$getRefClass())
[1] "RC"

tom$show()show(tom) 以及直接输入 tom 都可以输出对象的信息

> tom$show()
Reference class object of class "VIP"
Field "username":
[1] "tom"
Field "password":
[1] "1234"
Field "level":
[1] 3
> show(tom)
Reference class object of class "VIP"
Field "username":
[1] "tom"
Field "password":
[1] "1234"
Field "level":
[1] 3

追踪方法

> tom$trace("add")
Tracing reference method "add" for object from class "VIP"
[1] "add"
> tom$add(1, 3)
Tracing tom$add(1, 3) on entry 
[1] 4
> tom$add(4, 5)
Tracing tom$add(4, 5) on entry 
[1] 9
> tom$untrace("add")
Untracing reference method "add" for object from class "VIP"
[1] "add"
> add(1, 1)
[1] 2

将子类转换为父类类型

> tom$export('User')
Reference class object of class "User"
Field "username":
[1] "tom"
Field "password":
[1] "1234"
> tom
Reference class object of class "VIP"
Field "username":
[1] "tom"
Field "password":
[1] "1234"
Field "level":
[1] 3

从上面的结果可以看到,转换为父类型之后,level 属性被删除了,但是原始对象并没有被修改

使用一个对象给另一个对象赋值

> sam <- VIP()
> sam
Reference class object of class "VIP"
Field "username":
character(0)
Field "password":
character(0)
Field "level":
numeric(0)
> sam$import(tom$export("User"))
> sam
Reference class object of class "VIP"
Field "username":
[1] "tom"
Field "password":
[1] "1234"
Field "level":
numeric(0)
> sam$import(tom)
> sam
Reference class object of class "VIP"
Field "username":
[1] "tom"
Field "password":
[1] "1234"
Field "level":
[1] 3

3.8 RC 类方法

我们使用 setRefClass 函数定义的类,会自动包含一些方法帮助我们查看类的属性和方法。

比如,我们上面使用到的 $new() 函数,还有一些其他函数

查看 User 类中的属性及其类型

> User$fields()
   username    password 
"character" "character"

查看 User 中定义的方法

> User$methods()
 [1] ".objectPackage" ".objectParent"  "callSuper"      "copy"           "export"        
 [6] "field"          "getClass"       "getName"        "getRefClass"    "import"        
[11] "initFields"     "show"           "trace"          "untrace"        "usingMethods" 

查看函数的调用方式

> VIP$help("add")
Call:
$add(x, y)

User 的属性增加 getset 方法

> User$accessors("password")
> User$methods()
 [1] ".objectPackage" ".objectParent"  "callSuper"      "copy"           "export"        
 [6] "field"          "getClass"       "getName"        "getPassword"    "getRefClass"   
[11] "import"         "initFields"     "setPassword"    "show"           "trace"         
[16] "untrace"        "usingMethods"

将属性固定,一旦赋值后便不可更改

> User$lock("username")
# 查看被锁定的属性
> User$lock()
[1] "username"
> a <- User(username="fly")
> a
Reference class object of class "User"
Field "username":
[1] "fly"
Field "password":
character(0)
> a$username <- "a"
错误: invalid replacement: reference class field ‘username’ is read-only

3.9 示例

Person <- setRefClass(
  "Person", 
  fields = list(
    name="character",
    age="numeric"
  ),
  methods = list(
    initialize = function(name="Unknown", age=18) {
      name <<- name
      age <<- age
    },
    talk = function() {
      return("talking...")
    }
  )
)

Chinese <- setRefClass(
  "Chinese",
  contains = "Person",
  fields = list(
    language="character"
  ),
  methods = list(
    initialize = function(name, age, language="chinese") {
      callSuper(name, age)
      language <<- language
    },
    talk = function() {
      return(paste0(callSuper(), language))
    }
    
  )
)
Chinese$lock("language")

American <- setRefClass(
  "American",
  contains = "Person",
  fields = list(
    language="character"
  ),
  methods = list(
    initialize = function(name, age, language="english") {
      callSuper(name, age)
      language <<- language
    },
    talk = function() {
      return(paste0(callSuper(), language))
    }
  )
)

American$lock("language")

使用

> a <- American("lusy", 20)
> a
Reference class object of class "American"
Field "name":
[1] "lusy"
Field "age":
[1] 20
Field "language":
[1] "english"
> a$talk()
[1] "talking...english"
> b <- Chinese("lisin", 18)
> b
Reference class object of class "Chinese"
Field "name":
[1] "lisin"
Field "age":
[1] 18
Field "language":
[1] "chinese"
> b$talk()
[1] "talking...chinese"
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

名本无名

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值
>