使用列表作为底层数据结构

列表可能是创建新类时使用最广泛的数据结构，类描述了对象的类型和对象交互作用的方法，其中对象用于存储多种多样、长度不一的数据。

下面我们定义一个叫product的函数，创建一个由name、price和inventory构成的列表，该列表的类是product。我们还将自己定义它的print方法。

productor = function(name, price, inventory){
    obj = list(name = name,
               price = price,
               inventory = inventory)
    class(obj) = "product"
    obj
}

上面我们创建了一个列表，然后将它的类替换为product。我们还可以使用structure()：

product = function(name, price, inventory){
    structure(list(name = name,
              price = price,
              inventory = inventory),
              class = "product")
}

现在我们调用product()函数生成product类的实例：

laptop = product("Laptop", 499, 300)

查看它的结构和S3类方法分派：

typeof(laptop)
#> [1] "list"
class(laptop)
#> [1] "product"

此时我们还没有为该类定义任何方法，如果print将按默认列表输出：

print(laptop)
#> $name
#> [1] "Laptop"
#> 
#> $price
#> [1] 499
#> 
#> $inventory
#> [1] 300
#> 
#> attr(,"class")
#> [1] "product"

下面我们自定义一个print方法，使得输出更紧凑：

print.product = function(x, ...){
    cat("<product>\n")
    cat("name:", x$name, "\n")
    cat("price:", x$price, "\n")
    cat("inventory:", x$inventory, "\n")
    invisible(x)
}

print方法返回输入对象本身以备后用，这是一项约定。

现在我们再来看看输出：

laptop
#> <product>
#> name: Laptop 
#> price: 499 
#> inventory: 300

我们可以像操作列表一样访问laptop的成分：

laptop$name
#> [1] "Laptop"
laptop$price
#> [1] 499
laptop$inventory
#> [1] 300

如果我们创建另一个对象，并将两者放入一个列表然后打印，print.product仍然会被调用：

cellphone = product("Phone", 249, 12000)
products = list(laptop, cellphone)
products
#> [[1]]
#> <product>
#> name: Laptop 
#> price: 499 
#> inventory: 300 
#> 
#> [[2]]
#> <product>
#> name: Phone 
#> price: 249 
#> inventory: 12000

当products以列表形式被打印时，会对每个元素调用print()泛型函数，再由泛型函数执行方法分派。

大多数其他编程语言都对类有正式的定义，而S3没有，所以创建一个S3对象比较简单，但我们需要对输入参数进行充分的检查，以确保创建的对象与所属类内部一致。

除了定义新类，我们还可以定义新的泛型函数。下面创建一个叫value的泛型函数，它通过测量产品的库存值来为product调用实施方法：

value = function(x, ...)
    UseMethod("value")
value.default = function(x, ...){
    stop("Value is undefined")
}
value.product = function(x, ...){
    x$price * x$inventory
}

针对其他类，value调用default方法并终止运行。

value(laptop)
#> [1] 149700
value(cellphone)
#> [1] 2988000
value(data_frame)
#> Error in value.default(data_frame): Value is undefined

使用原子向量作为底层数据结构

上面我们已经演示了创建S3类和泛型函数的过程，有时候我们需要使用原子向量创建新类，下面展示百分比形式向量创建过程。

首先定义一个percent函数，它检查输入是否是数值向量并将输入对象类型改为percent，percent类继承numeric类：

percent = function(x){
    stopifnot(is.numeric(x))
    class(x) = c("percent", "numeric")
    x
}

这里的继承指方法分派首先在percent类中方法找，找不到就去numeric类方法中找。寻找的顺序由类名称的顺序决定。

pct = percent(c(0.1, 0.05, 0.25))
pct
#> [1] 0.10 0.05 0.25
#> attr(,"class")
#> [1] "percent" "numeric"

现在定义方法，让percent类以百分比形式存在：

as.character.percent = function(x, ...){
    paste0(as.numeric(x) * 100, "%")
}

现在我们可以得到字符型了：

as.character(pct)
#> [1] "10%" "5%"  "25%"

也可以直接调用as.character()为percent提供一个format方法：

format.percent = function(x, ...){
    as.character(x, ...)
}

format现在有相同的效果：

format(pct)
#> [1] "10%" "5%"  "25%"

类似地，我们调用format.percent()为percent提供print方法：

print.percent = function(x, ...){
    print(format.percent(x), quote = FALSE)
}

这里指定quote=FALSE使得打印的格式化字符串更像数字而非字符串。

pct
#> [1] 10% 5%  25%

注意，使用算术运算符操作后会自动保持输出向量类不变：

pct + 0.2
#> [1] 30% 25% 45%
pct * 0.5
#> [1] 5%    2.5%  12.5%

可惜使用其他函数可能不会保持输入对象的类，比如sum()、mean()等：

sum(pct)
#> [1] 0.4
mean(pct)
#> [1] 0.133
max(pct)
#> [1] 0.25
min(pct)
#> [1] 0.05

为了确保百分比形式保存，我们对percent类实施一些操作：

sum.percent = function(...){
    percent(NextMethod("sum"))
}
mean.percent = function(x, ...){
    percent(NextMethod("mean"))
}
max.percent = function(...){
    percent(NextMethod("max"))
}
min.percent = function(...){
    percent(NextMethod("max"))
}

NextMethod("sum")对numeric类调用sum()函数，然后再调用percent()函数将输出的数值向量包装为百分比形式：

sum(pct)
#> [1] 40%
mean(pct)
#> [1] 13.3333333333333%
max(pct)
#> [1] 25%
min(pct)
#> [1] 5%

但如果我们组合一个百分比向量和其他数值型的值，percent类又会消失掉，我们进行相同的改进：

c.percent = function(x, ...){
    percent(NextMethod("c"))
}

c(pct, 0.12)
#> [1] 10% 5%  25% 12%

dan….我们取子集又会有问题

pct[1:3]
#> [1] 0.10 0.05 0.25
pct[[2]]
#> [1] 0.05

同样地，我们对[和[[函数进行改造：

`[.percent` = function(x, i) {
    percent(NextMethod('['))
}
`[[.percent` = function(x, i){
    percent(NextMethod("[["))
}

此时显示就正常了：

pct[1:3]
#> [1] 10% 5%  25%
pct[[2]]
#> [1] 5%

实现这些方法后，我们可以在数据框中使用：

data.frame(id = 1:3, pct)
#>   id pct
#> 1  1 10%
#> 2  2  5%
#> 3  3 25%

S3继承

假设我们想要对一些交通工具，例如汽车、公共汽车和飞机进行建模。这些交通工具有一些共性，它们都有名称、速度、位置，而且都可以移动。为了形象化描述它们，我们定义一个基本类，称为vehichle，用于存储公共部分，另外定义car、bus和airplane这3个子类，它们继承vehichle，但具有自定义的行为。

首先，定义一个函数来创建vehicle对象，它本质上是一个环境。我们选择环境而不是列表，因为需要用到环境的引用语义，也就是说，我们传递一个对象，然后原地修改它，而不会创建这个对象的副本。因此无论什么位置将对象传递给函数，对象总是指向同一个交通工具。

Vehicle = function(class, name, speed) {
    obj = new.env(parent = emptyenv())
    obj$name = name
    obj$speed = speed
    obj$position = c(0, 0, 0)
    class(obj) = c(class, "vehicle")
    obj
}

这里的class(obj) = c(class, "vehicle")似乎有点语义不明。但前者是基础函数，后者是输入参数，R能够判断好。

下面函数创建继承vehicle的car、bus和airplane的特定函数：

Car = function(...){
    Vehicle(class = "car", ...)
}
Bus = function(...){
    Vehicle(class = "bus", ...)
}
Airplane = function(...){
    Vehicle(class = "airplane", ...)
}

现在我们可以为每一个子类创建实例：

car = Car("Model-A", 80)
bus = Bus("Medium-Bus", 40)
airplane = Airplane("Big-Plane", 800)

下面为vehicle提供通用的print方法：

print.vehicle = function(x, ...){
    cat(sprintf("<vehicle: %s>\n", class(x)[1]))
    cat("name:", x$name, "\n")
    cat("speed:", x$speed, "km/h\n")
    cat("position:", paste(x$position, collapse = ", "), "\n")
}

因为我们定义的3个子类都有了继承，所以print方法通用：

car
#> <vehicle: car>
#> name: Model-A 
#> speed: 80 km/h
#> position: 0, 0, 0
bus
#> <vehicle: bus>
#> name: Medium-Bus 
#> speed: 40 km/h
#> position: 0, 0, 0
airplane
#> <vehicle: airplane>
#> name: Big-Plane 
#> speed: 800 km/h
#> position: 0, 0, 0

因为交通工具可以移动，我们创建一个泛型函数move来表征这样的状态：

move = function(vehicle, x, y, z) {
    UseMethod("move")
}
move.vehicle = function(vehicle, movement) {
    if (length(movement) != 3){
        stop("All three dimensions must be specified to move a vehicle")
    }
    
    vehicle$position = vehicle$position + movement
    vehicle
}

这里我们将汽车和公共汽车的移动限定在二维平面上。

move.bus = move.car = function(vehicle, movement) {
    if (length(movement) != 2){
        stop("This vehicle only supports 2d movement")
    }
    
    movement = c(movement, 0)
    NextMethod("move")
}

这里我们将movement的第3个纬度强制转换为0，然后调用NextMethod("move")来调用move.vehicle()。

飞机既可以在2维也可以在3维：

move.airplane = function(vehicle, movement) {
    if (length(movement) == 2){
        movement = c(movement, 0)
    }
    
    NextMethod("move")
}

下载3种方法都实现了，进行测试。

move(car, c(1, 2, 3))
#> Error in move.car(car, c(1, 2, 3)): This vehicle only supports 2d movement

只能输入二维，所以提示报错了。

move(car, c(1, 2))
#> <vehicle: car>
#> name: Model-A 
#> speed: 80 km/h
#> position: 1, 2, 0

move(airplane, c(1, 2))
#> <vehicle: airplane>
#> name: Big-Plane 
#> speed: 800 km/h
#> position: 1, 2, 0

飞机，3维：

move(airplane, c(20,100,50))
#> <vehicle: airplane>
#> name: Big-Plane 
#> speed: 800 km/h
#> position: 21, 102, 50

注意，airplane的位置是累积的。因为前面说过，它本质是一个环境，因此修改move.vehicle()中的position不会创建一个副本再修改，而是本地修改！

学习自《R语言编程指南》