मैं एक मैट्रिक्स में मूल्यों की एक श्रृंखला पर चलती औसत की गणना करने के लिए R का उपयोग करने की कोशिश कर रहा हूं। सामान्य आर मेलिंग सूची खोज हालांकि बहुत उपयोगी नहीं रही है। प्रतीत नहीं होता है कि आर में एक अंतर्निहित फ़ंक्शन है जो मुझे चलती औसत की गणना करने की अनुमति देगा। क्या कोई पैकेज एक प्रदान करता है? या क्या मुझे अपना लिखने की आवश्यकता है?
जवाबों:
या आप इसे केवल फ़िल्टर का उपयोग करके गणना कर सकते हैं, यहां मेरे द्वारा उपयोग किए जाने वाले फ़ंक्शन हैं:
ma <- function(x, n = 5){filter(x, rep(1 / n, n), sides = 2)}यदि आप उपयोग करते हैं dplyr, तो stats::filterऊपर दिए गए फ़ंक्शन में निर्दिष्ट करने के लिए सावधान रहें ।
stats::filter
sides = 2चिड़ियाघर के लिए संरेखित = "केंद्र" के बराबर है: रोलमियन या RcppRoll :: roll_mean। sides = 1"सही" संरेखण के बराबर है। मुझे "आंशिक" डेटा (2 या अधिक मान) के साथ "बाएं" संरेखण या गणना करने का कोई तरीका नहीं दिखता है?
उपयोग cumsumकरना पर्याप्त और कुशल होना चाहिए। मान लें कि आपके पास एक वेक्टर x है और आप n संख्याओं का रनिंग योग चाहते हैं
cx <- c(0,cumsum(x))
rsum <- (cx[(n+1):length(cx)] - cx[1:(length(cx) - n)]) / n
जैसा कि @mzuther द्वारा टिप्पणियों में बताया गया है, यह मानता है कि डेटा में कोई NA नहीं हैं। उन लोगों से निपटने के लिए गैर-एनए मूल्यों की संख्या से प्रत्येक विंडो को विभाजित करने की आवश्यकता होगी। यहाँ ऐसा करने का एक तरीका है, जिसमें @Ricardo Cruz की टिप्पणी शामिल है:
cx <- c(0, cumsum(ifelse(is.na(x), 0, x)))
cn <- c(0, cumsum(ifelse(is.na(x), 0, 1)))
rx <- cx[(n+1):length(cx)] - cx[1:(length(cx) - n)]
rn <- cn[(n+1):length(cx)] - cn[1:(length(cx) - n)]
rsum <- rx / rn
यह अभी भी मुद्दा है कि अगर विंडो में सभी मान NA हैं तो शून्य त्रुटि से एक विभाजन होगा।
cumsum(c(1:3,NA,1:3))
cx <- c(0, cumsum(ifelse(is.na(x), 0, x)))।
में data.table 1.12.0 नया frollmeanसमारोह तेजी से और सटीक ध्यान से मतलब रोलिंग से निपटने की गणना में जोड़ा गया है NA, NaNऔर +Inf, -Infमान।
जैसा कि प्रश्न में कोई प्रतिलिपि प्रस्तुत करने योग्य उदाहरण नहीं है, यहाँ संबोधित करने के लिए बहुत अधिक नहीं है।
आप ?frollmeanमैनुअल के बारे में अधिक जानकारी पा सकते हैं , ऑनलाइन भी उपलब्ध है ?frollmean।
नीचे मैनुअल से उदाहरण:
library(data.table)
d = as.data.table(list(1:6/2, 3:8/4))
# rollmean of single vector and single window
frollmean(d[, V1], 3)
# multiple columns at once
frollmean(d, 3)
# multiple windows at once
frollmean(d[, .(V1)], c(3, 4))
# multiple columns and multiple windows at once
frollmean(d, c(3, 4))
## three above are embarrassingly parallel using openmpcaToolsपैकेज बहुत तेजी से मतलब / मिनट / अधिकतम / एसडी और कुछ अन्य कार्यों रोलिंग गया है। मैं केवल साथ काम किया है runmeanऔर runsdऔर वे अन्य संकुल तारीख करने के लिए उल्लेख किया है में से किसी का सबसे तेजी से कर रहे हैं।
आप RcppRollC ++ में लिखे गए बहुत तेज मूविंग एवरेज के लिए उपयोग कर सकते हैं । बस roll_meanफ़ंक्शन को कॉल करें । डॉक्स यहां देखे जा सकते हैं ।
अन्यथा, यह (धीमी) लूप के लिए चाल करना चाहिए:
ma <- function(arr, n=15){
res = arr
for(i in n:length(arr)){
res[i] = mean(arr[(i-n):i])
}
res
}res = arr। फिर एक लूप होता nहै जो सरणी के अंत तक, 15 वें तत्व से शुरू होता है । इसका मतलब यह है कि वह सबसे पहले सबसेट का मतलब लेता है, arr[1:15]जो स्पॉट को भरता है res[15]। अब, मैं एक संख्या के बजाय NA के प्रत्येक तत्व के res = rep(NA, length(arr))बजाय सेटिंग करना पसंद करता हूं , जहां हम 15 तत्वों का पूरा औसत नहीं ले सकते। res = arrres[1:14]
वास्तव RcppRollमें बहुत अच्छा है।
कैंटडूचथिस द्वारा पोस्ट किए गए कोड को चौथी पंक्ति में ठीक किया जाना चाहिए ताकि खिड़की को ठीक किया जा सके:
ma <- function(arr, n=15){
res = arr
for(i in n:length(arr)){
res[i] = mean(arr[(i-n+1):i])
}
res
}एक और तरीका, जो मिसिंग को संभालता है, यहां दिया गया है ।
एक तीसरा तरीका, आंशिक औसत की गणना करने के लिए कैंटचूचिस कोड में सुधार करना , इस प्रकार है:
ma <- function(x, n=2,parcial=TRUE){
res = x #set the first values
if (parcial==TRUE){
for(i in 1:length(x)){
t<-max(i-n+1,1)
res[i] = mean(x[t:i])
}
res
}else{
for(i in 1:length(x)){
t<-max(i-n+1,1)
res[i] = mean(x[t:i])
}
res[-c(seq(1,n-1,1))] #remove the n-1 first,i.e., res[c(-3,-4,...)]
}
}कैंटुचथिस और रोड्रिगो रेमेडियो के उत्तर के पूरक के लिए ;
moving_fun <- function(x, w, FUN, ...) {
# x: a double vector
# w: the length of the window, i.e., the section of the vector selected to apply FUN
# FUN: a function that takes a vector and return a summarize value, e.g., mean, sum, etc.
# Given a double type vector apply a FUN over a moving window from left to the right,
# when a window boundary is not a legal section, i.e. lower_bound and i (upper bound)
# are not contained in the length of the vector, return a NA_real_
if (w < 1) {
stop("The length of the window 'w' must be greater than 0")
}
output <- x
for (i in 1:length(x)) {
# plus 1 because the index is inclusive with the upper_bound 'i'
lower_bound <- i - w + 1
if (lower_bound < 1) {
output[i] <- NA_real_
} else {
output[i] <- FUN(x[lower_bound:i, ...])
}
}
output
}
# example
v <- seq(1:10)
# compute a MA(2)
moving_fun(v, 2, mean)
# compute moving sum of two periods
moving_fun(v, 2, sum)यहां उदाहरण कोड दिखाया गया है कि चिड़ियाघर पैकेज से फ़ंक्शन का उपयोग करके एक केंद्रित चलती औसत और एक अनुगामी चलती औसत की गणना कैसे करें ।rollmean
library(tidyverse)
library(zoo)
some_data = tibble(day = 1:10)
# cma = centered moving average
# tma = trailing moving average
some_data = some_data %>%
mutate(cma = rollmean(day, k = 3, fill = NA)) %>%
mutate(tma = rollmean(day, k = 3, fill = NA, align = "right"))
some_data
#> # A tibble: 10 x 3
#> day cma tma
#> <int> <dbl> <dbl>
#> 1 1 NA NA
#> 2 2 2 NA
#> 3 3 3 2
#> 4 4 4 3
#> 5 5 5 4
#> 6 6 6 5
#> 7 7 7 6
#> 8 8 8 7
#> 9 9 9 8
#> 10 10 NA 9एक runnerचलती कार्यों के लिए पैकेज का उपयोग कर सकता है । इस मामले में mean_runकार्य करते हैं। इसके साथ समस्या cummeanयह है कि यह NAमूल्यों को संभालता नहीं है , लेकिन mean_runकरता है। runnerपैकेज भी अनियमित समय श्रृंखला का समर्थन करता है और खिड़कियां तारीख पर निर्भर कर सकती हैं:
library(runner)
set.seed(11)
x1 <- rnorm(15)
x2 <- sample(c(rep(NA,5), rnorm(15)), 15, replace = TRUE)
date <- Sys.Date() + cumsum(sample(1:3, 15, replace = TRUE))
mean_run(x1)
#> [1] -0.5910311 -0.2822184 -0.6936633 -0.8609108 -0.4530308 -0.5332176
#> [7] -0.2679571 -0.1563477 -0.1440561 -0.2300625 -0.2844599 -0.2897842
#> [13] -0.3858234 -0.3765192 -0.4280809
mean_run(x2, na_rm = TRUE)
#> [1] -0.18760011 -0.09022066 -0.06543317 0.03906450 -0.12188853 -0.13873536
#> [7] -0.13873536 -0.14571604 -0.12596067 -0.11116961 -0.09881996 -0.08871569
#> [13] -0.05194292 -0.04699909 -0.05704202
mean_run(x2, na_rm = FALSE )
#> [1] -0.18760011 -0.09022066 -0.06543317 0.03906450 -0.12188853 -0.13873536
#> [7] NA NA NA NA NA NA
#> [13] NA NA NA
mean_run(x2, na_rm = TRUE, k = 4)
#> [1] -0.18760011 -0.09022066 -0.06543317 0.03906450 -0.10546063 -0.16299272
#> [7] -0.21203756 -0.39209010 -0.13274756 -0.05603811 -0.03894684 0.01103493
#> [13] 0.09609256 0.09738460 0.04740283
mean_run(x2, na_rm = TRUE, k = 4, idx = date)
#> [1] -0.187600111 -0.090220655 -0.004349696 0.168349653 -0.206571573 -0.494335093
#> [7] -0.222969541 -0.187600111 -0.087636571 0.009742884 0.009742884 0.012326968
#> [13] 0.182442234 0.125737145 0.059094786कोई अन्य विकल्पों को भी निर्दिष्ट कर सकता है lag, और केवल atविशिष्ट अनुक्रमित रोल कर सकता है । पैकेज और फ़ंक्शन प्रलेखन में अधिक ।
हालांकि थोड़ा धीमा है, लेकिन आप मैट्रिस पर गणना करने के लिए zoo: रोलप्ले का भी उपयोग कर सकते हैं।
reqd_ma <- rollapply(x, FUN = mean, width = n)जहाँ x डेटा सेट है, FUN = mean फ़ंक्शन है; आप इसे मिनट, अधिकतम, एसडी आदि में भी बदल सकते हैं और चौड़ाई रोलिंग विंडो है।
set.seed(123); x <- rnorm(1000); system.time(apply(embed(x, 5), 1, mean)); library(zoo); system.time(rollapply(x, 5, mean)) मेरी मशीन पर यह इतना तेज है कि यह 0 सेकंड का समय देता है।
इसके लिए स्लाइडर पैकेज का उपयोग किया जा सकता है। इसका एक इंटरफ़ेस है जिसे विशेष रूप से purrr के समान महसूस करने के लिए डिज़ाइन किया गया है। यह किसी भी मनमाने फ़ंक्शन को स्वीकार करता है, और किसी भी प्रकार के आउटपुट को वापस कर सकता है। डेटा फ्रेम पंक्तिबद्ध से अधिक पुनरावृत्त होते हैं। Pkgdown साइट यहाँ है ।
library(slider)
x <- 1:3
# Mean of the current value + 1 value before it
# returned as a double vector
slide_dbl(x, ~mean(.x, na.rm = TRUE), .before = 1)
#> [1] 1.0 1.5 2.5
df <- data.frame(x = x, y = x)
# Slide row wise over data frames
slide(df, ~.x, .before = 1)
#> [[1]]
#> x y
#> 1 1 1
#>
#> [[2]]
#> x y
#> 1 1 1
#> 2 2 2
#>
#> [[3]]
#> x y
#> 1 2 2
#> 2 3 3स्लाइडर और data.table दोनों का ओवरहेड frollapply()बहुत कम होना चाहिए (चिड़ियाघर की तुलना में बहुत तेज)। frollapply()यहाँ इस सरल उदाहरण के लिए थोड़ा तेज़ लगता है, लेकिन ध्यान दें कि यह केवल संख्यात्मक इनपुट लेता है, और आउटपुट को स्केलर संख्यात्मक मान होना चाहिए। स्लाइडर कार्य पूरी तरह से सामान्य हैं, और आप किसी भी डेटा प्रकार को वापस कर सकते हैं।
library(slider)
library(zoo)
library(data.table)
x <- 1:50000 + 0L
bench::mark(
slider = slide_int(x, function(x) 1L, .before = 5, .complete = TRUE),
zoo = rollapplyr(x, FUN = function(x) 1L, width = 6, fill = NA),
datatable = frollapply(x, n = 6, FUN = function(x) 1L),
iterations = 200
)
#> # A tibble: 3 x 6
#> expression min median `itr/sec` mem_alloc `gc/sec`
#> <bch:expr> <bch:tm> <bch:tm> <dbl> <bch:byt> <dbl>
#> 1 slider 19.82ms 26.4ms 38.4 829.8KB 19.0
#> 2 zoo 177.92ms 211.1ms 4.71 17.9MB 24.8
#> 3 datatable 7.78ms 10.9ms 87.9 807.1KB 38.7
forecast::maऔर इसमें सभी पड़ोस शामिल हैं, न कि सही।