r - 加速填充函数R

Question

我有一个包含缺失值的数据框，我编写了一个使用 R 3.3.2 填充的函数

pkgs <- c("dplyr", "ggplot2", "tidyr", 'data.table', 'lazyeval')
lapply(pkgs, require, character.only = TRUE)

UID <- c('A', 'A', 'A', 'B', 'B', 'B', 'C', 'C')
Col1 <- c(1, 0, 0, 0, 1, 0, 0, 0)
df <- data.frame(UID, Col1)

填写Col1的函数:

AggregatedColumns <- function(DF, columnToUse, NewCol1) {
  # Setting up column names to use
  columnToUse <- deparse(substitute(columnToUse))
  NewCol1 <- deparse(substitute(NewCol1))

  # Creating new columns 
  DF[[NewCol1]] <- ifelse(DF[[columnToUse]] == 1, 1, NA)
  DF <- DF %>% group_by_("UID") %>% sort(DF[[columnToUse]], decreasing = TRUE) %>% fill_(NewCol1)
  DF <- DF %>% group_by_("UID") %>% sort(DF$columnToUse, decreasing = TRUE) %>% fill_(NewCol1, .direction = 'up')
  DF[[NewCol1]] <- ifelse(is.na(DF[[NewCol1]]), 0, DF[[NewCol1]])

  DF
}

我已经删除了这部分函数，​​因为这是减慢函数速度的部分。我是编写函数的新手，对于如何/如果可以加快速度的任何建议，我将不胜感激。我已将速度问题隔离到函数的 fill_ 部分。

我想做的是将虚拟变量从 Col1 传递到 New_Column，然后将填充转发到其他相同的 ID。例如:

UID             Col1
John Smith        1
John Smith        0

应该变成

UID             Col1  New_Column
John Smith        1      1
John Smith        0      1

编辑函数我编辑了函数以适应@HubertL 的建议。该功能仍然相当慢，但希望通过这些编辑可以重现该示例。

AggregatedColumns <- function(DF, columnToUse, NewCol1) {
  # Setting up column names to use
  columnToUse <- deparse(substitute(columnToUse))
  NewCol1 <- deparse(substitute(NewCol1))

  # Creating new columns 
  DF[[NewCol1]] <- ifelse(DF[[columnToUse]] == 1, 1, NA)
    DF <- DF %>% group_by_("UID") %>% fill_(NewCol1) %>% fill_(NewCol1, .direction = 'up')
  DF[[NewCol1]] <- ifelse(is.na(DF[[NewCol1]]), 0, DF[[NewCol1]])

  DF
}

期望的输出:

UID Col1 New
A    1    1 
A    0    1
A    0    1 
B    0    1
B    1    1
B    0    1
C    0    0
C    0    0

Answer 1

首先，这里有几点:

1. 你没必要调用ifelse (两次)while this function is very inefficient
2. 当您可以仅使用基础 R 简单地矢量化过程时，您不必要地使用外部包中的低效函数(按组)(也是两次)。

这是一个简单的单行代码，没有使用任何外部包，在 5e7 数据集上将性能提高了 x72 倍(对于更大的数据集可能更多)

AggregatedColumns2 <- function(DF, columnToUse, NewCol1) {
    # Setting up column names to use
    columnToUse <- deparse(substitute(columnToUse))
    NewCol1 <- deparse(substitute(NewCol1))

    # Creating the new column (one simple line)
    DF[[NewCol1]] <- as.integer(DF$UID %in% DF$UID[DF[[columnToUse]] == 1])

    # returning new data set back
    DF
}

---

基准

set.seed(123)
library(stringi)
N <- 5e7
UID <- stri_rand_strings(N, 2)
Col1 <- sample(0:1, N, replace = TRUE)
df <- data.frame(UID, Col1)


system.time(res <- AggregatedColumns(df, Col1, NewCol1))
#   user  system elapsed 
# 198.67    3.94  203.07 

system.time(res2 <- AggregatedColumns2(df, Col1, NewCol1))
# user  system elapsed 
# 2.82    0.00    2.82  

现在为了比较它们，我将重新排序并转换为矩阵，因为 Hadleyverses 包添加了大量不必要的属性(比较 str(res) 中创建的困惑与 str(res2) 中的简单结构)

identical(arrange(res, UID) %>% as.matrix, arrange(res2, UID) %>% as.matrix)
## [1] TRUE