Pegar varias columnas juntas


99

Tengo un montón de columnas en un marco de datos que quiero pegar juntas (separadas por "-") de la siguiente manera:

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  

En el que quiero convertirme:

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

Normalmente podría hacer esto con:

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

y luego eliminar las columnas antiguas, pero desafortunadamente no sé los nombres de las columnas específicamente, solo un nombre colectivo para todas las columnas, por ejemplo, sabría que cols <- c('b','c','d')

¿Alguien sabe una forma de hacer esto?

Respuestas:


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

7
no es necesario aplicar aquí; la pasta está vectorizada, y eso es más eficiente
baptiste

1
@baptiste ..posible sin do.call?
Anthony Damico

1
seguro, podría usar evil(parse(...)), por ejemplo , pero creo que do.calles la llamada correcta aquí.
baptiste

Do.call aquí es la mejor técnica; mantiene la vectorización.
Clayton Stanley

1
hmm ... ¿cómo pasarías el pasaje collapse = "-"? a paste?
Anthony Damico

48

Como una variante de la respuesta de baptiste , con datadefinido como tiene y las columnas que desea juntar definidas encols

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

Puede agregar la nueva columna datay eliminar las antiguas con

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

lo que da

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

¿Falta una coma en "c (data [cols], ..."? Así: "c (data [, cols], ..."
roschu

2
@roschu Cualquiera funcionará. La indexación de un data.framevector con un solo carácter será una indexación de columna, a pesar de que el primer argumento suele ser el índice de fila.
Brian Diggs

rápido e inteligente. Gracias
Ali Khosro

32

Con el tidyrpaquete, esto se puede manejar fácilmente en 1 llamada de función.

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

Editar: excluir la primera columna, todo lo demás se pega.

# 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

3
Creo que OP mencionó que no conocen el nombre de la columna de antemano. De lo contrario, podrían hacerlo tal within(data, x <- paste(b,c,d,sep='-'))como lo ilustraron.
David Arenburg

Estoy de acuerdo con @DavidArenburg, esto no aborda la situación del OP. Creo unite_(data, "b_c_d", cols)que, o dependiendo de su data.frame real, también unite(data, b_c_d, -a)podría ser un candidato.
Sam Firke

13

Construiría un nuevo 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 = '-'))))

tenga en cuenta que, en lugar de d[ , cols]usted, es posible que desee utilizar d[ , names(d) != 'a']si todos menos la acolumna se van a pegar juntos.
baptiste

1
Una de las soluciones canónicas en SO, creo que podría acortar esto para cbind(a = d['a'], x = do.call(paste, c(d[cols], sep = '-'))), por ejemplo, evitar las comas, listy data.framemientras usa el data.framemétodo decbind
David Arenburg

9

Solo para agregar una solución adicional con la Reduceque probablemente sea más lenta do.callpero probadamente mejor que applyporque evitará la matrixconversión. Además, en su lugar, un forbucle que podríamos usar setdiffpara eliminar columnas no deseadas

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

Alternativamente, podríamos actualizar dataen su lugar usando el data.tablepaquete (asumiendo datos nuevos)

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

Otra opción es usar en .SDcolslugar de mgetcomo en

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

5

Comparé las respuestas de Anthony Damico, Brian Diggs y data_steve en una pequeña muestra tbl_dfy obtuve los siguientes resultados.

> 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

Sin embargo, cuando evalué por mi cuenta tbl_dfcon ~ 1 millón de filas y 10 columnas, los resultados fueron bastante diferentes.

> 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

En mi opinión, la sprintffunción-merece un lugar entre estas respuestas también. Puede usarlo de la sprintfsiguiente manera:

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

lo que da:

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

Y para crear el marco de datos requerido:

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

dando:

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

Aunque sprintfno tiene una clara ventaja sobre la combinación do.call/ pastede @BrianDiggs, es especialmente útil cuando también desea rellenar ciertas partes de la cadena deseada o cuando desea especificar el número de dígitos. Consulte ?sprintflas diversas opciones.

Otra variante sería utilizar pmap de:

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

Nota: esta pmapsolución solo funciona cuando las columnas no son factores.


Un punto de referencia en un conjunto de datos más grande:

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

resulta en:

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 

Datos usados:

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

3

Aquí hay un enfoque bastante poco convencional (pero rápido): use fwritefrom data.tablepara "pegar" las columnas juntas y freadvolver a leerlas. Por conveniencia, escribí los pasos como una función llamada fpaste:

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

He aquí un ejemplo:

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

¿Cómo funciona?

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

¿Qué pasa si escribe y lee en ramdisk? La comparación sería un poco más justa.
jangorecki

@jangorecki, no estoy seguro de si lo estoy haciendo correctamente (comencé con R TMPDIR=/dev/shm R) pero no noto una gran diferencia en comparación con estos resultados. Tampoco he jugado en absoluto con la cantidad de hilos utilizados para freado fwritepara ver cómo afecta los resultados.
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="-"))))    

0

Sé que esta es una pregunta antigua, pero pensé que de todos modos debería presentar la solución simple usando la función paste () como lo sugirió el interlocutor:

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
Al usar nuestro sitio, usted reconoce que ha leído y comprende nuestra Política de Cookies y Política de Privacidad.
Licensed under cc by-sa 3.0 with attribution required.