advanced R - 面向对象
2022-08-14
一切皆是对象。 一切皆是函数调用。 以上所谓的对象时指R中所有的数据，包括函数都可以作为对象进行输入，下面所讨论的才是面向对象编程中的对象。
R中有四种面向对象的结构，分别为S3,S4（R语言的前身为S语言）,RC(Reference Class,也称为R5),以及R6。其中前三种为R内置，R6由R6包提供。
当我们讨论面向对象时，我们在讨论什么？首先我们具有一个类（class）的概念，这是一个抽象的集合，犹如当我们在讨论人类时。一个类可以拥有一个子类，犹如当我们讨论黄种人，白种人，黑种人之与人类，反之，人类之与黄种人即为父类。父类与子类之间具有继承关系。一个类如何决定它是该类？这是一个哲学问题，正如我如何定义我。在R中一个类的定义包括属性（filed),方法（methods),其中属性在语言上是一个键值对（key-value pair)的形式，为一个名词性的描述，而方法是动词性的，体现了该类具有的操作。当我们议论某雪，某爱豆时，这就是我们所谓的对象（object)，该对象是由某类实例化而来（initialize)，为一个具体确定的个体。对于类的属性以及方法的修改为modified-in-place,即对其本身的修改，而不是modified-in-copy（复制对象后修改，重新建立name和对象的指向）。当我们讨论赋值 <-时，即是将一个name指向了一个对象，一个对象（针对RC,以及R6)被修改以后，所有指向它的name的值同时发生变化，即许多name共享一个对象，而该对象的修改是modified-in-place,那么通过任何一个指向该对象的name对该对象进行修改，其它指向该对象的name的值也同时发生变化。
以上所讨论的面向对象在RC，以及R6中体现。S3，以及S4中的面向对象是通过泛型函数（generic)实现的。所谓泛型函数，即在一个函数名例如plot下，包括了多个函数Plot.xxxx, plot.yyy, plot.zzz，当我们调用plot函数时，该plot泛函自动识别输入对象的类型从而调用不同的Plot.*** 函数。该面向对象的实现方式，属性和方法进行了分离，在对象中仅定义了属性，而方法通过泛函与对象进行匹配。另外，只有S4对属性的调用使用符号 @。
以下所有的内容来自R语言面向对象编程 教程
第一篇 基于S3的面向对象
- S3用起来简单，但在实际的面向对象编程的过程中，当对象关系有一定的复杂度，S3对象所表达的意义就变得不太清楚。
- S3封装的内部函数，可以绕过泛型函数的检查，以直接被调用。
- S3参数的class属性，可以被任意设置，没有预处理的检。
- S3参数，只能通过调用class属性进行函数调用，其他属性则不会被class()函数执行。
- S3参数的class属性有多个值时，调用时会被按照程序赋值顺序来调用第一个合法的函数。
第一节 创建S3对象
library(pryr) #辅助工具，用于检查对象类型
#通过变量创建S3对象
x <- 1
attr(x,'class') <- 'foo'
x
attr(x,"class")
class(x)
# 用pryr包的otype函数,检查x的类型
otype(x)
# 通过structure()函数创建S3对象
y <- structure(2,class="foo")
y
attr(y,"class")
class(y)
otype(y)
# 创建一个多类型的S3对象
x <- 1
attr(x,"class") <- c("foo","bar")
class(x)
otype(x)
第二节 泛型函数和方法调用
# 用UseMethod()定义teacher泛型函数
teacher <- function(x,...) UseMethod("teacher")
# 用pryr包中ftype()函数，检查teacher类型
ftype(teacher)
[1] "s3" "generic"
# 定义teacher内部函数
teacher.lecture <- function(x,...) print("讲课")
teacher.assignment <- function(x,...) print("布置作业")
teacher.correcting <- function(x,...) print("批改作业")
teacher.default <- function(x,...) print("你不是teacher")
a <- "teacher"
# 给老师变量设置行为
attr(a,"class") <- 'lecture'
# 执行老师的行为
teacher(a)
[1] “讲课”
# 直接调用teacher中定义的行为，虽然没啥用。
teacher.lecture()
第三节 查看S3对象的函数
# 查看teacher对象
teacher
function(x,...) Usemethod("teacher")
# 查看teacher对象的内部函数
> methods(teacher)
[1] teacher.assignment teacher.correcting teacher.default teacher.lecture
#通过methods()的generic.function参数，来匹配泛型函数名字
> methods(generic.function = predict)
[1] predict.ar* ......
# 通过methods()的class参数，来匹配类的名字
methods(class=lm)
[1]add1.lm* ......
# 用getAnywhere()函数,查看所有函数
getAnywhere(teacher.lecture)
# 使用getS3method()函数，也同样可以查看不可见的函数
getS3method("predict","ppr")
第四节 s3 对象的继承关系
node <- function(x) UseMethod("node",x)
> node.default <- function(x) "Default node"
#father函数
> node.father <- function(x) c("father")
# son函数，通过NextMethod()函数只想father函数
> node.son <- function(x) c('son',NextMethod())
#定义n1
> n1 <- structure(1,class=c("father"))
# 在node函数中传入n1,执行node.father()函数
> node(n1)
[1] "father"
# 定义n2，设置class属性为两个
> n2 <- structure(1,class=c("son","father"))
# 在node函数中传入n2,执行node.son()函数和node.father()函数
> node(n2)
[1] "son" "father"
第二篇 基于S4的面向对象
第一节 创建S4对象
# 加载pryr包
library(pryr)
# 基类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"))
# 验证radius参数
setValidity("Ellipse",function(object){
if(length(object@radius)!=2) stop("It's note Ellipse")
if(length(which(object@radius<=0))>0) stop("Radius is negative")
})
# Circle继承Ellipse
setClass("Circle",contains = "Ellipse",slots=list(radius="numeric"),prototype=list(radius=1,shape="Circle"))
# 验正radius属性值要大于等于0
setValidity("Circle",function(object){
if(object@radius <= 0) stop("Radius is negative")
})
# 定义area接口
setGeneric("area",function(obj,...) standardGeneric("area"))
# 定义area的Ellipse实现
setMethod("area","Ellipse",function(obj,...){
cat("Ellipse Area: \n")
pi*prod(obj@radius)
})
# 定义area的Circle实现
setMethod("area","Circle",function(obj,...){
cat("Circle Area:\n")
pi*obj@radius^2
})
# 创建实例
e1 <- new("Ellipse",name="e1",radius=c(2,5))
e2 <- new("Circle",name="e2",radius=2)
# 计算面积
area(e1)
area(e2)
第二节 从一个已经实例化的对象中创建新对象
setClass("Person",slots=list(name="character",age="numeric"))
# 创建一个对象实例n1
n1 <- new("Person",name="n1",age=19)
n1
# 从实例n1中，创建实例n2，并修改name的属性值
n2 <- initialize(n1,name="n2")
n2
第三节 访问对象属性
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
#a[1]
第四节 查看S4对象的函数
library(pryr)
# 检查work的类型
ftype(work)
# 直接查看work函数
work
# 查看work函数的显示定义
showMethod(work)
# 查看Person对象的work函数现实
getMethod("work","Person")
# 检查Person对象有没有work函数
existMethod("work","Person")
hasMethod("work","Person")
第三篇 基于RC的面向对象
第一节 创建RC对象
# 创建Animal类，包括name属性,构造方法initialize（），叫声方法bark()
Animal <- setRefClass("Animal",
fields=list(name="character"),
methods=list(
initialize = function(name){
name <<- "Animal"
},
bark = function()print("Animal::bark")
))
# 创建Cat类，继承Animal类，并重写（overwrite
#)了initialize()和bark()
Cat <- setRefClass("Cat",contains="Animal",
methods=list(
initialize = function(name) name <<- 'cat',
bark = function() print(paste(name,"is miao miao"))
))
# 创建Dog类
Dog <- setRefClass("Dog",contains="Animal",
methods=list(
initialize = function(name) name <<- 'Dog',
bark = function() print(paste(name,"is wang wang"))
))
# 创建Duck类
Duck<- setRefClass("Duck",contains="Animal",
methods=list(
initialize = function(name) name <<- 'Duck',
bark = function() print(paste(name,"is ga ga"))
))
# 创建cat实例
cat <- Cat$new()
cat$name
# cat叫声
cat$bark()
第二节 RC对象实例化后的内置方法，属性，以及辅助函数
- 内置方法
- initialize类的初始化函数，用于设置属性的默认值，只有在类定义的方法中使用。
- callSuper调用父类的同名方法，只能在类定义的方法中使用
- copy复制实例化对象的所有属性
- initFields给对象的属性赋值
- field查看属性或给属性赋值
- getClass查看对象的类定义
- getRefClass()同getClass()
- show 查看当前对象
- export查看属性值以类为作用域
- import 把一个对象的属性值赋值给另一个对象
- trace跟踪对象中方法调用，用于程序debug
- untrace取消跟踪
- usingMethods用于实现方法调用，只能在类定义的方法中使用，这个方法不利于程序的健壮性，所以不建议使用。
- 内置属性
- self 实例化对象自身
- .refClassDef类的定义类型
- 辅助函数
- new用于实例化对象
- help用于查询类中定义的所有方法
- methods列出类中定义的所有方法
- fields列出类中定义的所有属性
- lock给属性加锁，实例化的对象的属性只允许赋值依次，即赋值变量不可修改
- trace跟踪方法
- accessors给属性生成get/set方法
第四篇 基于R6的面向对象
第一节 创建R6类
Person <- R6Class("Person",
public = list(
name = NA,
initialize = function(name,gender){
self$name <- name
private$gender <- gender
},
hello = function(){
print(paste("Hello",self$name))
private$myGender()
},
member = function(){
print(self)
print(private)
print(ls(envir = private))
}
),
private = list(
gender = NA,
myGender = function(){
print(paste(self$name,"is",private$gender))
}
))
conan <- Person$new("Conan","Male")
conan$member()
第二节 R6的主动绑定
主动绑定(Active binding)是R6中一种特殊的函数调用方式，把对函数的访问表现为对属性的访问，主动绑定属于公有成员。在类的定义中，通过设置activate参数实现主动绑定的功能，给Person类增加两个主动绑定的函数activate和rand
Person <- R6Class("Person",
public = list(
num=100
),
active = list( # 主动绑定
active= function(value){
if(missing(value))
return (self$num+10)
else self$num <- value/2},
rand = function() rnorm(1)
))
conan <- Person$new()
conan$num # 查看公有属性
conan$active #调用主动绑定的active()函数,结果为num +10 = 100+10
# 给主动绑定额active函数传参书，用赋值符号"<-",而不是方法调用"()"
conan$active <- 20
conan$num
第三节 R6的继承关系
Person <- R6Class("Person",
public = list(
name=NA,
initialize = function(name,gender){
self$name <- name
private$gender <- gender
},
hello = function(){
print(paste("hello",self$name))
private$myGender()
}
),
private=list(
gender = NA,
myGender = function(){
print(paste(self$name,"is",private$gender))
}
))
Worker <- R6Class("Worker",
inherit = Person, #继承，指向父类
public = list(
bye = function(){
print(paste("bye",self$name))
}
)
)
u1 <- Person$new("Conan","Male") #实例化父类
u1$hello()
u2 <- Worker$new("Conan","Male") # 实例化子类
u2$hello()
u2$bye()
# 重写父类方法
Worker <- R6Class("Worker",
inherit = Person,
public = list(
bye = function(){
print(paste("bye",self$name))
}
),
private = list(
gender = NA,
myGender = function(){
print(paste("worker",self$name,"is",private$gender))
}
))
u2 <- Worker$new("Conan","Male")
u2$hello() # 调用hello()方法
# 子类中调用父类的方法
Worker <- R6Class("Worker",
inherit = Person,
public = list(
bye = function(){
print(paste("bye",self$name))
}
),
private = list(
gender = NA,
myGender = function(){
super$myGender()# 调用父类的方法
print(paste("worker",self$name,"is",private$gender))
}
))
u2 <- Worker$new("Conan","Male")
u2$hello()
第四节
R6类对象的静态属性
A <- R6Class("A",
public=list(
x = NULL
))
B <- R6Class("B",
public=list(
a = A$new()
))
b <- B$new() # 实例化B对象
b$a$x <- 1 # 给x变量赋值
b$a$x
## [1] 1
b2 <- B$new()
b2$a$x <-2
b2$a$x
## [1] 2
b$a$x
## [1] 2
第五节 R6类的可移植类型
- 可移植类型支持跨R包的继承；不可移植类型，在跨R包的继承的时候，兼容性不太好
- 可移植类型必须用self和private对象来访问类中的成员，如self$x.private$y。不可移植类型，可以直接使用变量x,y，并通过“«-”(超赋值)实现赋值。
RC <- setRefClass("RC",
fields = list(x="numeric"),
methods = list(
getx = function() x,
setx = function(value) x <<- value
))
rc <- RC$new()
rc$setx(10)
rc$getx()
## [1] 10
NR6 <- R6Class("NR6",# R6不可移植类型
portable= FALSE,
public = list(
x = NA,
getx = function() x,
setx = function(value) x <<- value
))
np6 <- NR6$new()
np6$setx(10)
np6$getx()
## [1] 10
PR6 <- R6Class("PR6",
portable = TRUE,
public= list(
x = NA,
getx = function() self$x,
setx = function(value) self$x <- value
))
pr6 <- PR6$new()
pr6$setx(10)
pr6$getx()
## [1] 10
第六节 R6的动态绑定
A <- R6Class("A",
public = list(
x = 1,
getx = function() x
))
A$set("public","getx2",function() self$x*2) # 动态增加getx2()方法
s <- A$new()
s$getx2()
## [1] 2
A$set("public","x",10,overwrite=TRUE) # 动态改变x属性
s <- A$new()
s$x
## [1] 10
s$getx2()
## [1] 20
第七节 R6的打印函数
A <- R6Class("A",
public = list(
x = 1,
getx = function() self$x
))
a <- A$new()
print(a) #使用默认的打印方法
## <A>
## Public:
## clone: function (deep = FALSE)
## getx: function ()
## x: 1
A <- R6Class("A",
public = list(
x = 1,
getx = function() self$x,
print = function(...){
cat("Class <A> of public",ls(self),":",sep="")
cat(ls(self),sep=",")
invisible(self)
}
))
a <- A$new()
print(a)
## Class <A> of publicclonegetxprintx:clone,getx,print,x
第八节 R6实例化对象的存储
# 类中定义的属性和方法统一存储到一个S3对象中
A <- R6Class("A",
class=TRUE,
public=list(
x = 1,
getx = function() self$x
))
a <- A$new()
class(a)
# 把类中定义的属性和方法统一存储到一个单独的环境空间中。
B <- R6Class("B",
class=TRUE,
public=list(
x = 1,
getx = function() self$x
))
b <- B$new()
class(b)
A <- R6Class("A",
lock = TRUE,# 锁定环境空间
public= list(
x = 1
))
## R6Class A: 'lock' argument has been renamed to 'lock_objects' as of version 2.1.This code will continue to work, but the 'lock' option will be removed in a later version of R6
s <- A$new()
ls(s)
## [1] "clone" "x"
# s$aa <- 11 # 增加新变量 Error
# rm("x",envir=s) # Error