定义 S4 类

S3 类仅用一个字符向量表示，与之不同的是，S4 类要求对类和方法有正式定义。为了
定义一个 S4 类，我们需要调用 setClass( )，并提供一种类成员的表示，这种表示被称
为字段（slots）。通过名称和每个字段的类来指定这种表示。本节中，我们使用 S4 类重新
定义 product 对象：
setClass("Product",
representation(name ="character",

price = "numeric",
inventory = "integer"))
一旦类被定义了，就可以使用 getSlots( ) 从类定义中获取字段：
getSlots("Product")
## name price inventory
## "character" "numeric" "integer"
S4 比 S3 更严谨，不仅因为 S4 要求类定义，还因为 R 能够确保新创建的对象实例中成
员的类与原来的类表示是一致的。现在，我们使用 new( ) 创建一个新的 S4 类对象实例，
并且指定字段的取值：
laptop <- new("Product", name = "Laptop-A", price = 299, inventory = 100)
## Error in validObject(.Object): invalid class "Product" object: invalid
object for slot "inventory" in class "Product": got class "numeric", should be
or extend class "integer"
上述代码产生了错误，这可能会让你觉得惊讶。如果仔细查看一下类表示，就会发现
inventory 必须是整数。换句话说，100 是个数值，它的类不是 integer。相反，应该
使用 100L：
laptop <- new("Product", name = "Laptop-A", price = 299, inventory = 100L)
laptop
## An object of class "Product"
## Slot "name":
## [1] "Laptop-A"
##
## Slot "price":
## [1] 299
##
## Slot "inventory":
## [1] 100
现在，一个 Product 类的新对象实例 laptop 已经创建好了，并且作为 Product 类
的一个对象被打印出来，所有字段的值也被自动打印出来。
对于一个 S4 对象，我们仍然可以使用 typeof( )和 class( )来获取类型信息：
typeof(laptop)
## [1] "S4"
class(laptop)
## [1] "Product"
## attr(,"package")
## [1] ".GlobalEnv"
这次，对象的类型是 S4，而非列表或其他数据类型，而且它的类是 S4 类中的名字。
S4 对象也是 R 中的“一等公民”，因为它有对应的检查函数：
isS4(laptop)
## [1] TRUE
与使用 $ 访问一个列表或环境不同，我们需要使用 @ 来访问一个 S4 对象的字段：
laptop@price *laptop@inventory
## [1] 29900
此外，我们还可以调用 slot( )，以字符形式提供字段名来访问一个字段。这与使用
双层方括号（[[ ]]）访问列表或环境的元素是等价的：
slot(laptop, "price")
## [1] 299
也可以用修改列表的方式修改一个 S4 对象：
laptop@price <- 289
但是，不能提供给字段与类表示不一致的内容：
laptop@inventory <- 200
## Error in (function (cl, name, valueClass) : assignment of an object of
class "numeric" is not valid for @'inventory' in an object of class "Product";
is(value, "integer") is not TRUE
也不能像给列表添加成分那样创建一个新的字段，因为 S4 对象的结构是根据它的类表
示固定下来的：
laptop@value <- laptop@price *laptop@inventory
## Error in (function (cl, name, valueClass) : 'value' is not a slot in class
"Product"
现在，我们创建另一个对象实例，但是只提供部分字段值：
toy <- new("Product", name = "Toys", price = 10)
toy
## An object of class "Product"
## Slot "name":
## [1] "Toys"
##
## Slot "price":
## [1] 10
##
## Slot "inventory":
## integer(0)
上述代码没有指定字段 inventory，所以结果对象 toy 选取了一个空的整数向量作
为 inventory。如果你认为这并不是一个合意的默认值，我们可以指定类的原型，这样
将会以它作为模板创建每个对象实例：
setClass("Product",
representation(name = "character",
price = "numeric",
inventory = "integer"),
prototype(name = "Unnamed", price = NA_real_, inventory = 0L))
在上面这个原型中，我们将 price 的默认值设定为数值型缺失值，将 inventory 的
默认值设定为整数。注意到 NA 是一个逻辑值，与类表示不一致，所以不能用在这里。
然后，我们就可以使用相同的代码重新创建 toy：
toy <- new("Product", name = "Toys", price = 10)
toy
## An object of class "Product"
## Slot "name":
## [1] "Toys"
##
## Slot "price":
## [1] 10
##
## Slot "inventory":
## [1] 0
这次，inventory 取原型中的默认值 0L。然而，如果我们需要对输入参数施加更多
约束呢？尽管参数的类会被检查，但是仍然可以提供对 Product 类的对象实例无意义的
值。举个例子，我们可以创建一个有负库存的 bottle 对象：
bottle <- new("Product", name = "Bottle", price = 1.5, inventory = -2L)
bottle
## An object of class "Product"
## Slot "name":
## [1] "Bottle"
##
## Slot "price":
## [1] 1.5
##
## Slot "inventory":
## [1] -2
接下来的代码创建了一个验证函数，用于确保一个 Product 类的对象的字段是有意
义的。这个验证函数有些特殊，因为当输入对象没有错误时，函数返回 TRUE；当输入对象
有错误时，函数返回一个字符向量来描述错误。因此，当字段无效时，最好不要使用 stop( )
或者 warning( )。
这里，我们通过检查每个字段的长度和它们是不是缺失值来验证对象的有效性。而且，
price 必须是正数，inventory 必须是非负数：
validate_product <- function(object) {
errors <- c(
if (length(object@name) != 1)
"Length of name should be 1"
else if (is.na(object@name))
"name should not be missing value",
if (length(object@price) != 1)
"Length of price should be 1"
else if (is.na(object@price))
"price should not be missing value"
else if (object@price <= 0)
"price must be positive",
if (length(object@inventory) != 1)
"Length of inventory should be 1"
else if (is.na(object@inventory))
"inventory should not be missing value"
else if (object@inventory < 0)
"inventory must be non-negative")
if (length(errors) == 0) TRUE else errors
}
我们编写了这个很长的函数，考虑所有可能出现的错误值，并明确标注每种情况的错
误信息。这个函数是可以运行的，因为表达式 if (FALSE) expr 返回 NULL，而
c(x, NULL)返回 x。最后如果没有产生错误信息，函数返回 TRUE，否则返回错误信息。
定义了这个函数，我们就可以直接使用它对 bottle 进行验证：
validate_ _product(bottle)
## [1] "inventory must be non-negative"
验证函数返回了预料之中的错误信息。现在，我们可以进一步改进类定义函数，使其
每次创建一个新的对象实例时，都会执行验证过程。当使用 setClass( )定义 Product
类时，只需指定 validity 参数：
setClass("Product",
representation(name = "character",
price = "numeric",
inventory = "integer"),
prototype(name = "Unnamed",
price = NA_real_, inventory = 0L),
validity = validate_product)
这样每次创建 Product 类的对象实例时，我们提供的值都会被自动检查。甚至原型
也会被检查。下面是两种没有通过验证的情况。
第 1 种情况：
bottle <- new("Product", name = "Bottle")
## Error in validObject(.Object): invalid class "Product" object: price
should not be missing value
上述代码无效，因为原型中 price 的默认值是 NA_real_。而在验证函数中，价格不
能是缺失值。
第 2 种情况：
bottle <- new("Product", name = "Bottle", price = 3, inventory = -2L)
## Error in validObject(.Object): invalid class "Product" object: inventory
must be non-negative
这次失效的原因是 inventory 必须是非负整数。
注意到，只有在创建一个新的 S4 类对象实例时，才会对其进行验证。一旦对象被创建
出来，就再也不会进行验证了。换句话说，除非我们再次明确地对其进行验证，否则仍然
可以设定一个糟糕的字段值。