एकाधिक कॉलम पर रोलिंग रिग्रेशन

Question

मुझे एकाधिक कॉलम वाले xts ऑब्जेक्ट पर रोलिंग रैखिक प्रतिगमन की गणना करने का सबसे प्रभावी तरीका खोजने का कोई समस्या है। मैंने स्टैक ओवरफ्लो पर कई पहले प्रश्नों की खोज और पढ़ा है।

यह question and answer करीब आता है लेकिन मेरी राय में पर्याप्त नहीं है क्योंकि मैं सभी प्रतिगमनों में निर्भर परिवर्तनीय अपरिवर्तित के साथ कई प्रतिगमनों की गणना करना चाहता हूं। मैं यादृच्छिक डेटा के साथ एक उदाहरण पुन: पेश करने की कोशिश की है:

require(xts) 
require(RcppArmadillo) # Load libraries 

data <- matrix(sample(1:10000, 1500), 1500, 5, byrow = TRUE) # Random data 
data[1000:1500, 2] <- NA # insert NAs to make it more similar to true data 
data <- xts(data, order.by = as.Date(1:1500, origin = "2000-01-01")) 

NR <- nrow(data) # number of observations 
NC <- ncol(data) # number of factors 
obs <- 30 # required number of observations for rolling regression analysis 
info.names <- c("res", "coef") 

info <- array(NA, dim = c(NR, length(info.names), NC)) 
colnames(info) <- info.names 

सरणी आदेश समय के साथ और प्रति कारक कई चर (बच, गुणांक आदि) स्टोर करने के लिए में बनाया जाता है।

loop.begin.time <- Sys.time() 

for (j in 2:NC) { 
    cat(paste("Processing residuals for factor:", j), "\n") 
    for (i in obs:NR) { 
    regression.temp <- fastLm(data[i:(i-(obs-1)), j] ~ data[i:(i-(obs-1)), 1]) 
    residuals.temp <- regression.temp$residuals 
    info[i, "res", j] <- round(residuals.temp[1]/sd(residuals.temp), 4) 
    info[i, "coef", j] <- regression.temp$coefficients[2] 
    } 
} 

loop.end.time <- Sys.time() 
print(loop.end.time - loop.begin.time) # prints the loop runtime 

पाश विचार से पता चलता है data[, 1] निर्भर चर (कारक) अन्य कारकों में से एक के खिलाफ हर बार के रूप में के साथ एक 30 टिप्पणियों रोलिंग प्रतिगमन को चलाने के लिए है। मुझे 30 अवशेषों को एक अस्थायी वस्तु में संग्रहीत करने के लिए उन्हें fastLm मानकीकृत अवशेषों की गणना नहीं करना है।

लूप बेहद धीमा है और एक्सटीएस ऑब्जेक्ट में कॉलम (कारक) की संख्या लगभग 100 - 1,000 कॉलम तक बढ़ जाती है, तो यह एक बोझिल हो जाता है। मुझे उम्मीद है कि एक बड़े डेटा सेट पर रोलिंग रिग्रेशन बनाने के लिए एक और अधिक कुशल कोड है।

Answer 1

यदि आप रैखिक प्रतिगमन के गणित के स्तर पर जाते हैं तो यह बहुत तेज़ होना चाहिए। यदि एक्स स्वतंत्र चर है और वाई निर्भर चर है। गुणांक द्वारा

Beta = inv(t(X) %*% X) %*% (t(X) %*% Y)

दिया जाता है मैं एक छोटे से उलझन में हूँ जो चर के बारे में आप पर निर्भर है और जो एक स्वतंत्र लेकिन उम्मीद है कि सुलझाने के लिए एक समान समस्या नीचे आप के रूप में अच्छी मदद मिलेगी है होना चाहता हूँ।

नीचे दिए गए उदाहरण में मैं मूल 5 के बजाय 1000 चर लेता हूं और किसी भी एनए को पेश नहीं करता हूं।

require(xts) 

data <- matrix(sample(1:10000, 1500000, replace=T), 1500, 1000, byrow = TRUE) # Random data 
data <- xts(data, order.by = as.Date(1:1500, origin = "2000-01-01")) 

NR <- nrow(data) # number of observations 
NC <- ncol(data) # number of factors 
obs <- 30 # required number of observations for rolling regression analysis 

अब हम यहोशू के टीटीआर पैकेज का उपयोग कर गुणांक की गणना कर सकते हैं।

३.९३४४६१ सेकेंड

res.array = array(NA, dim=c(NC, NR, obs)) 
for(z in seq(obs)) { 
    res.array[,,z] = coredata(data - lag.xts(coeffs, z-1) * as.numeric(in.dep.var)) 
} 
res.sd <- apply(res.array, c(1,2), function(z) z/sd(z)) 

की

library(TTR) 

loop.begin.time <- Sys.time() 

in.dep.var <- data[,1] 
xx <- TTR::runSum(in.dep.var*in.dep.var, obs) 
coeffs <- do.call(cbind, lapply(data, function(z) { 
    xy <- TTR::runSum(z * in.dep.var, obs) 
    xy/xx 
})) 

loop.end.time <- Sys.time() 

print(loop.end.time - loop.begin.time) # prints the loop runtime 

समय अंतर मैं अनुक्रमण res.sd में किसी भी त्रुटि नहीं किया है आप मानकीकृत बच देना चाहिए। किसी भी बग को ठीक करने के लिए कृपया इस समाधान को ठीक करने के लिए स्वतंत्र महसूस करें।