作者：张丹，R语言中文社区专栏特邀作者，《R的极客理想》系列图书作者，民生银行大数据中心数据分析师，前况客创始人兼CTO。
个人博客 http://fens.me， Alexa全球排名70k。
前言
对于R语言的面向对象编程，不同于其他的编程语言，R语言提供了3种底层对象类型，一种是S3类型，一种是S4类型，还有一种是RC类型。
S3对象简单、具有动态性、结构化特征不明显；S4对象结构化、功能强大；RC对象是2.12版本后使用的新类型，用于解决S3,S4很难实现的对象。
本文将从S3对象开始，介绍R语言面向对象编程的细节。
目录
S3对象介绍
创建S3对象
泛型函数和方法调用
查看S3对象的函数
S3对象继承
S3对象的缺点
S3对象的使用
1.S3对象介绍
在R语言中，基于S3对象的面向对象编程，是一种基于泛型函数的实现方式。泛型函数是一种特殊的函数, 根据传入对象的类型决定调用哪个具体的方法。基于S3对象实现的面向对象编程，不同其他语言的面向对象编程，是一种动态函数调用的模拟实现。S3对象被广泛应用于R的早期的开发包中。
关于面向对象的介绍，请参考文章：R语言面向对象编程
2.创建S3对象
本文的系统环境
Linux: Ubuntu Server 12.04.2 LTS 64bit
R: 3.0.1 x86_64-pc-linux-gnu
注：pryr只支持Linux系统环境
为了方便我们检查对象的类型，引入pryr包作为辅助工具。
1# 加载pryr包
2> library(pryr)
通过变量创建S3对象
1> x<-1
2> attr(x,'class')<-'foo'
3
4> x
5[1] 1
6attr(,"class")
7[1] "foo"
8
9> class(x)
10[1] "foo"
11
12# 用pryr包的otype函数，检查x的类型
13> otype(x)
14[1] "S3"
通过structure()函数创建S3对象
1> y <- structure(2, class = "foo")
2
3> y
4[1] 2
5attr(,"class")
6[1] "foo"
7
8> class(y)
9[1] "foo"
10
11> otype(y)
12[1] "S3"
创建一个多类型的S3对象
S3对象没有明确结构关系，一个S3对象可以有多个类型, S3对象的 class 属性可以是一个向量，包括多种类型。
1> x<-1
2> attr(x,'class')<- c("foo", "bar")
3> class(x)
4[1] "foo" "bar"
5> otype(x)
6[1] "S3"
3.泛型函数和方法调用
对于S3对象的使用，通常用UseMethod()函数来定义一个泛型函数的名称，通过传入参数的class属性，来确定不同的方法调用。
定义一个teacher的泛型函数
+ 用UseMethod()定义teacher泛型函数
+ 用teacher.xxx的语法格式定义teacher对象的行为
+ 其中teacher.default是默认行为
1# 用UseMethod()定义teacher泛型函数
2> teacher <- function(x, ...) UseMethod("teacher")
3
4# 用pryr包中ftype()函数，检查teacher的类型
5> ftype(teacher)
6[1] "s3" "generic"
7
8# 定义teacher内部函数
9> teacher.lecture <- function(x) print("讲课")
10> teacher.assignment <- function(x) print("布置作业")
11> teacher.correcting <- function(x) print("批改作业")
12> teacher.default<-function(x) print("你不是teacher")
方法调用时，通过传入参数的class属性，来确定不同的方法调用。
定义一个变量a，并设置a的class属性为lecture
把变量a，传入到teacher泛型函数中
函数teacher.lecture()函数的行为被调用
1> a<-'teacher'
2
3# 给老师变量设置行为
4> attr(a,'class') <- 'lecture'
5
6# 执行老师的行为
7> teacher(a)
8[1] "讲课"
当然，我们也可以直接调用teacher中定义的行为，如果这样做了就失败了面向对象封装的意义。
1> teacher.lecture()
2[1] "讲课"
3
4> teacher.lecture(a)
5[1] "讲课"
6
7> teacher()
8[1] "你不是teacher"
4.查看S3对象的函数
当我们使用S3对象进行面向对象封装后，可以用methods()函数来查看S3对象中的定义的内部行为函数。
1# 查看teacher对象
2> teacher
3function(x, ...) UseMethod("teacher")
4
5# 查看teacher对象的内部函数
6> methods(teacher)
7[1] teacher.assignment teacher.correcting teacher.default teacher.lecture
通过methods()的generic.function参数，来匹配泛型函数名字。
1> methods(generic.function=predict)
2 [1] predict.ar* predict.Arima* predict.arima0*
3 [4] predict.glm predict.HoltWinters* predict.lm
4 [7] predict.loess* predict.mlm predict.nls*
5[10] predict.poly predict.ppr* predict.prcomp*
6[13] predict.princomp* predict.smooth.spline* predict.smooth.spline.fit*
7[16] predict.StructTS*
8
9 Non-visible functions are asterisked
通过methods()的class参数，来匹配类的名字。
1> methods(class=lm)
2 [1] add1.lm* alias.lm* anova.lm case.names.lm*
3 [5] confint.lm* cooks.distance.lm* deviance.lm* dfbeta.lm*
4 [9] dfbetas.lm* drop1.lm* dummy.coef.lm* effects.lm*
5[13] extractAIC.lm* family.lm* formula.lm* hatvalues.lm
6[17] influence.lm* kappa.lm labels.lm* logLik.lm*
7[21] model.frame.lm model.matrix.lm nobs.lm* plot.lm
8[25] predict.lm print.lm proj.lm* qr.lm*
9[29] residuals.lm rstandard.lm rstudent.lm simulate.lm*
10[33] summary.lm variable.names.lm* vcov.lm*
11
12 Non-visible functions are asterisked
用getAnywhere()函数，查看所有的函数。
1# 查看teacher.lecture函数
2> getAnywhere(teacher.lecture)
3A single object matching ‘teacher.lecture’ was found
4It was found in the following places
5 .GlobalEnv
6 registered S3 method for teacher
7with value
8
9function(x) print("讲课")
10
11# 查看不可见的函数predict.ppr
12> predict.ppr
13Error: object 'predict.ppr' not found
14> exists("predict.ppr")
15[1] FALSE
16
17# getAnywhere()函数查找predict.ppr
18> getAnywhere("predict.ppr")
19A single object matching ‘predict.ppr’ was found
20It was found in the following places
21 registered S3 method for predict from namespace stats
22 namespace:stats
23with value
24
25function (object, newdata, ...)
26{
27 if (missing(newdata))
28 return(fitted(object))
29 if (!is.null(object$terms)) {
30 newdata <- as.data.frame(newdata)
31 rn <- row.names(newdata)
32 Terms <- delete.response(object$terms)
33 m <- model.frame(Terms, newdata, na.action = na.omit,
34 xlev = object$xlevels)
35 if (!is.null(cl <- attr(Terms, "dataClasses")))
36 .checkMFClasses(cl, m)
37 keep <- match(row.names(m), rn)
38 x <- model.matrix(Terms, m, contrasts.arg = object$contrasts)
39 }
40 else {
41 x <- as.matrix(newdata)
42 keep <- seq_len(nrow(x))
43 rn <- dimnames(x)[[1L]]
44 }
45 if (ncol(x) != object$p)
46 stop("wrong number of columns in 'x'")
47 res <- matrix(NA, length(keep), object$q, dimnames = list(rn,
48 object$ynames))
49 res[keep, ] <- matrix(.Fortran(C_pppred, as.integer(nrow(x)),
50 as.double(x), as.double(object$smod), y = double(nrow(x) *
51 object$q), double(2 * object$smod[4L]))$y, ncol = object$q)
52 drop(res)
53}
54<bytecode: 0x000000000df6c2d0>
55<environment: namespace:stats>
使用getS3method()函数，也同样可以查看不可见的函数
1# getS3method()函数查找predict.ppr
2> getS3method("predict", "ppr")
3function (object, newdata, ...)
4{
5 if (missing(newdata))
6 return(fitted(object))
7 if (!is.null(object$terms)) {
8 newdata <- as.data.frame(newdata)
9 rn <- row.names(newdata)
10 Terms <- delete.response(object$terms)
11 m <- model.frame(Terms, newdata, na.action = na.omit,
12 xlev = object$xlevels)
13 if (!is.null(cl <- attr(Terms, "dataClasses")))
14 .checkMFClasses(cl, m)
15 keep <- match(row.names(m), rn)
16 x <- model.matrix(Terms, m, contrasts.arg = object$contrasts)
17 }
18 else {
19 x <- as.matrix(newdata)
20 keep <- seq_len(nrow(x))
21 rn <- dimnames(x)[[1L]]
22 }
23 if (ncol(x) != object$p)
24 stop("wrong number of columns in 'x'")
25 res <- matrix(NA, length(keep), object$q, dimnames = list(rn,
26 object$ynames))
27 res[keep, ] <- matrix(.Fortran(C_pppred, as.integer(nrow(x)),
28 as.double(x), as.double(object$smod), y = double(nrow(x) *
29 object$q), double(2 * object$smod[4L]))$y, ncol = object$q)
30 drop(res)
31}
32<bytecode: 0x000000000df6c2d0>
33<environment: namespace:stats>
5.S3对象的继承关系
S3对象有一种非常简单的继承方式，用NextMethod()函数来实现。
定义一个 node泛型函数
1> node <- function(x) UseMethod("node", x)
2> node.default <- function(x) "Default node"
3
4# father函数
5> node.father <- function(x) c("father")
6
7# son函数，通过NextMethod()函数指向father函数
8> node.son <- function(x) c("son", NextMethod())
9
10# 定义n1
11> n1 <- structure(1, class = c("father"))
12# 在node函数中传入n1，执行node.father()函数
13> node(n1)
14[1] "father"
15
16# 定义n2，设置class属性为两个
17> n2 <- structure(1, class = c("son", "father"))
18# 在node函数中传入n2，执行node.son()函数和node.father()函数
19> node(n2)
20[1] "son" "father"
通过对node()函数传入n2的参数，node.son()先被执行，然后通过NextMethod()函数继续执行了node.father()函数。这样其实就模拟了，子函数调用父函数的过程，实现了面向对象编程中的继承。
6.S3对象的缺点
从上面对S3对象的介绍来看，S3对象并不是完全的面向对象实现，而是一种通过泛型函数模拟的面向对象的实现。
S3使用起来简单，但在实际的面向对象编程过程中，当对象关系有一定的复杂度，S3对象所表达的意义就会变得不太清楚。
S3封装的内部函数，可绕过泛型函数的检查，以直接被调用。
S3参数的class属性，可以被任意设置，没有预处理的检查。
S3参数，只能通过调用class属性进行函数调用，其他属性则不会被class()函数执行。
S3参数的class属性有多个值时，调用时会按照程序赋值顺序来调用第一个合法的函数。
所以，S3只能R语言面向对象的一种简单的实现。
7.S3对象的使用
S3对象系统，被广泛地应用于R语言的早期开发中。在base包中，就有很多的S3对象。
base包的S3对象
1# mean函数
2> mean
3function (x, ...)
4UseMethod("mean")
5
6
7> ftype(mean)
8[1] "s3" "generic"
9
10# t函数
11> ftype(t)
12[1] "s3" "generic"
13
14# plot函数
15> ftype(plot)
16[1] "s3" "generic"
自定义的S3对象
1# 定义数字型变量a
2> a <- 1
3# 变量a的class为numeric
4> class(a)
5[1] "numeric"
6
7# 定义泛型函数f1
8> f1 <- function(x) {
9+ a <- 2
10+ UseMethod("f1")
11+ }
12
13# 定义f1的内部函数
14> f1.numeric <- function(x) a
15
16# 给f1()传入变量a
17> f1(a)
18[1] 2
19
20# 给f1()传入数字99
21> f1(99)
22[1] 2
23
24# 定义f1的内部函数
25> f1.character <- function(x) paste("char", x)
26
27# 给f1()传入字符a
28> f1("a")
29[1] "char a"
这样，我们就对S3对象系统有了一个全面认识，开始R语言的面向对象编程之路。
往期精彩：
公众号后台回复关键字即可学习
回复 爬虫 爬虫三大案例实战
回复 Python 1小时破冰入门
回复 数据挖掘 R语言入门及数据挖掘
回复 人工智能 三个月入门人工智能
回复 数据分析师 数据分析师成长之路
回复 机器学习 机器学习的商业应用
回复 数据科学 数据科学实战
回复 常用算法 常用数据挖掘算法