A sapply версия. Возможно, существуют более изящные способы ее написания, но если у вас большие таблицы, как вы сказали, вы можете легко распараллелить их.
Используя данные, предложенные @denis:
df1 <- data.frame(ID = c("A","B","C"))
df2 <- read.table(text = "
ID Color Type Price
A Green 1 5
A Blue 2 6
A Blue 2 4
B Green 3 7
B Blue 2 2
C Green 2 4
C Blue 4 5
D Green 2 2
D Blue 4 8
",header = T)
Вот простая функция, которая делает то, что вы хотите с sapply:
getPrices <- function(tableid=df1,tablevalues=df2,color="Blue",type=2){
filteredtablevalues <- droplevels(tablevalues[ tablevalues$Color == "Blue" & tablevalues$Type == 2 & tablevalues$ID %in% df1$ID,])
#droplevels could be skipped by using unique(as.character(filteredtablevalues$ID)) in the sapply, not sure what would be the quickest
sapply(levels(filteredtablevalues$ID),function(id,tabval)
{
sum(tabval$Price[tabval$ID == id])
},tabval=filteredtablevalues)
}
Как вы видите, я добавил два параметра, которые позволяют вам выбрать для пары цвет / тип. И вы можете добавить это:
tmp=getPrices(df1,df2)
finaltable=cbind.data.frame(ID=names(tmp),Price=tmp)
Если вам абсолютно необходим фрейм данных с идентификатором столбца и ценой столбца.
Я попробую провести тестирование, когда у меня будет время, но написанное таким образом, вы сможете легко распараллелить это с library(parallel) и library(Rmpi), что может спасти вам жизнь, если у вас очень и очень большие наборы данных.
РЕДАКТИРОВАТЬ:
Benchmark:
Мне не удалось воспроизвести пример dplyr, предложенный @denis, но я мог сравнить версию data.table:
#Create a bigger dataset
nt=10000 #nt as big as you want
df2=rbind.data.frame(df2,
list(ID= sample(c("A","B","C"),nt,replace=T),
Color=sample(c("Blue","Green"),nt,replace=T),
Type=sample.int(5,nt,replace=T),
Price=sample.int(5,nt,replace=T)
)
)
Вы можете тестировать, используя library(microbenchmark):
library(microbenchmark)
microbenchmark(sply=getPrices(df1,df2),dtbl=setDT(df2)[ID %in% unique(df1$ID), .(sum = sum(Price[ Type == 2 & Color == "Blue"])),by = ID],dplyr=df2 %>% filter(ID %in% unique(df1$ID)) %>% group_by(ID) %>% summarize(sum = sum(Price[Type==2 & Color=="Blue"])))
На моем компьютере выдает:
Unit: milliseconds
expr min lq mean median uq max neval
sply 78.37484 83.89856 97.75373 89.17033 118.96890 131.3226 100
dtbl 75.67642 83.44380 93.16893 85.65810 91.98584 137.2851 100
dplyr 90.67084 97.58653 114.24094 102.60008 136.34742 150.6235 100
Edit2:
sapply выглядит немного быстрее, чем data.table, хотя и незначительно. Но использование sapply может быть очень полезным, если у вас огромный стол ID. Затем вы используете library(parallel) и получаете еще больше времени.
Теперь подход data.table кажется самым быстрым. Но все же, преимущество sapply в том, что вы можете легко распараллелить его. Хотя в этом случае и с учетом того, как я написал функцию getPrices, она будет эффективной, только если ваша таблица ID огромна.