how to automatically update a slot of S4 class in R

Question

I was playing around with S4 objects in R and was wondering about the following:

Let's assume the following simplified example: We have two S4 classe within R, one called Customer and another Order. We define them with the following slots:

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)

Obviously, firstCustomer and firstOrder are linked via the CustomerID. Is it possible to automatically update the OrderHistory slot of Customer once a new Order instance is created? Assuming that OrderHistory has two columns, "Description" and "Cost", how can I automatically update a new order instance? Is there a elegant / general way to do it? Most likely, the class Order needs a slot of type "Customer". Many thanks in advance

Answer 1

You can't link across two independent objects, so you need methods that use both. Here is an example with a replacement method:

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

Produces:

** Customer #1: test

  new iPhone  145
  macbook 999