data.table группировка по нескольким последовательным факторам

Question

Я пытаюсь оценить некоторые параметры через n факторов в data.table. Хотя я знаком с использованием функциональности by для выполнения операции с коэффициентом; выполнение этого для нескольких последовательных факторов вызывает некоторые проблемы.

В качестве примера, с упрощенным набором

df <- data.table(Group = c(rep("A", 2), rep("B", 3), rep("C", 2), rep("D", 4), "E", rep("F", 4)), Variable = round(rnorm(16), 2)) 

Group Variable 
1:  A  0.13  
2:  A  0.26 
3:  B -1.36 
4:  B -0.78 
5:  B -0.92 
6:  C  0.00 
7:  C -2.49 
8:  D -1.85 
9:  D  0.37 
10: D -0.57 
11: D  1.42 
12: E -0.72 
13: F -1.04 
14: F  1.86 
15: F  0.49 
16: F  1.61 

Использование df[, mean(Variable), by = Group] даст среднее для каждой группы. Тем не менее, я хотел бы рассчитать среднее значение для предыдущих групп n.
Я пробовал использовать M[, zoo::rollapply(Variable, n, mean), by = Group], однако, потому что Группы имеют разные размеры, используя фиксированный n не будет работать.

Что хотела бы, функциональность сродни df[, mean(Variable), by = "This Group and previous n Groups].

Выход я пытаюсь добиться (для случая п = 3) будет выглядеть

Group Variable 
1:  A NA  
2:  A NA 
3:  B NA 
4:  B NA 
5:  B NA 
6:  C 0.13 
7:  C 0.13 
8:  D -1.36 
9:  D -1.36 
10: D -1.36 
11: D -1.36 
12: E 0 
13: F -1.85 
14: F -1.85 
15: F -1.85 
16: F -1.85 

Любая помощь будет оценена.

Answer 1

library(data.table) 
library(RcppRoll) 
df1 <- df[, .(n=.N, S=sum(Variable)), by = Group] 
df1[, NewVariable:=roll_sum(S, 3, align="right", fill=NA)/roll_sum(n, 3, align="right", fill=NA),] 
df[df1, on="Group"] 
    Group Variable n  S NewVariable 
1:  A -0.63 2 -0.45   NA 
2:  A  0.18 2 -0.45   NA 
3:  B -0.84 3 1.09   NA 
4:  B  1.60 3 1.09   NA 
5:  B  0.33 3 1.09   NA 
6:  C -0.82 2 -0.33 0.04428571 
7:  C  0.49 2 -0.33 0.04428571 
8:  D  0.74 4 2.52 0.36444444 
9:  D  0.58 4 2.52 0.36444444 
10:  D -0.31 4 2.52 0.36444444 
11:  D  1.51 4 2.52 0.36444444 
12:  E  0.39 1 0.39 0.36857143 
13:  F -0.62 4 -1.75 0.12888889 
14:  F -2.21 4 -1.75 0.12888889 
15:  F  1.12 4 -1.75 0.12888889 
16:  F -0.04 4 -1.75 0.12888889 

Надеюсь, мое решение само собой разумеется.

dplyr эквивалент

df %>% 
    group_by(Group) %>% 
    summarise(n=n(), S=sum(Variable)) %>% 
    mutate(NewVar=roll_sum(S, 3, align="right", fill=NA)/roll_sum(n, 3, align="right", fill=NA)) %>% 
    left_join(df, by="Group") 

---

данных

set.seed(1) 
df <- data.table(Group = c(rep("A", 2), rep("B", 3), rep("C", 2), rep("D", 4), "E", rep("F", 4)), Variable = round(rnorm(16), 2)) 

Информация Пакет

[1] RcppRoll_0.2.2 data.table_1.9.5 

Answer 2

Я могу вам помочь, если вы готовы преобразовать свою таблицу данных в файл data.frame и выполнить этот процесс. Посмотрите на этот пример и выполните команды шаг за шагом, чтобы увидеть, как это работает. Этот пример относится к случаю n = 3, о котором вы упомянули.

library(dplyr) 

df <- data.frame(Group = c(rep("A", 2), rep("B", 3), rep("C", 2), rep("D", 4), "E", rep("F", 4)), 
       Variable = round(rnorm(16), 2)) 


df %>% group_by(Group) %>% 
    do(data.frame(df2 = df)) %>% 
    mutate(diff = as.numeric(Group) - as.numeric(df2.Group)) %>% 
    filter(diff %in% 0:2) %>% 
    mutate(unique_pairs = n_distinct(diff)) %>% 
    filter(unique_pairs ==3) %>% 
    mutate(Mean = mean(df2.Variable)) %>% 
    filter(diff==0) %>% 
    select(Group, Mean) %>% 
    ungroup 

Философия просто состоит в том, чтобы создать все комбинации между именами «Группа», а затем создать несколько полезных столбцов для фильтрации. Вы можете сделать этот процесс с циклом for, но я ожидаю, что он будет медленнее.

В случае, если вы действительно хотите работать с data.table (еще dplyr но data.table структуры в фоновом режиме), попробуйте следующее:

library(dplyr) 
library(data.table) 

df <- data.table(Group = c(rep("A", 2), rep("B", 3), rep("C", 2), rep("D", 4), "E", rep("F", 4)), 
        Variable = round(rnorm(16), 2)) 

df = df %>% mutate(Group2 = as.numeric(as.factor(Group))) 

df %>% 
    group_by(Group2, Group) %>% 
    do(data.table(df2 = df)) %>% 
    mutate(diff = Group2 - df2.Group2) %>% 
    filter(diff %in% 0:2) %>% 
    group_by(Group2, Group) %>% 
    mutate(unique_pairs = n_distinct(diff)) %>% 
    filter(unique_pairs ==3) %>% 
    group_by(Group2, Group) %>% 
    mutate(Mean = mean(df2.Variable)) %>% 
    filter(diff==0) %>% 
    select(Group2, Group, Mean) %>% 
    ungroup 

Здесь data.table не любит факторы, так что я имел для работы с числами вместо букв для переменной Group. Кроме того, после каждого мутанта мне пришлось снова сгруппировать (это известная проблема dplyr, когда вы хотите работать с таблицей data.table в фоновом режиме). Философия точно такая же.

Answer 3

Это не может быть наиболее эффективным способом, но это работает:

Во-первых, давайте установим семя для воспроизводимости:

set.seed(1038) 
> df 
    Group Variable 
1:  A -0.86 
2:  A  0.57 
3:  B  0.10 
4:  B -1.57 
5:  B  1.73 
6:  C -0.56 
7:  C  0.54 
8:  D -1.71 
9:  D -0.47 
10:  D -1.00 
11:  D  1.03 
12:  E -0.47 
13:  F -1.06 
14:  F -2.06 
15:  F -0.57 
16:  F  1.70 

Теперь устранить литом Group как целое, чтобы сделать n-1 более ощутимым, а затем уплотняют все многочисленные наблюдения по grp_no:

setkey(df[ , grp_no := as.integer(as.factor(Group))], grp_no) 
df_ttls <- df[ , .(ttl = sum(Variable), .N), by = grp_no] 
> df_ttls 
    grp_no ttl N 
1:  1 -0.29 2 
2:  2 0.26 3 
3:  3 -0.02 2 
4:  4 -2.15 4 
5:  5 -0.47 1 
6:  6 -1.99 4 

Теперь создать средневзвешенное значение, которое вы ищете, используя shift:

df_ttls[ , lag3avg := rowSums(sapply(0:2, shift, x = ttl))/ 
       rowSums(sapply(0:2, shift, x = N))] 

И слиться обратно в полный набор данных:

df[df_ttls, lag3avg := i.lag3avg][ ] 
    Group Variable grp_no  lag3avg 
1:  A -0.86  1   NA 
2:  A  0.57  1   NA 
3:  B  0.10  2   NA 
4:  B -1.57  2   NA 
5:  B  1.73  2   NA 
6:  C -0.56  3 -0.007142857 
7:  C  0.54  3 -0.007142857 
8:  D -1.71  4 -0.212222222 
9:  D -0.47  4 -0.212222222 
10:  D -1.00  4 -0.212222222 
11:  D  1.03  4 -0.212222222 
12:  E -0.47  5 -0.377142857 
13:  F -1.06  6 -0.512222222 
14:  F -2.06  6 -0.512222222 
15:  F -0.57  6 -0.512222222 
16:  F  1.70  6 -0.512222222 

Обратите внимание, что это может быть легко расширена до функции:

k_lag_avg <- function(k){ 
    df[df_ttls[ , .(grp_no, rowSums(sapply(1:k - 1L, shift, x = ttl))/ 
        rowSums(sapply(1:k -1L, shift, x = N)))], 
    paste0("lag", k, "avg") := i.V2] 
} 

k_lag_avg(5L); df[ ] 
    Group Variable grp_no  lag3avg lag5avg 
1:  A -0.86  1   NA   NA 
2:  A  0.57  1   NA   NA 
3:  B  0.10  2   NA   NA 
4:  B -1.57  2   NA   NA 
5:  B  1.73  2   NA   NA 
6:  C -0.56  3 -0.007142857   NA 
7:  C  0.54  3 -0.007142857   NA 
8:  D -1.71  4 -0.212222222   NA 
9:  D -0.47  4 -0.212222222   NA 
10:  D -1.00  4 -0.212222222   NA 
11:  D  1.03  4 -0.212222222   NA 
12:  E -0.47  5 -0.377142857 -0.2225000 
13:  F -1.06  6 -0.512222222 -0.3121429 
14:  F -2.06  6 -0.512222222 -0.3121429 
15:  F -0.57  6 -0.512222222 -0.3121429 
16:  F  1.70  6 -0.512222222 -0.3121429