Data.table loop efficiency

Question

У меня есть два data.tables, которые содержат 34 столбца, где столбцы точно такие же.

Month SpId1 SpId2 ... SpId33 

Редактировать: Ниже приведен пример данных с использованием функции от Reproducible Example воспроизведите

AltSuitSp1 <- data.table(structure(list(Month = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 2L,12L, 12L, 12L), .Label = c("1", "10", "11", "12", "2", "3", "4","5", "6", "7", "8", "9"), class = "factor"), SpdSpSuit = c(0,0, 0, 0, 0, 0, 0, 0, 0, 0), SpdIncSuit = c(0, 0, 0,0, 0, 0, 0, 0, 0, 0), SpdGrowSuit = c(0.4625, 0.4625, 0.4625, 0.4625, 0.4625, 0.4625, 0.4625,0.4625, 0.4625, 0.4625), RzbSpSuit = c(0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333,0.283333333, 0.283333333, 0.283333333, 0.283333333), RzbIncSuit = c(0.34,0.34, 0.34, 0.34, 0.34, 0.34, 0.34, 0.34, 0.34, 0.34), RzbGrowSuit = c(0.283333333,0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333), FMSSpSuit = c(0.34,0.34, 0.34, 0.34, 0.34, 0.34, 0.34, 0.34, 0.34, 0.34), FMSIncSuit = c(0.425, 0.425, 0.425, 0.425, 0.425, 0.425, 0.425, 0.425, 0.425, 0.425), FMSGrowSuit = c(0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333), BhsSpSuit = c(0.283333333,0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.233333333, 0.233333333, 0.233333333), BhsIncSuit = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), BhsGrowSuit = c(0.283333333,0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.233333333, 0.233333333, 0.233333333), BrtSpSuit = c(0.866666667,0.866666667, 0.866666667, 0.866666667, 0.866666667, 0.866666667,0.866666667, 0.54, 0.54, 0.54), BrtIncSuit = c(0.8, 0.8, 0.8, 0.8, 0.8,0.8, 0.8, 0.43, 0.43, 0.43), BrtGrSuit = c(0.8, 0.8, 0.8, 0.8, 0.8, 0.8,0.8, 0.86, 0.86, 0.86), CcfSpSuit = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), CcfIncSuit = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0),CcfGrSuit = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), GsfSpSuit = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), GsfIncSuit = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), GsfGrSuit = c(0, 0, 0, 0, 0,0, 0, 0, 0, 0), RbtSpSuit = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), RbtIncSuit = c(0, 0, 0, 0, 0, 0, 0, 0, 0,0), RbtGrSuit = c(0.95, 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, 0.925, 0.925, 0.925), SmbSpSuit = c(0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.675, 0.675,0.675), SmbIncSuit = c(0.75, 0.75, 0.75, 0.75, 0.75, 0.75, 0.75, 0.766666667,0.766666667, 0.766666667), SmbGrSuit = c(0.9, 0.9, 0.9, 0.9, 0.9, 0.9, 0.9, 0.0875, 0.0875, 0.0875), StbSpSuit = c(0.425, 0.425, 0.425, 0.425, 0.425, 0.425, 0.425, 0.425, 0.425, 0.425), StbIncSuit = c(0, 0,0, 0, 0, 0, 0, 0, 0, 0), StbGrSuit = c(0, 0, 0, 0, 0,0, 0, 0, 0, 0), HbcSpSuit = c(0, 0, 0, 0, 0, 0, 0,0, 0, 0), HbcIncSuit = c(0, 0, 0, 0, 0, 0, 0, 0, 0,0), HbcGrSuit = c(0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.425, 0.425, 0.425)), .Names = c("Month", "SpdSpSuit", "SpdIncSuit", "SpdGrowSuit","RzbSpSuit", "RzbIncSuit", "RzbGrowSuit", "FMSSpSuit", "FMSIncSuit","FMSGrowSuit", "BhsSpSuit", "BhsIncSuit", "BhsGrowSuit", "BrtSpSuit","BrtIncSuit", "BrtGrSuit", "CcfSpSuit", "CcfIncSuit", "CcfGrSuit","GsfSpSuit", "GsfIncSuit", "GsfGrSuit", "RbtSpSuit", "RbtIncSuit","RbtGrSuit", "SmbSpSuit", "SmbIncSuit", "SmbGrSuit", "StbSpSuit","StbIncSuit", "StbGrSuit", "HbcSpSuit", "HbcIncSuit", "HbcGrSuit"), class = c("data.table", "data.frame"), row.names = c(NA, -10L))) 

AltSuitDates <- data.table(structure(list(Month = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 10L, 11L,12L), SpdSpT = c(NA, NA, NA, NA, NA, 1L, 1L, NA, NA, NA), SpdIncT = c(NA,NA, NA, NA, NA, 1L, 1L, NA, NA, NA), SpdGrT = c(1L, 1L, 1L, 1L,1L, 1L, 1L, 1L, 1L, 1L), RzbSpT = c(NA, NA, NA, 1L, 1L, 1L, NA,NA, NA, NA), RzbIncT = c(NA, NA, NA, 1L, 1L, 1L, NA, NA, NA,NA), RzbGrT = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), FmsSpT = c(NA,NA, 1L, 1L, NA, NA, NA, NA, NA, NA), FmsIncT = c(NA, NA, 1L,1L, 1L, NA, NA, NA, NA, NA), FMSGrT = c(1L, 1L, 1L, 1L, 1L, 1L,1L, 1L, 1L, 1L), BhsSpT = c(NA, NA, NA, 1L, 1L, 1L, NA, NA, NA,NA), BhsIncT = c(NA, NA, NA, 1L, 1L, 1L, NA, NA, NA, NA), BhsGrT = c(1L,1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), BRTsp = c(1L, 1L, 1L, NA,NA, NA, NA, 1L, 1L, 1L), BRTinc = c(1L, 1L, 1L, 1L, NA, NA, NA,1L, 1L, 1L), BRTgr = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), CCFsp = c(NA, NA, NA, NA, 1L, 1L, 1L, NA, NA, NA), CCFinc = c(NA,NA, NA, NA, 1L, 1L, 1L, NA, NA, NA), CCFgr = c(1L, 1L, 1L, 1L,1L, 1L, 1L, 1L, 1L, 1L), GSFsp = c(NA, NA, NA, NA, 1L, 1L, 1L,NA, NA, NA), GSFinc = c(NA, NA, NA, NA, 1L, 1L, 1L, NA, NA, NA), GSFgr = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), RBTsp = c(1L,1L, 1L, 1L, 1L, 1L, 1L, NA, NA, NA), RBTinc = c(1L, 1L, 1L, 1L,1L, 1L, 1L, NA, NA, NA), RBTgr = c(1L, 1L, 1L, 1L, 1L, 1L, 1L,1L, 1L, 1L), SMBsp = c(NA, NA, NA, 1L, 1L, 1L, 1L, NA, NA, NA), SMBinc = c(NA, NA, NA, 1L, 1L, 1L, 1L, NA, NA, NA), SMBgr = c(1L,1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), STBsp = c(NA, NA, NA, NA,NA, 1L, 1L, NA, NA, NA), STBinc = c(NA, NA, NA, NA, NA, 1L, 1L,NA, NA, NA), STBgr = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), HBCsp = c(NA, NA, NA, 1L, 1L, 1L, NA, NA, NA, NA), HBCinc = c(NA,NA, NA, 1L, 1L, 1L, NA, NA, NA, NA), HBCgr = c(1L, 1L, 1L, 1L,1L, 1L, 1L, 1L, 1L, 1L)), .Names = c("Month", "SpdSpT", "SpdIncT","SpdGrT", "RzbSpT", "RzbIncT", "RzbGrT", "FmsSpT", "FmsIncT","FMSGrT", "BhsSpT", "BhsIncT", "BhsGrT", "BRTsp", "BRTinc", "BRTgr","CCFsp", "CCFinc", "CCFgr", "GSFsp", "GSFinc", "GSFgr", "RBTsp","RBTinc", "RBTgr", "SMBsp", "SMBinc", "SMBgr", "STBsp", "STBinc","STBgr", "HBCsp", "HBCinc", "HBCgr"), class = c("data.table","data.frame"), row.names = c(NA, -10L))) 

Где ИСП идентификатор вида. Один DT имеет длину более 5 миллионов строк (AltSuitSp1), другой - 12 (AltSuitDates). Я использую DT, длина которого составляет 12 строк (что соответствует 12 месяцам) для обновления большего DT. В настоящее время я использую вложенным, если, иначе, если структура в цикле, чтобы проверить состояние и обновить большую DT Основе меньший DT (см код ниже)

h <- 1 
n <- length(AltSuitSp1[,Month]) 
stm <- AltSuitSp1[,Month] # AltSuitSp1 is the 5+ million row DT 

cond1 <- which(stm == 1) # list of all rows of AltSuitSp1 where the Month is = 1 
cond2 <- which(stm == 2) # list of all rows of AltSuitSp1 where the Month is = 2 
... 
cond12 <- which(stm == 12) 

for (h in seq(n)){ 
    if (any(cond1 == h)){ 
     set(AltSuitSp1,h,2:34,(AltSuitSp1[h,2:34,with=F] * AltSuitDates[1,2:34,with=F])) 
    }else if (any(cond2 == h)){ 
     set(AltSuitSp1,h,2:34,(AltSuitSp1[h,2:34,with=F] * AltSuitDates[2,2:34,with=F])) 
    }else if ... 
    }else if (any(cond12)){ 
     set(AltSuitSp1,h,2:34,(AltSuitSp1[h,2:34,with=F] * AltSuitDates[12,2:34,with=F])) 
    }else 
     break 
} 

Теперь я запускаю этот код для 1 минуту и ​​проверили, как далеко продвинулся. В настоящее время я вижу около 29-30 циклов в секунду, и h продвинулся примерно до 1800 итераций. Однако даже при 30 петлях в секунду (что довольно медленно: Using Set in DT), этот код займет приблизительно 2 дня. Однако, как показывает приведенный ниже результат, он делает то, что я хочу/ожидаю от него.

AltSuitSp1Results <- data.table(structure(list(Month = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 2L,12L, 12L, 12L), .Label = c("1", "10", "11", "12", "2", "3", "4","5", "6", "7", "8", "9"), class = "factor"), SpdSpSuit = c(NA,NA, NA, NA, NA, NA, NA, 0, 0, 0), SpdIncSuit = c(NA, NA, NA,NA, NA, NA, NA, 0, 0, 0), SpdGrowSuit = c(0, 0, 0, 0, 0, 0, 0,0.4625, 0.4625, 0.4625), RzbSpSuit = c(NA, NA, NA, NA, NA, NA,NA, 0.283333333, 0.283333333, 0.283333333), RzbIncSuit = c(NA,NA, NA, NA, NA, NA, NA, 0.34, 0.34, 0.34), RzbGrowSuit = c(0,0, 0, 0, 0, 0, 0, 0.283333333, 0.283333333, 0.283333333), FMSSpSuit = c(NA,NA, NA, NA, NA, NA, NA, 0.34, 0.34, 0.34), FMSIncSuit = c(NA,NA, NA, NA, NA, NA, NA, 0.425, 0.425, 0.425), FMSGrowSuit = c(0,0, 0, 0, 0, 0, 0, 0.283333333, 0.283333333, 0.283333333), BhsSpSuit = c(NA,NA, NA, NA, NA, NA, NA, 0.233333333, 0.233333333, 0.233333333), BhsIncSuit = c(NA, NA, NA, NA, NA, NA, NA, 0, 0, 0), BhsGrowSuit = c(0,0, 0, 0, 0, 0, 0, 0.233333333, 0.233333333, 0.233333333), BrtSpSuit = c(0.866666667,0.866666667, 0.866666667, 0.866666667, 0.866666667, 0.866666667,0.866666667, 0, 0, 0), BrtIncSuit = c(0.8, 0.8, 0.8, 0.8, 0.8,0.8, 0.8, 0.43, 0.43, 0.43), BrtGrSuit = c(0, 0, 0, 0, 0, 0,0, 0.86, 0.86, 0.86), CcfSpSuit = c(NA, NA, NA, NA, NA, NA, NA,0, 0, 0), CcfIncSuit = c(NA, NA, NA, NA, NA, NA, NA, 0, 0, 0),CcfGrSuit = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), GsfSpSuit = c(NA,NA, NA, NA, NA, NA, NA, 0, 0, 0), GsfIncSuit = c(NA, NA,NA, NA, NA, NA, NA, 0, 0, 0), GsfGrSuit = c(0, 0, 0, 0, 0,0, 0, 0, 0, 0), RbtSpSuit = c(NA, NA, NA, NA, NA, NA, NA,0, 0, 0), RbtIncSuit = c(NA, NA, NA, NA, NA, NA, NA, 0, 0,0), RbtGrSuit = c(0, 0, 0, 0, 0, 0, 0, 0.925, 0.925, 0.925), SmbSpSuit = c(NA, NA, NA, NA, NA, NA, NA, 0.675, 0.675,0.675), SmbIncSuit = c(NA, NA, NA, NA, NA, NA, NA, 0.766666667,0.766666667, 0.766666667), SmbGrSuit = c(0, 0, 0, 0, 0, 0,0, 0.0875, 0.0875, 0.0875), StbSpSuit = c(NA, NA, NA, NA,NA, NA, NA, 0.425, 0.425, 0.425), StbIncSuit = c(NA, NA,NA, NA, NA, NA, NA, 0, 0, 0), StbGrSuit = c(0, 0, 0, 0, 0,0, 0, 0, 0, 0), HbcSpSuit = c(NA, NA, NA, NA, NA, NA, NA,0, 0, 0), HbcIncSuit = c(NA, NA, NA, NA, NA, NA, NA, 0, 0,0), HbcGrSuit = c(0, 0, 0, 0, 0, 0, 0, 0.425, 0.425, 0.425)), .Names = c("Month", "SpdSpSuit", "SpdIncSuit", "SpdGrowSuit","RzbSpSuit", "RzbIncSuit", "RzbGrowSuit", "FMSSpSuit", "FMSIncSuit","FMSGrowSuit", "BhsSpSuit", "BhsIncSuit", "BhsGrowSuit", "BrtSpSuit","BrtIncSuit", "BrtGrSuit", "CcfSpSuit", "CcfIncSuit", "CcfGrSuit","GsfSpSuit", "GsfIncSuit", "GsfGrSuit", "RbtSpSuit", "RbtIncSuit","RbtGrSuit", "SmbSpSuit", "SmbIncSuit", "SmbGrSuit", "StbSpSuit","StbIncSuit", "StbGrSuit", "HbcSpSuit", "HbcIncSuit", "HbcGrSuit"), class = c("data.table", "data.frame"), row.names = c(NA, -10L))) 

Очевидно, что я не собираюсь об этом эффективно и выполняю небрежное программирование. Тем не менее, я изо всех сил пытаюсь выяснить, где именно я могу оптимизировать свой код. Я пытаюсь изобрести встроенную функцию DT DT? Я в одном из Кругов; Я пропустил какое-то место, где есть возможность проголосовать: R Inferno?

В принципе, мне нужно обновить столбцы 2:34 в AltSuitSp1 DT, основанные на AltSuitDates DT, используя столбец Month в качестве условия, чтобы узнать, какую строку использовать из AltSuitDates DT для обновления AltSuitSp1. Любая помощь приветствуется.

Answer 1

EDIT, обновленный для запуска с данными, которые были опубликованы.

Это должно работать:

AltSuitSp1$Month <- as.integer(levels(AltSuitSp1$Month))[AltSuitSp1$Month] 
setkey(AltSuitDates, Month) 
d.cols <- ncol(AltSuitDates) - 1L 
AltSuitDates[AltSuitSp1, ][, 
    c(list(Month=Month), 
    mapply(
    `*`, 
    .SD[, 2:(d.cols + 1), with=F], 
    .SD[, (d.cols + 2):(2 * d.cols + 1), with=F], 
    SIMPLIFY=FALSE 
)) ] 

В принципе, вы начинаете путем объединения двух таблиц по Month (третьей строке), то вы используете .SD, который представляет собой специальный объект, который относится к самой таблице данных, чтобы передайте первый набор строк из AltSuitSp1, а второй набор из AltSuitDates (теперь все они находятся в одной таблице) до mapply, чтобы он мог их умножать. Вот данные, которые я использовал:

library(data.table) 
set.seed(1) 
AltSuitSp1 <- do.call(rbind, replicate(3, data.table(Month=1:12, a=runif(12), b=runif(12), c=runif(12)), s=F)) 
AltSuitDates <- data.table(Month=1:12, a=runif(12, 5, 10), b=runif(12, 5, 10), c=runif(12, 5, 10)) 

Answer 2

Основываясь на @ BrodieG замечании, это была переработана для размещения 34 столбцов в SP2. На наборе данных вашего размера (5e6 строк, 34 столбца) он работает примерно через 4 минуты.

Основной подход состоит в том, чтобы добавить ссылочные столбцы (называемые здесь Dates), к SP1, по одному за раз. Затем обновите соответствующий столбец SP1, а затем повторите его со следующего столбца. Это довольно эффективно с точки зрения памяти (только один дополнительный столбец в любой точке) и по-прежнему использует набор данных по таблице data.table.

library(data.table) 
set.seed(1) 
ncol <- 34 
nrow <- 5e6 
m <- matrix(sample(10000:99999,nrow*ncol,replace=T),ncol=ncol) 
SP1 <- data.table(Month=sample(1:12,nrow(m),replace=T),m) 
m <- matrix(sample(1:12,12*ncol,replace=T),ncol=ncol) 
SP2 <- data.table(Month=sample(1:12,12),m) 
cols <- paste0("SpId",(1:ncol(m))) 
setnames(SP1,2:(ncol(m)+1),cols) 
setnames(SP2,2:(ncol(m)+1),cols) 

system.time({ 
    setkey(SP1,"Month") 
    setkey(SP2,"Month") 
    lapply(1:ncol,function(i){ 
    setnames(SP2,cols[i],"Dates") # don't want colname collision in merge 
    SP1[SP2[,c("Month","Dates"),with=F],Dates:=Dates] 
    SP1[,cols[i]:=.SD[,cols[i],with=F]*Dates,with=F] 
    setnames(SP2,"Dates",cols[i]) # set it back so next iteration works 
    }) 
}) 
# user system elapsed 
# 219.54 22.45 242.59 

Answer 3

Попробуйте это. Я думаю, что это может быть похоже на BrodieG, но когда я копировал ответ BrodieG, он не работал для меня, и я не знаю, как читать через часть mapply, чтобы выяснить, что я сделал неправильно ....

comb<-merge(AltSuitSp1,AltSuitDates,by="Month") 
sp<-colnames(AltSuitSp1)[2:NCOL(AltSuitSp1)] 
dat<-colnames(AltSuitDates)[2:NCOL(AltSuitDates)] 
comb[,eval(parse(text=paste0("list(Month,",paste0(sp,"=",sp,"*",dat,collapse=","),")")))] 

Я знаю, что старина eval(parse(text= как правило, не считается хорошей практикой, но когда все у вас есть молоток, что делает винты идут в лес.