प्रति पंक्ति डेटाटेबल फ़ंक्शन बहुत धीमा

Question

मुझे प्रति पंक्ति (6 एम + पंक्तियों) के भारित साधनों की गणना करने की आवश्यकता है, लेकिन इसमें बहुत लंबा समय लगता है। वजन के साथ स्तंभ एक चरित्र-क्षेत्र है, इसलिए भारित। मीन सीधे उपयोग नहीं किया जा सकता है।

पृष्ठभूमि डेटा:

library(data.table) 
library(stringr) 
values <- c(1,2,3,4) 
grp <- c("a", "a", "b", "b") 
weights <- c("{10,0,0,0}", "{0,10,0,0}", "{10,10,0,0}", "{0,0,10,0}") 
DF <- data.frame(cbind(grp, weights)) 
DT <- data.table(DF) 

string.weighted.mean <- function(weights.x) { 
    tmp.1 <- na.omit(as.numeric(unlist(str_split(string=weights.x, pattern="[^0-9]+")))) 
    tmp.2 <- weighted.mean(x=values, w=tmp.1) 
} 

यहाँ data.frames के साथ यह कैसे किया जा सकता है (बहुत धीमी गति से) है:

DF$wm <- mapply(string.weighted.mean, DF$weights) 

यह काम करता है लेकिन जिस तरह से बहुत धीमी गति से (घंटे) है:

DT[, wm:=mapply(string.weighted.mean, weights)] 

चीजों को गति देने के लिए अंतिम पंक्ति को फिर से कैसे बदला जा सकता है?

Answer 1

DT[, rowid := 1:nrow(DT)] 
setkey(DT, rowid) 
DT[, wm :={ 
    weighted.mean(x=values, w=na.omit(as.numeric(unlist(str_split(string=weights, pattern="[^0-9]+")))))  
}, by=rowid] 

Answer 2

चूंकि यह प्रकट नहीं होता है कि समूह भारित मतलब की गणना से कोई लेना देना नहीं है, मैं इस समस्या को थोड़ा आसान बनाने की कोशिश की।

 values <- seq(4) 

# A function to compute a string of length 4 with random weights 0 or 10 
    tstwts <- function() 
    { 
     w <- sample(c(0, 10), 4, replace = TRUE) 
     paste0("{", paste(w, collapse = ","), "}") 
    } 

# Generate 100K strings and put them into a vector 
    u <- replicate(1e5, tstwts()) 
    head(u) # Check 
    table(u) 

# Function to compute a weighted mean from a string using values 
# as an assumed external numeric vector 'values' of the same length as 
# the weights 
    f <- function(x) 
     { 
      valstr <- gsub("[\\{\\}]", "", x) 
      wts <- as.numeric(unlist(strsplit(valstr, ","))) 
      sum(wts * values)/sum(wts) 
     } 

# Execute the function f recursively on the vector of weights u 
    v <- sapply(u, f) 

# Some checks: 
    head(v) 
    table(v) 

अपने सिस्टम पर, 100K repetitions के लिए,

> system.time(sapply(u, f)) 
    user system elapsed 
    3.79 0.00 3.83 

इस (बिना समूहों) के एक डेटा तालिका संस्करण

DT <- data.table(weights = u) 
DT[, wt.mean := lapply(weights, f)]) 
head(DT) 
dim(DT) 

अपने सिस्टम पर हो सकता है, इस

लेता है

system.time (डीटी [, wt.mean: = lapply (भार, एफ)] उपयोगकर्ता प्रणाली 3,62 0,03 3,69

गुजरे तो एक प्रणाली मेरा करने के लिए तुलनीय पर मिलियन टिप्पणियों प्रति के बारे में 35-40 रों उम्मीद (Win7, 2.8GHz डुअल कोर चिप, 8 जीबी रैम)। YMMV।