R 语言入门 —— 面向对象

标签：语言 function 入门 Person 对象面向对象 tom 属性 name

R 语言入门 —— 面向对象

文章目录

R 语言入门 —— 面向对象

R 作为一种函数式编程语言，主要是面向统计计算，代码量通常不大，所以一般使用面向过程式的编程就足以完成任务。一般除了开发 R 包之外，也很少有人会用到 R 的面向对象编程，在 R 中，函数式编程也比面向对象编程重要的多。

但随着统计分析在生物学领域的兴起，各种数据分析包的开发者也更加注重代码的可维护性和扩展性，为了更好地理解和学习这些包，我们也有必要了解 R 中的面向对象编程思想。

R 中的面向对象编程系统比较多，其中内置的就有三种：S3、S4 和 RC 类型，其他第三方包也提供了三种不同的面向对象编程系统：R6、R.oo 和 proto。

我们主要介绍其中 4 种：

S3：R 中第一个面向对象系统，广泛存在于早期开发的 R 包中，实现简单且容易上手，是 R 代码库 CRAN 中最常用的系统。
S4：对 S3 进行了更严格和正式的重写，有专门的函数用于定义类、泛型函数、方法以及实例化对象，提供了参数检查和多重继承等功能
RC（reference classes）：是 R 中新一代的面向对象系统，不同于 S3 和 S4 的泛型函数实现方式，它将对象函数封装在类的定义内部，其在行为风格上更像其他面向对象编程语言。
R6：类似于 RC 类，但是更简单、更轻量，支持成员私有化和公有化，支持主动绑定、跨包继承。

注意

在后续的介绍中，我们会用到 sloop 提供的函数，来帮助我们查看对象的类型，需要先安装该包。内置类是 R 自带的，不需要导入。
install.packages('sloop')
library(sloop)

S3 类

1. 基本概念

S3 对象至少要有一个 class 属性，标识对象的类型，该属性可以是一个或多个类型（向量），其他属性可以用于存储数据.例如内置的 factor 类型

f <- factor(1:3)
otype(f)       # sloop 包中的函数，获取对象所属的类
# [1] "S3"
attributes(f)  # 获取对象的所有属性
# $levels
# [1] "1" "2" "3"

# $class
# [1] "factor"

可以使用 unclass 函数获取对象的底层类型，但这会剥离对象的 class 属性，使其不再是一个 S3 类对象

unclass(f)
# [1] 1 2 3
# attr(,"levels")
# [1] "1" "2" "3"
otype(uf)
# [1] "base"

使用 class 函数可以获取对象的类型， attr 函数可以获取对象的指定属性

class(f)
# [1] "factor"
attr(f, 'class')
# [1] "factor"

S3 对象与它的底层类型在泛型函数中的表现是不一样的，因为泛型函数是根据传入对象的类型，调用相应类型的函数实现。判断一个函数是不是泛型函数（generic），可以使用 sloop 包中的 ftype 函数，许多内置函数都是泛型函数，如 str、print 等

ftype(str)
# [1] "S3"      "generic"
str(f)  # 查看对象的结构
# Factor w/ 3 levels "1","2","3": 1 2 3
str(unclass(f))
# int [1:3] 1 2 3
# - attr(*, "levels")= chr [1:3] "1" "2" "3"

泛型函数主要充当一个分派任务的角色，根据传入对象的类型，寻找相应类型的方法的并调用它，如果找不到对应类型所定义的方法，则会调用默认方法。使用 sloop 包中的 s3_dispatch 可以获取所有可能分派的方法列表，例如，str(f) 实际上调用的是 str.default

s3_dispatch(str(f))
#    str.factor
# => str.default
s3_dispatch(str(unclass(f)))
#    str.integer
#    str.numeric
# => str.default

其中，default 其实是一个伪类，并不是一个真正的类，而是当 str 函数所接收的对象没有定义相应的 str 方法时的替代品，

2. 创建 S3 对象

要创建自己的 S3 类型，只需为对象设置一个 class 属性，例如

a <- c(1, 3, 6)
attr(a, 'class') <- 'num'
a
# [1] 1 3 6
# attr(,"class")
# [1] "num"
otype(a)
# [1] "S3"
class(a)
# [1] "num"
class(a) <- 'int'
a
# [1] 1 3 6
# attr(,"class")
# [1] "int"

或者使用 structure 函数来创建

structure(a, class = 'num')
# [1] 1 3 6
# attr(,"class")
# [1] "num"
structure(a, class = c('num', 'int'))
# [1] 1 3 6
# attr(,"class")
# [1] "num" "int"

S3 对象并没有一个正式的定义类的形式，无法通过内建的方法来确保同一个类所创建的对象具有相同的结构，我们可以自己创建一个专门构造函数来执行类的实例化。

new_student <- function(name = character(), sex = character(), age = numeric(), score = double()) {
  # 参数校验
  stopifnot(is.character(sex))
  stopifnot(sex %in% c('male', 'female'))
  stopifnot(is.numeric(age))
  stopifnot(is.double(score))
  
  if (score < 0 || score > 100) {
    stop('"score" must between 0 and 100!')
  }
  # 创建对象
  structure(
    list(
      name = name,
      sex = sex,
      age = age,
      score = score
    ),
    class = "student"
  )
}

上面我们定义了一个构造函数 new_student 用于创建 student 对象，通过函数形参接收 4 个属性值并将数据存储为一个 list 对象。在函数的开头部分，添加了属性值的校验，确保属性值在正确的取值范围内，最后创建并返回一个 student 类对象。

我们可以使用这一构造函数来创建对象

a <- new_student('Tom', 'male', 18, 89.5)
b <- new_student('Jey', 'female', 19, 95)
a
# $name
# [1] "Tom"
# 
# $sex
# [1] "male"
# 
# $age
# [1] 18
# 
# $score
# [1] 89.5
# 
# attr(,"class")
# [1] "student"

我们没有定义 student 的 str 方法，所以调用了默认的 str.default

str(a)
# List of 4
# $ name : chr "Tom"
# $ sex  : chr "male"
# $ age  : num 18
# $ score: num 89.5
# - attr(*, "class")= chr "student"
s3_dispatch(str(a))
#    str.student
# => str.default

我们可以为 str 泛型函数添加支持 student 类的 str 方法，可以看到调用的将是 str.student 方法，而不再是 str.default

str.student <- function(x, ...) {
  print(attr(a, "names"))
}
str(a)
# [1] "name"  "sex"   "age"   "score"
s3_dispatch(str(a))
# => str.student
#  * str.default

3. 创建泛型函数

使用 UseMethod() 函数创建自己的泛型函数，并添加不同类对象的支持，注意第一个参数的值要与泛型函数名称相同。例如，我们添加两个泛型函数 eat 和 learn 用于展示不同对象的行为

eat <- function(x, ...) {
  UseMethod("eat")
}
learn <- function(...) {
  UseMethod("learn")
}
ftype(eat)
# [1] "S3"      "generic"
ftype(learn)
# [1] "S3"      "generic"

并添加默认行为和 student 类型对象的行为

# eat
eat.default <- function(x, ...) {
  print("[Default]: eat")
}
eat.student <- function(x, ...) {
  print("[Student]: eat")
}
# learn
learn.default <- function(x, ...) {
  print("[Default]: learn")
}
learn.student <- function(x, ...) {
  print("[Student]: learn")
}

调用泛型函数

eat(1:3)
# [1] "[Default]: eat"
eat(a)
# [1] "[Student]: eat"
learn(b)
# [1] "[Student]: learn"
learn("bcd")
# [1] "[Default]: learn"

为内置类添加 eat 方法支持

eat.list <- function(x, ...) {
  print("I can't eat anymore!")
}
eat(list(a = 1, b = "c"))
[1] "I can't eat anymore!"

泛型函数会根据对象的 class 属性，调用对应类型的方法，找不到对应类型则调用默认方法。

使用 methods 函数可以查看泛型函数或类所包含的所有方法

methods(generic.function = eat)
# [1] eat.default eat.list    eat.student
# see '?methods' for accessing help and source code
methods(class = "student")
# [1] eat   learn str  
# see '?methods' for accessing help and source code

如果是内置泛型函数，你可能会看到某些方法带有 * 号，表示这个方法的代码实现对我们是不可见的，可以使用 getAnywhere 和 getS3method 两个函数来获取这些方法，例如

getAnywhere(print.xtabs)
# A single object matching ‘print.xtabs’ was found
# It was found in the following places
# registered S3 method for print from namespace stats
# namespace:stats
# with value
# 
# function (x, na.print = "", ...) 
# {
#   ox <- x
#   attr(x, "call") <- NULL
#   print.table(x, na.print = na.print, ...)
#   invisible(ox)
# }
# <bytecode: 0x7fb7db393330>
#   <environment: namespace:stats>

4. S3 对象的继承

S3 对象的继承是使用 NextMethod() 函数来实现的，但其实严格意义上来说并不算继承，只继承了父类的方法，并没有继承父类的属性。例如，我们定义一个 college 类来继承 student 类的 learn.student 方法

learn.college <- function(x, ...) {
  NextMethod()
  print("I am learning computer programming!")
}

b <- new_student('Jey', 'female', 19, 95)
class(b) <- c("college", "student")

learn(a)
# [1] "[Student]: learn"
learn(b)
# [1] "[Student]: learn"
# [1] "I am learning computer programming!"

注意：在设置对象 b 的 class 的属性时，父类要放在后面

5. 缺点

由于 S3 是 R 语言最早的面向对象系统，当时基于类层次结构的面向对象编程思想才提出不久，其基于泛型函数来模拟面向对象，其实并不是完全的面向对象。

虽然 S3 对象用起来简单，但是当对象关系具有一定复杂度时，往往很难清楚表达对象的意义，构建对象时没有类型检查功能。而且 class 属性可以被任意修改

S4 类

相较于 S3，S4 面向对象的实现则更加严格和正式，有专门的函数用于定义类（setClass）、泛型函数（setGeneric）、方法（setMethod）以及实例化函数（new），同时也提供了参数检查与多重继承等功能。

S4 还新增了一个重要组件 slot，用于存储对象的属性，并使用专门的运算符 @（读作 at）来访问组件。

Bioconductor 社区的包是以 S4 对象作为基础框架，只接受 S4 定义的 R 包，所以，对于生物信息分析者来说，学习 S4 是非常有必要的。

S4 类相关的函数都在 R 基础包 methods 中定义，可以先导入该包

library(methods)

1. 创建类和对象

想要创建一个 S4 类，需要使用 setClass 函数来定义，其参数有

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

其中主要的几个参数

Class: 类名，字符串类型
slots: 使用一个命名向量或 list 来定义类的属性及其数据类型
prototype: 设置属性的默认值，可以使用 initialize() 函数进行更灵活的设置
contains=character(): 指定父类
validity: 定义属性的类型检查函数，也可以使用 setValidity() 函数进行独立的设置，避免类定义过于臃肿

我们创建一个 Person 类和并实例化一个对象 tom

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

tom <- new("Person", name = "Tom", age = 18)
tom
# An object of class "Person"
# Slot "name":
#   [1] "Tom"
# 
# Slot "age":
#   [1] 18
# 
# Slot "weight":
# numeric(0)
otype(tom)
# [1] "S4"
str(tom)
# Formal class 'Person' [package ".GlobalEnv"] with 3 slots
#   ..@ name  : chr "Tom"
#   ..@ age   : num 18
#   ..@ weight: num(0)

或者使用另一种更易理解的方式

Person <- setClass("Person",
  slots = list(
    name = "character",
    age = "numeric",
    weight = "numeric"
  )
)
joy <- Person(name = "Joy", age = 20, weight = 54.6)

2. 属性访问

访问对象属性使用 @ 和 slot 函数，类似于 list 的 $ 和 [[ 的访问方式

tom@name
# [1] "Tom"
slot(tom, "age")
# [1] 18
tom@weight <- 61.5
slot(tom, "age") <- 19
tom
# An object of class "Person"
# Slot "name":
#   [1] "Tom"
# 
# Slot "age":
#   [1] 19
# 
# Slot "weight":
#   [1] 61.5

使用 slotNames 函数可以返回对象或类的属性列表

slotNames(tom)
# [1] "name"   "age"    "weight"
slotNames("Person")
# [1] "name"   "age"    "weight"

使用 getSlots 函数可以获取类的属性名称及其类型

getSlots("Person")
#        name         age      weight 
# "character"   "numeric"   "numeric"

使用 getClass 获取类或对象的定义

getClass(tom)
# An object of class "Person"
# Slot "name":
#   [1] "Tom"
# 
# Slot "age":
#   [1] 19
# 
# Slot "weight":
#   [1] 61.5
# 
getClass("Person")
# Class "Person" [in ".GlobalEnv"]
# 
# Slots:
#   
#   Name:       name       age    weight
# Class: character   numeric   numeric

3. 类型检查和默认值

类型检查

构造函数会自动检查传入属性的类型是否正确，如果传入错误的类型将会抛出异常

Person(name = 1:10)
# Error in validObject(.Object) : 
#   invalid class “Person” object: invalid object for slot "name" in class "Person": got class "integer", should be or extend class "character"

但是仅仅只是做了类型检查，如果我们设置 age 属性为一个向量，并不会报错

Person(name = "Lux", age = c(19, 20))
# An object of class "Person"
# Slot "name":
#   [1] "Lux"
# 
# Slot "age":
#   [1] 19 20
# 
# Slot "weight":
#   numeric(0)

我们可以使用 setValidity 函数为类添加验证器函数，函数的参数为类对象，当验证属性有效时返回 TRUE

setValidity("Person", function(object) {
  tmp <- c()  # 空向量，用于存储属性的长度
  for (n in slotNames(object)) {  # 遍历所有属性
    tmp <- c(tmp, length(slot(object, n)))  # 添加属性长度
  }
  if (min(tmp) != max(tmp)) {  # 所有属性是否具有相同的长度
    stop("all slots must be same length")
  } else {
    return(TRUE)
  }
})

当我们设置完类的验证器之后，再次运行将会抛出异常

Person(name = "Lux", age = c(19, 20))
# Error in validityMethod(object) : all slots must be same length
# Called from: validityMethod(object)

也可以使用 validObject 函数来验证对象是否有效

validObject(tom)
# Error in validityMethod(object) : all slots must be same length
# Called from: validityMethod(object)

设置默认值

为了方便，我们通常会为一些值较固定的属性设置一个默认值，或者是将不确定的属性设置为缺失值。

Person <- setClass("Person",
  slots = list(
    name = "character",
    age = "numeric",
    weight = "numeric"
  ),
  prototype = list(
    name = NA_character_,
    age = -1,
    weight = 0.0
  )
)
Person()
# An object of class "Person"
# Slot "name":
#   [1] NA
# 
# Slot "age":
#   [1] -1
# 
# Slot "weight":
#   [1] 0

4. 泛型函数与方法

S4 泛型函数使用 setGeneric 函数来定义，并使用 standardGeneric 函数来发起调度

setGeneric("names", function(x) standardGeneric("names"))

使用 setMethod 函数为泛型函数定义方法，我们将对象属性的获取封装成函数

setMethod("name", "Person", function(obj){
  obj@name
})
name(tom)
# [1] "Tom"

类似地，我们可以将对象的属性进行封装，添加一个访问函数来获取属性值，一个设置函数来设置属性值

setGeneric("age", function(obj, ...) standardGeneric("age"))
setMethod("age", "Person", function(obj){
  obj@age
})

setGeneric("age<-", function(obj, ...) standardGeneric("age<-"))
setMethod("age<-", "Person", function(obj, value) {
  obj@age <- value
  validObject(obj)  # 为对象设置属性时也别忘了检查数据的正确性
  obj
})
age(tom)
# 18
age(tom) <- 19
age(tom)
# 19

将类属性进行封装，在 Java 中是很常见的一种操作，将属性值私有化，并提供访问和设置函数接口，并在函数中对设置的值进行检查，避免属性直接暴露在外面，无法保证数据的有效性。

5. 继承

S4 对象的继承是通过 contains 参数来设置的，可接受字符串类名或字符串向量（多重继承）。例如，我们定义一个 Chinese 类，继承自 Person，并添加一个国籍属性

Chinese <- setClass("Chinese", contains = "Person", 
  slots = list(country = "character"), 
  prototype = list(country = "China")
)
confucius <- Chinese(name = "Confucius", age = 100, weight = 66)
confucius
# An object of class "Chinese"
# Slot "country":
#   [1] "China"
# 
# Slot "name":
#   [1] "Confucius"
# 
# Slot "age":
#   [1] 100
# 
# Slot "weight":
#   [1] 66

来看看为 Person 定义的函数，能不能直接用在 Chinese 上

name(confucius)
# [1] "Confucius"
age(confucius)
# [1] 100
age(confucius) <- 3000
age(confucius)
# [1] 3000

没问题，不仅属性继承了，连方法也继承了。使用 is 函数来判断对象的继承关系

is(tom)
# [1] "Person"
is(confucius)
# [1] "Chinese" "Person" 
is(confucius, "Person")
# [1] TRUE
is(confucius, "Chinese")
# [1] TRUE
is(tom, "Chinese")
# [1] FALSE

接下来我们演示一个多重继承和多重分派的例子，再定义一个 American 类，也是继承自 Person，然后定义一个 Hybrid 类，继承自 Chinese 和 American，表示混血

American <- setClass(
  "American", contains = "Person", 
  slots = list(country = "character"), 
  prototype = list(country = "American")
)
Hybrid <- setClass(
  "Hybrid", contains = c("Chinese", "American"), 
  slots = list(country = "character"), 
  prototype = list(country = NA_character_)
)
lisi <- Chinese(name = "Lisi", age = 100, weight = 56)
alex <- American(name = "Alex", age = 10, weight = 66)

然后定义一个泛型函数，接受两个参数，传入的类型为 Chinese 和 American，那我为什么设置为两个 Person 类呢？因为这两个类都是继承自 Person，在分派时会搜索传入类型的父类，这样我就不需要考虑这两个类型放置的顺序了

setGeneric("hybrid", function(x, y) standardGeneric("hybrid"))
setMethod("hybrid", signature("Person", "Person"), function(x, y) {
  cat(x@country, y@country)
})
hybrid(lisi, alex)
# China American
hybrid(alex, lisi)
# American China

更进一步，考虑其中一个类型是未知的，或者缺省了一个，这时，需要用到两个伪类：

ANY：表示任意类型
missing：表示缺省

setMethod("hybrid", signature("Person", "ANY"), function(x, y) {
	# 判断对象是否继承自 Person 且包含 country 属性
  if (is(y, "Person") && "country" %in% slotNames(y)) {
    cat(x@country, y@country)
  } else {
    cat(x@country, "unknown") 
  }
})
setMethod("hybrid", signature("Person", "missing"), function(x, y) {
  cat(x@country)
})
hybrid(lisi, 1)
# China unknown
hybrid(lisi)
# China

当然，我们可以使用点函数 ... 来创建可变参数的泛型函数，这需要更多的类型判断。

6. 与 S3 交互

S4 类可以继承自 S3 类，会带有一个虚拟的 slot—— .Data，用于存储基础类或 S3 对象的值

Alpha <- setClass(
  "Alpha", contains = "character",
  slots = c(min = "character", max = "character"),
  prototype = structure(character(), min = NA_character_, max = NA_character_)
)

a <- Alpha(c("A", "J", "P", "S"), min = "A", max = "S")
a
# An object of class "Alpha"
# [1] "A" "J" "P" "S"
# Slot "min":
#   [1] "A"
# 
# Slot "max":
#   [1] "S"
# 
[email protected]
# [1] "A" "J" "P" "S"
a@min
# [1] "A"

也可以将 S3 泛型函数转换为 S4 泛型函数

ftype(print)
# [1] "S3"      "generic"
setGeneric("print", function(x, ...) standardGeneric("print"))
# [1] "print"
ftype(print)
# [1] "S4"      "generic"
setMethod("print", "Alpha", function (x, ...) {
  print([email protected])
})
print(a)
# [1] "A" "J" "P" "S"

使用 setMethod() 函数时，如果第一个参数指定的函数不是泛型函数，会自动运行 setGeneric() 进行转换

RC 类

不同于 S3 和 S4，RC 面向对象系统不再通过泛型函数模型来实现类的方法，而是将方法封装在类的定义中，其在行为风格上更贴近其他面向对象语言。

RC 通过 $ 符号来调用方法、访问和修改对象的属性值，不同于常用的函数式编程模型，调用方法或设置属性值会修改对象本身。

1. 创建类和对象

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

主要参数

Class: 字符串类名
fields: 定义属性名称与类型，可以是命名字符串向量或命名列表。
contains: 定义父类，多重继承传递父类向量。如果父类也是 RC 类，会继承父类的属性和方法
methods: 一个命名列表，定义对象可调用的方法。也可以使用 $methods 方法定义函数

定义类

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: 
#   "field", "trace", "getRefClass", "initFields", "copy", "callSuper", ".objectPackage", "export", 
# 	"untrace", "getClass", "show", "usingMethods", ".objectParent", "import"
# 
# Reference Superclasses: 
#   "envRefClass"

可以看到，虽然我们没有定义类方法，但是有很多内置的方法可以使用，后面将会介绍其中几个函数

创建对象，可以使用 new 方法或直接使用类名创建

genders <- factor(c("Female", "Male"))
tom <- Person$new(name="Tom", age = 19, gender = genders[2])
jerry <- Person(name = "jerry", age = 5, gender = genders[2])

tom
# Reference class object of class "Person"
# Field "name":
# [1] "Tom"
# Field "age":
# [1] 19
# Field "gender":
# [1] Male
# Levels: Female Male

查看类型

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

属性访问

jerry$gender
# [1] Male
# Levels: Female Male
tom$age <- 20
tom$age
# [1] 20

2. 定义和使用方法

我们可以在定义类时添加方法

Person <- setRefClass(
  "Person", fields = c(name='character',age='numeric',gender='factor'),
  methods = list(
    setAge = function(x) { age <<- x },
    getAge = function() { age }
  )
)
tom <- Person$new(name="Tom", age = 19, gender = genders[2])
tom$getAge()
# [1] 19
tom$setAge(20)
tom$age
# [1] 20

注意，我们使用了 <<- 方式来更改属性值，因为 <- 只会影响函数作用域内部的值，而我们需要向上层类中写入值。

使用 $methods() 的方式添加一个函数

Person$methods(
  setName = function(x) { name <- x },
  getName = function() {name }
)
# Warning message:
#   In .checkFieldsInMethod(def, fieldNames, allMethods) :
#   场名本地分配不会改变场的内容：
# name <- x
# 你意思是不是用"<<-"? (在类别"Person"的"setName"方法里)

已经发出警告了，<- 只能影响局部变量，调用函数试试

tom$setName("tomi")
tom$getName()
# [1] "Tom"

并没有影响 name 属性的值

3. 构造函数

每次 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("Tomi")
# Reference class object of class "Person"
# Field "name":
# [1] "Tomi"
# Field "age":
# [1] 18
# Field "gender":
# [1] Female
# Levels: Female Male

4. 继承

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
# Reference class object of class "VIP"
# Field "username":
# [1] "tom"
# Field "password":
# [1] "123456"
# Field "level":
# [1] 1
tom$username
# [1] "tom"
tom$getName()
# [1] "tom"

5. 内置方法

RC 类具有很多内置的方法

方法	描述
`initialize`	初始化构造函数，只执行一次
`callSuper`	调用父类同名方法，用于方法的重写
`copy`	赋值对象
`initFields`	为对象的属性赋值
`field`	用于获取属性的值，如果参数是两个，相当于设置属性值
`getClass`	查看对象的类定义
`show`	查看当前对象
`export`	将对象转换为其他类型对象
`import`	用其他类对象的值代替当前对象的值，必须与当前对象类型一样或其父类
`trace`	跟踪对象方法的调用，用于 `debug`
`untrace`	取消跟踪
`usingMethods`	用于实现方法的调用

为上面的两个类添加方法

User$methods(
  getName = function() {
    return(username)
  }
)
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=1)
tom$getName()
# VIP： tom

如果 tom 想更改用户名和密码，可以使用 initFields 或 field 函数为对象重新赋值

tom$initFields(username="Tomi", password="654321")
# Reference class object of class "VIP"
# Field "username":
# [1] "Tomi"
# Field "password":
# [1] "654321"
# Field "level":
# [1] 1
tom$field("username")
# [1] "Tomi"
tom$field("username", "Tom")
tom$getName()
# VIP： Tom

追踪方法的使用

tom$trace("add")
# Tracing reference method "add" for object from class "VIP"
# [1] "add"
tom$add(1, 5)
# Tracing tom$add(1, 5) on entry 
# [1] 6
tom$add(3, 7)
# Tracing tom$add(3, 7) on entry 
# [1] 10
tom$untrace("add")
# Untracing reference method "add" for object from class "VIP"
# [1] "add"

tom 如果取消了 VIP，将没有了 VIP 权限

tom$export('User')
# Reference class object of class "User"
# Field "username":
# [1] "Tom"
# Field "password":
# [1] "654321"
tom$level
[1] 1

从上面的结果可以看到，转换为父类型之后，返回的是一个 User 对象，level 属性已被删除，但是原始对象并没有被修改

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

Lisa <- VIP()
Lisa$import(tom$export("User"))
Lisa$import(tom)
# Reference class object of class "VIP"
# Field "username":
# [1] "Tom"
# Field "password":
# [1] "654321"
# Field "level":
# numeric(0)

6. 类方法

除了我们上面使用到的 $new() 和 $methods() 函数，还有一些其他类方法可供使用

查看类的所有属性及其类型

VIP$fields()
#    username    password       level 
# "character" "character"   "numeric"

查看可用方法

VIP$methods()
# [1] ".objectPackage" ".objectParent"  "add"            "callSuper"      "copy"           "export"        
# [7] "field"          "getClass"       "getName"        "getName#User"   "getRefClass"    "import"        
# [13] "initFields"     "multiple"       "show"           "trace"          "untrace"        "usingMethods"

为属性自动添加 get 和 set 方法

VIP$accessors("password")
tom$getPassword()
# [1] "654321"
tom$setPassword("123456")
tom$password
# [1] "123456"

将对象锁定禁止被修改

VIP$lock("username")
VIP$lock()  # 获取被锁定的属性
# [1] "username"
tom <- VIP(username="tom", password="123456", level=1)
tom$username <- "Tomi"
# 错误: invalid replacement: reference class field ‘username’ is read-only

R6 类

R6 类与 RC 比较像，但是更简单，更快，更轻量级，同时还支持：

属性和方法的公有化和私有化
主动绑定
跨包之间的继承

R6 类是由一个独立的包提供的，使用前需要先进行安装

install.packages("R6")
library(R6)

1. 定义类和方法

类和方法的定义是通过 R6Class() 函数来进行定义的

R6Class(classname = NULL, public = list(), private = NULL,
  active = NULL, inherit = NULL, lock_objects = TRUE, class = TRUE,
  portable = TRUE, lock_class = FALSE, cloneable = TRUE,
  parent_env = parent.frame(), lock)

主要参数

参数	描述
`classname`	类名
`public`	共有成员和方法
`private`	私有成员和方法
`active`	主动绑定的函数列表
`inherit`	父类
`lock_objects`	是否锁定对象，锁定后无法为对象添加成员
`lock_class`	是否锁定类，锁定后无法使用 `$set` 为类添加新的成员
`class`	是否把属性封装成对象，不封装，则类属性将存在一个环境空间中
`portable`	是否可移植类型
`cloneable`	是否可以调用 `$clone` 来拷贝对象

下面简单定义一个类

Person <- R6Class(
  "Person",
  public = list(
    name = NA,
    initialize = function(name, salary = 1000) {
      stopifnot(is.character(name), length(name) == 1)
      self$name <- name
    },
    say = function() {
      cat("my name is ", self$name)
    }
  )
)

在类中，self 表示类本身，self$name 访问类的 name 属性，initialize 函数与 RC 类的一样，用于初始化及数据检查。

使用 $new 函数来创建一个对象

tom <- Person$new(name = "tom")
tom
# <Person>
#   Public:
#		  clone: function (deep = FALSE) 
#     initialize: function (name) 
#     name: tom
#     say: function ()
tom$name
# [1] "tom"
tom$say()
# my name is tom

查看类与实例的类型

class(Person)
# [1] "R6ClassGenerator"
class(tom)
# [1] "Person" "R6"    
otype(tom)
# [1] "R6"

还有一个比较重要的函数 $print()，虽然不是必须的，但是可以自定义你的类的输出信息。为了避免代码重复，我们使用 $set 函数来添加

Person$set("public", "print", function(...) {
  cat("Person: \n")
  cat("  Name: ", self$name, "\n", sep = "")
  invisible(self)
})
tom <- Person$new(name = "tom")
tom
# Person: 
#   Name: tom

$set 还可以用于添加属性，如果设置 overwrite = TRUE，则会覆盖现有属性的默认值

Person$set("public", "age", 18)
tom <- Person$new(name = "tom")
tom$age
# [1] 18

Person$set("public", "age", 28, overwrite = TRUE)
tom <- Person$new(name = "tom")
tom$age
# [1] 28

2. 公有和私有成员

顾名思义，公有成员时外部对象可以直接访问的，而私有成员只能在类内部进行访问，两种成员的访问方式也是不同的，公有成员使用 self 对象来引用，而私有成员用 private 对象来引用。

Person <- R6Class(
  "Person",
  public = list(
    name = NA_character_,
    initialize = function(name, salary = 1000) {
      self$name <- name
      private$salary <- salary
    },
    say = function() {
      cat("my name is", self$name)
    },
    raise_salary = function(percent) {
      private$setMoney(private$salary * (1 + percent))
      invisible(self)
    },
    get_salary = function() private$salary
  ),
  private = list(
    salary = NA,
    setMoney = function(m) {
      cat(paste0("change ", self$name, "'s salary!\n"))
      private$salary <- m
    }
  )
)

我们在类中添加了私有属性 money 和私有函数 setMoney，并添加了一个公有函数 raise_salary 用于对私有属性进行修改

tom <- Person$new(name = "tom")
tom$get_salary()
# [1] 1000
tom$raise_salary(0.1)
# change tom's salary!
tom$get_salary()
# [1] 1100
tom$salary
# NULL

私有成员无法通过 $ 来进行访问，只能通过函数调用。同时，你应该也注意到在 raise_salary 函数中，我们使用了 invisible(self)，其作用是允许我们对 raise_salary 进行链式调用

tom$raise_salary(0.1)$raise_salary(0.1)$raise_salary(0.2)
# change tom's salary!
# change tom's salary!
# change tom's salary!
tom$get_salary()
# [1] 2125.873

那 self 和 private 对象有什么区别呢？我们可以使用 $set 函数来添加一个 test 方法测试一下

Person$set("public", "test", function() {
  print(self)
  print(strrep("=", 20))
  print(private)
  print(strrep("=", 20))
  print(ls(envir = private))
})
tom <- Person$new(name = "tom")
tom$test()
# <Person>
# Public:
#   clone: function (deep = FALSE) 
#   get_salary: function () 
#   initialize: function (name, salary = 1000) 
#   name: tom
#   raise_salary: function (percent) 
#   say: function () 
#   test: function () 
# Private:
#   salary: 1000
#   setMoney: function (m) 
# [1] "===================="
# <environment: 0x7f7bf8930520>
# [1] "===================="
# [1] "salary"   "setMoney"

self 对象是实例化的对象本身，而 private 则是一个环境空间。这个环境空间就像是变量的作用域，所有私有成员都在这个作用域内，因此，private 只在类中被调用，而对于类外部是不可见的。

3. 主动绑定

主动绑定可以让函数的调用看起来像是在访问属性，主动绑定总是公开成员，外不可见的。

这与 Python 中的 @property 装饰器是一样的，有些时候，我们并不想直接把数据属性暴露在外面，被随意修改，而且属性与其他属性相关联，当其他属性值被修改时，该值也需要更新。例如，学生类，包含各科的成绩，而总分在各科成绩修改时，需要同时更新，这时候可以使用主动绑定，将计算总分的函数变成属性。

Student <- R6Class(
  "Student",
  public = list(
    chinese = NA_real_,
    mathematics = NA_real_,
    computer = NA_real_,
    initialize = function(name, chinese, mathematics, computer) {
      stopifnot(is.character(name), length(name) == 1)
      stopifnot(is.numeric(chinese), length(chinese) == 1)
      stopifnot(is.numeric(mathematics), length(mathematics) == 1)
      stopifnot(is.numeric(computer), length(computer) == 1)
      
      private$.name <- name
      self$chinese <- chinese
      self$mathematics <- mathematics
      self$computer <- computer
    },
    name = function(x) {
      if (missing(x)) private$.name
      else private$.name <- x
    }
  ),
  private = list(
    .name = NA_character_
  ),
  active = list(
    total = function() { self$chinese + self$mathematics + self$computer }
  )
)

注意：属性及方法的名称必须唯一，不能有重复，所以将私有属性设置为 .name

tom <- Student$new("Tom", 85, 99, 95)
tom$total
# [1] 279
tom$chinese <- 90
tom$total
# [1] 284
tom$name()
# [1] "Tom"
tom$name("Tomi")
tom$name()
# [1] "Tomi"

4. 继承

R6 通过 inherit 参数指定父类，例如，我们定义一个 worker 类，它继承自上面的 Person 类

Worker <- R6Class(
  "Worker",
  inherit = Person,
  public = list(
    company = "Gene",
    info = function() {
      print("NGS analysis!")
    }
  )
)

siri <- Worker$new("Siri", 100)
# <Worker>
# Inherits from: <Person>
# Public:
#   clone: function (deep = FALSE) 
#   company: Gene
#   get_salary: function () 
#   info: function () 
#   initialize: function (name, salary = 1000) 
#   name: Siri
#   raise_salary: function (percent) 
#   say: function () 
# Private:
#   salary: 100
#   setMoney: function (m)
siri$raise_salary(0.1)
# change Siri's salary!
siri$get_salary()
# [1] 110

我们可以使用 super 对象来调用父类的方法，让我们来重写 raise_salary 方法

Worker$set("public", "raise_salary", function(percent) {
  super$raise_salary(percent + 0.1)
})
siri <- Worker$new("Siri", 100)
siri$raise_salary(0.1)
# change Siri's salary!
siri$get_salary()
# [1] 120

5. 静态对象

如果要在类的所有实例中共享变量，则要将该共享变量设置为另一个类的对象

ShareClass <- R6Class(
  "ShareClass",
  public = list(
    num = NULL
  )
)
Common <- R6Class(
  "Common",
   public = list(
     share = ShareClass$new()
  )
)

c1 <- Common$new()
c1$share$num <- 1
c1$share$num
# [1] 1
c2 <- Common$new()
c2$share$num
# [1] 1
c2$share$num <- 2
c1$share$num
# [1] 2

标签：语言,function,入门,Person,对象,面向对象,tom,属性,name
From： https://blog.csdn.net/dxs18459111694/article/details/139696476

R 语言入门 —— 面向对象