Вставить несколько столбцов вместе

100

У меня есть несколько столбцов в фрейме данных, которые я хочу вставить вместе (разделенные знаком "-") следующим образом:

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  

Кем я хочу стать:

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
источник

Ответы:

104
# 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 ) ]
Энтони Дамико
источник
8
здесь не нужно подавать заявку; paste векторизован, и это более эффективно,
baptiste
1
@baptiste .. можно без do.call?
Энтони Дамико
1
конечно, вы могли бы, например, использовать evil(parse(...)), но я считаю, do.callчто это правильный выбор.
baptiste
Do.call - лучший метод; поддерживает векторизацию.
Clayton Stanley
1
хм .. как бы вы прошли collapse = "-"? к paste?
Энтони Дамико
48

Как вариант ответа батиста , с 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
Брайан Диггс
источник
Не пропущена ли запятая в «c (data [cols], ...»? Например: «c (data [, cols], ...»
roschu
2
@roschu Либо подойдет. Индексирование data.frameс одним символьным вектором будет индексированием столбца, несмотря на то, что первым аргументом обычно является индекс строки.
Брайан Диггс,
быстро и умно. Спасибо
Али
33

Используя tidyrpackage, это можно легко решить за 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
источник
3
Я думаю, что OP упомянул, что они не знают имя столбца заранее., Иначе они могли бы сделать это так, within(data, x <- paste(b,c,d,sep='-'))как они проиллюстрировали.
Дэвид Аренбург
Я согласен с @DavidArenburg, это не касается ситуации OP. Я думаю, unite_(data, "b_c_d", cols)что или в зависимости от их фактического data.frame, unite(data, b_c_d, -a)тоже может быть кандидатом.
Сэм Фирке
14

Я бы построил новый data.frame:

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 = '-'))))
батист
источник
обратите внимание, что вместо этого d[ , cols]вы можете захотеть использовать, d[ , names(d) != 'a']если все, кроме aстолбца, должны быть вставлены вместе.
baptiste
2
Одно из канонических решений для SO, я думаю, вы могли бы сократить это cbind(a = d['a'], x = do.call(paste, c(d[cols], sep = '-'))), например, избегать запятых, listа data.frameпри использовании data.frameметодаcbind
Дэвид Аренбург
9

Просто чтобы добавить дополнительное решение, Reduceкоторое, вероятно, будет медленнее, do.callно вероятно лучше, чем applyпотому, что оно предотвратит matrixпреобразование. Кроме того, вместо этого forмы могли бы просто использовать цикл setdiffдля удаления ненужных столбцов

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на месте, используя data.tableпакет (при условии наличия свежих данных)

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]
Дэвид Аренбург
источник
5

Я сравнил ответы Энтони Дамико, Брайана Диггса и 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

Однако, когда я самостоятельно оценил tbl_df~ 1 миллион строк и 10 столбцов, результаты были совсем другими.

> 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
КристоферТулл
источник
5

На мой взгляд, 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он не имеет явного преимущества перед комбинацией do.call/ paste@BrianDiggs, он особенно полезен, когда вы также хотите дополнить определенные части желаемой строки или когда вы хотите указать количество цифр. См. ?sprintfНесколько вариантов.

Другой вариант - использовать 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')) 
Яап
источник
3

Вот довольно нетрадиционный (но быстрый) подход: используйте fwritefrom, data.tableчтобы «вставить» столбцы вместе и 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
источник
Что делать, если писать и читать на рамдиск? Сравнение было бы чуточку честнее.
jangorecki
@jangorecki, не уверен, правильно ли я делаю (я начал R с TMPDIR=/dev/shm R), но я не замечаю огромной разницы по сравнению с этими результатами. Я также вообще не играл с количеством используемых потоков freadи не fwriteвидел, как это влияет на результаты.
A5C1D2H2I1M1N2O1R2T1
1
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="-"))))    
user1317221_G
источник
0

Я знаю, что это старый вопрос, но подумал, что в любом случае должен представить простое решение с использованием функции 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
Рикки Франклин Фредериксен
источник