有没有更好的方法来转换我的数据框?

时间:2019-05-21 17:17:45

标签: r

我有一个包含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 

我的第一个问题是为什么第二种方法这么慢?
第二个问题是是否有更好的/替代方法?

3 个答案:

答案 0 :(得分: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,使每个列表元素的长度相同。 “相同长度”由max(lengths(tmp))给出,附加NA的函数为`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, ...)列表元素。

答案 1 :(得分:0)

一个有效的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

答案 2 :(得分:0)

我实现了这两种新方法,并用实际数据执行了它们。它们非常快,但是都没有返回期望值:

getEmployment(id: number): Observable<Employment> {
    const url = `${this.EmploymentUrl}/${id}`;
    return this.http.get<Employment>(url).pipe(
      tap(_ => this.log('fetched employment id=${id}')),
      catchError(this.handleError<Employment>('getEmployment id=${id}'))
    );
  }

这给出了这个输出:

# 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])

当我将实现的结果与evtlog的级别进行匹配时:

 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中的因子到整数的转换中。 对于第二个选项(#4),解决方案很简单。更改

head(levels(evtlog$color))

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

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

做到了。

我还没有找到第一种选择的解决方案(#3)。

谢谢, 本