将多个列粘贴在一起

Question

我有一个数据框中的许多列，我想将它们粘合在一起（用“-”分隔），如下所示：

data <- data.frame('a' = 1:3, 
                   'b' = c('a','b','c'), 
                   'c' = c('d', 'e', 'f'), 
                   'd' = c('g', 'h', 'i'))
i.e.     
     a   b   c  d  
     1   a   d   g  
     2   b   e   h  
     3   c   f   i  

Which I want to become:

a x  
1 a-d-g  
2 b-e-h  
3 c-f-i  

通常我可以使用以下方法完成此操作：

within(data, x <- paste(b,c,d,sep='-'))

然后删除旧列，但遗憾的是我不知道具体的列名，只有所有列的集合名称，例如我会知道 cols <- c('b','c','d')

有人知道如何做到这点吗？

- user1165199

Answer 1

# your starting data..
data <- data.frame('a' = 1:3, 'b' = c('a','b','c'), 'c' = c('d', 'e', 'f'), 'd' = c('g', 'h', 'i')) 

# columns to paste together
cols <- c( 'b' , 'c' , 'd' )

# create a new column `x` with the three columns collapsed together
data$x <- apply( data[ , cols ] , 1 , paste , collapse = "-" )

# remove the unnecessary columns
data <- data[ , !( names( data ) %in% cols ) ]

- Anthony Damico

---

不需要在这里申请；粘贴已矢量化，这更有效率。 - baptiste

@baptiste ..没有使用do.call的可能性吗？ - Anthony Damico

当然，你可以使用evil(parse(...))，但我认为在这里使用do.call是正确的选择。 - baptiste

嗯..你怎么通过collapse="-"传递给paste函数呢？ - Anthony Damico

运行得非常完美。它需要应用或其变体来将多个列连接成一个单独的列，其中列名未知。其他解决方案对我无效。同时lapply也不起作用。 - Simone

Answer 2

作为对 baptiste 答案 的一种变体，假设您已经定义了数据为data，并且要合并的列在cols中定义。

cols <- c("b", "c", "d")

您可以通过以下步骤将新列添加到 data 并删除旧列：

data$x <- do.call(paste, c(data[cols], sep="-"))
for (co in cols) data[co] <- NULL

提供

> data
  a     x
1 1 a-d-g
2 2 b-e-h
3 3 c-f-i

- Brian Diggs

---

在“c(data[cols],…”中是否缺少逗号？像这样：“c(data[,cols],…” - roschu

@roschu 两种方法都可以。使用单个字符向量对data.frame 进行索引，将是一个列索引，尽管第一个参数通常是行索引。 - Brian Diggs

快速而智能。谢谢。 - Ali Khosro

Answer 3

使用tidyr包，这可以轻松地在1个函数调用中处理。

data <- data.frame('a' = 1:3, 
                   'b' = c('a','b','c'), 
                   'c' = c('d', 'e', 'f'), 
                   'd' = c('g', 'h', 'i'))

tidyr::unite_(data, paste(colnames(data)[-1], collapse="_"), colnames(data)[-1])

  a b_c_d
1 1 a_d_g
2 2 b_e_h
3 3 c_f_i

---

编辑： 不包括第一列，其他所有内容都要粘贴。

# tidyr_0.6.3

unite(data, newCol, -a) 
# or by column index unite(data, newCol, -1)

#   a newCol
# 1 1  a_d_g
# 2 2  b_e_h
# 3 3  c_f_i

- data_steve

---

我认为OP提到他们事先不知道列名，否则他们可以像他们所示的那样只使用within(data, x <- paste(b,c,d,sep='-'))来完成。 - David Arenburg

我同意@DavidArenburg的观点，这并没有解决问题。我认为unite_(data, "b_c_d", cols)或者根据实际情况，unite(data, b_c_d, -a)也许是一个可选方案。 - Sam Firke

Answer 4

我会构建一个新的数据框：

d <- data.frame('a' = 1:3, 'b' = c('a','b','c'), 'c' = c('d', 'e', 'f'), 'd' = c('g', 'h', 'i')) 

cols <- c( 'b' , 'c' , 'd' )

data.frame(a = d[, 'a'], x = do.call(paste, c(d[ , cols], list(sep = '-'))))

- baptiste

---

请注意，如果要将除“a”列之外的所有列粘合在一起，则可能需要使用d[ , names(d) != 'a']而不是d[ , cols]。 - baptiste

我认为您可以将SO上的一个规范解决方案简化为cbind(a = d ['a']，x = do.call（paste，c（d [cols]，sep =' - ')))，例如，在使用cbind方法的data.frame时避免逗号、列表和data.frame。 - David Arenburg

Answer 5

只是为了添加额外的解决方案，使用 Reduce 可能比 do.call 更慢，但可能比 apply 更好，因为它将避免 matrix 转换。此外，我们可以使用 setdiff 来删除不需要的列，而不是使用 for 循环。

cols <- c('b','c','d')
data$x <- Reduce(function(...) paste(..., sep = "-"), data[cols])
data[setdiff(names(data), cols)]
#   a     x
# 1 1 a-d-g
# 2 2 b-e-h
# 3 3 c-f-i

---

或者我们可以使用 data.table 包就地更新 data（假设数据是新鲜的）

library(data.table)
setDT(data)[, x := Reduce(function(...) paste(..., sep = "-"), .SD[, mget(cols)])]
data[, (cols) := NULL]
data
#    a     x
# 1: 1 a-d-g
# 2: 2 b-e-h
# 3: 3 c-f-i

另一个选择是使用.SDcols而不是mget，如下所示：

setDT(data)[, x := Reduce(function(...) paste(..., sep = "-"), .SD), .SDcols = cols]

- David Arenburg

Answer 6

在我看来，sprintf函数也应该被列入这些答案之中。你可以按照以下方式使用sprintf：

do.call(sprintf, c(d[cols], '%s-%s-%s'))

这将给出：

 [1] "a-d-g" "b-e-h" "c-f-i"

并创建所需的数据框：

data.frame(a = d$a, x = do.call(sprintf, c(d[cols], '%s-%s-%s')))

提供：

  a     x
1 1 a-d-g
2 2 b-e-h
3 3 c-f-i

尽管 sprintf 没有比 @BrianDiggs 的 do.call/paste 组合更明显的优势，但当您还想填充所需字符串的某些部分或者想指定数字位数时，它非常有用。请参见 ?sprintf 以获取多个选项。

另一种变体是使用 purrr 中的 pmap：

pmap(d[2:4], paste, sep = '-')

注意：此 pmap 解决方案仅适用于列不是因子的情况。

---

在更大的数据集上进行基准测试：

# create a larger dataset
d2 <- d[sample(1:3,1e6,TRUE),]
# benchmark
library(microbenchmark)
microbenchmark(
  docp = do.call(paste, c(d2[cols], sep="-")),
  appl = apply( d2[, cols ] , 1 , paste , collapse = "-" ),
  tidr = tidyr::unite_(d2, "x", cols, sep="-")$x,
  docs = do.call(sprintf, c(d2[cols], '%s-%s-%s')),
  times=10)

结果为：

Unit: milliseconds
 expr       min        lq      mean    median        uq       max neval cld
 docp  214.1786  226.2835  297.1487  241.6150  409.2495  493.5036    10 a  
 appl 3832.3252 4048.9320 4131.6906 4072.4235 4255.1347 4486.9787    10   c
 tidr  206.9326  216.8619  275.4556  252.1381  318.4249  407.9816    10 a  
 docs  413.9073  443.1550  490.6520  453.1635  530.1318  659.8400    10  b 

---

使用的数据：

d <- data.frame(a = 1:3, b = c('a','b','c'), c = c('d','e','f'), d = c('g','h','i')) 

- Jaap

---

这是我首选的答案，因为sprintf允许（就像paste一样）在每个变量之间插入不同的字符串，而不仅仅是像“-”或“_”这样的一个字符串，所以可以像sprintf一样使用c(d2 [cols]，'%s（%s）这里还有其他文本%s')。 - lokxs

这是我首选的答案，因为sprintf允许（就像paste一样）在每个变量之间插入不同的字符串，而不仅仅是像“-”或“_”那样的一个字符串，所以可以像sprintf一样使用c(d2[cols]，'%s（%s）这里还有其他文本%s')。 - lokxs

Answer 7

我对Anthony Damico、Brian Diggs和data_steve在一个小的tbl_df样本中给出的答案进行了基准测试，并得到了以下结果。

> data <- data.frame('a' = 1:3, 
+                    'b' = c('a','b','c'), 
+                    'c' = c('d', 'e', 'f'), 
+                    'd' = c('g', 'h', 'i'))
> data <- tbl_df(data)
> cols <- c("b", "c", "d")
> microbenchmark(
+     do.call(paste, c(data[cols], sep="-")),
+     apply( data[ , cols ] , 1 , paste , collapse = "-" ),
+     tidyr::unite_(data, "x", cols, sep="-")$x,
+     times=1000
+ )
Unit: microseconds
                                         expr     min      lq      mean  median       uq       max neval
do.call(paste, c(data[cols], sep = "-"))       65.248  78.380  93.90888  86.177  99.3090   436.220  1000
apply(data[, cols], 1, paste, collapse = "-") 223.239 263.044 313.11977 289.514 338.5520   743.583  1000
tidyr::unite_(data, "x", cols, sep = "-")$x   376.716 448.120 556.65424 501.877 606.9315 11537.846  1000

然而，当我对自己的包含约1百万行和10列的tbl_df进行评估时，结果却有很大不同。

> microbenchmark(
+     do.call(paste, c(data[c("a", "b")], sep="-")),
+     apply( data[ , c("a", "b") ] , 1 , paste , collapse = "-" ),
+     tidyr::unite_(data, "c", c("a", "b"), sep="-")$c,
+     times=25
+ )
Unit: milliseconds
                                                       expr        min         lq      mean     median        uq       max neval
do.call(paste, c(data[c("a", "b")], sep="-"))                 930.7208   951.3048  1129.334   997.2744  1066.084  2169.147    25
apply( data[ , c("a", "b") ] , 1 , paste , collapse = "-" )  9368.2800 10948.0124 11678.393 11136.3756 11878.308 17587.617    25
tidyr::unite_(data, "c", c("a", "b"), sep="-")$c              968.5861  1008.4716  1095.886  1035.8348  1082.726  1759.349    25

- ChristopherTull

Answer 8

这里有一个颇为不寻常（但速度很快）的方法：使用data.table中的fwrite将列“粘”在一起，然后使用fread将其读回来。为了方便，我已经将步骤编写成了一个名为fpaste的函数：

fpaste <- function(dt, sep = ",") {
  x <- tempfile()
  fwrite(dt, file = x, sep = sep, col.names = FALSE)
  fread(x, sep = "\n", header = FALSE)
}

以下是一个示例：

d <- data.frame(a = 1:3, b = c('a','b','c'), c = c('d','e','f'), d = c('g','h','i')) 
cols = c("b", "c", "d")

fpaste(d[cols], "-")
#       V1
# 1: a-d-g
# 2: b-e-h
# 3: c-f-i

它的性能如何？

d2 <- d[sample(1:3,1e6,TRUE),]
  
library(microbenchmark)
microbenchmark(
  docp = do.call(paste, c(d2[cols], sep="-")),
  tidr = tidyr::unite_(d2, "x", cols, sep="-")$x,
  docs = do.call(sprintf, c(d2[cols], '%s-%s-%s')),
  appl = apply( d2[, cols ] , 1 , paste , collapse = "-" ),
  fpaste = fpaste(d2[cols], "-")$V1,
  dt2 = as.data.table(d2)[, x := Reduce(function(...) paste(..., sep = "-"), .SD), .SDcols = cols][],
  times=10)
# Unit: milliseconds
#    expr        min         lq      mean     median         uq       max neval
#    docp  215.34536  217.22102  220.3603  221.44104  223.27224  225.0906    10
#    tidr  215.19907  215.81210  220.7131  220.09636  225.32717  229.6822    10
#    docs  281.16679  285.49786  289.4514  286.68738  290.17249  312.5484    10
#    appl 2816.61899 3106.19944 3259.3924 3266.45186 3401.80291 3804.7263    10
#  fpaste   88.57108   89.67795  101.1524   90.59217   91.76415  197.1555    10
#     dt2  301.95508  310.79082  384.8247  316.29807  383.94993  874.4472    10

- A5C1D2H2I1M1N2O1R2T1

---

如果你将写入和读取操作指向ramdisk，那么比较就会更加公平一些。 - jangorecki

@jangorecki，我不确定我是否做得正确（我使用TMPDIR=/dev/shm R启动了R），但与这些结果相比，我没有注意到很大的差异。我也没有尝试过调整fread或fwrite使用的线程数，看看它如何影响结果。 - A5C1D2H2I1M1N2O1R2T1

Answer 9

使用 {tidyr v1.2.0} 的简单直接代码

使用 {tidyr v1.2.0} 的解决方案

library(tidyr)

data %>% unite("x", all_of(cols), remove = T, sep = "-")

• "x" 是新列的名称。
• all_of(cols) 是我们想要合并的列的选择。使用 <tidy-select>，列名不需要硬编码。
• remove = T 我们删除输入列
• sep = "-" 我们定义值之间的分隔符
• 如果有 NA，我们也可以添加 na.rm = TRUE

输出

#   a     x
# 1 1 a-d-g
# 2 2 b-e-h
# 3 3 c-f-i

输入数据

data <- data.frame('a' = 1:3, 
                   'b' = c('a','b','c'), 
                   'c' = c('d', 'e', 'f'), 
                   'd' = c('g', 'h', 'i'))
cols <- c('b','c','d')
data

#   a b c d
# 1 1 a d g
# 2 2 b e h
# 3 3 c f i

*这个解决方案与已经发布的不同。

- Ruam Pimentel

Answer 10

我知道这是一个老问题，但我认为我应该提供一个简单的解决方案，使用像问题者建议的paste()函数：

data_1<-data.frame(a=data$a,"x"=paste(data$b,data$c,data$d,sep="-")) 
data_1
  a     x
1 1 a-d-g
2 2 b-e-h
3 3 c-f-i

- Rikki Franklin Frederiksen