【问题标题】:Speedy/elegant way to unite many pairs of columns快速/优雅的方式来连接多对列
【发布时间】:2015-02-24 01:40:24
【问题描述】:

是否有一种优雅/快速的方式来组合 data.frame 中的所有列对?

例如,使用mapply()paste()我们可以转这个data.frame:

mydf <- data.frame(a.1 = letters, a.2 = 26:1, b.1 = letters, b.2 = 1:26)
head(mydf)
  a.1 a.2 b.1 b.2
1   a  26   a   1
2   b  25   b   2
3   c  24   c   3
4   d  23   d   4
5   e  22   e   5
6   f  21   f   6

进入这个data.frame:

mydf2 <- mapply(function(x, y) {
     paste(x, y, sep = ".")},
     mydf[ ,seq(1, ncol(mydf), by = 2)],
     mydf[ ,seq(2, ncol(mydf), by = 2)])
head(mydf2)
     a.1    b.1  
[1,] "a.26" "a.1"
[2,] "b.25" "b.2"
[3,] "c.24" "c.3"
[4,] "d.23" "d.4"
[5,] "e.22" "e.5"
[6,] "f.21" "f.6"

但是,当应用于大型数据集时,这感觉很笨拙并且有点慢。有什么建议,也许使用 Hadley 包?

编辑: 理想的解决方案可以轻松扩展到大量列,这样列的名称就不需要包含在函数调用中。谢谢!

【问题讨论】:

  • 你可以简化一点像mapply(paste,mydf[c(TRUE,FALSE)],mydf[c(FALSE,TRUE)],sep=".")data.frame(Map(paste,mydf[c(TRUE,FALSE)],mydf[c(FALSE,TRUE)],sep="."))
  • 不确定这在多大程度上不那么笨拙。但是,我得到了以下内容。 odd &lt;- seq(1, ncol(mydf), 2);lapply(odd, function(x) paste(mydf[,x], mydf[,x+1], sep = ".")) %&gt;% do.call(cbind,.)

标签: r reshape dplyr tidyr


【解决方案1】:

有趣的是,OP 的解决方案似乎是最快的:

f1 <- function(mydf) {
    mapply(function(x, y) {
        paste(x, y, sep = ".")},
        mydf[ ,seq(1, ncol(mydf), by = 2)],
        mydf[ ,seq(2, ncol(mydf), by = 2)])
}

f.thelatemail <- function(mydf) {
    mapply(paste,mydf[c(TRUE,FALSE)],mydf[c(FALSE,TRUE)],sep=".")
}

require(dplyr)

f.on_the_shores_of_linux_sea <- function(mydf) {
    transmute(mydf,x1=paste0( a.1,'.', a.2),x2=paste0( b.1,'.', b.2)) 
}

f.jazurro <- function(mydf) {
    odd <- seq(1, ncol(mydf), 2);
    lapply(odd, function(x) paste(mydf[,x], mydf[,x+1], sep = ".")) %>% 
        do.call(cbind,.)
}

library(data.table) 
f.akrun <- function(mydf) {
    res <- as.data.table(matrix(, ncol=ncol(mydf)/2, nrow=nrow(mydf)))
    indx <- seq(1, ncol(mydf), 2)
    setDT(mydf)
    for(j in seq_along(indx)){
        set(res, i=NULL, j=j, value= paste(mydf[[indx[j]]], 
                                           mydf[[indx[j]+1]], sep='.'))
    }
    res
}

mydf <- data.frame(a.1 = letters, a.2 = 26:1, b.1 = letters, b.2 = 1:26)
mydf <- mydf[rep(1:nrow(mydf),5000),]


library(rbenchmark)
benchmark(f1(mydf),f.thelatemail(mydf),f.on_the_shores_of_linux_sea(mydf),f.jazurro(mydf),f.akrun(mydf))

结果:

#                                 test replications elapsed relative user.self sys.self user.child sys.child
# 5                      f.akrun(mydf)          100  14.000   75.269    13.673    0.296          0         0
# 4                    f.jazurro(mydf)          100   0.388    2.086     0.314    0.071          0         0
# 3 f.on_the_shores_of_linux_sea(mydf)          100  15.585   83.790    15.293    0.280          0         0
# 2                f.thelatemail(mydf)          100  26.416  142.022    25.736    0.639          0         0
# 1                           f1(mydf)          100   0.186    1.000     0.169    0.017          0         0

[更新基准]

我添加了来自@thelatemail 的一个解决方案,我在原始答案中错过了它,以及来自@akrun 的一个解决方案:

f.thelatemail2 <- function(mydf) {
    data.frame(Map(paste,mydf[c(TRUE,FALSE)],mydf[c(FALSE,TRUE)],sep="."))
}

f.akrun2 <- function(mydf) {    
    setDT(mydf)
    indx <- as.integer(seq(1, ncol(mydf), 2))
    mydf2 <- copy(mydf)
    for(j in indx){
        set(mydf2, i=NULL, j=j, value= paste(mydf2[[j]],
                                             mydf2[[j+1]], sep="."))
    }
    mydf2[,indx, with=FALSE]
}

基准测试:

library(rbenchmark)

benchmark(f1(mydf),f.thelatemail(mydf), f.thelatemail2(mydf), f.on_the_shores_of_linux_sea(mydf),f.jazurro(mydf),f.akrun(mydf),f.akrun2(mydf))
#                                 test replications elapsed relative user.self sys.self user.child sys.child
# 6                      f.akrun(mydf)          100  13.247   69.356    12.897    0.340          0         0
# 7                     f.akrun2(mydf)          100  12.746   66.733    12.405    0.339          0         0
# 5                    f.jazurro(mydf)          100   0.327    1.712     0.254    0.073          0         0
# 4 f.on_the_shores_of_linux_sea(mydf)          100  16.347   85.586    15.838    0.445          0         0
# 2                f.thelatemail(mydf)          100  26.307  137.733    25.536    0.708          0         0
# 3               f.thelatemail2(mydf)          100  15.938   83.445    15.136    0.750          0         0
# 1                           f1(mydf)          100   0.191    1.000     0.156    0.036          0         0

【讨论】:

  • 我怀疑c(TRUE, FALSE) 会更慢。我认为在我的解决方案中,新数据集的创建速度会减慢,即。 res &lt;- as.data.table(..。否则,set 会很快。另外,请注意 OP 要求多对。所以,我不知道transmute 方法是否会是一个选项。
  • @akrun,确实,c(TRUE, FALSE) 导致的减速是巨大的(比较 f.thelatemailf1)。我正在徘徊可能是什么原因。
  • 我不知道原因,但最近做了一个类似的基准测试stackoverflow.com/questions/28667872/passing-empty-index-in-r/…
  • 如果您不介意,您能否在不创建新的res 数据集的情况下更新原始数据集的基准。我制作了原始数据集的copy,以防 OP 需要原始数据集。
  • 我尝试了一个包含更多列的更大数据集(更新了我的帖子)。它显示f.jazurro 略好于f.akrun2。我想如果我让数据变得更大,它可能会变成data.tables 的青睐:-)
【解决方案2】:

我不确定这是最好的方法。看看下面的代码是否能提高速度

require(dplyr)
transmute(mydf,x1=paste0( a.1,'.', a.2),x2=paste0( b.1,'.', b.2)) 

根据评论更新答案:-)

【讨论】:

  • 您可以使用transmute 删除原始列。
  • 这个答案的唯一问题是它不能扩展到更多的列,抱歉,这个问题并不清楚!
【解决方案3】:

使用来自data.tableset 的选项。它对于大型数据集应该很快,因为它通过引用进行修改并且避免了[.data.table 的开销。假设每对列对列进行排序。

library(data.table)
res <- as.data.table(matrix(, ncol=ncol(mydf)/2, nrow=nrow(mydf)))
indx <- seq(1, ncol(mydf), 2)
setDT(mydf)
for(j in seq_along(indx)){
   set(res, i=NULL, j=j, value= paste(mydf[[indx[j]]], 
                           mydf[[indx[j]+1]], sep='.'))
 }
head(res)
#    V1  V2
#1: a.26 a.1
#2: b.25 b.2
#3: c.24 c.3
#4: d.23 d.4
#5: e.22 e.5
#6: f.21 f.6

除了创建新的结果数据集外,我们还可以更新原始数据集的相同或副本。会有一些关于类型转换的警告,但我想这会更快一些(未进行基准测试)

setDT(mydf)
mydf2 <- copy(mydf)
for(j in indx){
  set(mydf2, i=NULL, j=j, value= paste(mydf2[[j]],
   mydf2[[j+1]], sep="."))
 }
 mydf2[,indx, with=FALSE]

基准测试

我在包含许多列的稍大数据上尝试了基准测试。

数据

set.seed(24)
d1 <- as.data.frame(matrix(sample(letters,500*10000, replace=TRUE), 
    ncol=500), stringsAsFactors=FALSE)
set.seed(4242)
d2 <- as.data.frame(matrix(sample(1:200,500*10000,
            replace=TRUE), ncol=500))
d3 <- cbind(d1,d2)
mydf <- d3[,order(c(1:ncol(d1), 1:ncol(d2)))]
mydf1 <- copy(mydf) 

比较f1f.jazurro(最快)(来自@Marat Talipov 的帖子)与f.akrun2

   microbenchmark(f1(mydf), f.jazurro(mydf), f.akrun2(mydf1),
         unit='relative', times=20L)
   #Unit: relative
   #        expr      min        lq     mean   median       uq      max neval
   #      f1(mydf) 3.420448 2.3217708 2.714495 2.653178 2.819952 2.736376    20
   #f.jazurro(mydf) 1.000000 1.0000000 1.000000 1.000000 1.000000 1.000000    20
   #f.akrun2(mydf1) 1.204488 0.8015648 1.031248 1.042262 1.097136 1.066671    20
   #cld
   #b
   #a 
   #a 

在这方面,f.jazurrof.akrun2 略好。我认为如果我增加组大小、nrows 等,这将是一个有趣的比较

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 2021-05-04
    • 2017-05-10
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2022-01-22
    • 1970-01-01
    相关资源
    最近更新 更多