Найти максимум из комбинации двух таблиц (слишком медленный цикл)

Question

У меня есть таблица данных «the.data», где в первом столбце указаны измерительный инструмент, а остальные разные измеренные данные.

instrument <- c(1,2,3,4,5,1,2,3,4,5) 
hour <- c(1,1,1,1,1,2,2,2,2,2) 
da <- c(12,14,11,14,10,19,15,16,13,11) 
db <- c(21,23,22,29,28,26,24,27,26,22) 
the.data <- data.frame(instrument,hour,da,db) 

Я также определили группы инструментов, в которых, например, группы 1 (g1) относится к инструментам 1 и 2.

g1 <- c(1,2) 
g2 <- c(4,3,1) 
g3 <- c(1,5,2) 
g4 <- c(2,4) 
g5 <- c(5,3,1,2,6) 
groups <- c("g1","g2","g3","g4","g5") 

мне нужно, чтобы узнать, на которой час сумма каждой группы имеет максимум для каждого типа данных и его сумму.

g1 час 1: сумма (да) = 12 + 14 = 26 g1 час 2: сумма (да) = 19 + 15 = 34

Таким образом, для g1 и да ответ час 2 и значение 34.

Я сделал это с помощью цикла for внутри цикла, но это занимает слишком много времени (я прерывался через несколько часов). Проблема в том, что the.data составляет около 100 000 строк в длину и что существует около 5.000 групп с 2-50 инструментами каждый.

Что может быть хорошим методом для этого?

Искренне благодарим всех участников Stack-overflow.

Обновление: теперь только пять групп в примерах.

/Chris

Answer 1

Петля group должны остаться, или в лучшем случае можно заменить на что-то вроде lapply(). Однако цикл hour можно полностью заменить, переформатировав на матрицу instrument x hour, а затем просто выполнив векторизованную алгебру. Например:

library(reshape2) 

groups = list(g1, g3) 

the.data.a = dcast(the.data[,1:3], instrument ~ hour) 

> sapply(groups, function(x) data.frame(max = max(colSums(the.data.a[x, -1])), 
             ind = which.max(colSums(the.data.a[x, -1])))) 
    [,1] [,2] 
max 34 45 
ind 2 2 

Answer 2

Вот один подход с использованием plyr и reshape2 от Хэдли. Во-первых, мы добавим некоторые логические значения в the.data в зависимости от того, находится ли этот инструмент в этой группе. Затем мы расплавим его в длинный формат, подмножим строки, которые нам не нужны, а затем выполните группу с помощью ddply или data.table.

#add boolean columns 
the.data <- transform(the.data, 
         g1 = instrument %in% g1, 
         g2 = instrument %in% g2, 
         g3 = instrument %in% g3, 
         g4 = instrument %in% g4, 
         g5 = instrument %in% g5 
        ) 

#load library 
library(reshape2) 
#melt into long format 
the.data.m <- melt(the.data, id.vars = 1:4) 
#subset out data that that has FALSE for the groupings 
the.data.m <- subset(the.data.m, value == TRUE) 

#load plyr and data.table 
library(plyr) 
library(data.table) 

#plyr way 
ddply(the.data.m, c("variable", "hour"), summarize, out = sum(da)) 
#data.table way 
dt <- data.table(the.data.m) 
dt[, list(out = sum(da)), by = "variable, hour"] 

У некоторых бенчмаркинга, чтобы увидеть, что быстрее:

library(rbenchmark) 
f1 <- function() ddply(the.data.m, c("variable", "hour"), summarize, out = sum(da)) 
f2 <- function() dt[, list(out = sum(da)), by = "variable, hour"] 

> benchmark(f1(), f2(), replications=1000, order="elapsed", columns = c("test", "elapsed", "relative")) 
    test elapsed relative 
2 f2() 3.44 1.000000 
1 f1() 6.82 1.982558 

Так, data.table примерно 2 раза быстрее для этого примера. Ваши мили могут отличаться.

И просто чтобы показать, что это дает правильные значения:

> dt[, list(out = sum(da)), by = "variable, hour"] 
     variable hour out 
[1,]  g1 1 26 
[2,]  g1 2 34 
[3,]  g2 1 25 
[4,]  g2 2 29 

... 

Answer 3

Вы не предоставили свой код (или программный способ для создания групп, которые, казалось бы, необходимо со счетчиком группы 5000), но это может быть более эффективное использование R:

groups <- list(g1,g2,g3,g4,g5) 
gmax <- list() 
# The "da" results 
for(gitem in seq_along(groups)) { 
     gmax[[gitem]] <- with(subset(the.data , instrument %in% groups[[gitem]]), 
           tapply(da , hour, sum)) } 
damat <- matrix(c(sapply(gmax, which.max), 
        sapply(gmax, max)) , ncol=2) 

# The "db" results 
for(gitem in seq_along(groups)) { 
     gmax[[gitem]] <- with(subset(the.data , instrument %in% groups[[gitem]]), 
           tapply(db , hour, sum)) } 
dbmat <- matrix(c(sapply(gmax, which.max), 
        sapply(gmax, max)) , ncol=2) 

#-------- 
> damat 
    [,1] [,2] 
[1,] 2 34 
[2,] 2 29 
[3,] 2 45 
[4,] 1 14 
[5,] 2 42 
> dbmat 
    [,1] [,2] 
[1,] 2 50 
[2,] 2 53 
[3,] 1 72 
[4,] 1 29 
[5,] 1 73 

Answer 4

Вот несколько модифицированный вариант John Colby's answer, с некоторыми образцами данных.

set.seed(21) 
instrument <- sample(100, 1e5, TRUE) 
hour <- sample(24, 1e5, TRUE) 
da <- trunc(runif(1e5)*10) 
db <- trunc(runif(1e5)*10) 
the.data <- data.frame(instrument,hour,da,db) 
groups <- replicate(5000, sample(100, sample(50,1))) 
names(groups) <- paste("g",1:length(groups),sep="") 

library(reshape2) 
system.time({  
the.data.a <- dcast(the.data[,1:3], instrument ~ hour, sum) 
out <- t(sapply(groups, function(i) { 
    byHour <- colSums(the.data.a[i,-1]) 
    c(max(byHour), which.max(byHour)) 
})) 
colnames(out) <- c("max.hour","max.sum") 
}) 
# Using da as value column: use value.var to override. 
# user system elapsed 
# 3.80 0.00 3.81