Tính trung bình di chuyển

Tôi đang cố gắng sử dụng R để tính trung bình di chuyển qua một loạt các giá trị trong ma trận. Việc tìm kiếm danh sách gửi thư R bình thường không hữu ích lắm. Dường như không có hàm tích hợp trong R sẽ cho phép tôi tính trung bình di chuyển. Có gói nào cung cấp không? Hay tôi cần phải tự viết?

• Phương tiện lăn / Tối đa / Trung bình trong gói sở thú (rollmean)
• Di chuyển trung bình trong TTR
• ma trong dự báo

Hoặc bạn có thể chỉ cần tính toán nó bằng bộ lọc, đây là chức năng tôi sử dụng:

ma <- function(x, n = 5){filter(x, rep(1 / n, n), sides = 2)}

Nếu bạn sử dụng dplyr, hãy cẩn thận để chỉ định stats::filtertrong chức năng trên.

Sử dụng cumsumphải đủ và hiệu quả. Giả sử bạn có một vector x và bạn muốn có một số tiền chạy của n số

cx <- c(0,cumsum(x))
rsum <- (cx[(n+1):length(cx)] - cx[1:(length(cx) - n)]) / n

Như đã chỉ ra trong các bình luận của @mzuther, điều này giả định rằng không có NA trong dữ liệu. để đối phó với những người sẽ yêu cầu chia mỗi cửa sổ cho số lượng giá trị không phải NA. Đây là một cách để làm điều đó, kết hợp nhận xét từ @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

Điều này vẫn có một vấn đề là nếu tất cả các giá trị trong cửa sổ là NA thì sẽ có một phép chia bằng 0.

Trong data.table,frollmean chức năng mới 1.12.0 đã được thêm vào để tính toán cán nhanh và chính xác có nghĩa là xử lý cẩn thận NA, NaNvà +Inf,-Inf giá trị.

Vì không có ví dụ tái tạo trong câu hỏi nên không có nhiều hơn để giải quyết ở đây.

Bạn có thể tìm thêm thông tin về ?frollmeanhướng dẫn sử dụng, cũng có sẵn trực tuyến tại?frollmean .

Ví dụ từ hướng dẫn dưới đây:

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 openmp

Các caToolsgói đã rất nhanh lăn trung bình / min / max / sd và vài chức năng khác. Tôi chỉ làm việc với runmeanvà runsdhọ là những người nhanh nhất trong số các gói khác được đề cập cho đến nay.

Bạn có thể sử dụng RcppRollcho các đường trung bình di chuyển rất nhanh được viết bằng C ++. Chỉ cần gọi roll_meanhàm. Tài liệu có thể được tìm thấy ở đây .

Mặt khác, vòng lặp này (chậm hơn) sẽ thực hiện thủ thuật:

ma <- function(arr, n=15){
  res = arr
  for(i in n:length(arr)){
    res[i] = mean(arr[(i-n):i])
  }
  res
}

Trong thực tế RcppRolllà rất tốt.

Mã được đăng bởi cantdutchthis phải được sửa trong dòng thứ tư để cửa sổ được sửa:

ma <- function(arr, n=15){
  res = arr
  for(i in n:length(arr)){
    res[i] = mean(arr[(i-n+1):i])
  }
  res
}

Một cách khác, xử lý các sai lầm, được đưa ra ở đây .

Cách thứ ba, cải thiện mã cantdutchthis để tính trung bình một phần hoặc không, như sau:

  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,...)]
  }
}

Để bổ sung cho câu trả lời của cantdutchthis và Rodrigo Remedio ;

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)

Dưới đây là mã ví dụ cho thấy cách tính trung bình di chuyển trung tâm và trung bình di chuyển kéo theo sử dụng rollmeanhàm từ gói sở thú .

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

Người ta có thể sử dụng runnergói cho các chức năng di chuyển. Trong trường hợp này mean_runchức năng. Vấn đề cummeanlà nó không xử lý NAcác giá trị, nhưng mean_runkhông. runnergói cũng hỗ trợ chuỗi thời gian không thường xuyên và cửa sổ có thể phụ thuộc vào ngày:

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

Người ta cũng có thể chỉ định các tùy chọn khác như lagvà chỉ cuộn atcác chỉ mục cụ thể. Thêm trong gói và tài liệu chức năng .

Mặc dù hơi chậm nhưng bạn cũng có thể sử dụng zoo :: rollapply để thực hiện các phép tính trên ma trận.

reqd_ma <- rollapply(x, FUN = mean, width = n)

Trong đó x là tập dữ liệu, FUN = mean là hàm; bạn cũng có thể thay đổi nó thành min, max, sd vv và chiều rộng là cửa sổ cuộn.

Gói trượt có thể được sử dụng cho việc này. Nó có một giao diện được thiết kế đặc biệt để cảm thấy tương tự như purrr. Nó chấp nhận bất kỳ chức năng tùy ý và có thể trả về bất kỳ loại đầu ra nào. Khung dữ liệu thậm chí được lặp qua hàng khôn ngoan. Trang web pkgdown ở đây .

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

Chi phí hoạt động của cả thanh trượt và data.table frollapply()phải khá thấp (nhanh hơn nhiều so với sở thú). frollapply()có vẻ nhanh hơn một chút cho ví dụ đơn giản này ở đây, nhưng lưu ý rằng nó chỉ lấy đầu vào số và đầu ra phải là một giá trị số vô hướng. các hàm trượt hoàn toàn chung chung và bạn có thể trả về bất kỳ loại dữ liệu nào.

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