क्या मैप्ली समानांतर करने का कोई प्रभावी तरीका है?

Question

मेरे पास कई पंक्तियां हैं और प्रत्येक पंक्ति पर मैं एक गैर-रैखिक फ़ंक्शन के अनियूट की गणना करता हूं। मेरे पास क्वाड-कोर उबंटू मशीन है जिसने मेरे कोड को दो दिनों के लिए नहीं चलाना बंद कर दिया है। आश्चर्य की बात नहीं है, मैं चीजों को गति देने के तरीकों की तलाश में हूं ;-)

कुछ शोध के बाद, मैंने देखा कि वर्तमान में केवल एक कोर का उपयोग किया जाता है और समांतरता करना ही काम है। गहराई से खोना, मैं निष्कर्ष पर आया (शायद गलत तरीके से?) कि पैकेज foreach वास्तव में मेरी समस्या के लिए नहीं है क्योंकि बहुत अधिक ओवरहेड का उत्पादन होता है (उदाहरण के लिए, SO)। यूनिक्स मशीनों के लिए एक अच्छा विकल्प multicore लगता है। विशेष रूप से, सहायता पृष्ठ की जांच करने के बाद pvec फ़ंक्शन सबसे प्रभावी लगता है।

हालांकि, अगर मैं इसे सही ढंग से समझता हूं, तो यह फ़ंक्शन केवल एक वेक्टर लेता है और तदनुसार इसे विभाजित करता है। मुझे एक फ़ंक्शन की आवश्यकता है जिसे लंबित किया जा सकता है, लेकिन एकाधिक वैक्टर (या data.frame इसके बजाय) लेता है, जैसे कि mapply फ़ंक्शन करता है। क्या वहां कुछ भी है जो मुझे याद आया?

यहां एक छोटा सा उदाहरण है जो मैं करना चाहता हूं: (ध्यान दें कि इसमें plyr उदाहरण शामिल है क्योंकि यह mapply फ़ंक्शन के आधार का विकल्प हो सकता है और इसमें समानांतर विकल्प है। हालांकि, यह मेरे धीमे है कार्यान्वयन और आंतरिक रूप से, यह foreach कॉल parallelize करने, इसलिए मुझे लगता है कि यह मदद नहीं करेगा। वह सही है?)

library(plyr) 
library(foreach) 
n <- 10000 
df <- data.frame(P = rnorm(n, mean=100, sd=10), 
       B0 = rnorm(n, mean=40, sd=5), 
       CF1 = rnorm(n, mean=30, sd=10), 
       CF2 = rnorm(n, mean=30, sd=5), 
       CF3 = rnorm(n, mean=90, sd=8)) 

get_uniroot <- function(P, B0, CF1, CF2, CF3) { 

    uniroot(function(x) {-P + B0 + CF1/x + CF2/x^2 + CF3/x^3}, 
      lower = 1, 
      upper = 10, 
      tol = 0.00001)$root 

} 

system.time(x1 <- mapply(get_uniroot, df$P, df$B0, df$CF1, df$CF2, df$CF3)) 
    #user system elapsed 
    #0.91 0.00 0.90 
system.time(x2 <- mdply(df, get_uniroot)) 
    #user system elapsed 
    #5.85 0.00 5.85 
system.time(x3 <- foreach(P=df$P, B0=df$B0, CF1=df$CF1, CF2=df$CF2, CF3=df$CF3, .combine = "c") %do% { 
    get_uniroot(P, B0, CF1, CF2, CF3)}) 
    #user system elapsed 
    # 10.30 0.00 10.36 
all.equal(x1, x2$V1) #TRUE 
all.equal(x1, x3) #TRUE 

इसके अलावा, मैं ऊपर अतः लिंक से chunkapply रयान थॉम्पसन के समारोह को लागू करने की कोशिश की (केवल छुटकारा मिल गया doMC भाग का, क्योंकि मैं इसे इंस्टॉल नहीं कर सका। उसका उदाहरण काम करता है, हालांकि, अपने फ़ंक्शन को समायोजित करने के बाद भी।), लेकिन नहीं किया इसे काम करने के लिए नहीं मिलता है। हालांकि, चूंकि यह foreach का उपयोग करता है, मैंने सोचा कि ऊपर वर्णित वही तर्क लागू होते हैं, इसलिए मैंने इसे बहुत लंबा प्रयास नहीं किया।

#chunkapply(get_uniroot, list(P=df$P, B0=df$B0, CF1=df$CF1, CF2=df$CF2, CF3=df$CF3)) 
#Error in { : task 1 failed - "invalid function value in 'zeroin'" 

पुनश्च: मैं जानता हूँ कि मैं सिर्फ बढ़ सकते हैं tol चरण हैं, जो एक uniroot लगाने के लिए आवश्यक हैं की संख्या को कम करने के लिए। हालांकि, मैंने पहले से ही tol जितना संभव हो उतना बड़ा सेट किया है।

Answer 1

मैं parallel पैकेज का उपयोग करता हूं जो आर 2.14 में बनाया गया है और matrices के साथ काम करता है। आप तो बस इस तरह mclapply इस्तेमाल कर सकते हैं:

dfm <- as.matrix(df) 
result <- mclapply(seq_len(nrow(dfm)), 
      function(x) do.call(get_uniroot,as.list(dfm[x,])), 
      mc.cores=4L 
     ) 
unlist(result) 

यह मूलतः कर रहा है एक ही mapply करता है, लेकिन एक समानांतर तरीके से।

लेकिन ...

मन आपको लगता है कि साथ में चलाना हमेशा की तरह अच्छी तरह से कुछ भूमि के ऊपर के लिए मायने रखता है। जैसा कि मैंने आपके द्वारा लिंक किए गए प्रश्न में समझाया है, समानांतर जाकर केवल भुगतान करता है यदि आपका आंतरिक कार्य ओवरहेड से काफी लंबा है। आपके मामले में, आपका अनइरूट फ़ंक्शन बहुत तेज़ काम करता है। फिर आप अपने डेटा फ्रेम को बड़े हिस्सों में कटौती करने पर विचार कर सकते हैं, और दोनों को मज़ेदार और mclapply गठबंधन कर सकते हैं। यह करने के लिए एक संभव तरीका है:

ncores <- 4 
id <- floor(
     quantile(0:nrow(df), 
       1-(0:ncores)/ncores 
     ) 
    ) 
idm <- embed(id,2) 

mapply_uniroot <- function(id){ 
    tmp <- df[(id[1]+1):id[2],] 
    mapply(get_uniroot, tmp$P, tmp$B0, tmp$CF1, tmp$CF2, tmp$CF3) 
} 
result <-mclapply(nrow(idm):1, 
        function(x) mapply_uniroot(idm[x,]), 
        mc.cores=ncores) 
final <- unlist(result) 

यह कुछ फेरबदल की जरूरत हो सकती है, लेकिन यह अनिवार्य रूप से वास्तव में के रूप में कई टुकड़े में अपने df टूट जाता है के रूप में वहाँ कोर रहे हैं, और हर कोर पर mapply चलाते हैं।

> x1 <- mapply(get_uniroot, df$P, df$B0, df$CF1, df$CF2, df$CF3) 
> all.equal(final,x1) 
[1] TRUE 

Answer 2

यह वास्तव में एक सर्वोत्तम प्रथाओं सुझाव नहीं है, लेकिन काफी गति-अप 'एक vectorized' फैशन में सभी मापदंडों के लिए रूट की पहचान करके किया जा सकता है: इस काम करता है दिखाने के लिए। उदाहरण के लिए,

bisect <- 
    function(f, interval, ..., lower=min(interval), upper=max(interval), 
      f.lower=f(lower, ...), f.upper=f(upper, ...), maxiter=20) 
{ 
    nrow <- length(f.lower) 
    bounds <- matrix(c(lower, upper), nrow, 2, byrow=TRUE) 
    for (i in seq_len(maxiter)) { 
     ## move lower or upper bound to mid-point, preserving opposite signs 
     mid <- rowSums(bounds)/2 
     updt <- ifelse(f(mid, ...) > 0, 0L, nrow) + seq_len(nrow) 
     bounds[updt] <- mid 
    } 
    rowSums(bounds)/2 
} 

और फिर

> system.time(x2 <- with(df, { 
+  f <- function(x, PB0, CF1, CF2, CF3) 
+   PB0 + CF1/x + CF2/x^2 + CF3/x^3 
+  bisect(f, c(1, 10), PB0, CF1, CF2, CF3) 
+ })) 
    user system elapsed 
    0.180 0.000 0.181 
> range(x1 - x2) 
[1] -6.282406e-06 6.658593e-06 

के बारे में 1.3s बनाम प्रत्येक के लिए अलग से uniroot के आवेदन के लिए। यह पी और बी 0 को समय से पहले एक ही मूल्य में मिला, क्योंकि इस तरह वे समीकरण में प्रवेश करते हैं।

अंतिम मूल्य पर सीमा +/- diff(interval) * (.5^maxiter) या तो हैं। एक फैनसीयर कार्यान्वयन रैखिक या वर्गिक इंटरपोलेशन (?uniroot में उद्धृत संदर्भ में) के साथ विस्थापन को प्रतिस्थापित करेगा, लेकिन फिर समान कुशल अभिसरण (और सभी मामलों में त्रुटि प्रबंधन) व्यवस्था करने के लिए और अधिक कठिन होगा।

Answer 3

यह एक पुराना विषय है लेकिन अब आपके पास parallel::mcmapply दस्तावेज़ here है। विकल्पों में mc.cores सेट करना न भूलें। मैं आमतौर पर ओएस ऑपरेशंस के लिए एक सीपीयू मुक्त करने के लिए mc.cores=parallel::detectCores()-1 का उपयोग करता हूं।

x4 <- mcmapply(get_uniroot, df$P, df$B0, df$CF1, df$CF2, df$CF3,mc.cores=parallel::detectCores()-1)