R 面向对象编程(OOP)

面向对象概述

面向对象编程（Object Oriented Programming，OOP）是一种计算机编程架构。OOP 的一条基本原则是计算机程序是由单个能够起到子程序作用的单元或对象组合而成。面向对象编程有三个重要特点: 封装, 继承和多态。

面向对象编程大大提高了代码编写的效率，防止代码一盘散沙而只能小打小闹，严格的OOP有助于构建大工程，有利于团队合作和社区分享。可以说OOP的使用程度标志着一门语言的成熟和值钱程度。广泛使用的Java和JavaScript都是这样一路走向OOP的怀抱的。

R base 本身提供了3种类，S3, S4和Reference Classes, or RC，另一种和RC类似的R6类是以R6包提供的。ggplot2的作者hadley认为S3最重要，其次是R6，然后是S4。也有很多人认为S4最重要，其次是RC，而S3应该被避免。这就意味着R的社区使用着不同的系统。

S3和S4使用泛型，和现今最流行的语言(比如Java和JS)的OOP概念差异相当大。虽然总体概念类似，但是细节理念差很多，并不能即刻实现现有OOP技能到R的转变。

而RC以及在RC基础上进一步发展的R6标准已经逐步开始接近主流编程语言中面向对象的实现模式。

OOP命名的一些约定：类名首字母大写的名词或名词组合，类似 Student, ParaName；方法名使用首字母小写的动词，类似 print(), actionPerformed(), paraName()；变量名小写开头，如 firstName, orderNumber等。

S3

S3对象没什么特别的，只是带有class属性的base类型对象而已。通过structure()函数就能够构造一个对象，如果分配至少一个class属性，就是S3对象，如果没有class属性，就是base对象。由于R语言中一切都是对象，所有可以通过这种方法构造任何想要的对象——向量、列表、函数等等。

> structure(1, class = c("son", "father"))

泛型函数

R的print()函数很强大，能输出数字、字符、list、文本框等，你可能会想里面是不是很多if else 判断呢？如果是，那么只有原始作者能定义打印的类型，其他用户怎么添加新的打印类型呢？实际上这是通过S3泛型函数实现的。

# 不同的类有不同的print方法，查看print所有泛型方法
> methods(print)
  [1] print.acf*                                          
  [2] print.AES*                                          
  [3] print.agnes*                                        
  [4] print.all_vars*                                     
  [5] print.anova*   
  ...
  [274] print.xngettext*                                    
  [275] print.xtabs*                                        
  see '?methods' for accessing help and source code
#


# 没想到，+号, [号 也是泛型函数
> getGeneric('+')
standardGeneric for "+" defined from package "base"
  belonging to group(s): Arith 

function (e1, e2) 
standardGeneric("+", .Primitive("+"))


Methods may be defined for arguments: e1, e2
Use  showMethods("+")  for currently available ones.

S3类仅仅是一个class属性，没有严格的检查，很松散。适用于日常代码较少时个人使用。有3个常用的函数：

is.object(xx) 查看xx是否是一个类的对象。

getS3method('fnName','className') 查看className对应的fnName的S3泛型方法。

getAnywhere('print.teacher') 查看函数的定义位置。

警告：因为点号.是S3实现泛型函数的方法，为了防止歧义，应避免在普通变量名中使用.号。普通变量命名推荐使用 para_name, paraName，类名使用 ParaName。

> a='d'
> is.object(a) #没有class属性，还不是S3类
[1] FALSE
> class(a)='teacher' #添加class属性
> is.object(a) #有class属性了，就是S3类了
[1] TRUE

> attributes(a)
$class
[1] "teacher"
> a
[1] "d"
attr(,"class")
[1] "teacher"  #没错，a已经是一个teacher类了，太随意了！！


# 为teacher类定义一个print方法，就是在print后加点，再加上类名
> print.teacher=function(x){ print(paste('S3 class teacher:', x))}

> print(a) #由于a是teacher类，所以自动调用其泛型方法
[1] "S3 class teacher: d"


# 查找teacher类对应的print方法
> getS3method('print','teacher')
function(x){ print(paste('S3 class teacher:', x))}

# 查找在哪里定义的？
> getAnywhere('print.teacher')
A single object matching ‘print.teacher’ was found
It was found in the following places
  .GlobalEnv
  registered S3 method for print
with value

function(x){ print(paste('S3 class teacher:', x))}

S3泛型函数和方法: UseMethod

“方法”在R里面就是指函数，S3中OOP“方法”是通过泛型函数（generic function）实现的。概念很抽象，但实现方式很简单，先看一个小例子。

## 第一步：定义一个泛型函数，这个函数的函数体只有一个固定的语句
doit = function(...) UseMethod("doit")

## 第二步：设置针对特定CLASS的动作函数
doit.character = function(...) {
    cat("With STRING class attribute\n")
}
doit.integer = function(...) {
    cat("With INTEGER class attribute\n")
}
doit.God = function(...) {
    cat("With God class attribute\n")
}
### 第三步：设置一个默认的动作函数
doit.default = function(...) {
    cat("UNKNOWN class attribute\n")
}


##上面三个步骤就完成了doit泛型函数的设置。看看效果吧：
a = "ABCDE"

doit(a)
## With STRING class attribute

attr(a, "class") = "integer"
class(a) #[1] "integer"
doit(a)
## With INTEGER class attribute

attr(a, "class") = "God"
doit(a)
## With God class attribute

a = as.factor(a)
doit(a)
## UNKNOWN class attribute

注意几点：

- 在函数定义部分定义了5个函数，doit函数为“泛型函数”，其他函数为“方法”

- 泛型函数有一个关键的语句：调用UseMethod函数

- 除泛型函数外其他函数名称的前缀（如果可以这么叫的话）都是和泛型函数相同，名称的后缀为CLASS名或default，用点号相连

- 使用的时候可以只使用不带点号的doit函数，泛型函数根据其参数的class属性选择合适的“方法”函数

这里面还有一个问题：针对特定类型的动作函数并没有用于识别数据类型的代码，函数调用的形式都是一样的，doit函数怎么知道该执行那个操作？关键就在于UseMethod这个函数。这个函数只能在函数体内使用，它可以有两个参数：

UseMethod(generic, object)

generic 是泛型函数的名称（字符串）， object 是用于确定动作函数的对象，如果缺省将使用泛型函数的第一个参数，UseMethod取其CLASS属性。如果要用其他参数进行类型判断，只需修改泛型函数。下面修改后的泛型函数使用第二个参数进行动作函数选择：

doit("abc", 1:10)
## With STRING class attribute

doit(1:10, "abc")
## With INTEGER class attribute

doit = function(...) {
    xx = list(...)
    UseMethod("doit", xx[[2]])
}
# 注意下面结果与修改泛型函数前的差别
doit(1:10, "abc")
## With STRING class attribute

generic 参数只说是泛型函数的名称，但没有限制必需和UseMethod调用者的函数名称相同。summary是R定义的最常用泛型函数之一，下面代码中的doit函数把summary函数的全部用法都偷过来了。如果你老记不住summary这个名称的写法，不妨试试这种用法：

> doit = function(...) UseMethod("summary")
> doit(1:10)
#   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
#   1.00    3.25    5.50    5.50    7.75   10.00

> doit(airquality)
# airquality是R基本安装包datasets下的一组数据。

NextMethod 函数

在子类方法中，通过NextMethod()函数指向父类的同名方法。

这是一个非常特殊的函数。《R Language Definition》中的说法是这样的： Methods invoked as a result of a call to NextMethod behave as if they had been invoked from the previous method.

太高深了，一头雾水。还是用代码来看看：

doit = function(...) UseMethod("doit")
doit.character = function(...) {
    cat("With STRING class attribute\n")
    NextMethod()
}

doit.integer = function(...) {
    cat("With INTEGER class attribute\n")
    NextMethod()
}

doit.God = function(...) {
    cat("With God class attribute\n")
    NextMethod()
}

doit.default = function(...) {
    cat("UNKNOWN class attribute\n")
}

## 多CLASS属性对象
x = "abc"
class(x) = c("UNKNOWN", "integer", "character", "God")
doit(x)
# With INTEGER class attribute
# With STRING class attribute
# With God class attribute
# UNKNOWN class attribute

原来如此。如果在方法中都加入NextMethod函数，泛型函数会按照CLASS属性对所有方法都应用一遍。

但奇怪的是：x变量的CLASS属性第一个是位置类型UNKNOWN，doit泛型函数首先会使用它，但default方法中并没有使用NextMethod函数，运行完doit.default函数应该结束了，为什么有那么多输出呢？这就是《R Language Definition》天书中说的 as if 的意思：含有NextMethod函数的方法“似乎”都被幽灵一样的“前一种方法”调用了！

但这还不是全部。如果每种方法都使用NextMethod函数，程序运行将进入循环，对class属性向量的循环。这也不是简单的循环，是嵌套的：

doit = function(...) UseMethod("doit")
doit.a1 = function(...) {
    cat("Loop 1 begin\n")
    NextMethod()
    cat("Loop 1 end\n")
}
doit.a2 = function(...) {
    cat("Loop 2 begin\n")
    NextMethod()
    cat("Loop 2 end\n")
}
doit.default = function(...) {
    cat("DEFAULT method goes here ...\n")
}
class(x) = c("unknown", "a1", "a2")
doit(x)
# Loop 1 begin
# Loop 2 begin
# DEFAULT method goes here ...
# Loop 2 end
# Loop 1 end

class(x) = c("a1", "unknown", "a2")
doit(x)
# Loop 1 begin
# Loop 2 begin
# DEFAULT method goes here ...
# Loop 2 end
# Loop 1 end

class(x) = c("unknown", "a2", "a1")
doit(x)
# Loop 2 begin
# Loop 1 begin
# DEFAULT method goes here ...
# Loop 1 end
# Loop 2 end

class(x) = c("a1", "a2", "unknown1", "unknown2")
doit(x)
# Loop 1 begin
# Loop 2 begin
# DEFAULT method goes here ...
# Loop 2 end
# Loop 1 end

从上面代码的运行结果可以看出：

- 循环最外层从CLASS属性向量第一个“已知”类属性开始，依次嵌套

- default方法在循环最内层，而且不管有几个“未知”类属性，它只执行一次

- 循环层次和“未知”类属性的位置无关

隐含的意思还包括：如果你在default方法中放入NextMethod函数，程序将进入死循环（还好R有预防措施）。其他更深层次的用法自己揣摩。

推荐用R包 sloop包的otype()函数查看类的来源，是 base, S3还是S4。

查看 S3 函数的源码

> getAnywhere("[[<-.data.frame")


> `[[<-.data.frame` 
function (x, i, j, value) 
{
    if (!all(names(sys.call()) %in% c("", "value"))) 
...


例1: 查 print 的有哪些实现
> methods("print") |> head()
[1] "print,ANY-method"            "print,diagonalMatrix-method"
[3] "print,sparseMatrix-method"   "print.aareg"
[5] "print.abbrev"                "print.acf"

查看具体一个print的实现代码：
> getAnywhere("print.data.frame")
A single object matching ‘print.data.frame’ was found
It was found in the following places
  package:base
  registered S3 method for print from namespace base
  namespace:base
with value

function (x, ..., digits = NULL, quote = FALSE, right = TRUE, 
    row.names = TRUE, max = NULL)

S4

S4 提供了基本的定义helper模板，低层逻辑和S3类似，比S3正式、严谨很多。使用专门的函数来创建类(setClass()), 泛型 (类似于Java的接口)(setGeneric()), 和方法 (setMethod())。 S4定义在R base的methods包中，交互式环境一般都加载过了，但是批处理模式(如 Rscript)不一定，最好手动添加 library(methods)。查看包中定义的所有函数: 先引入包，然后 ls("package:methods")

记住2点：没有一个能回答所有疑问的S4参照标准，R的内部文档偶尔和社区最佳实践矛盾！当使用高级用法时，要仔细阅读文档，还要常搜索、常实验。

Bioconductor 社区是S4的长期用户，对S4的高效利用很有研究，比如 S4 classes and methods taught by Martin Morgan and Hervé Pagès, 或者查看新版本 Bioconductor course materials. Martin Morgan 是R-core成员，也是Bioconductor项目领导，是世界上S4领域的应用专家。建议仔细阅读他回答过的问题 stackoverflow。

S3与S4之间的差异：
1.在定义S3类的时候，没有显式的定义过程，而定义S4类的时候需要调用函数setClass；
2.在初始化S3对象的时候，只是建立了一个list，然后设置其class属性，而初始化S4对象时需要使用函数new；
3.提取变量的符号不同，S3为$，而S4为@；
4.在应用泛型函数时，S3需要定义f.classname，而S4需要使用setMethod函数；
5.在声明泛型函数时，S3使用UseMethod()， 而S4使用setGeneric()。

Object-Oriented Programming in R: S4 Classes

S4对象系统是一种标准的R语言面向对象实现方式，S4对象有明确的类定义，参数定义，参数检查，继承关系，实例化等的面向对象系统的特征。 S4对象系统具有明显的结构化特征，更适合面向对象的程序设计。Bioconductor社区，以S4对象系统做为基础架构，只接受符合S4定义的R包。

基于 S4 进行面向对象编程的时候, 就需要注意, 把一个类的方法和类的变量都放在同一个文件中, 采用合适的名称进行命名。

权威资料链接: hadley 书中的S4类 | A (Not So) Short Introduction to S4

1. Defining Classes 定义类

class和slots是定义R S4类最重要的参数。

# R包 Seurat 4 中类的定义
Seurat = setClass(
  Class = 'Seurat',
  slots = c(
    assays = 'list',
    meta.data = 'data.frame',
    active.assay = 'character',
    active.ident = 'factor',
    graphs = 'list',
    neighbors = 'list',
    reductions = 'list',
    images = 'list',
    project.name = 'character',
    misc = 'list',
    version = 'package_version',
    commands = 'list',
    tools = 'list'
  )
)

完整 S4类定义形参列表：

MyClass = setClass("MyClass", slots= ...., contains =....)

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

Argument	Description	Default
Class	A character value specifying the name for the new class. (Only required argument.) 类名，唯一必须参数。
slots	定义属性和属性类型。slots 接受一个 vector 或者 list, 把变量名和其类型名对应起来即可。slots=c(name = "character", age = "numeric", note="ANY").	伪类 ANY 接受任何类型。
prototype	定义属性的默认值
contains	A character vector containing the names of the classes that this class extends (usually called superclasses). 父类字符串数组，继承关系。	character()
prototype, where, validity, sealed, package	都有替代品，不提倡用了。
representation, access, version, S3methods	deprecated from version 3.0.0 of R。

prototype 定义类属性的默认值

设定默认值的时候, prototype 接受一个 list, 其中变量名和默认值一一对应。

# 设置属性age的默认值20
> setClass("Person", slots=list(name="character",age="numeric"), 
           prototype = list(name="NoName", age = 20)) # 也可以定义为 NA_character_, NA_real_

# 属性age为空
> p1=new("Person",name="XiaoMing")
> p1
An object of class "Person"
Slot "name":
[1] "XiaoMing"

Slot "age":
[1] 20

Redefinition 类的重定义错误

这是由于R的类 both definition and construction occur at run time. 运行 setClass()时，相当于在全局变量注册了一个隐藏的类定义。与所有修改状态的函数一样，需要小心使用setClass()。实例化后再重定义该类，有可能产生一个属性不存在错误。

这让在交互状态下创建新类变得迷惑。R6类也有这个问题。

## 类的重定义冲突
setClass("A", slots = c(x = "numeric"))
a <- new("A", x = 10);a
# An object of class "A"
# Slot "x":
# [1] 10

setClass("A", slots = c(a_different_slot = "numeric"))
a
# An object of class "A"
# Slot "a_different_slot":
# Error in slot(object, what) : 
#   no slot of name "a_different_slot" for this object of class "A"
# Error during wrapup: no slot of name "a_different_slot" for this object of class "A"



## 查看全局种的这个隐藏的类定义，发现它只有新定义时的一个属性
> .GlobalEnv$.__C__A
Class "A" [in ".GlobalEnv"]

Slots:
                       
Name:  a_different_slot
Class:          numeric

> str(.__C__A)
Formal class 'classRepresentation' [package "methods"] with 11 slots
  ..@ slots     :List of 1
  .. ..$ a_different_slot: chr "numeric"
  .. .. ..- attr(*, "package")= chr "methods"
  ..@ contains  : list()
  ..@ virtual   : logi FALSE
  ..@ prototype :Formal class 'S4' [package ""] with 0 slots
 list()
  ..@ validity  : NULL
  ..@ access    : list()
  ..@ className : chr "A"
  .. ..- attr(*, "package")= chr ".GlobalEnv"
  ..@ package   : chr ".GlobalEnv"
  ..@ subclasses: list()
  ..@ versionKey: 
  ..@ sealed    : logi FALSE

# 而根据老模板定义的类还有属性x
> str(a)
Formal class 'A' [package ".GlobalEnv"] with 1 slot
  ..@ x : num 10
  ..@ NA: NULL
Warning message:
Not a validObject(): no slot of name "a_different_slot" for this object of class "A" 

# 可以使用 removeClass 来删除类
removeClass(Class = "Student")
# 删除类后, 已经存在的类的实例并不会被删除.

2. New Objects 实例化对象

有3种实例化R S4对象的方法：使用new实例化，使用类名实例化，从已有对象initialize(oldObj)出新实例。构造函数的函数名为 initialize，new 函数就调用 initialize 函数。

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

查对象的类名is()、class()、str()，查一个对象是不是S4类mode()或isS4()。

查类的全部属性 showClass("类名")

## 实例
## 方法1: 定义类Student, slots定义成员变量及变量类型
> setClass("Student", slots=list(name="character", age="numeric", GPA="numeric"))

## 实例化对象
> s1 = new("Student",name="John", age=21, GPA=3.5)
> s1
An object of class "Student"
Slot "name":
[1] "John"

Slot "age":
[1] 21

Slot "GPA":
[1] 3.5

## 可以单独设置数字的NA
> john = new("Student", name = "John Smith", age = NA_real_)
> str(john)
Formal class 'Student' [package ".GlobalEnv"] with 3 slots
  ..@ name: chr "John Smith"
  ..@ age : num NA
  ..@ GPA : num(0) 




## 方法2: 定义类时也可以有返回值
> Student=setClass("Student", slots=list(name="character", age="numeric", GPA="numeric"))
> Student
class generator function for class “Student” from package ‘.GlobalEnv’
function (...) 
new("Student", ...)

> s2=Student(name="John", age=21, GPA=3.5)
> s2
An object of class "Student"
Slot "name":
[1] "John"

Slot "age":
[1] 21

Slot "GPA":
[1] 3.5


## 方法3: 从实例s2中，创建实例s3，并修改name的属性值
s3=initialize(s2, name="s3Name");s3
An object of class "Student"
Slot "name":
[1] "s3Name"

Slot "age":
[1] 21

Slot "GPA":
[1] 3.5




# 查看对象是不是S4类
> mode(s1) ##而S3的mode是list
[1] "S4"

> isS4(s1)
[1] TRUE

> typeof(p1)
[1] "S4"

> class(s1)
[1] "Student"
attr(,"package")
[1] ".GlobalEnv"

## 查看对象的类名
> is(s1)
[1] "Student"

> str(s2)
Formal class 'Student' [package ".GlobalEnv"] with 3 slots
  ..@ name: chr "John"
  ..@ age : num 21
  ..@ GPA : num 3.5

## 查看定义过的类有哪些slots
> showClass("Student")
Class "Student" [in ".GlobalEnv"]

Slots:
                                    
Name:       name       age       GPA
Class: character   numeric   numeric

Helper 助手函数创建实例

new()是一个低级命令。我们可以包装的更好用一些。助手函数要点: 1.与类同名; 2.接口良好，默认值合适; 3.为终端用户提供友好的报错; 4.最后调用new()

比如我们可以使用助手函数，明确name是必须的，age是可选的；还把age强制转为double类型。

### 助手函数
Person=function(name, age=NA){
  age=as.double(age)
  new("Person", name=name, age=age)
}

Person("Jim")
# An object of class "Person"
# Slot "name":
# [1] "Jim"
# 
# Slot "age":
# [1] NA

自定义构造函数 initialize()

# 自定义构造函数 initialize()
setClass("People", slots=c(name="character", age="numeric"))

setMethod(
  f          = "initialize",
  signature  = "People",
  
  #这个变量名必须是 .Object: args( getMethod("initialize") )
  definition = function(.Object, name, age) { 
    cat("Welcome to my initialize function!\n") 
    .Object@name <- name
    .Object@age  <- age
    return(.Object)
  })#[1] "initialize"
p1=new("People", name="Xi", age=70)
# Welcome to an my initialize function!
p1
# An object of class "People"
# Slot "name":
# [1] "Xi"
# 
# Slot "age":
# [1] 70

3. Accessing Slots 访问属性及类型检查

访问成员变量使用@符号，或者slot()函数。

也可以定义属性的 setter和getter。

setValidity()实现对象的类型检查。

> s1@name
[1] "John"

> slot(s1, "name")
[1] "John"

## 访问不存在的属性，则直接报错。防止错误拼写，更安全稳健。
## 而S3类不会报错，而是直接添加新属性。
> s1@age2
Error: no slot of name "age2" for this object of class "Student"


## 可以直接修改对象
> s1@name="Tom"
> s1@name
[1] "Tom"

> slot(s1,"name") = "Robin"
> slot(s1,"name")
[1] "Robin"
> s1@name
[1] "Robin"

我们可以为age属性设置setter 和 getter，先用setGeneric()创建(generics 泛型)接口，再用setMethod()实现方法。

自省方法 showMethods('方法名') 获得一个该泛型方法当前可用的方法定义。

## 定义 getter 和 setter 的接口:
setGeneric("age", function(x) standardGeneric("age"))
setGeneric("age<-", function(x, value) standardGeneric("age<-"))

## 实现接口
setMethod("age", "Student", function(x) x@age)
setMethod("age<-", "Student", function(x, value) {
  x@age <- value
  x
})

age(s1) #21
age(s1) <- 50
age(s1) #> [1] 50


# 像Java一样定义 getter和setter
# getAge()
setGeneric("getAge", function(x) standardGeneric("getAge"))
setMethod("getAge", "Student", function(x) x@age)
getAge(s1)

# setAge() 实现方法的参数，要和接口定义的参数一致
setGeneric("setAge", function(x, value) standardGeneric("setAge"))
setMethod("setAge", "Student", function(x, value){
  x@age=value
  x
})
getAge(s1)
s1=setAge(s1, 16) #不会自动覆盖，只能主动覆盖
s1

getAge(s1)=20
## Error in getAge(s1) = 20 : could not find function "getAge<-" 


## 查看一个可用的S4类的方法
is(s1) #"Student"
mode(s1) #"S4"

showMethods(age)
# Function: age (package .GlobalEnv)
# x="Student"
showMethods('age')
showMethods('age<-')

showMethods(getAge)
setAge
showMethods('setAge')

setReplaceMethod()定义setter

定义setter，可以使用 setMethod 函数, 但是函数名称里面要加上 "<-", 或者使用 setReplaceMethod, 函数名称里面不加 "<-".

还可以定义 "[" 函数和 "[<-" 函数方便操作.

# 使用函数 setReplaceMethod() 定义setter方法:
setGeneric(
  name = "setAge2<-",
  def  = function(object, type, value) {
    standardGeneric("setAge2<-")
  })
# setReplaceMethod("fun") is the same as setMethod("fun<-")
setReplaceMethod(
  f          = "setAge2",
  signature  = "Student",
  definition = function(object, type, value) {
    slot(object, type) <- value
    return(object)
  })
s1@age #21
setAge2(s1, "age")=25
s1@age #25



# 还可以定义 "[" 函数和 "[<-" 函数方便操作.
setMethod(
  f          = "[",
  signature  = "Student",
  definition = function(x,i,j,drop) { #这个j是啥？ //todo
    if (i == "name") {
      return(x@name)
    } else if (i == "age") {
      return(x@age)
    } else if (i == "GPA") {
      return(x@GPA)
    }
  })#[1] "["

setReplaceMethod(
  f          = "[",
  signature  = "Student",
  definition = function(x,i,j,value) {
    if (i == "name") {
      x@name <- value
    } else if (i == "age") {
      x@age <- value
    } else if (i == "GPA") {
      x@GPA <- value
    }
    validObject(x)
    return(x)
  })#[1] "[<-"

s1['age'] #25
s1['age']=22
s1['age'] #22 

属性类型检查

S4只对属性值的类型做检查，对属性值个数、范围的检查需要借助setValidity()函数实现。

## 类型检查
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.")
})
new("Person", name='Lily', age=20)
new("Person", name='Lily', age=-20) #Error in validityMethod(object) : Age is negative.  


# 传入参数长度必须一致
new("Person", name=c('Lily', 'LiLei'), age=20 )

setValidity("Person", function(object){
  if ( length(object@name) != length(object@age) ){
    "@name and @age must be the same length"
  }else{
    TRUE
  }
})
new("Person", name=c('Lily', 'LiLei'), age=20 )
# Error in validObject(.Object) : 
#   invalid class “Person” object: @name and @age must be the same length


# 不过，只有最近定义的setValidity有效; 只有new()会自动调用验证，其后再修改就不受验证函数限制了。
p2=Person(name="Tom", age=2)
p2@age=1:10
p2
# An object of class "Person"
# Slot "name":
# [1] "Tom"
# 
# Slot "age":
#  [1]  1  2  3  4  5  6  7  8  9 10

# 也可以明式的手动验证
validObject(p2)
# Error in validObject(p2) : 
#  invalid class “Person” object: @name and @age must be the same length

更完善的助手类: 包含validObject()

在R中定义字面函数 setter 不能修改对象的值，还要返回值主动覆盖一次。而定义方法名<- 则可以。

# 更完善的助手类: 在setter中包含validObject()
setGeneric("name", function(x) standardGeneric("name"))
setMethod("name", "Person", function(x) x@name )
name(p1) #"XiaoMing"

# 定义 setter
setGeneric("name<-", function(x, value) standardGeneric("name<-"))
setMethod("name<-", "Person", function(x, value){
  x@name=value
  validObject(x) ## 设置新值的时候主动校验。
  x
})

name(p1) #"XiaoMing"
name(p1)="Tom"
name(p1) #"Tom"

name(p1)=letters
# Error in validObject(x) : 
#invalid class “Person” object: @name and @age must be the same length
name(p1) #"Tom"

4. Inheritance 继承

使用关键词 contains 指定父类。R支持继承多个父类，不过多个父类容易混乱，单继承更稳健。

ANY 是所有的 S4 类的最基本的父类, 所以一个类和定义的父类均没有定义相应方法时, 最后会使用 ANY 类的方法。

# 定义父类
setClass("Person", 
         slots=list(name="character",age="numeric"), 
         prototype = list(name="NoName", age = 20)
)
p1=new("Person",name="XiaoMing")
p1

# 定义子类
setClass("Employee", 
         contains = "Person", #指定父类
         slots = c(
           boss = "Person"
         ),
         prototype = list(
           boss = new("Person")
         )
)
e1=new("Employee", name="Tom", boss=p1)
str(e1)
# Formal class 'Employee' [package ".GlobalEnv"] with 3 slots
#   ..@ boss:Formal class 'Person' [package ".GlobalEnv"] with 2 slots
#   .. .. ..@ name: chr "XiaoMing"
#   .. .. ..@ age : num 20
#   ..@ name: chr "Tom"
#   ..@ age : num 20



# 自省：对象的类名
> is(p1)
[1] "Person"
> is(e1)
[1] "Employee" "Person"

# 自省：对象是不是某个类，使用第二个参数
> is(e1, 'Person')
[1] TRUE
> is(e1, 'Employee')
[1] TRUE
> is(e1, 'Student')
[1] FALSE

5. Generics and methods 泛型(接口)与方法

通过S4对象系统，把原来的函数定义和调用2步，为成了4步进行：定义数据对象类型，定义接口函数，定义实现函数，把数据对象以参数传入到接口函数，执行实现函数。

把函数的定义和实现分离，符合常说的接口和实现分离。通过setGeneric()来定义接口，通过setMethod()来定义实现。这样可以让S4对象系统更符合面向对象的特征。R的S4对象系统是一个结构化的、完整的面向对象实现。

对于已经存在的方法原型, 可以直接使用 setMethod(f='方法名', signature='类名', definition=函数定义体) 定义，never use other arguments.

# show()接口系统定义过，这里为Student类实现。
setMethod("show",
          "Student",
          function(object) {
            cat(object@name, "\n")
            cat(object@age, "years old\n")
            cat("GPA:", object@GPA, "\n")
          }
)
show(s1)
# Robin
# 21 years old
# GPA: 3.5

而对于自定义的方法则需要先使用 setGenerics()定义接口，再用setMethod实现方法。S4 中的 standardGeneric() 相当于 S3中的 UseMethod() 。

同一个函数接口可以有多个具体实现，且这些具体实现可以属于不同的类。

# 定义一个没有预定义过泛型的函数，报错。要先定义接口。
setMethod("getXXX", "Person", function(x){ x})
# no existing definition for function ‘getXXX’

# 定义接口时，函数体不要使用{}，否则会触发一步计算，浪费资源。方法体用小驼峰
setGeneric("myGeneric", function(x) standardGeneric("myGeneric"))

## 搞不懂 setGeneric的参数 signature ="x" 有什么用？ //todo 懂了
setGeneric("myGeneric", 
  function(x, ..., verbose = TRUE) standardGeneric("myGeneric"),
  signature = "x" #可能是通过第n个传入参数x来区别对哪个类使用哪个实现。其中...参数不参与。只有一个参数时，不用指定。
)

setGeneric("myGeneric", function(x) standardGeneric("myGeneric"))
setMethod("myGeneric", "Person", function(x){
  cat("Class:", is(x)[[1]], "\n", 
      " Name: ", x@name, "\n", 
      " age: ", x@age, "\n",
      sep="") 
})
myGeneric(p1)
# Class:Person
#  Name: XiaoMing
#  age: 20

# 自省
typeof(p1) #S4
showMethods(myGeneric)
# Function: myGeneric (package .GlobalEnv)
# x="Person"


# 查泛型函数在某类的实现  selectMethod("generic", "class").
> selectMethod("myGeneric", "Person")
Method Definition:

function (x) 
{
    cat("Class:", is(x)[[1]], "\n", " Name: ", x@name, "\n", 
        " age: ", x@age, "\n", sep = "")
}

Signatures:
        x       
target  "Person"
defined "Person"

由接口查实现函数:methods("generic"); 由类查该类的实现函数: methods(class = "class"); 某泛型对某类的实现 selectMethod("generic", "class").

由于使用 setGeneric 会把之前的定义给覆盖, 我们可以使用 lockBinding 函数来锁定定义, 避免误操作。

lockBinding("getAge", .GlobalEnv)
lockBinding("setAge2<-", .GlobalEnv)

思考：定义泛型接口时，为什么要重复两遍函数名？ //todo

6. 自定义实现show(): 默认打印对象的方法

show()是默认打印对象的方法，为自己的类自定义show()方法能优化显示。

为了实现方法体，就需要先查看泛型方法怎么定义的参数。泛型方法的自省用 getGeneric()函数。

> getGeneric("show")
standardGeneric for "show" defined from package "methods"

function (object) 
standardGeneric("show")
<bytecode: 0x3618e20>
<environment: 0x35561c8>
Methods may be defined for arguments: object
Use  showMethods("show")  for currently available ones. 泛型方法不实现是不能用的。
(This generic function excludes non-simple inheritance; see ?setIs)


# 查看接口的参数定义
> args(getGeneric("show"))
function (object) 
NULL

> args(getGeneric("myGeneric"))
function (x) 
NULL

为自定义的类实现该接口。

# 为Person类自定义打印对象的方法 show()
setMethod("show", "Person", function(object) {
  cat(is(object)[[1]], "\n",
      "  Name: ", object@name, "\n",
      "  Age:  ", object@age, "\n",
      sep = ""
  )
})
p1
# Person
#   Name: XiaoMing
#   Age:  20

例2：为Seurat v4类添加自定义方法 print2()

library(Seurat)
scObj #PBMC 3k data

# 定义泛型方法
setGeneric("print2", function(x) standardGeneric("print2"))

# R 方法名字中可以有逗号
`print2,Seurat` = function(x){
  print(">>>in print,Seurat...My defination")
  message("cell number:", ncol(x))
}
`print2,Seurat`(scObj) #真的可以直接调用
# [1] ">>>in print,Seurat...My defination"
# cell number:2700

#定义S4类的方法
setMethod(
  f="print2",
  #signature = "Seurat",
  signature = signature(x="Seurat"),
  definition = `print2,Seurat`
)
#可能会有警告。
# Warning message:
# For function ‘print2’, signature ‘Seurat’: argument in method definition changed from (obj) to (x) 
# 警告的原因是 setGeneric 中泛型函数的虚参数名 和 `print2,Seurat`()函数实现的虚参名不同。改为相同即可消除警告。

print2(scObj) #调用该S4方法
# [1] ">>>in print,Seurat...My defination"
# cell number:2700 

7. Method dispatch 方法调度：ANY和missing伪类

R S4类有2个特点，多继承，就是一个类可以有多个父类；多重调度，一个接口可以根据参数选择使用的函数。这让R很强大，当然也不好理解给定的输入会选择哪个方法。实践中，要尽量单继承，让方法调度尽量简化，除非不得不用采用。

在单继承链条上，调用具体类的实例方法时，会沿着继承链向上查找，直到找到则返回该方法。还有2个重要的伪类，一个是最顶层的 ANY 类（类似S3中的default伪类），可以在这上面定义方法。ANY <- classFather <- classSon.

第二个伪类是 MISSING 类，当没有参数时调用。对单调度没用，但对于使用+和-的双调度、并依赖参数是一个或两个的情况很重要。

对于双继承，方法调度的原则是选择路径最短的方法(closest == fewest arrows)；如果一样距离，按字母顺序(comes earlier in the alphabet will be picked); ANY 伪类上定义的方法被认为十分的远，不影响模糊性。忠告：最好别用双继承，非要用计算好方法调度距离，为模糊的节点单独实现方法。

实例1: 使用missing伪类，根据参数数量选择要调用的函数

# 单继承 类关系图
# Mouse -> Mammal -> Animal
#          Bird  -> Animal

## 定义类的继承
setClass('Animal', slots=list(name="character") )
setClass('Bird', slots=list(beakLength="numeric"), 
         contains = "Animal" )
setClass('Mammal', slots=list(height="numeric"),
         contains = "Animal" )
setClass('Mouse', slots=list(breed="character"),
         contains = "Mammal" )
# 实例化类
bird1=new("Bird", name="bird1", beakLength=1.2);bird1
cat1=new("Mammal", name="cat1", height=30.3);cat1
mouse1=new("Mouse", name="mouse1", height=5.2, breed="C57");mouse1
inherits(mouse1, "Animal") # [1] TRUE

# 定义接口
#setGeneric('yell', function(x) standardGeneric("yell"))
setGeneric('yell', function(x, y) standardGeneric("yell"), signature = c("x","y") )

# 为Animal类实现yell方法
setMethod("yell", "Animal", function(x){
  cat(">> Animal yell:", "\n")
  cat(x@name, 'is yelling!')
})
yell(bird1) #>> Animal yell: 

# 为Bird类实现yell方法
setMethod("yell", "Bird", function(x){
  cat(">> Bird yell:", "\n")
  cat(x@name, 'is yelling!')
})
yell(bird1) #>> Bird yell: 


# 为Mouse类实现1参数的yell方法
setMethod("yell", c("Mouse", 'missing'), function(x, y){
  cat(">> Mouse yell: 1 paras", "\n")
  cat(x@name, 'is yelling!')
})
# 为Mouse类实现2参数的yell方法
setMethod("yell", "Mouse", function(x, y){
  cat(">> Mouse yell: 2 paras", "\n")
  cat(x@name, 'is yelling!')
  cat("\n", 'y=',y, sep="")
})
## 成功的根据参数数量调用了不同的实现，而函数名相同
yell(mouse1) #>> Mouse yell: 1 paras
yell(mouse1, 2) #>> Mouse yell: 2 paras

yell(cat1) #>> Animal yell: 

实例2：根据参数个数选择运算方法

so上的提问: 一个参数调用方法实现1, 2个参数调用方法实现2，方法同名。我的方案如下。

# 默认使用全部参数做签名验证
setGeneric("myMethod", function(x,y) standardGeneric("myMethod"))

# 定义方法实现1
setMethod(
  "myMethod", 
  signature = c("numeric", 'missing'),  ## 使用missing伪类，表示第二个参数不存在
  definition = function(x) {
    
    print("MyMethod on numeric (1 para)")
  })

# 定义方法实现2
setMethod(
  "myMethod", 
  signature = c("numeric", "numeric"), 
  definition = function(x, y) {
    
    print("MyMethod on numeric, numeric (2 paras)")
  })
myMethod(100) #[1] "MyMethod on numeric (1 para)"
myMethod(10,20) #[1] "MyMethod on numeric, numeric (2 paras)"

8. 在S4中使用S3方法

利用S4和S3的分发机制，可以在S4中调用S3方法。但方法不能同名。

## S3类的方法
whatIs = function(...) UseMethod("whatIs")
whatIs.default=function(object){cat("Class:",data.class(object), sep='')}
whatIs.character=function(object){
  cat("Class:",data.class(object),"; ",
      "nchar:", nchar(object), sep='')
}
whatIs.matrix=function(object){
  cat("Class:", data.class(object), "; ",
      nrow(object), "rows", ncol(object), 'colums', sep='')
}
# test
whatIs(1:9) #Class:numeric
whatIs(whatIs) #Class:function
whatIs("some") #Class:character; nchar:4
whatIs.character('some')

A=matrix(c(1:8), nrow=4);A
class(A) #"matrix"
whatIs(A) #whatIs.matrix(A)
#Class:matrix; 4rows2colums

## 在S4中调用
setGeneric('whatIs2', function(object) standardGeneric("whatIs2") )
setMethod("whatIs2","character", whatIs.character)
setMethod("whatIs2","matrix", whatIs.matrix)
setMethod("whatIs2","ANY", whatIs.default)

whatIs2("Tim") #Class:character; nchar:3
whatIs2(A) #Class:matrix; 4rows2colums
whatIs2(whatIs) #Class: function

9. Introspection 自省

查看class：

#查看类 slot 变量名, slotNames 函数.
slotNames(s1) 
slotNames("Student")
#"name" "age"  "GPA"

#获得类 slot, getSlots 函数.
getSlots("Student")
#       name         age         GPA 
#"character"   "numeric"   "numeric" 

#获得类, getClass 函数.
getClass(s1)

S2=getClass("Student") #返回值是类，可以用于实例化对象
new(S2, name="XL", age=19, GPA=4)
# An object of class "Student"
# Slot "name":
# [1] "XL"
# 
# Slot "age":
# [1] 19
# 
# Slot "GPA":
# [1] 4 

查对象的类型

> class(p1) #Student; |> is(s1) #Student;

|> typeof(s1) #S4; |> isS4(s1) #TRUE;

查看方法：

查看类是否有特定的方法: existsMethod(f = "show", signature = "Person") #[1] TRUE

直接获得某个方法的代码: getMethod(f="show", signature="Person")

查看泛型show在Person类中的实现: selectMethod("show", "Person")

# 查看一个 S4 类所拥有的方法可以使用函数 showMethods 函数.
> showMethods(classes="Student")

Function ".DollarNames":
 <not an S4 generic function>
Function: [ (package base)
x="Student", i="ANY", j="ANY", drop="ANY"
x="Student", i="character", j="missing", drop="missing"
    (inherited from: x="Student", i="ANY", j="ANY", drop="ANY")

Function: [<- (package base)
x="Student", i="ANY", j="ANY", value="ANY"
x="Student", i="character", j="missing", value="numeric"
    (inherited from: x="Student", i="ANY", j="ANY", value="ANY")

# 提取某个函数fn在某个类Clazz中的实现，到文件(默认为fn.clazz.R)
dumpMethod('whatIs2', "ANY", file="xx.R") 

10. 查看 S4 函数的源码

> getMethod("[[<-", signature = "Seurat")
Method Definition:

function (x, i, j, ..., value) 
{
    x <- UpdateSlots(object = x)
...


例:
> getMethod("show", signature = 'Seurat')
Method Definition:

function (object) 
{
    object <- UpdateSlots(object = object)
    assays <- FilterObjects(object = object, classes.keep = "Assay")
    nfeatures <- sum(vapply(X = assays, FUN = function(x) {
        return(nrow(x = object[[x]]))
    }, FUN.VALUE = integer(length = 1L)))

Reference classes(RC)

RC 对象是 S4 和 environments（一个特殊的基本类型）的结合体。类定义使用setRefClass()，同时定义属性和方法。随后调用$methods()还可以继续定义方法。如果类被包export出来，则加载包时就可以用该类。通过属性contains=，继承父类的属性和方法，除非被子类重写。

Reference classes in R are similar to object-oriented classes in other programming languages. They have all the features of S4 classes with an added environment. To create a reference class, we use the setRefClass() function. The methods in a reference class belong to the class itself.

创建RC类和对象

RC类对象系统从底层上改变了原有S3和S4对象系统的设计，去掉了泛型函数，正真地以类为基础实现面向对象的特征。

RC 是一种具有引用语义的类系统，它更像其他面向对象编程语言(Java, C++)中的类系统。它将所有的类属性及对应方法都封装在一个实例生成器中，通过生成器可以生成需要的实例，进而执行对应的类方法。在方法中修改字段的值，需要用<<-。

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

参数
Class:定义类名
fields:定义字段及其属性
methods:定义方法
	initialize 方法是对字段属性值设置为默认值的方法

# for RC class
Person=setRefClass("Person", fields=list(name="character", age="numeric"),
  methods=list(
    initialize=function(name, age){
      print("Person::initialize")
      name<<-name
      age<<-age
    },
    setName=function(name){
      name<<-name
    },
    getName=function(){
      .self$name
    }
  )
)
class(Person) #"refObjectGenerator"
Person #Generator for class "Person":

# 列出所有属性
Person$fields()
#       name         age 
#"character"   "numeric"

Person$methods() #列出所有方法
#Person$getName()

# 实例化
p1=Person$new(name="Tom", age=20)
p1
is(p1)
p1$getName()# Tom


## 探索环境空间
e1=as.environment(p1)
ls(envir = e1) #"age"   "field" "name"  "show" 
e1$age #20

# 属性名的获取和设置
p1$name #Tom
p1$name="Tim"
p1$name #Tim

p1$setName("Jim")
p1$name #Jim
p1

p1$show()

## 添加方法
Person$methods(
  show=function(){
    'Show the object Person'
    cat('Class:', class(.self)[1],": name=",.self$name,
        ", age=", .self$age, sep="")
  },
  show2=function(){
    'Show2 the object Person'
    cat('Class:', class(.self)[1],": name=",.self$name,
        ", age=", .self$age, sep="")
  }
)
Person$help("show2")

p2=Person$new(name="Lily", age=18)

p1$show2() #实例化时没有，则自动更新
p1$show() #实例化时有的，使用旧的
#
p2$show2() #新的
p2$show() #新的

RC类的继承: contains 属性

用callSuper()函数进行调用父类的同名方法。注意：这个callSuper()和initialize()这二个函数只能在类定义的方法中使用。

obj$initFields()方法修改属性。

# 定义子类
Student=setRefClass("Student", contains ="Person",
                    fields=list(score="numeric") )
Student
class(Student)
Student$fields()
#       name         age       score 
#"character"   "numeric"   "numeric" 

# 没有初始化函数，用父类初始化函数，不认识 score
s1=Student$new(name="Xiaoming", age=15, score=90) #Error
s1=Student$new(name="Xiaoming", age=15)
s1 #使用最新的show方法
is(s1)
class(s1)

# 子类中重写show方法
Student$methods(
  show=function(){
    'Show the object Student'
    cat('-->son: Class:', class(.self)[1],": name=",.self$name,
        ", age=", .self$age, 
        ", score=", .self$score, 
        sep="")
  },
  show2=function(){
    'Show2 the object Student'
    callSuper() #调用父类同名方法
    cat("\n")
    cat('-->son2: Class:', class(.self)[1],": name=",.self$name,
        ", age=", .self$age, 
        ", score=", .self$score, 
        sep="")
  }
)
s2=Student$new(name="Daming", age=18)
s2 #调用自己的新方法
s2$show2()
#Class:Student: name=Daming, age=18
#-->son2: Class:Student: name=Daming, age=18

s1 #调用定义时的方法
s1$show() #调用定义时的方法

s2$score=100
s2$score

typeof(p1) #S4
class(p1) #Person


## 自动添加访问 get/set
Student$accessors('score')
s2$getScore()
s2$setScore(98)
s2$score #98


# 修改属性的值
s2 #-->son: Class:Student: name=Daming, age=18, score=98
s2$initFields(age=19, score=89)
s2 #-->son: Class:Student: name=Daming, age=19, score=89

# 直接赋值是引用传递的，本质上是一个对象
s3=s2
s4=s2$copy() #为什么出错？
#Error in .Object$initialize(...) : 
#  argument "name" is missing, with no default

p2
p3=p2
p4=p2$copy()


p2$age=21
p1
p2

p3=p2$copy()
p3$import(p1)
p3

自省方法：

查看类的属性: Person$fields()

查看类的方法: Person$methods()

查看类的基本属性: getRefClass("Person")

为类的某个字段增加 get/set方法: Person$accessors("age")

锁定类的某个字段，设置其为常量: Person$lock("age") #初始化后不能修改

R6

R6是一个单独的R包，与我们熟悉的原生的面向对象系统类型S3，S4和RC类型不一样。在R语言的面向对象系统中，R6类型与RC类型是比较相似的，但R6并不是基于S4的面向对象系统。在用R6类型开发R包的时候，不用依赖于methods包，而用RC类型开发Ｒ包的时候，则必须设置methods包的依赖。

R6类型比RC类型更符合其他编程对于面向对象的设置，支持类的公有和私有成员，支持函数的主动绑定，并支持跨包的继承关系。由于RC类型的面向对象系统设计并不彻底，所以才会有R6这样的包出现。下面，就让我们来体会一下，基于R6面向对象系统编程吧。

R6包：R6: Encapsulated Classes with Reference Semantics

library("R6") #R6不是内置包，是一个第三方扩展包，因此在使用R6系统前需要提前加载该包

参考资料

R 官方资料: A (Not So) Short Introduction to S4
https://cran.r-project.org/doc/contrib/Genolini-S4tutorialV0-5en.pdf


1.Object Oriented Programming (OOP) in R | Create R Objects & Classes
https://data-flair.training/blogs/object-oriented-programming-in-r/


2.Object Oriented Programming (OOP) in R with S3, S4, and RC
https://techvidvan.com/tutorials/r-object-oriented-programming/


3.【推荐: 本文第一信息源】object-oriented programming (OOP). 
https://adv-r.hadley.nz/oo.html
https://adv-r.hadley.nz/s4.html


4.Object-Oriented Programming with S3 and R6 in R
https://www.datacamp.com/courses/object-oriented-programming-in-r-s3-and-r6


5. R 学习笔记: S4 编程基础
https://zhuanlan.zhihu.com/p/21396190