R mit Rdist, um Ergebnisse in einer Datentabelle zu generieren

Question

Ich versuche, eine Berechnung mit einer Abstandsmatrix zu beschleunigen. Der folgende Codeausschnitt funktioniert in dem Skript, von dem er stammt, ist aber langsam. Sie wählt eine bestimmte Kombination aus Land, Jahr und Szenario aus, berechnet die MFAD und schreibt die Kombinationsinformationen einschließlich des MFAD-Ergebnisses und rbind in MFADHolder.

MFADHolder <- data.table(scenario = character(0), region_code.IMPACT159 = character(0), year = character(0), MFAD = numeric(0)) 
for (k in yearList) {   
    for (l in scenList) {   
    for (n in ctylist) {    
     dt <- dt.main[ year == k & scenario == l & region_code.IMPACT159 == n,]   
     itemlist <- unique(dt$IMPACT_code)    
     dt[,c("scenario", "region_code.IMPACT159", "year", "IMPACT_code") := NULL]    
     d <- as.data.table(rdist(dt))   
     data.table::setnames(d, old = names(d), new = itemlist)   
     MFAD <- sum(d)/20   
     newRow <- as.list(c(l,n,k,MFAD))   
     MFADHolder <- rbind(MFADHolder, newRow)   
    }   
    }   
} 

Mit Rstudio des neuen Profilierungswerkzeug, fand ich, dass die Linie

dt <- dt.main[ year == k & scenario == l & region_code.IMPACT159 == n,] 

den Großteil der Rechenzeit in Anspruch nimmt, vermutlich wegen all des Kopierens des dt. Ich dachte, ich könnte alles innerhalb der Datentabelle tun. Die folgende Codezeile könnte im Prinzip den gesamten obigen Code ersetzen, außer dass es nicht funktioniert.

dt.main[, MFAD := sum(rdist(dt.main[,!(c("scenario", "region_code.IMPACT159", "year", "IMPACT_code"))]))/20, 
by = c("scenario", "year", "region_code.IMPACT159")] 

Die Idee ist rdist auf nur den entsprechenden Spalten in dt.main auszuführen, die oben dt Kopiercode ersetzt, dann durch 20 in der Distanzmatrix, divide ganze Element summieren und alle Ergebnisse in den Schreib MFAD-Spalte.

Wenn ich es ausführe, wird es nie abgeschlossen und R stirbt, weil mein Mac nicht genügend Systemspeicher hat und/oder seine Festplatte nicht mehr genügend Speicherplatz hat.

ist hier kompletter Code, um das Problem

library(data.table) 
library(fields) # needed for rdist function 
dt.main <- readRDS("dt.main.rds") 
dt.main[, MFAD := sum(rdist(dt.main[,!(c("scenario", "region_code.IMPACT159", "year", "nutrient"))]))/len.nutlist, 
     by = c("scenario", "year", "region_code.IMPACT159")] 

Und hier ist ein Link zu einer RDS-Datendatei für die Prüfung zu demonstrieren - https://github.com/GeraldCNelson/nutmod/commit/c06b51478223bdc3226cccbe9498df0472a57465#diff-21615ea67b6aed07b31f6c21e89a810b

Answer 1

John Smiths Code war im Grunde genau das, was ich brauchte, aber nicht tat Lauf wie geschrieben.

Die folgende Version ist und ist extrem schnell!

cols <- setdiff(colnames(dt.main), c("scenario", "region_code.IMPACT159", "year", "nutrient")) 
system.time(dt.main[, `:=` (MFAD = sum(rdist(.SD))/.N), 
      by = c("scenario", "year", "region_code.IMPACT159"), .SDcols = cols])