как автоматически обновить слот класса S4 в R
Я играл с объектами S4 в R и задавался вопросом о следующем:
Предположим следующий упрощенный пример: у нас есть два класса S4 внутри R, один называется 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. Можно ли автоматически обновить слот OrderHistory клиента после создания нового экземпляра заказа? Если предположить, что OrderHistory имеет два столбца, "описание" и "стоимость", как я могу автоматически обновить новый экземпляр заказа? Есть ли элегантный / общий способ сделать это? Скорее всего, классу Order нужен слот типа "Customer". Заранее большое спасибо
2 ответов:
Вы не можете связать два независимых объекта, поэтому вам нужны методы, которые используют оба. Вот пример с методом замены:
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
Следующее не добавляет к подходу @BrodieG, но подчеркивает, что вы, вероятно, хотите смоделироватьтаблицы клиентов, товаров и т. д. кроме того, во многих случаях я думаю, что классы подобны таблицам базы данных, и принципы хорошего дизайна базы данных, вероятно, применимы к хорошему дизайну классов (опять же, вспоминая классы S4 и семантику копирования при изменении R, означают, что классы моделируют столбцы, а не строки, как во многих других случаях). языки).
## 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"))Для небольшой полноты, вот минимальная реализация, начинающаяся с некоторых служебных функций для генерации последовательных идентификаторов и обновления слотов объектов
.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(), берущей имена клиентов и номенклатур и сопоставляющей их с идентификаторами клиентов и номенклатур..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И наши общие продажи (мы хотели бы иметь хорошие аксессуары для этого)
Семантика копирования при изменении R, вероятно, означает, что этот тип итеративного обновления очень неэффективен; мы могли бы быть умными в этом или признать, что мы повторно изобретаем интерфейс к базе данных, и реализовать бэк-энд в SQL.> sum(bus@Items@Cost[bus@Transactions@ItemId]) [1] 700
Comments