定义新类并创建对象

现在，我们可以尝试定义新类了。注意到 class(x) 获取 x 的类，而 class(x)<-
"some_class"将 x 的类设为 some_class。
1．使用列表作为底层数据结构
就像 lm 和 rpart，列表可能是创建新类时使用最广泛的底层数据结构。这是因为类描
述了对象的类型和对象之间交互作用的方法，其中，对象用于存储多种多样、长度不一的
数据。
下面这个例子中，我们定义了一个名为product 的函数，这个函数创建了一个由 name、
price 和 inventory 构成的列表，并且该列表的类是 product。我们还定义了它自己的
print 方法，并且可以随着学习的不断深入，一步步增加更多的方法来拓展函数的行为：
product <- 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"
很明显，laptop 是一个类为 product 的列表。因为我们还没有为这个类定义任何方
法，所有它的行为与一个普通列表对象相同。如果将它打印出来，就会得到一个带有自定
义类属性的列表：
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 方法返回输入对象本身以备后用，这是一项约定。如果打印是自定义的，那么，
我们经常使用 invisible 来阻止函数返回对象的重复打印，也可以尝试直接返回 x 看看
会发生什么情况。
然后，我们再次打印这个变量。因为已经定义了 print 方法，所以打印变量时会分派
到 print.product：
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 对象相对简单一些。但是很重要的一点是，要对输入参数进行充分的检查，以确保创
建的对象与所属类内部一致。
举个反例，我们创建了一个带有非负整数库存的产品，而没有进行合适的检查：
product("Basket", 150, -0.5)
## <product>
## name: Basket
## price: 150
## inventory: -0.5
为了避免出现这样的情况，我们需要在对象生成函数 product( )中添加检查条件：
product <- function(name, price, inventory) {
stopifnot(
is.character(name), length(name) == 1,
is.numeric(price), length(price) == 1,
is.numeric(inventory), length(inventory) == 1,
price > 0, inventory >= 0)
structure(list(name = name,
price = as.numeric(price),
inventory = as.integer(inventory)),
class = "product")
}
这个函数是加强版，其中name 必须是单个字符串，price 必须是一个正数，inventory
必须是一个非负数。使用这个函数，我们就不会因错误而创造残次品，并且可以很早发现错误：
product("Basket", 150, -0.5)
## Error: inventory >= 0 is not TRUE
除了定义新类，也可以定义新的泛型函数。在接下来的代码中，我们创建了一个名
为 value 的新的泛型函数，它通过测量产品的库存值来为 product 调用实施方法：
value <- function(x, ...)
UseMethod("value")
value.default <- function(x, ...) {
stop("Value is undefined")
}
value.product <- function(x, ...) {
x$price *x$inventory
}
对于其他的类，泛型函数 value( ) 调用 value.default 并终止运行。现在，
value( )可以用于所有 product( )创建的对象实例：
value(laptop)
## [1] 149700
value(cellphone)
## [1] 2988000
泛型函数也适用于 apply 函数族，它对输入向量或列表的每个元素执行方法分派：
sapply(products, value)
## [1] 149700 2988000
还有一个问题：一旦创建了一个既定类的对象，是不是意味着这个对象就不能再改变
了？不是的，我们还可以改变它。在这个例子中，还可以修改 laptop 中的已有元素：
laptop$price <- laptop$price *0.85
也可以在 laptop 中创建一个新的元素：
laptop$value <- laptop$price *laptop$inventory
现在，我们看看修改是否有效：
laptop
## <product>
## name: Laptop
## price: 424.15
## inventory: 300
更有甚者，我们可以设定一个元素为 NULL 来移除它。这就是 S3 系统会被认为非正式
的原因。你无法确保一个既定类型的对象有固定的数据字段和方法。
2．使用原子向量作为底层数据结构
在前面的内容中，我们通过一个示例，演示了从列表对象出发创建新类的过程。实
际
上，有时需要利用原子向量创建新类对象。在这一小节中，我们将逐步展示百分比形式向
量的创建过程。
首先，定义一个函数：percent( )。这个函数仅仅用于检查输入是不是一个数值向
量，并将输入对象的类改为 percent，percent 类继承 numeric 类：
percent <- function(x) {
stopifnot(is.numeric(x))
class(x) <- c("percent", "numeric")
x
}
这里的继承是指方法分派首先在percent 类的方法中找，如果找不到，就去numeric 类
的方法中找。寻找的顺序由类名称的顺序决定。S3 继承将会在后面内容中进行详细讲解。
现在，我们可以将一个数值向量变成百分比向量：
pct <- percent(c(0.1, 0.05, 0.25, 0.23))
pct
## [1] 0.10 0.05 0.25 0.23
## attr(,"class")
## [1] "percent" "numeric"
因为此时，还没有为 percent 定义实现方法。所以，pct 只是一个具有自定义类属性
的普通数值向量。定义这个类是为了以百分比形式展示向量的值，例如，以 25% 形式展示，
而不是原来的小数形式：
as.character.percent <- function(x, ...) {
paste0(as.numeric(x) *100, "%")
}
现在，我们就可以得到合意的百分比形式的字符向量了：
as.character(pct)
## [1] "10%" "5%" "25%" "23%"
同样地，也可以直接调用 as.character( )为 percent( )提供 format 方法：
format.percent <- function(x, ...) {
as.character(x, ...)
}
这样，format( ) 具有同样的效果：
format(pct)
## [1] "10%" "5%" "25%" "23%"
类似地，直接调用 format.percent( )为 percent( )提供 print 方法：
print.percent <- function(x, ...) {
print(format.percent(x), quote = FALSE)
}
这里，我们指定参数 quote = FALSE，使得打印的格式化字符串更像数字而非字符
串。这也正是我们想要的效果：
pct
## [1] 10% 5% 25% 23%
注意到，算术运算符（例如+和*）会自动保持输出向量的类不改变。因此，输出向量
仍以百分比形式返回：
pct + 0.2
## [1] 30% 25% 45% 43%
pct *0.5
## [1] 5% 2.5% 12.5% 11.5%
遗憾的是，其他函数可能不会继续保持输入对象的类。例如，sum( )、mean( )、
max( )和 min( )就会丢掉自定义的类，返回一个普通的数值向量：
sum(pct)
## [1] 0.63
mean(pct)
## [1] 0.1575
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"))
}
第 1 种方法中，NextMethod("sum")对 numeric 类调用 sum( )函数，然后再调用
percent( )函数将输出的数值向量包装为百分比形式。其他 3 种方法也是同样的逻辑：
sum(pct)
## [1] 63%
mean(pct)
## [1] 15.75%
max(pct)
## [1] 25%
min(pct)
## [1] 5%
现在，这些函数的返回值也是百分比形式了。但是，如果我们组合一个百分比向量和
其他数值型的值，percent 类又会消失掉：
c(pct, 0.12)
## [1] 0.10 0.05 0.25 0.23 0.12
我们对组合函数 c( ) 进行同样的改进：
c.percent <- function(x, ...) {
percent(NextMethod("c"))
}
现在，组合百分比向量和其他数值型的值仍然返回百分比向量：
c(pct, 0.12, -0.145)
## [1] 10% 5% 25% 23% 12% -14.5%
但是，另一方面，当我们对百分比向量构建子集或者从中提取一个值时，percent 类
也会丢失：
pct[1:3]
## [1] 0.10 0.05 0.25
pct[[2]]
## [1] 0.05
为了解决这个问题，我们需要用同样的方式对 percent 实施[和[[。看到一个形如
[.percent 的方法，你可能会觉得很意外，但是当我们对一个百分比向量使用这些操作
符时，它确实匹配了 percent 类：
`[.percent` <- function(x, i) {
percent(NextMethod("["])
}
`[[.percent` <- function(x, i) {
percent(NextMethod("[["))
}
此时，构建子集和提取元素都会保留 percent 类：
pct[1:3]
## [1] 10% 5% 25%
pct[[2]]
## [1] 5%
在实现所有这些方法后，我们可以将百分比向量转换成数据框的一列：
data.frame(id = 1:4, pct)
## id pct
## 1 1 10%
## 2 2 5%
## 3 3 25%
## 4 4 23%
作为数据框的一列，百分比形式被正确保留了下来。
3．S3 继承
S3 系统是非正式的。只需要以 method.class 这种形式创建一个函数，为泛型函数
实现方法分派。而且，只需要提供一个多元素字符向量，就可以反映类之间的继承关系（即
向量中类名称出现的先后顺序）。
正如上一节中提到的，类向量确定了方法分派中匹配类的顺序。我们将用一个简单的
例子进行展示，其中构造了一些具有继承关系的类。
假设，我们想要对一些交通工具，例如对汽车、公共汽车和飞机进行建模。这些交通
工具有一些共性，它们都有名称、速度、位置，而且都可以移动。为了形象化描述它们，我们
定义了一个基本类，称为 vehicle，用于存储这些公共部分。另外定义了 car、bus 和
airplane 这 3 个类（子类），它们继承 vehicle 类（父类），但是各自具有自定义的行为。
首先，定义一个函数来创建 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 既是函数的一个参数，又是一个基础函数，所以
class(obj) <- c(class, "vehicle")可能看起来有些语义不明。实际上，
class(obj) <- 将查找 class <- 函数，所以这种用法不会引起歧义。vehicle( )
函 数 是 具 有 公 共 数 据 字 段 的 车 辆 类 对 象 的 通 用 创 建 者 。 以 下 函 数 是 创 建 继
承 vehicle 的 car、bus 和 airplane 的特定函数：
Car <- function(...) {
Vehicle(class = "car", ...)
}
Bus <- function(...) {
Vehicle(class = "bus", ...)
}
Airplane <- function(...) {
Vehicle(class = "airplane", ...)
}
使用上面 3 个函数，我们就可以创建这 3 个对象：car、bus 和 airplane。它们都继
承 vehicle 类。现在，我们为每个类创建一个对象实例：
car <- Car("Model-A", 80)
bus <- Bus("Medium-Bus", 45)
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 = ", "))
}
我们在上一小节提到过，所谓继承是指子类从父类继承方法。如果子类中不存在某个方法，
那么就会使用父类中的方法。因为没有定义print.car、print.bus 或者print.airplane，
所以打印car、bus 和airplane 这些变量的时候，就会调用print.vehicle( )：
car
## <vehicle: car>
## name: Model-A
## speed: 80 km/h
## position: 0, 0, 0
bus
## <vehicle: bus>
## name: Medium-Bus
## speed: 45 km/h
## position: 0, 0, 0
airplane
## <vehicle: airplane>
## name: Big-Plane
## speed: 800 km/h
## position: 0, 0, 0
交通工具是被设计为驾驶和移动的运载工具。自然地，我们可以定义一个名为 move 的
泛型函数，用来修改交通工具的位置以反映用户提供的三维空间中的移动。由于不同的交
通工具以不同的方式移动，并且具有明显的局限性，所以我们可以为刚刚定义的不同类的
交通工具进一步实施几种不同的 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
}
这里，我们将汽车和公共汽车的移动限定在二维平面上。通过检查movement 向量的长度
（只允许为2），实现 move.bus 和 move.car 两种方法。如果提供的 movement 向量是无效的，
则将 movement 的第 3 个维度强制转换为 0，然后通过调用 NextMethod("move")来调
用 move.vehicle( )，并且其参数为 vehicle 和转换后最新的 movement：
move.bus <- move.car <- function(vehicle, movement) {
if (length(movement) != 2) {
stop("This vehicle only supports 2d movement")
}
movement <- c(movement, 0)
NextMethod("move")
}
飞机可以在二维平面上移动，也可以在三维空间中移动。因此，move.airplane 相对灵
活，二者都可以接收。如果movement 向量是二维的，相当于movement 的第3 个维度为0：
move.airplane <- function(vehicle, movement) {
if (length(movement) == 2) {
movement <- c(movement, 0)
}
NextMethod("move")
}
至此，move 方法对 3 种交通工具都能实现了，我们可以用 3 个对象实例进行检验。
首先，看一下这种情况：我们为汽车提供了一个三维向量，想让它移动，但是表达式返回
了错误信息。
move(car, c(1, 2, 3))
## Error in move.car(car, c(1, 2, 3)): This vehicle only supports 2d movement
虽然上述函数调用的方法分派找到了方法 move.car( )，但是却因参数 movement
无效而终止运行。下面这段代码提供了有效的二维 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
也可以让飞机在三维空间中移动：
move(airplane, c(20, 50, 80))
## <vehicle: airplane>
## name: Big-Plane
## speed: 800 km/h
## position: 21, 52, 80
注意到，对象 airplane 的位置是累积的，因为它本质上是一个环境，因此，修改
move.vehicle( )中的 position 不会创建一个副本再修改，而是本地修改。无论你在
任何地方传递对象 airplane，它只会有一个实例版本。