识别对象，泛型函数和方法

大多数对象都是S3对象。

library(pryr)
df <- data.frame(x = 1:10, y = letters[1:10])
otype(df) 

## [1] "S3"

df是S3对象

otype(df$x)

## [1] "base"

numeric vector不是S3

otype(df$y)

## [1] "S3"

在S3中，方法属于函数，称为泛型函数，或泛型。

S3 methods do not belong to objects or classes.

查看一个函数是否是泛型，可以看是否有UseMethod，或ftype()

mean

## function (x, ...) 
## UseMethod("mean")
## <bytecode: 0x000000000af17700>
## <environment: namespace:base>

ftype(mean)

## [1] "s3"      "generic"

library(Mreport)

## 载入需要的程辑包：leafletCN

ftype(geo_pointplot)

## [1] "function"

ftype(caculate_carsmean)

## [1] "function"

ftype(sum)

## [1] "primitive" "generic"

ftype(`[`)

## [1] "primitive" "generic"

Given a class, the job of an S3 generic is to call the right S3 method. You can recognise S3 methods by their names, which look like generic.class(). For example, the Date method for the mean() generic is called mean.Date(), and the factor method for print() is called print.factor().

ftype(t.data.frame)

## [1] "s3"     "method"

ftype(t.test)

## [1] "s3"      "generic"

You can see all the methods that belong to a generic with methods()

methods("mean")

## [1] mean.Date     mean.default  mean.difftime mean.POSIXct  mean.POSIXlt 
## see '?methods' for accessing help and source code

methods("t.test")

## [1] t.test.default* t.test.formula*
## see '?methods' for accessing help and source code

You can also list all generics that have a method for a given class:

methods(class = "ts")

##  [1] [             [<-           aggregate     as.data.frame cbind        
##  [6] coerce        cycle         diff          diffinv       initialize   
## [11] kernapply     lines         Math          Math2         monthplot    
## [16] na.omit       Ops           plot          print         show         
## [21] slotsFromS3   t             time          window        window<-     
## see '?methods' for accessing help and source code

定义类和创建对象

To make an object an instance of a class, you just take an existing base object and set the class attribute. You can do that during creation with structure(), or after the fact with class<-():

foo <- list()
class(foo) <- "foo"
class(foo)

## [1] "foo"

S3 objects are usually built on top of lists, or atomic vectors with attributes.

class(foo)

## [1] "foo"

inherits(foo, "foo")

## [1] TRUE

Most S3 classes provide a constructor function:

foo <- function(x) {
  if (!is.numeric(x)) stop("X must be numeric")
  structure(list(x), class = "foo")
}

a <- 1:3
a <- foo(a)
class(a)

## [1] "foo"

you can change the class of existing objects:

mod <- lm(log(mpg) ~ log(disp), data = mtcars)
class(mod)

## [1] "lm"

print(mod)

## 
## Call:
## lm(formula = log(mpg) ~ log(disp), data = mtcars)
## 
## Coefficients:
## (Intercept)    log(disp)  
##      5.3810      -0.4586

class(mod) <- "data.frame"
print(mod)

##  [1] coefficients  residuals     effects       rank          fitted.values
##  [6] assign        qr            df.residual   xlevels       call         
## [11] terms         model        
## <0 行> (或0-长度的row.names)

mod$coefficients

## (Intercept)   log(disp) 
##   5.3809725  -0.4585683

创建方法和泛型

To add a new generic, create a function that calls UseMethod(). UseMethod() takes two arguments: the name of the generic function, and the argument to use for method dispatch.

There’s no need to pass any of the arguments of the generic to UseMethod() and you shouldn’t do so.

f <- function(x) UseMethod("f")
ftype(f)

## [1] "s3"      "generic"

A generic isn’t useful without some methods. To add a method, you just create a regular function with the correct (generic.class) name:

f.a <- function(x) "Class a"

a <- structure(list(), class = "a")
class(a)

## [1] "a"

f(a)

## [1] "Class a"

Adding a method to an existing generic works in the same way:

mean.a <- function(x) "hello a"
mean(a)

## [1] "hello a"

方法分配

f <- function(x) UseMethod("f")
f.a <- function(x) "Class a"
f.default <- function(x) "Unknown class"

f(structure(list(), class = "a"))

## [1] "Class a"

f(structure(list(), class = c("b", "a")))

## [1] "Class a"

f(structure(list(), class = "c"))

## [1] "Unknown class"

Because methods are normal R functions, you can call them directly:

c <- structure(list(), class = "c")
f(c)

## [1] "Unknown class"

f.default(c)

## [1] "Unknown class"

f.a(c)

## [1] "Class a"

However, this is just as dangerous as changing the class of an object, so you shouldn’t do it.

练习

ftype(t.test)

## [1] "s3"      "generic"

body(t.test)

## UseMethod("t.test")

methods(t.test)

## [1] t.test.default* t.test.formula*
## see '?methods' for accessing help and source code

a <- structure(list(),class="test")
class(a)

## [1] "test"

try(t(a))

## Warning in mean.default(x): 参数不是数值也不是逻辑值：回覆NA

body(t.default)

## .Internal(t.default(x))

methods(class = "POSIXt")

##  [1] -            +            all.equal    as.character Axis        
##  [6] coerce       cut          diff         hist         initialize  
## [11] is.numeric   julian       Math         months       Ops         
## [16] pretty       quantile     quarters     round        seq         
## [21] show         slotsFromS3  str          trunc        weekdays    
## see '?methods' for accessing help and source code

methods(class = "POSIXct")

##  [1] [             [[            [<-           as.data.frame as.Date      
##  [6] as.list       as.POSIXlt    c             coerce        format       
## [11] initialize    mean          print         rep           show         
## [16] slotsFromS3   split         summary       Summary       weighted.mean
## [21] xtfrm        
## see '?methods' for accessing help and source code

methods(class = "POSIXlt")

##  [1] [             [<-           anyNA         as.data.frame as.Date      
##  [6] as.double     as.matrix     as.POSIXct    c             coerce       
## [11] duplicated    format        initialize    is.na         length       
## [16] mean          names         names<-       print         rep          
## [21] show          slotsFromS3   sort          summary       Summary      
## [26] unique        weighted.mean xtfrm        
## see '?methods' for accessing help and source code

all3 <- list(methods(class = "POSIXct"),methods(class = "POSIXlt"),methods(class = "POSIXt"))
all3 <- lapply(all3, function(x) attr(x,"info")$generic)
(allgen <- Reduce(union,all3))

##  [1] "["             "[["            "[<-"           "as.data.frame"
##  [5] "as.Date"       "as.list"       "as.POSIXlt"    "c"            
##  [9] "coerce"        "format"        "initialize"    "mean"         
## [13] "print"         "rep"           "show"          "slotsFromS3"  
## [17] "split"         "summary"       "Summary"       "weighted.mean"
## [21] "xtfrm"         "anyNA"         "as.double"     "as.matrix"    
## [25] "as.POSIXct"    "duplicated"    "is.na"         "length"       
## [29] "names"         "names<-"       "sort"          "unique"       
## [33] "-"             "+"             "all.equal"     "as.character" 
## [37] "Axis"          "cut"           "diff"          "hist"         
## [41] "is.numeric"    "julian"        "Math"          "months"       
## [45] "Ops"           "pretty"        "quantile"      "quarters"     
## [49] "round"         "seq"           "str"           "trunc"        
## [53] "weekdays"

objs <- mget(ls("package:base"),inherits=T)
funs <- Filter(is.function,objs)

funsl2 <- Filter(function(x) "generic" %in% ftype(x),funs)
length(funsl2)

## [1] 176

len <- vapply(names(funsl2), compose(length,methods),FUN.VALUE = numeric(1))
names(funsl2)[len==max(len)]

## [1] "print"

funsl2[len==max(len)]

## $print
## function (x, ...) 
## UseMethod("print")
## <bytecode: 0x0000000008770bb8>
## <environment: namespace:base>