Dán nhiều cột với nhau

Tôi có một loạt các cột trong khung dữ liệu mà tôi muốn dán lại với nhau (được phân tách bằng "-") như sau:

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  

Mà tôi muốn trở thành:

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

Tôi thường có thể làm điều này với:

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

và sau đó xóa các cột cũ, nhưng tiếc là tôi không biết cụ thể tên của các cột, chỉ có một tên chung cho tất cả các cột, ví dụ: tôi sẽ biết rằng cols <- c('b','c','d')

Có ai biết một cách để làm điều này?

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

Là một biến thể trên câu trả lời của baptiste , với datađịnh nghĩa như bạn có và các cột bạn muốn tập hợp lại được xác định trongcols

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

Bạn có thể thêm cột mới vào datavà xóa những cột cũ bằng

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

cái nào cho

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

Sử dụng tidyrgói, điều này có thể được xử lý dễ dàng trong 1 lần gọi hàm.

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

Chỉnh sửa: Loại trừ cột đầu tiên, mọi thứ khác sẽ được dán.

# 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

Tôi sẽ tạo một data.frame mới:

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 = '-'))))

Chỉ cần thêm giải pháp bổ sung Reducecó thể chậm hơn do.callnhưng có thể tốt hơn applyvì nó sẽ tránh matrixchuyển đổi. Ngoài ra, thay vì một forvòng lặp chúng ta có thể chỉ cần sử dụng setdiffđể loại bỏ các cột không cần thiết

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

Ngoài ra, chúng tôi có thể cập nhật datatại chỗ bằng cách sử dụng data.tablegói (giả sử dữ liệu mới)

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

Một tùy chọn khác là sử dụng .SDcolsthay vì mgetnhư trong

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

Tôi đã chuẩn hóa các câu trả lời của Anthony Damico, Brian Diggs và data_steve trên một mẫu nhỏ tbl_dfvà nhận được kết quả sau.

> 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

Tuy nhiên, khi tôi tự đánh giá tbl_dfvới ~ 1 triệu hàng và 10 cột, kết quả khá khác biệt.

> 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

Theo tôi, sprintfchức năng cũng xứng đáng có một vị trí trong số những câu trả lời này. Bạn có thể sử dụng sprintfnhư sau:

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

mang lại:

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

Và để tạo khung dữ liệu cần thiết:

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

cho:

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

Mặc dù sprintfkhông có lợi thế rõ ràng so với do.call/ pastesự kết hợp của @BrianDiggs, nó đặc biệt hữu ích khi bạn cũng muốn chèn các phần nhất định của chuỗi mong muốn hoặc khi bạn muốn chỉ định số chữ số. Xem ?sprintfmột số tùy chọn.

Một biến thể khác sẽ được sử dụng pmaptừrừ rừ:

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

Lưu ý: pmapgiải pháp này chỉ hoạt động khi các cột không phải là yếu tố.

Điểm chuẩn trên một tập dữ liệu lớn hơn:

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

kết quả trong:

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ữ liệu đã sử dụng:

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

Đây là một cách tiếp cận khá độc đáo (nhưng nhanh): sử dụng fwritetừ data.tableđể "dán" các cột lại với nhau và freadđể đọc lại. Để thuận tiện, tôi đã viết các bước dưới dạng một hàm có tên fpaste:

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

Đây là một ví dụ:

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

Nó hoạt động như thế nào?

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

library(plyr)

ldply(apply(data, 1, function(x) data.frame(
                      x = paste(x[2:4],sep="",collapse="-"))))

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

#  and with just the vector of names you have:

ldply(apply(data, 1, function(x) data.frame(
                      x = paste(x[c('b','c','d')],sep="",collapse="-"))))

# or equally:
mynames <-c('b','c','d')
ldply(apply(data, 1, function(x) data.frame(
                      x = paste(x[mynames],sep="",collapse="-"))))    

Tôi biết đây là một câu hỏi cũ, nhưng tôi nghĩ rằng dù sao thì tôi cũng nên trình bày giải pháp đơn giản bằng cách sử dụng hàm paste () như người hỏi đề xuất:

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