Есть ли лучшие способы трансформировать мой фрейм данных?

Question

У меня есть лог-файл с 130000 строками. Каждая строка содержит CaseID, метку времени и код / ​​фактор для действия. Фрейм данных упорядочен на CaseID, метка времени. Мне нужно изменить порядок данных таким образом, чтобы я получал все коды активности, принадлежащие одному делу, в одной строке вместе с CaseID

Пример:

df <- data.frame("CaseID" = c(1,1,3,2,1,4,2,3), 
  Activ = as.factor(c("A","B","A","C","D","C", "D", "C")))

  CaseID Activ
1      1     A
2      1     B
3      3     A
4      2     C
5      1     D
6      4     C
7      2     D
8      3     C

следует преобразовать в:

     [,1] [,2] [,3]
[1,]    1    2    4
[2,]    3    4   NA
[3,]    1    3   NA
[4,]    3   NA   NA

После изменения кадра данных:

df %>% arrange(CaseID) %>% mutate(case_rank = cumsum(c(0,as.numeric(diff(as.numeric(CaseID)))!=0)) +1) %>%       group_by(CaseID) %>% mutate(rank = 1:n()) %>% mutate(act_count = n()) -> df

Я реализовал 2 разных способа.

ptm <- proc.time()
Interim <- matrix(nrow = max(df$case_rank), ncol = max(df$rank))
for (i in 1:nrow(df)) {
  Interim[df[[i, "case_rank"]], df[[i, "rank"]]]  <- as.numeric(df[i, "Activ"])
} 
Interim
print(proc.time() - ptm)

ptm <- proc.time()
cols <- max(df$act_count)
emptyrow <- rep(NA, cols)
df2 <- data.frame(matrix(NA, nrow = max(df$case_rank), ncol = cols))
for(row in 1:max(df$case_rank)) 
  df2[row,] <- head(append(as.numeric(filter(df, CaseID == row)$Activ), emptyrow), cols)
m1 <- as.matrix(df2)
print(proc.time() - ptm)

После применения этого кода к исходному фрейму данных я получил следующие результаты:

   user  system elapsed 
  1.334   0.227   1.581 
   user  system elapsed 
  3.182   1.126   4.351 

Мой первый вопрос: почему второй метод такой медленный?
Второй вопрос: есть ли лучшие / альтернативные способы для этого?

Ben

Answer 1

Вот один из вариантов.

df$tmp <- match(df$Activ, sort(unique(df$Activ)))

tmp2 <- unstack(df, tmp ~ CaseID)
out <- do.call(rbind, lapply(tmp2, `length<-`, max(lengths(tmp2))))
out
#  [,1] [,2] [,3]
#1    1    2    4
#2    3    4   NA
#3    1    3   NA
#4    3   NA   NA

---

Первый шаг - преобразовать буквы в цифры, используя

df$tmp <- match(df$Activ, sort(unique(df$Activ)))

df$tmp выглядит как

df$tmp
# [1] 1 2 1 3 4 3 4 3

Теперь мы используем unstack, который возвращает список

unstack(df, tmp ~ CaseID)
#$`1`
#[1] 1 2 4

#$`2`
#[1] 3 4

#$`3`
#[1] 1 3

#$`4`
#[1] 3

Далее вам нужно добавить NA s, чтобы каждый элемент списка был одинаковой длины. «Та же длина» задается max(lengths(tmp)), а функция для добавления NA s равна `lengths<-`.

lapply(tmp2, `length<-`, max(lengths(tmp2)))
#$`1`
#[1] 1 2 4

#$`2`
#[1]  3  4 NA

#$`3`
#[1]  1  3 NA

#$`4`
#[1]  3 NA NA

Все, что осталось сделать, это rbind элементы списка, используя do.call(rbind, ...).

Answer 2

Я реализовал оба новых метода и выполнил их с реальными данными.Они очень быстрые, но оба не возвращают ожидаемые значения:

# 1 (Original)
ptm <- proc.time()
Interim <- matrix(nrow = max(evtlog$case_rank), ncol = max(evtlog$rank))
for (i in 1:nrow(evtlog)) {
  Interim[evtlog[[i, "case_rank"]], evtlog[[i, "rank"]]] <- as.numeric(evtlog[i, "color"])
}
print(proc.time() - ptm)
print(Interim[1, 1:10])

# 3
ptm <- proc.time()
setDT(evtlog)[, grp := .GRP, color]
Interim <- dcast(evtlog, CaseID ~ rowid(CaseID), value.var = 'grp')[, CaseID := NULL][]
print(proc.time() - ptm)
print(Interim[1, 1:10])

# 4
ptm <- proc.time()
evtlog$tmp <- match(evtlog$color, sort(unique(evtlog$color)))
tmp2 <- unstack(evtlog, tmp ~ CaseID)
Interim <- do.call(rbind, lapply(tmp2, `length<-`, max(lengths(tmp2))))
print(proc.time() - ptm)
print(Interim[1, 1:10])

Это дает следующий вывод:

 user  system elapsed 
0.491   0.000   0.491 
 [1]  1 10 14 37 11  3 14  8  8  8
 user  system elapsed 
0.011   0.000   0.006 
 1 2 3 4 5 6 7 8 9 10
 1: 1 2 3 4 5 6 3 7 7  7
 user  system elapsed 
0.006   0.000   0.003 
 [  1]  1  9 12 13 10  3 12  7  7  7

Когда я сопоставляю результаты моей реализации с уровнями изevtlog:

head(levels(evtlog$color))

[1] "Bestelaanvraag Aanmaken"              "Bestelaanvraag Aanvraaggegevens"      "Bestelaanvraag Afwijzen"             
[4] "Bestelaanvraag Annuleren"             "Bestelaanvraag Document intrekken"    "Bestelaanvraag Geen actie ondernomen"

Я получаю правильные ответы, поэтому проблема должна заключаться в переводе фактора в evtlog в целое число.Для второго варианта (# 4) решение было простым.Изменение

match(evtlog$color, sort(unique(evtlog$color)))

на

match(evtlog$color, levels(evtlog$color))

сделало это.

Я еще не нашел решение для первого варианта (# 3).

Спасибо, Бен

Answer 3

Один вариант будет dcast из эффективного data.table пакета

library(data.table)
setDT(df)[, grp := .GRP, Activ]
dcast(df, CaseID ~ rowid(CaseID), value.var = 'grp')[, CaseID := NULL][]
#   1  2  3
#1: 1  2  4
#2: 3  4 NA
#3: 1  3 NA
#4: 3 NA NA