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

时间:2015-04-21 18:06:24

标签: r s4

我正在玩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链接的。创建新订单实例后,是否可以自动更新Customer的OrderHistory槽?假设OrderHistory有两列,&#34;描述&#34;和&#34;成本&#34;,如何自动更新新的订单实例?有优雅/一般的方法吗?最有可能的是,订单类需要一个类型为&#34; Customer&#34;的插槽。非常感谢提前

2 个答案:

答案 0 :(得分:3)

您无法链接两个独立的对象,因此您需要使用两者的方法。以下是替换方法的示例:

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

答案 1 :(得分:2)

以下内容并未添加到@ BrodieG的方法中,但强调您可能希望对客户,项目等的进行建模,而不是个人客户&amp; C。此外,在许多情况下,我认为类就像数据库表,良好的数据库设计原则可能适用于良好的类设计(再次记住S4类和R&#39; s copy-on-change语义意味着类模型而非与许多其他语言一样。)

## 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的变更复制语义可能意味着这种类型的迭代更新非常效率低下;我们可以聪明一点,或者认识到我们正在重新发明数据库的接口,并在SQL中实现后端。