Свертывание избранных групп

Question

Я пытаюсь найти более быстрый способ итеративного свертывания выбранных групп во фрейме данных.Я в настоящее время перебираю приобретения, даты и переменные.Я хотел бы векторизовать это, если это возможно.

Учитывая набор идентификаторов [1,2], я хотел бы взять все значения для идентификатора 2 и добавить его в идентификатор id1.Кроме того, после этого я хотел бы удалить id2 из набора данных.

Создание данных для корректировки

dates <- c("Q1", "Q2", "Q3", "Q4")
ids <- c(1,2,3,4)
x1 <- seq(from=1, by=1, length=16)
x2 <- seq(from=1, by=2, length=16)
dat <- expand.grid(dates=dates, ids=ids)
dat <- data.frame(dat, x1, x2)

Создание данных для корректировки с помощью

ref <- data.frame(acquirer=c(2,3), acquired=c(1,4))

медленная тройкадля итеративного свертывания

for(i in 1:nrow(ref)){
  for(j in c("x1", "x2")){
    for(z in c("Q1", "Q2", "Q3", "Q4")){
      dat[dat$ids==ref$acquirer[i] & dat$dates==z, j] <- 
          dat[dat$ids==ref$acquirer[i] & dat$dates==z, j] +
          dat[dat$ids==ref$acquired[i] & dat$dates==z, j]
      dat[dat$ids==ref$acquired[i] & dat$dates==z, j] <- NA
    }
  }
}

Answer 1

Подход с использованием пакета data.table:

library(data.table)
setDT(dat)
setDT(ref)

#join the acquirer and acquired into a data.table and calculate x1 and x2 values
acqDat <- dat[dat[ref, on=.(ids=acquirer), allow.cartesian=TRUE],
    on=.(dates, ids=acquired), allow.cartesian=TRUE,
    .(dates, ids=i.ids, x1=x1+i.x1, x2=x2+i.x2)]

#update by reference the updated x1 and x2 values
dat[, c("x1", "x2") := acqDat[copy(.SD), on=.(dates, ids), .(x1, x2)]]

Выход:

    dates ids x1 x2
 1:    Q1   1 NA NA
 2:    Q2   1 NA NA
 3:    Q3   1 NA NA
 4:    Q4   1 NA NA
 5:    Q1   2  6 10
 6:    Q2   2  8 14
 7:    Q3   2 10 18
 8:    Q4   2 12 22
 9:    Q1   3 22 42
10:    Q2   3 24 46
11:    Q3   3 26 50
12:    Q4   3 28 54
13:    Q1   4 NA NA
14:    Q2   4 NA NA
15:    Q3   4 NA NA
16:    Q4   4 NA NA

Answer 2

Это должно работать в случае свертывания 2 в 1:

library(dplyr)
dat %>% 
  mutate(ids = if_else(ids == 2, 1, ids)) %>% 
  group_by(ids, dates) %>% 
  summarize(x1 = sum(x1), x2 = sum(x2))

Вы можете добавить другое изменение или использовать вызов case_when, если есть несколько перекодировок.