R plyr，data.table，应用data.frame的某些列答案

【问题标题】：R plyr, data.table, apply certain columns of data.frameR plyr，data.table，应用data.frame的某些列
【发布时间】：2014-01-30 03:12:03
【问题描述】：

我正在寻找加快代码速度的方法。我正在研究apply/ply 方法以及data.table。不幸的是，我遇到了问题。

这是一个小样本数据：

ids1   <- c(1, 1, 1, 1, 2, 2, 2, 2)
ids2   <- c(1, 2, 3, 4, 1, 2, 3, 4)
chars1 <- c("aa", " bb ", "__cc__", "dd  ", "__ee", NA,NA, "n/a")
chars2 <- c("vv", "_ ww_", "  xx  ", "yy__", "  zz", NA, "n/a", "n/a")
data   <- data.frame(col1 = ids1, col2 = ids2, 
                 col3 = chars1, col4 = chars2, 
          stringsAsFactors = FALSE)

这是一个使用循环的解决方案：

library("plyr")
cols_to_fix <- c("col3","col4")
for (i in 1:length(cols_to_fix)) {
  data[,cols_to_fix[i]] <- gsub("_", "", data[,cols_to_fix[i]])
  data[,cols_to_fix[i]] <- gsub(" ", "", data[,cols_to_fix[i]])
  data[,cols_to_fix[i]] <- ifelse(data[,cols_to_fix[i]]=="n/a", NA, data[,cols_to_fix[i]])
}

我最初查看ddply，但我想使用的一些方法只使用向量。因此，我无法弄清楚如何在某些列中一一对应地处理 ddply。

另外，我一直在查看laply，但我想将原始data.frame 与更改一起返回。谁能帮我？谢谢。

根据之前的建议，这是我尝试从 plyr 包中使用的内容。

选项 1：

data[,cols_to_fix] <- aaply(data[,cols_to_fix],2, function(x){
   x <- gsub("_", "", x,perl=TRUE)
   x <- gsub(" ", "", x,perl=TRUE)
   x <- ifelse(x=="n/a", NA, x)
},.progress = "text",.drop = FALSE)

选项 2：

data[,cols_to_fix] <- alply(data[,cols_to_fix],2, function(x){
   x <- gsub("_", "", x,perl=TRUE)
   x <- gsub(" ", "", x,perl=TRUE)
   x <- ifelse(x=="n/a", NA, x)
},.progress = "text")

选项 3：

data[,cols_to_fix] <- adply(data[,cols_to_fix],2, function(x){
   x <- gsub("_", "", x,perl=TRUE)
   x <- gsub(" ", "", x,perl=TRUE)
   x <- ifelse(x=="n/a", NA, x)
},.progress = "text")

这些都没有给我正确的答案。

apply 效果很好，但我的数据非常大，plyr 包中的进度条会非常好。再次感谢。

【问题讨论】：

“非常大”有多大？您能否提供与您的真实数据维度相对应的示例数据？当操作需要数小时才能完成时，需要进度条。这里唯一的瓶颈是gsub 和分配期间的大量副本（后者可以通过引用分配来避免）。提供真实的数据维度肯定会有所帮助。
@Arun 进度条对于 >5 秒的任务很有用，因为它可以帮助您校准需要多长时间。

标签： r data.table plyr apply

【解决方案1】：

这是使用set 的data.table 解决方案。

require(data.table)
DT <- data.table(data)
for (j in cols_to_fix) {
    set(DT, i=NULL, j=j, value=gsub("[ _]", "", DT[[j]], perl=TRUE))
    set(DT, i=which(DT[[j]] == "n/a"), j=j, value=NA_character_)
}

DT
#    col1 col2 col3 col4
# 1:    1    1   aa   vv
# 2:    1    2   bb   ww
# 3:    1    3   cc   xx
# 4:    1    4   dd   yy
# 5:    2    1   ee   zz
# 6:    2    2   NA   NA
# 7:    2    3   NA   NA
# 8:    2    4   NA   NA

第一行读取：在 DT 中为所有 i(=NULL) 设置，并且 column=j 的值 gsub(..)。
第二行内容为：在 DT 中设置，其中 i(=condn) 和 column=j，值为 NA_character_。

注意：使用 PCRE (perl=TRUE) 有很好的加速效果，尤其是在更大的向量上。

【讨论】：

【解决方案2】：

这是一个data.table 解决方案，如果您的桌子很大，应该会更快。 := 的概念是列的“更新”。我相信，因此，您不会像“普通”数据框解决方案那样在内部再次复制表。

require(data.table)
DT <- data.table(data)

fxn = function(col) {
  col = gsub("[ _]", "", col, perl = TRUE)
  col[which(col == "n/a")] <- NA_character_
  col
}

cols = c("col3", "col4");

# lapply your function
DT[, (cols) := lapply(.SD, fxn), .SDcols = cols]
print(DT)

【讨论】：

+1 也结帐?set。它避免了[.data.table 开销，因此速度更快。对于遍历每一列和更新值（通过引用）特别有用。
我已经尝试使用set() 函数来解决这个问题，但可以想出一个可行的答案。我还没有找到将函数应用于set() 内的值调用的示例。请随意编辑答案。
我之前使用set 写了一个答案，然后将其删除。我现在已经取消删除了。你说，由于你的真实数据非常大，它可能会非常快。让我知道您发现了什么（如果您设法对所有这些答案进行基准测试）。希望它有所帮助。
我知道它现在是如何工作的。这实际上不是我的问题，但无论如何我发现 set 的使用很有指导意义，谢谢你的回答！
当然！很晚才意识到我写的是“your”而不是“OP's”。无法编辑。

【解决方案3】：

无需循环（for 或 *ply）：

tmp <- gsub("[_ ]", "", as.matrix(data[,cols_to_fix]), perl=TRUE)
tmp[tmp=="n/a"] <- NA
data[,cols_to_fix] <- tmp

基准

我只对 Arun 的 data.table 解决方案和我的矩阵解决方案进行基准测试。我假设需要修复许多列。

基准代码：

options(stringsAsFactors=FALSE)

set.seed(45)
K <- 1000; N <- 1e5
foo <- function(K) paste(sample(c(letters, "_", " "), 8, replace=TRUE), collapse="")
bar <- function(K) replicate(K, foo(), simplify=TRUE)
data <- data.frame(id1=sample(5, K, TRUE), 
                   id2=sample(5, K, TRUE)
)
data <- cbind(data, matrix(sample(bar(K), N, TRUE), ncol=N/K))

cols_to_fix <- as.character(seq_len(N/K))
library(data.table)

benchfun <- function() {
  time1 <- system.time({
    DT <- data.table(data)
    for (j in cols_to_fix) {
      set(DT, i=NULL, j=j, value=gsub("[ _]", "", DT[[j]], perl=TRUE))
      set(DT, i=which(DT[[j]] == "n/a"), j=j, value=NA_character_)
    }
  })

  data2 <- data
  time2 <- system.time({
    tmp <- gsub("[_ ]", "", as.matrix(data2[,cols_to_fix]), perl=TRUE)
    tmp[tmp=="n/a"] <- NA   
    data2[,cols_to_fix] <- tmp
  })

  list(identical= identical(as.data.frame(DT), data2),
       data.table_timing= time1[[3]],
       matrix_timing=time2[[3]])
}

replicate(3, benchfun())

基准测试结果：

#100 columns to fix, nrow=1e5
#                  [,1]   [,2]  [,3]  
#identical         TRUE   TRUE  TRUE  
#data.table_timing 6.001  5.571 5.602 
#matrix_timing     17.906 17.21 18.343

#1000 columns to fix, nrow=1e4
#                  [,1]   [,2]   [,3]  
#identical         TRUE   TRUE   TRUE  
#data.table_timing 4.509  4.574  4.857 
#matrix_timing     13.604 14.219 13.234

#1000 columns to fix, nrow=100
#                  [,1]  [,2]  [,3] 
#identical         TRUE  TRUE  TRUE 
#data.table_timing 0.052 0.052 0.055
#matrix_timing     0.134 0.128 0.127

#100 columns to fix, nrow=1e5 and including 
#data1 <- as.data.frame(DT) in the timing
#                           [,1]  [,2]  [,3]   [,4]   [,5]   [,6]   [,7]   [,8]   [,9]   [,10] 
#identical                  TRUE  TRUE  TRUE   TRUE   TRUE   TRUE   TRUE   TRUE   TRUE   TRUE  
#data.table_timing          5.642 5.58  5.762  5.382  5.419  5.633  5.508  5.578  5.634  5.397 
#data.table_returnDF_timing 5.973 5.808 5.817  5.705  5.736  5.841  5.759  5.833  5.689  5.669 
#matrix_timing              20.89 20.3  19.988 20.271 19.177 19.676 20.836 20.098 20.005 19.409

data.table 只快了三倍。如果我们决定更改数据结构（如 data.table 解决方案所做的那样）并将其保留为矩阵，这种优势可能会更小。

【讨论】：

我没有看到 OP 正在处理大数据。在这里，在 col 子集、as.matrix、<-(tmp)、<-(tmp)（第二行）和<-(data)（最后一行）期间制作了一个副本。可能相当昂贵..我很好奇。如果 OP 没有，我稍后会进行基准测试。
@Arun 如果我们不坚持最后要有一个data.frame，我们也许可以减少副本的数量。另外，我预计 data.table 的性能会更好，但相比之下，矩阵解决方案的性能相当不错。
当您在函数中计时 DT <- data.table(data) 时，我希望您还将最终转换为 data.frame 计时，因为这是所需的输出。关键在于制作副本的效果（其中一部分来自您转换为matrix 以利用其性能）。那么，如果转换需要太多时间，那又有什么意义呢？这或多或少是我想要解决的问题。
即便如此，当您将 N 更改为 1e7 时，DT 需要 13 秒，而矩阵输出需要 26 秒。这只是'2x'。但是“时间”可能有点误导。特别是当它按顺序或许多秒/分钟时。
@Arun 不，我没有时间as.data.frame(DT) 因为恕我直言将data.table 转回普通的data.frame 会很愚蠢。我知道这个简单的基准测试程序不是最佳的，但我认为这里就足够了。然而，结论是 data.table 比基础 R 解决方案快，但不是一个数量级。

【解决方案4】：

我认为您可以使用常规的旧 apply 执行此操作，这将在每一列上调用您的清理函数 (margin=2)：

fxn = function(col) {
  col <- gsub("_", "", col)
  col <- gsub(" ", "", col)
  col <- ifelse(col=="n/a", NA, col)
  return(col)
}
data[,cols_to_fix] <- apply(data[,cols_to_fix], 2, fxn)
data
#   col1 col2 col3 col4
# 1    1    1   aa   vv
# 2    1    2   bb   ww
# 3    1    3   cc   xx
# 4    1    4   dd   yy
# 5    2    1   ee   zz
# 6    2    2 <NA> <NA>
# 7    2    3 <NA> <NA>
# 8    2    4 <NA> <NA>

编辑：听起来您需要使用 plyr 包。我不是plyr 的专家，但这似乎可行：

library(plyr)
data[,cols_to_fix] <- t(laply(data[,cols_to_fix], fxn))

【讨论】：

如何使用 plyr 包中的功能之一？它有一些我非常喜欢的能力（即进度条）。
我尝试使用 aaply 和 alply，它们应该类似于 apply，但我没有得到正确的答案。
@Brad 使用您尝试执行的操作编辑您的代码；否则很难提供帮助。
布罗迪，感谢您的建议。我将修改后的代码放在原始帖子中。 @josilber 和你的建议都很好，但我无法用 plyr 找出替代方案。

【解决方案5】：

这是所有不同答案的基准：

首先，所有答案都是单独的函数：

1) 阿伦的

arun <- function(data, cols_to_fix) {
    DT <- data.table(data)
    for (j in cols_to_fix) {
        set(DT, i=NULL, j=j, value=gsub("[ _]", "", DT[[j]], perl=TRUE))
        set(DT, i=which(DT[[j]] == "n/a"), j=j, value=NA_character_)
    }
    return(DT)
}

2) 马丁的

martin <- function(data, cols) {
    DT <- data.table(data)    
    colfun = function(col) {
        col <- gsub("_", "", col)
        col <- gsub(" ", "", col)
        col <- ifelse(col=="n/a", NA, col)
    }
    DT[, (cols) := lapply(.SD, colfun), .SDcols = cols]
    return(DT)
}

3) 罗兰的

roland <- function(data, cols_to_fix) {
    tmp <- gsub("[_ ]", "", as.matrix(data[,cols_to_fix]))
    tmp[tmp=="n/a"] <- NA   
    data[,cols_to_fix] <- tmp
    return(data)
}

4) 布罗迪格的

brodieg <- function(data, cols_to_fix) {
    fix_fun <- function(x) gsub("(_| )", "", ifelse(x == "n/a", NA_character_, x))
    data[, cols_to_fix] <- apply(data[, cols_to_fix], 2, fix_fun)
    return(data)
}

5) 乔西尔伯的

josilber <- function(data, cols_to_fix) {
    colfun2 <- function(col) {
        col <- gsub("_", "", col)
        col <- gsub(" ", "", col)
        col <- ifelse(col=="n/a", NA, col)
        return(col)
    }
    data[,cols_to_fix] <- apply(data[,cols_to_fix], 2, colfun2)
    return(data)
}

2) 基准测试功能：

我们将运行此函数 3 次，并取运行中的最小值（移除缓存效果）作为运行时：

bench <- function(data, cols_to_fix) {
    ans <- c( 
        system.time(arun(data, cols_to_fix))["elapsed"], 
        system.time(martin(data, cols_to_fix))["elapsed"], 
        system.time(roland(data, cols_to_fix))["elapsed"], 
        system.time(brodieg(data, cols_to_fix))["elapsed"],
        system.time(josilber(data, cols_to_fix))["elapsed"]
    )
}

3) 在（稍微）大数据上，只需修复 2 个列（如此处的 OP 示例）：

require(data.table)
set.seed(45)
K <- 1000; N <- 1e5
foo <- function(K) paste(sample(c(letters, "_", " "), 8, replace=TRUE), collapse="")
bar <- function(K) replicate(K, foo(), simplify=TRUE)
data <- data.frame(id1=sample(5, N, TRUE), 
                   id2=sample(5, N, TRUE), 
                   col3=sample(bar(K), N, TRUE), 
                   col4=sample(bar(K), N, TRUE)
        )

rown <- c("arun", "martin", "roland", "brodieg", "josilber")
coln <- paste("run", 1:3, sep="")
cols_to_fix <- c("col3","col4")
ans <- matrix(0L, nrow=5L, ncol=3L)
for (i in 1:3) {
    print(i)
    ans[, i] <- bench(data, cols_to_fix)
}
rownames(ans) <- rown
colnames(ans) <- coln

#           run1  run2  run3
# arun     0.149 0.140 0.142
# martin   0.643 0.629 0.621
# roland   1.741 1.708 1.761
# brodieg  1.926 1.919 1.899
# josilber 2.067 2.041 2.162

【讨论】：

我认为只用两列进行基准测试是没有意义的。

【解决方案6】：

apply 版本是要走的路。看起来@josilber 提出了相同的答案，但这个答案略有不同（注意正则表达式）。

fix_fun <- function(x) gsub("(_| )", "", ifelse(x == "n/a", NA_character_, x))
data[, cols_to_fix] <- apply(data[, cols_to_fix], 2, fix_fun)

更重要的是，当你想进行split-apply-combine分析时，一般你想使用ddply和data.table。在这种情况下，您的所有数据都属于同一个组（没有任何与您不同的子组），因此您不妨使用apply。

apply 语句中心的2 表示我们希望通过第二维对输入进行子集化，并传递结果（在本例中为向量，每个向量代表cols_to_fix 中数据框中的一列) 到完成工作的函数。 apply 然后重新组合结果，我们将其分配回cols_to_fix 中的列。如果我们使用 1 代替，apply 会将数据框中的行传递给函数。结果如下：

data
#   col1 col2 col3 col4
# 1    1    1   aa   vv
# 2    1    2   bb   ww
# 3    1    3   cc   xx
# 4    1    4   dd   yy
# 5    2    1   ee   zz
# 6    2    2 <NA> <NA>
# 7    2    3 <NA> <NA>
# 8    2    4 <NA> <NA>

如果您有子组，那么我建议您使用data.table。一旦您习惯了语法，就很难在方便和速度方面被击败。它还可以跨数据集进行高效连接。

【讨论】：

小修正：data.table 不是 **split**-apply-combine 方法。这种误解似乎以某种方式出现了。它不会先拆分大量数据然后再应用。在计算时间+空间复杂度方面，这对于大数据（可能有太多级别）来说尤其糟糕。相反，data.table 只为最大的组分配内存，一次。然后，它巧妙地重用相同的内存（内存占用更少）并评估函数，同时从C 循环遍历每个组（为了速度）。
@Arun，感谢您提供背景细节。我仍然会说data.table 从概念的角度使用by 时是split-apply-combine。从这个角度来看，底层实现是什么并不重要。即使从技术角度来看，您仍在拆分原始数据，您是在迭代地进行而不是实际拆分。显然，在性能方面存在很大差异，但同样，从最终用户的角度来看，它本质上仍然是一个分裂。您只是非常聪明地将拆分的足迹最小化。
请不要认为这是对data.table 的任何批评。我认为 data.table 是 R 中最被低估的软件包。我并不是因为 data.table 的评分较低，而是因为 data.table 应该在几乎所有“R 中的最佳软件包”列表的顶部.
当您将它与ddply 一起使用在同一个句子中时，它会起作用。因为ddply首先splits整个数据-在apply+combine之前将拆分数据存储在一个变量中。这会让人对幕后发生的事情产生错误的印象。注册。你的 conceptual 视角，那么 everything 就是拆分-应用-组合，不是吗？包括一个 for-loop - 例如：x <- 1:100; y=integer(100L); for (i in 1:100) {tmp=x[i]; tmp2=tmp*2; y[i]=tmp2 } 此处的数据实际上并未被拆分。但根据您的定义，它仍然“拆分”原始数据。我不同意。我不会错误地理解你的观点。
我想我想说的是：订单很重要（如果不是对你，对我来说:)）。在s-a-c 中，首先拆分数据，然后应用要应用的任何函数，然后再组合。但是，它在这里的工作方式不同。最好地描述这个顺序是：首先获取组 (1:10) -> 按组划分子集 (df$y[..]) -> 应用（前例中没有任何内容：以上）-> 组合（在内部为 lapply 完成）。