浅谈R语言的面向对象编程

R语言有两种不同的OOP机制，分别是从其前身S语言继承而来的S3 Object和S4 Object，其中S4 Object更加的正式、也是现在用于开发的主力军，所以本文就从S4 Object谈起，并在最后讨论一下古老的S3 Object。

那我们就开始吧！首先我们来设计一个时间序列类，在它的内部，需要包含主数据、起始时间与截止时间、取样间隔这些数据。在R中我们可以定义如下：

    setClass("TimeSeries",
        representation(
            data = "numeric",
            start = "POSIXct",
            end = "POSIXct"
        )
    )

在这段代码中，data/start/end用于存放数据，称作“槽(slot)”。

现在我们已经定义了一个类，我们就来创建一个TimeSeries对象吧！

    My_TimeSeries <- new("TimeSeries",
        data = c(1,2,3,4,5,6),
        start = as.POSIXct("01/12/2015 0:00:00", tz = "GMT",
        format = "%m/%d/%Y %H:%M:%S"),
        end = as.POSIXct("12/04/2015 0:00:00", tz = "GMT",
        format = "%m/%d/%Y %H:%M:%S")
    )

与其他OOP语言类似，R中新建对象的通用函数也叫”new”，但只能用于新建S4对象。现在我们来看看我们刚刚新建的My_TimeSeries：

    > My_TimeSeries
    An object of class "TimeSeries"
    Slot "data":
    [1] 1 2 3 4 5 6
    Slot "start":
    [1] "2015-01-12 GMT"
    Slot "end":
    [1] "2015-12-04 GMT"

    >My_TimeSeries@data   #可以使用"@"符号来引用类中的内容
    [1] 1 2 3 4 5 6
    > My_TimeSeries@start
    [1] "2015-01-12 GMT"

但是，一个bug出现了：如果用户把start和end颠倒、或者把end误输为一个比start还靠前的时间，这样会造成时间序列变得没有意义。R语言提供了一个新建对象时的检验机制，只需要在setValidity函数中设置一下：

    setValidity("TimeSeries",
        function(object) {
            object@start < object@end &&
            length(object@start) == 1 &&
            length(object@end) == 1
        }
    )

现在我们来试一下定义一个end在start前的TimeSeries对象：

    > bad_TimeSeries <- new("TimeSeries",
    + data=c(7, 8, 9, 10, 11, 12),
    + start=as.POSIXct("07/01/2009 0:06:00", tz="GMT",
    + format="%m/%d/%Y %H:%M:%S"),
    + end=as.POSIXct("07/01/1999 0:11:00", tz="GMT",
    + format="%m/%d/%Y %H:%M:%S")
    + )
    Error in validObject(.Object) : 类别为“TimeSeries”的对象不对: FALSE

同时，也可以使用validObject()函数来检验一个对象是否有效。

    > validObject(My_TimeSeries)
    [1] TRUE

其实，在定义类的时候也可以通过validity参数定义该类的合法性判断，如：

    setClass("anotherTimeSeries",
        representation(
            data = "numeric",
            start = "POSIXct",
            end = "POSIXct"
        ),
        validity = function(object){ #定义时加上合法性判断
            object@start < object@end &&
            length(object@start) == 1 &&
            length(object@end) == 1
        } 
    )

这样定义与前面的先定义类、后定义合法性检测的做法是等价的，只是把两步都集成到了setClass()函数中。

下面我们来看一下R语言中函数的多态性。我们先从重载一个通用函数summary()开始：

    > summary(My_TimeSeries)
    Length Class Mode 
    1 TimeSeries S4 
    > setMethod("summary", #重载summary
    +     signature = "TimeSeries",
    +     definition = function(object){
    +         print( paste(object@start, " to ", object@end,
    +                     sep = "", collapse = ""))
    +         print( paste(object@data, sep = ";", collapse = ""))
    +     }
    + )
    从the global environment里的程辑包‘base’为‘summary’建立新的泛型函数
    [1] "summary"
    > summary(My_TimeSeries)
    [1] "2015-01-12 to 2015-12-04"
    [1] "123456"

我们可以看到，当我们没对TimeSeries类重载summary()函数的时候，summary(My_TimeSeries)只提供了一些简要的信息。而在我们重载后，它就可以按照我们的要求输出信息了。

同时，我们知道运算符在R中也是相当于函数调用，也就是a+b与‘+’(a,b)是等价的。通过这个特性我们就可以重载R语言的运算符。

    #这样，就可以使用My_TimeSeries[i]了
    setMethod("[",
        signature("TimeSeries"),
        definition = function(x, i, j, ..., drop){
            return(x@data[i])
        }
    )

    > My_TimeSeries[3]
    [1] 3

而要新建一个泛型函数，则可以使用setGeneric()函数来定义、再用setMethod()函数来实现它对各种类的功能。

    setGeneric("increment",       #建立一个函数名为increment的泛型函数
        def = function(object, step, ...)
        standardGeneric("increment")
    )
    #对TimeSeries类重载increment函数，使之返回object[step+1]-object[1]的数值
    setMethod("increment",        
        signature = "TimeSeries",
        def = function(object, step, ...){
            return(object[step+1] - object[1])
        }
    )
    #对numeric类重载increment函数，使之返回object[step-1]-object[1]的数值
    setMethod("increment",
        signature = "numeric",
        def = function(object, step, ...){
            return(object[step-1] - object[1])
        }
    )

那么我们的定义的这个increment()泛型函数是否有效呢？我们来检验一下：

   > increment(My_TimeSeries,3)#根据我们的定义，应当返回My_TimeSeries[4]-My_TimeSeries[1]
   [1] 3
   > vec <- vector("numeric", length = 6)
   > vec <- c(1:6)    
   #现在我们来看一下对numeric型向量，运行increment()函数的结果
   > increment(vec, 3)
   [1] 1

在泛型函数的最后，让我来写一个错误的示范：

    > setMethod("anotherIncrement",
    +     signature = "TimeSeries",
    +     def = function(object, step, ...){
    +         return(object[step+1] - object[1])
    +     }
    + )
    Error in setMethod("anotherIncrement", signature = "TimeSeries", def = function(obj    ect, : 
    函数‘anotherIncrement’没有定义

在这个例子中，由于我没有定义anotherIncrement()为泛型函数，直接调用setMethod()就会报错——因为你根本没有定义它！

而如果我们对某个S4泛型函数不太了解，不知道它可以用于哪些类时，就可以使用showMethods()函数来看得到它可以作用的对象。

    > showMethods(increment)
    Function: increment (package .GlobalEnv)
    object="integer"
        (inherited from: object="numeric")
    object="numeric"
    object="TimeSeries"

下面我们来看看类的派生：现在我们想要一个类来记录个人体重的变化情况。我们希望记录下个人的姓名和身高，其他的信息直接使用TimeSeries类记录就可以了，我们可以定义如下：

    setClass("WeightHistory", #派生
        representation(
            height = "numeric",
            name = "character"
        ),
        contains = "TimeSeries"
    )

现在我们来创建一个WeightHistory类的对象，来储存AlexDannel的体重数据

    AlexDannel <- new("WeightHistory",
        data = c(120,118,119,123,121,119),
        start = as.POSIXct("07/01/2015 0:00:00", tz = "GMT",
        format = "%m/%d/%Y %H:%M:%S"),
        end = as.POSIXct("12/01/2015 0:00:00", tz = "GMT",
        format = "%m/%d/%Y %H:%M:%S"),
        height = 166,
        name = "Alex Dannel"
    )

有没有和新建TimeSeries序列对象的时候很像呢？

我们还可以用另一种方法定义WeightHistory类，那就是先定义一个Person类，里面包含name和height的slot（槽），然后直接从Person类和TimeSeries类继承出来。

    setClass("Person",
        representation(
            height = "numeric",
            name = "character"
        ) 
    )

   setClass("anotherWeightHistory",
       contains = c("TimeSeries", "Person")
   )

虚类：差点忘了还有虚类这个东东~ 其实在R中定义虚类也特别简单

    setClass("Cat",   #定义一个cat类，让NamedThing作为它和Person的虚基类
        representation(
            breed = "character",
            name = "character"
        )
    )

    setClassUnion("NamedThing",    #定义虚基类
        c("Person", "Cat")
    )

下面我们来简单讨论一下S3 Object类吧！其实S3类要比S4类更加“随意”，而S3类与JavaScript这种基于原型的(prototype-based)类非常相似。

#在S3类中，早已有对TimeSeries的定义，ts类对现在的R也是可用，现在我们来创建一个ts对象
my.ts <- ts(data=c(1, 2, 3, 4, 5), start=c(2009, 2), frequency=12)

需要注意的是，S3类中不能使用@来取slot中的值。

而要创建一个S3类的对象，则可以使用attr()函数或者structure()函数：

    > x<-1    #通过attr创建
    > attr(x,'class')<-'foo'    > x
    [1] 1
    >attr(,"class")
    [1] "foo"
    >class(x)
    "foo"
    >otype(x)    #检查x的类型
    "S3"

#通过structure()创建
> y <- structure(2, class = "foo")
> y
[1] 2
attr(,"class")
[1] "foo"
> class(y)
[1] "foo"
> otype(y)
[1] "S3"

而要定义一个S3泛型函数，也是比较灵活的——只需如下三步：

1. Pick a name for the generic function. We’ll call this gname.
2. Create a function named gname. In the body for gname, call UseMethod(“gname“).
3. For each class that you want to use with gname, create a function called
    gname.classname whose first argument is an object of class classname.

——《R in a nutshell》, 2nd Edition

以plot为例，我们想要重载plot函数，使之可以对TimeSeries类绘图，就可以这样定义：

    plot.TimeSeries <- function(object, ...){
        plot(object@data, ...)
    }

现在，你就可以直接通过plot(My_TimeSeries)来画出图像了！

而如果想要查看S3泛型函数可以用于哪些类时，就可以使用methods()函数来看得到它可以作用的对象（因为用S4的showMethods()函数会报错→_→）。

> methods(plot)
 [1] plot.acf* plot.data.frame* plot.decomposed.ts* plot.default plot.dendrogram* plot.density* 
 [7] plot.ecdf plot.factor* plot.formula* plot.function plot.hclust* plot.histogram* 
[13] plot.HoltWinters* plot.isoreg* plot.lm* plot.medpolish* plot.mlm* plot.ppr* 
[19] plot.prcomp* plot.princomp* plot.profile.nls* plot.raster* plot.shingle* plot.spec* 
[25] plot.stepfun plot.stl* plot.table* plot.trellis* plot.ts plot.tskernel* 
[31] plot.TukeyHSD* 
see '?methods' for accessing help and source code

我们甚至可以通过gets3method()函数来查看S3泛型函数的源代码：

library(lattice)
getS3method("histogram", class = "formula")

 

到这里，笔者所知的R语言面向对象编程就介绍完毕了。由于作者水平有限，许多系统函数的参数没能系统的描述。读者不妨仔细阅读setClass、setGeneric、setMethod、new、method等函数的帮助页面，以加深对R语言OOP的理解。