Variable frameshift rolling average untuk beberapa variabel

Question

Saya memiliki kumpulan data seperti

index <- seq(2000,2020)
weight <-seq(50,70)
length <-seq(10,50,2)
data <- cbind(index,weight,length)
row.names(data) <-as.character(seq(1:21))
data

   index weight length
1   2000     50     10
2   2001     51     12
3   2002     52     14
4   2003     53     16
5   2004     54     18
6   2005     55     20
7   2006     56     22
8   2007     57     24
9   2008     58     26
10  2009     59     28
11  2010     60     30
12  2011     61     32
13  2012     62     34
14  2013     63     36
15  2014     64     38
16  2015     65     40
17  2016     66     42
18  2017     67     44
19  2018     68     46
20  2019     69     48
21  2020     70     50

Saya perlu membuat beberapa variabel baru yang mewakili pengukuran sebelumnya untuk semua interval.

Saya perlu memiliki nilai-nilai ini untuk setiap baris (untuk setiap indeks):

• berat badan 1 hari sebelum pengukuran
• berat rata-rata selama 1-2 hari sebelum pengukuran
• berat rata-rata selama 1-3 hari sebelum pengukuran
• dll. hingga 10 hari [frame bervariasi dari 1 hingga 10, frameshift sama dengan 1]

setelah itu:

• berat badan 2 hari sebelum pengukuran
• berat rata-rata selama 2-3 hari sebelum pengukuran
• berat rata-rata selama 2-4 hari sebelum pengukuran
• dll. hingga 11 hari [frame bervariasi dari 1 hingga 10, frameshift sama dengan 2]

dan dilanjutkan hingga frameshift yaitu sebesar 30. Jadi, frame bervariasi dari rata-rata 1 hari hingga 10 hari dan frame ini bergeser dari 1 hari sebelum pengukuran menjadi 30 hari sebelum pengukuran.

Juga, saya perlu melakukan itu untuk beberapa kolom (sekitar 10).

Terima kasih!

Answer 1

Mempertimbangkan paket tidyversedan zooini adalah proposisi:

Persiapkan lingkungan

library(tidyverse)
data <- tibble(
  index = seq(2000,2020),
  weight = seq(50,70),
  length = seq(10,50,2)
)

Lakukan pekerjaan:

Ulangi semua frameshift dan hitung semua rolling mean dari 1 hingga 10:

lapply(1:30, function(frameshift) {
  w <- lag(data$weight, frameshift)
  lapply(1:10, function(k) {
    name <- sprintf("frameshift%i_k%i", frameshift, k)
    tibble("{name}" := zoo::rollmean(x = w, k = k, fill = NA, align = "r"))
  }) %>% bind_cols()
}) %>% bind_cols()

Terakhir, Anda hanya perlu mengikat tibble yang dihasilkan dengan data Anda ...

Cicipi dengan frameshift 3 dan rollmean hingga 5

res <- lapply(3, function(frameshift) {
  w <- lag(data$weight, frameshift)
  lapply(1:5, function(k) {
    name <- sprintf("frameshift%i_k%i", frameshift, k)
    tibble("{name}" := zoo::rollmean(x = w, k = k, fill = NA, align = "r"))
  }) %>% bind_cols()
}) %>% bind_cols()

bind_cols(data, res)

A tibble: 21 x 8
  index weight length frameshift3_k1 frameshift3_k2 frameshift3_k3 frameshift3_k4 frameshift3_k5
   <int>  <int>  <dbl>          <dbl>          <dbl>          <dbl>          <dbl>          <dbl>
 1  2000     50     10             NA           NA               NA           NA               NA
 2  2001     51     12             NA           NA               NA           NA               NA
 3  2002     52     14             NA           NA               NA           NA               NA
 4  2003     53     16             50           NA               NA           NA               NA
 5  2004     54     18             51           50.5             NA           NA               NA
 6  2005     55     20             52           51.5             51           NA               NA
 7  2006     56     22             53           52.5             52           51.5             NA
 8  2007     57     24             54           53.5             53           52.5             52
 9  2008     58     26             55           54.5             54           53.5             53
10  2009     59     28             56           55.5             55           54.5             54

Answer 2

Gunakan rollapplyrsebagai berikut. Ubah offsetske -(2:11)untuk set kedua.

library(zoo)

offsets <- -(1:10)

n <- length(offsets)
means <- function(x) c(cumsum(x) / seq_along(x), NA * offsets)[1:n]
r <- rollapplyr(data[, "weight"], list(offsets), means, partial = TRUE, fill = NA)
colnames(r) <- -offsets
cbind(data, r)

memberi:

   index weight length  1    2  3    4  5    6  7    8  9   10
1   2000     50     10 NA   NA NA   NA NA   NA NA   NA NA   NA
2   2001     51     12 50   NA NA   NA NA   NA NA   NA NA   NA
3   2002     52     14 51 50.5 NA   NA NA   NA NA   NA NA   NA
4   2003     53     16 52 51.5 51   NA NA   NA NA   NA NA   NA
5   2004     54     18 53 52.5 52 51.5 NA   NA NA   NA NA   NA
6   2005     55     20 54 53.5 53 52.5 52   NA NA   NA NA   NA
7   2006     56     22 55 54.5 54 53.5 53 52.5 NA   NA NA   NA
8   2007     57     24 56 55.5 55 54.5 54 53.5 53   NA NA   NA
9   2008     58     26 57 56.5 56 55.5 55 54.5 54 53.5 NA   NA
10  2009     59     28 58 57.5 57 56.5 56 55.5 55 54.5 54   NA
11  2010     60     30 59 58.5 58 57.5 57 56.5 56 55.5 55 54.5
12  2011     61     32 60 59.5 59 58.5 58 57.5 57 56.5 56 55.5
13  2012     62     34 61 60.5 60 59.5 59 58.5 58 57.5 57 56.5
14  2013     63     36 62 61.5 61 60.5 60 59.5 59 58.5 58 57.5
15  2014     64     38 63 62.5 62 61.5 61 60.5 60 59.5 59 58.5
16  2015     65     40 64 63.5 63 62.5 62 61.5 61 60.5 60 59.5
17  2016     66     42 65 64.5 64 63.5 63 62.5 62 61.5 61 60.5
18  2017     67     44 66 65.5 65 64.5 64 63.5 63 62.5 62 61.5
19  2018     68     46 67 66.5 66 65.5 65 64.5 64 63.5 63 62.5
20  2019     69     48 68 67.5 67 66.5 66 65.5 65 64.5 64 63.5
21  2020     70     50 69 68.5 68 67.5 67 66.5 66 65.5 65 64.5