आर प्रोग्रामिंग: प्रत्येक पंक्ति

Question

अद्यतन करने के लिए पहले गणना की गई पंक्ति का उपयोग करना मेरे पास बहुत बड़ी समय श्रृंखला है और मुझे शुरुआत में कुछ मनमाना मूल्य और वर्तमान समय अवधि में परिवर्तन के आधार पर एक अलग समय श्रृंखला बनाने की आवश्यकता है। असली डाटासेट में यह परिवर्तन डेटा फ्रेम के अन्य चर पर निर्भर करता है, लेकिन मेगावाट का एक उद्देश्य के लिए, मैं इसे पुन: इस प्रकार है:

initial_value <- 100 
set.seed(123) 
library(data.table) 
df <- as.data.table(data.frame(num = c(1:10),change = rnorm(10))) 

नया वेरिएबल value पिछली अवधि में अपने स्वयं के मूल्य के रूप में परिभाषित किया गया है के साथ साथ वर्तमान अवधि में change। पहले अवलोकन में मूल्य मनमाने ढंग से चुने गए initial_value द्वारा निर्धारित किया जाता है। अगर वहाँ value पर कोई प्रतिबंध नहीं होती तो यह

df <- df[, value0 := initial_value + cumsum(change)] 

यह बहुत तेजी से data.table उपयोग कर रहा है के रूप में बस बनाया जा सकता है। हालांकि, दुर्भाग्य से, change पिछले अवधि में वास्तविक value पर भी निर्भर हो सकता है। विशेष रूप से, मान लें कि जब भी यह 102 तक पहुंच जाता है, तो श्रृंखला को अगली अवधि में initial_value तक पहुंचने की आवश्यकता होती है और वहां 3 अवधि तक रहती है।

df$value <- NA 
df$value[1] <- initial_value + df$change[1] 
for (i in 2:nrow(df)) { 
    if (is.na(df$value[i])) { 
    if (df$value[i-1] < 102) { 
     df$value[i] <- df$value[i-1] + df$change[i] 
    } else { 
     df$value[i:(i+2)] <- initial_value 
    } 
    } 
} 

:

num  change value0  value 
1: 1 -0.56047565 99.43952 99.43952 
2: 2 -0.23017749 99.20935 99.20935 
3: 3 1.55870831 100.76806 100.76806 
4: 4 0.07050839 100.83856 100.83856 
5: 5 0.12928774 100.96785 100.96785 
6: 6 1.71506499 102.68292 102.68292 
7: 7 0.46091621 103.14383 100.00000 
8: 8 -1.26506123 101.87877 100.00000 
9: 9 -0.68685285 101.19192 100.00000 
10: 10 -0.44566197 100.74626 99.55434 

अब तक एक ही रास्ता है कि मैं इस परिणाम का उत्पादन करने में कामयाब रहे एक पाश उपयोग कर रहा है: इस प्रकार, निम्न डेटा फ्रेम में, मैं चर value बनाने के लिए है, जबकि कोड ऊपर value0 उत्पादन की जरूरत है

हालांकि, लाखों अवलोकनों के दर्जनों (दर्जनों) पर लूपिंग बेहद धीमी है। क्या संभवतः इसे सदिश बनाने या प्रक्रिया को अधिक कुशलता से चलाने का कोई तरीका है?

Answer 1

मैं आपको सरल लूप के लिए आरसीपीपी का उपयोग करने का सुझाव देता हूं। अनुरोधित तर्क को दोहराना आसान है।
आपका कार्यः

fun_r <- function(){ 
    df$value <- NA 
    df$value[1] <- initial_value + df$change[1] 
    for (i in 2:nrow(df)) { 
    if (is.na(df$value[i])) { 
     if (df$value[i-1] < 102) { 
     df$value[i] <- df$value[i-1] + df$change[i] 
     } else { 
     df$value[i:(i+2)] <- initial_value 
     } 
    } 
    } 
    df 
} 

C++ में एक ही समारोह

library(Rcpp) 
cppFunction({' 
    NumericVector fun_c(NumericVector change, double init, double thr){ 
    int n = change.size(); 
    int end; 
    NumericVector out(n); 
    out[ 0 ] = init + change[ 0 ]; 

    for(int i = 1; i < n; i++){ 

    if(out[ i - 1 ] < thr){ 

     out[i] = out[ i - 1 ] + change[ i ]; 

    } else { 

     end = std::min(i + 2 , n - 1); 
     for(int j = i; j <= end; j++) { 
     out[ j ] = init; 
     i = j; 
     } 
    } 

    } 
    return out; 
} 
'}) 

अद्यतन: आर समारोह पहली बार के लिए लिखा (ऊपर) data.frame subsetting है, जो करने के लिए अत्यधिक अप्रभावी तरीका है पर आधारित है आर फंक्शन में डेटा के साथ सौदा बस सभी मानकों में खोने की उम्मीद है। लूपिंग करते समय, हमेशा एक सदिश (वेक्टर और मैट्रिक्स) गणना करना चाहिए। समारोह नीचे Rcpp उदाहरण के साथ और अधिक competetive हैं जो:

fun_r2 <- function(change, initial_value, thr){ 
    n <- length(change) 
    value <- numeric(n) 
    value[1] <- initial_value + change[1] 

    for (i in 2:n) { 
    if (value[i]==0) { 
     if (value[i-1] < thr) { 
     value[i] <- value[i-1] + change[i] 
     } else { 
     value[i:(i+2)] <- initial_value 
     } 
    } 
    } 
    value 
} 

तीन कार्यों ही परिणाम पैदा करता है, और fun_c सबसे तेजी से है, लेकिन vectorized fun_r2 समारोह स्वीकार्य के रूप में माना जा सकता है।

df$value <- fun_r() 
df$value_r2 <- fun_r2(as.vector(df$change), init=100, thr=102) 
df$value_rcpp <- fun_c(df$change, init=100, thr=102) 

all.equal(df$value, df$value_rcpp) 
all.equal(df$value, df$value_r2) 
# TRUE 

mb <- microbenchmark::microbenchmark(
    fun_r(), 
    fun_r2(as.vector(df$change), init=100, thr=102), 
    fun_c(df$change, init=100, thr=102), 
    times=100L 
) 

# expr  mean 
# 1 fun_r() 6650.72481 
# 2 fun_r2() 42.28442 
# 3 fun_c() 18.24121 

आनंद लें!