如何在 R 中自动更新 S4 类的插槽

Question

我在 R 中玩 S4 对象，想知道以下问题：

假设以下简化示例：我们在 R 中有两个 S4 类，一个称为 Customer，另一个称为 Order。我们使用以下插槽定义它们：

Customer <- setClass(Class = "Customer",slots = c(CustomerID = "numeric", Name = "character", OrderHistory = "data.frame"),
                     prototype = list(CustomerID = 0,Name = "",OderHistory = data.frame()))

Order <- setClass(Class = "Order",slots = c(CustomerID = "numeric", Description = "character",
                                               Cost = "numeric"), 
                     prototype = list(CustomerID = 0,Description = "",Cost = 0))


# constructor

Customer <- function(CustomerID, Name, OrderHistory=data.frame()){
  #drop sanity checks
  new("Customer",CustomerID = CustomerID, Name = Name, OrderHistory = OrderHistory)
}

Order <- function(CustomerID, Description = "",Cost = 0){
  #drop sanity checks
  new("Order",CustomerID = CustomerID, Description = "", Cost = 0)
}

#create two objects

firstCustomer <- Customer(1,"test")

firstOrder <- Order(1,"new iPhone", 145)

显然，firstCustomer 和 firstOrder 是通过 CustomerID 链接的。是否可以在创建新的 Order 实例后自动更新 Customer 的 OrderHistory 槽？假设 OrderHistory 有两列，“Description”和“Cost”，我怎样才能自动更新一个新的订单实例？有没有一种优雅/通用的方法来做到这一点？最有可能的是，订单类需要一个“客户”类型的插槽。非常感谢提前

Answer 1

您不能链接两个独立的对象，因此您需要同时使用这两个对象的方法。下面是一个替换方法的例子：

Customer <- setClass(
  "Customer", 
  slots=c(
    CustomerID="numeric", 
    Name="character", 
    OrderHistory="list"
  ),
  prototype=list(OrderHistory = list())
)
Order <- setClass(
  Class="Order", 
  slot =c(
    Description="character", Cost="numeric"
) )

setGeneric(
  "add<-", 
  function(object, value, ...) StandardGeneric("add<-")
)
setMethod("add<-", c("Customer", "Order"), 
  function(object, value) {
    object@OrderHistory <- append(object@OrderHistory, value)
    object    
  }
)
setMethod("show", "Customer", 
  function(object) {
    cat("** Customer #", object@CustomerID, ": ", object@Name, "\n\n", sep="")
    for(i in object@OrderHistory) cat("\t", i@Description, "\t", i@Cost, "\n", sep="")
  }
)

firstCustomer <- new("Customer", CustomerID=1, Name="test")
add(firstCustomer) <- new("Order", Description="new iPhone", Cost=145)
add(firstCustomer) <- new("Order", Description="macbook", Cost=999)

firstCustomer

生产：

** Customer #1: test

  new iPhone  145
  macbook 999

Answer 2

以下内容并未添加到@BrodieG 的方法中，但强调您可能希望对客户、项目等的表 进行建模，而不是对单个客户等进行建模。此外，在许多情况下，我认为类就像数据库表，良好的数据库设计原则可能适用于良好的类设计（再次记住 S4 类和 R 的更改时复制语义意味着类模型 列 而不是许多其他语言中的 rows）。

## Customers -- analogous to a data.frame or data base table
setClass(Class = "Customers",
  slots = c(CustomerId = "integer", Name = "character"))

## Items -- analogous to a data.frame or data base table
setClass(Class = "Items",
  slots = c(ItemId = "integer", Description = "character", Cost = "numeric"))

## Transactions -- analogous to a data.frame or data base table
setClass(Class="Transactions",
  slots = c(TransactionId="integer", CustomerId="integer", ItemId="integer"))

您可能会在这些表之间提供某种明确的协调

## Business -- analogous to a data *base*
Business = setClass(Class = "Business",
  slots = c(Customers="Customers", Items="Items", Transactions="Transactions"))

为了完整起见，这里有一个最小的实现，从一些用于生成顺序 ID 和更新对象槽的实用函数开始

.nextid <- function(x, slotName, n=1L)
    max(0L, slot(x, slotName)) + seq_len(n)

.update <- function(x, ...) {
    args <- list(...)
    for (nm in names(args))
        args[[nm]] <- c(slot(x, nm), args[[nm]])
    do.call("initialize", c(list(x), args))
}

以下将客户和商品的向量添加到业务中

add_customers <- function(business, customerNames)
{
    customers <- slot(business, "Customers")
    len <- length(customerNames)
    initialize(business,
               Customers=.update(customers,
                 CustomerId=.nextid(customers, "CustomerId", len),
                 Name=customerNames))
}

add_items <- function(business, descriptions, costs)
{
    items <- slot(business, "Items")
    len <- length(descriptions)
    initialize(business,
               Items=.update(items,
                 ItemId=.nextid(items, "ItemId", len),
                 Description=descriptions, Cost=costs))
}

最后在交易表中记录购买；我们希望它对用户更加友好，使用 purchase() 函数获取客户和项目名称，并将它们映射到客户和项目 ID。

.purchase <- function(business, customerId, itemIds)
{
    transactions <- slot(business, "Transactions")
    len <- length(itemIds)
    initialize(business,
               Transactions=.update(transactions,
                 TransactionId=rep(.nextid(transactions, "TransactionId"), len),
                 CustomerId=rep(customerId, len),
                 ItemId=itemIds))
}

我们的业务在行动

bus <- Business()
bus <- add_customers(bus, c("Fred", "Barney"))
bus <- add_items(bus, c("Phone", "Tablet"), c(200, 250))
bus <- .purchase(bus, 1L, 1:2)  # Fred buys Phone, Tablet
bus <- .purchase(bus, 2L, 2L)   # Barney buys Tablet

以及我们的总销售额（我们需要很好的访问器）

> sum(bus@Items@Cost[bus@Transactions@ItemId])
[1] 700

R 的 copy-on-change 语义很可能意味着这种类型的迭代更新非常效率低下；我们可能对此很聪明，或者认识到我们正在重新发明数据库接口，并在 SQL 中实现后端。