अनुकूलित रोलिंग कार्यों

Question

वहाँ किसी तरह अनुकूलित कार्य (rollmean, rollmedian आदि) (zoo पैकेज या कुछ इसी तरह से) rollapply उपयोग करने के लिए समय-आधारित खिड़की के साथ रोलिंग कार्यों की गणना करने के बजाय है, कई अवलोकनों के आधार पर? मैं जो चाहता हूं वह सरल है: अनियमित समय श्रृंखला में प्रत्येक तत्व के लिए, मैं एक रोलिंग फ़ंक्शन को एन-डेज़ विंडो के साथ गणना करना चाहता हूं। यही है, खिड़की को वर्तमान अवलोकन से पहले एन दिनों तक सभी अवलोकनों को शामिल करना चाहिए। समय श्रृंखला में डुप्लीकेट भी हो सकते हैं।

यहां एक उदाहरण का पालन किया गया है।

 date value 
1/11/2011  5 
1/11/2011  4 
1/11/2011  2 
8/11/2011  1 
13/11/2011  0 
14/11/2011  0 
15/11/2011  0 
18/11/2011  1 
21/11/2011  4 
5/12/2011  3 

एक 5 दिन की अवधि, सही करने के लिए गठबंधन के साथ एक रोलिंग मंझला, निम्नलिखित गणना में परिणाम चाहिए: निम्नलिखित समय श्रृंखला को देखते हुए

> c(
    median(c(5)), 
    median(c(5,4)), 
    median(c(5,4,2)), 
    median(c(1)), 
    median(c(1,0)), 
    median(c(0,0)), 
    median(c(0,0,0)), 
    median(c(0,0,0,1)), 
    median(c(1,4)), 
    median(c(3)) 
    ) 

[1] 5.0 4.5 4.0 1.0 0.5 0.0 0.0 0.0 2.5 3.0 

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

Answer 1

यहां समस्या के साथ मेरा झुकाव है। अगर उस तरह की चीज आपको मिलती है (मुझे नहीं पता कि यह गति के मामले में संतोषजनक है), तो मैं इसे अधिक विस्तृत उत्तर के रूप में लिख सकता हूं (भले ही यह @ आरबीएटी के विचार पर आधारित है)।

library(zoo) 
library(dplyr) 

# create a long time series 
start <- as.Date("1800-01-01") 
end <- as.Date(Sys.Date()) 

df <- data.frame(V1 = seq.Date(start, end, by = "day")) 
df$V2 <- sample(1:10, nrow(df), replace = T) 

# make it an irregular time series by sampling 10000 rows 
# including allowing for duplicates (replace = T) 
df2 <- df %>% 
    sample_n(10000, replace = T) 

# create 'complete' time series & join the data & compute the rolling median 
df_rollmed <- data.frame(V1 = seq.Date(min(df$V1), max(df$V1), by = "day")) %>% 
    left_join(., df2) %>% 
    mutate(rollmed = rollapply(V2, 5, median, na.rm = T, align = "right", partial = T)) %>% 
    filter(!is.na(V2)) # throw out the NAs from the complete dataset 

Answer 2

गति की जांच नहीं की है, लेकिन यह होना चाहिए कि अगर कोई तारीख से अधिक max.dup आवृत्तियां तो है कि पिछले 5 * max.dup प्रविष्टियों पिछले 5 दिनों तो एक पंक्ति का समारोह fn नीचे पारित कर दिया दिखाया शामिल rollapplyr को यह करना होगा:

k <- 5 

dates <- as.numeric(DF$date) 
values <- DF$value 

max.dup <- max(table(dates)) 

fn <- function(ix, d = dates[ix], v = values[ix], n = length(ix)) median(v[d >= d[n]-k]) 

rollapplyr(1:nrow(DF), max.dup * k, fn, partial = TRUE) 
## [1] 5.0 4.5 4.0 1.0 0.5 0.0 0.0 0.0 2.5 3.0 

नोट: हम DF के लिए इस प्रयोग किया है:

Lines <- " 
     date value 
1/11/2011  5 
1/11/2011  4 
1/11/2011  2 
8/11/2011  1 
13/11/2011  0 
14/11/2011  0 
15/11/2011  0 
18/11/2011  1 
21/11/2011  4 
5/12/2011  3 
" 
DF <- read.table(text = Lines, header = TRUE) 
DF$date <- as.Date(DF$date, format = "%d/%m/%Y") 

Answer 3

हम इस आधार सिर्फ उपयोग कर सकते हैं इस प्रकार लागू होते हैं:

पहले डेटा की स्थापना (द्वारा नोट पर आधारित @ जी Grothendieck)

library(data.table) 
Lines <- " 
     date value 
1/11/2011  5 
1/11/2011  4 
1/11/2011  2 
8/11/2011  1 
13/11/2011  0 
14/11/2011  0 
15/11/2011  0 
18/11/2011  1 
21/11/2011  4 
5/12/2011  3 
" 
DT <- as.data.table(read.table(text = Lines, header = TRUE)) 
DT$date <- as.Date(DF$date, format = "%d/%m/%Y") 
DT$row <- 1:NROW(DF) 
setkey(DT, row, date) #mark columns as sorted, for speed 

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

roll.median.DT <- function(x){ 
    this.date <- as.Date(x[1]) 
    this.row <- as.numeric(x[3]) 
    median(DT[row <= this.row & date >= (this.date-5)]$value) #NB DT is not defined within function, so it is found from parent scope 
} 
apply(DT, FUN=roll.median.DT, MARGIN = 1) 
[1] 5.0 4.5 4.0 1.0 0.5 0.0 0.0 0.0 2.5 3.0 

Answer 4

अधिकांश उत्तर समय श्रृंखला नियमित करने के लिए NA डालने का सुझाव देते हैं। हालांकि, यह लंबे समय तक श्रृंखला के मामले में धीमा हो सकता है। इसके अतिरिक्त, यह उन कार्यों के लिए काम नहीं करता है जिनका उपयोग NA के साथ नहीं किया जा सकता है।

रोलप्ली (चिड़ियाघर पैकेज) की चौड़ाई तर्क एक सूची हो सकती है (विवरण के लिए रोलप्ली की मदद देखें)। इस पर आधारित मैंने एक फ़ंक्शन लिखा जो रोलप्ली के साथ चौड़ाई पैरामीटर के रूप में उपयोग करने के लिए एक सूची बनाता है। फ़ंक्शन चलने वाली विंडो समय और सूचकांक आधारित नहीं होने पर फ़ंक्शन अनियमित चिड़ियाघर वस्तुओं के लिए अनुक्रमणिका निकालता है। इसलिए चिड़ियाघर वस्तु का सूचकांक वास्तविक समय होना चाहिए।

# Create a zoo object where index represents time (e.g. in seconds) 

d <- zoo(c(1,1,1,1,1,2,2,2,2,2,16,25,27,27,27,27,27,31),  
     c(1:5,11:15,16,25:30,31)) 

# Create function 

createRollapplyWidth = function(zoodata, steps, window){ 

    mintime = min(time(zoodata))  

    maxtime = max(time(zoodata)) 

    spotstime = seq(from = mintime , to = maxtime, by = steps) 

    spotsindex = list() 

    for (i in 1:length(spotstime)){ 
    spotsindex[[i]] = as.numeric(which(spotstime[i] <= time(zoodata) & time(zoodata) < spotstime[i] + window))} 

    rollapplywidth = list() 
    for (i in 1:length(spotsindex)){ 
    if (!is.na(median(spotsindex[[i]]))){ 
     rollapplywidth[[round(median(spotsindex[[i]]))]] = spotsindex[[i]] - round(median(spotsindex[[i]]))} 
    } 
    return(rollapplywidth) 
    } 


# Create width parameter for rollapply using function 

rollwidth = createRollapplyWidth(zoodata = d, steps = 5, window = 5) 

# Use parameter in rollapply 

result = rollapply(d, width = rollwidth , FUN = sum, na.rm = T) 
result 

सीमा: दिनांकित समय पर आधारित नहीं है लेकिन सेकंड में समय पर आधारित है। रोलैप्ली का पैरामीटर "आंशिक" काम नहीं करता है।