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

Question

我在 R 中玩弄 S4 对象，想知道以下内容：

让我们假设以下简化示例：我们在 R 中有两个 S4 classe，一个名为 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"，我怎样才能自动更新一个新的订单实例？有没有一种优雅/通用的方法来做到这一点？最有可能的是，class 订单需要类型为 "Customer" 的槽位。非常感谢

Answer 1

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

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 的方法中，但强调您可能想要对客户、项目等的 tables 进行建模，而不是个人客户等此外，在许多情况下，我认为 classes 就像数据库 tables，良好的数据库设计原则可能适用于良好的 class 设计（再次记住 S4 class ]es 和 R 的 copy-on-change 语义意味着 classes 模型 columns 而不是 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"))

您可能会在这些 table

之间提供某种明确的协调

## 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))
}

最后在交易中记录购买table；我们希望这对用户更友好，使用 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.

中实现后端

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

how to automatically update a slot of S4 class in R

r

s4