Coller plusieurs colonnes ensemble

99

J'ai un tas de colonnes dans un dataframe que je veux coller ensemble (séparés par "-") comme suit:

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  

Ce que je veux devenir:

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

Je pourrais normalement le faire avec:

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

puis en supprimant les anciennes colonnes, mais malheureusement je ne connais pas spécifiquement les noms des colonnes, seulement un nom collectif pour toutes les colonnes, par exemple je saurais que cols <- c('b','c','d')

Quelqu'un connaît-il un moyen de faire cela?

user1165199
la source

Réponses:

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 ) ]
Anthony Damico
la source
7
pas besoin de postuler ici; coller est vectorisé, et c'est plus efficace
baptiste
1
@baptiste .. possible sans do.call?
Anthony Damico
1
bien sûr, vous pourriez par exemple utiliser evil(parse(...)), mais je crois que do.callc'est le bon appel ici.
baptiste le
Do.call ici est la meilleure technique; maintient la vectorisation.
Clayton Stanley
1
hmm .. comment passeriez-vous le collapse = "-"travers? à paste?
Anthony Damico
48

En variante de la réponse de baptiste , avec datadéfini comme vous l'avez et les colonnes que vous voulez rassembler définies danscols

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

Vous pouvez ajouter la nouvelle colonne dataet supprimer les anciennes avec

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

qui donne

> data
  a     x
1 1 a-d-g
2 2 b-e-h
3 3 c-f-i
Brian Diggs
la source
Y a-t-il une virgule manquante dans "c (data [cols], ..."? Comme ceci: "c (data [, cols], ...")
roschu
2
@roschu Either fonctionnera. L'indexation d'un data.frameavec un vecteur de caractère unique sera une indexation de colonne, bien que le premier argument soit généralement l'index de ligne.
Brian Diggs
rapide et intelligent. Merci
Ali Khosro
32

En utilisant tidyrpackage, cela peut être facilement géré en 1 appel de fonction.

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

Edit: excluez la première colonne, tout le reste est collé.

# 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
la source
3
Je pense qu'OP a mentionné qu'ils ne connaissaient pas le nom de la colonne à l'avance, sinon ils pourraient le faire within(data, x <- paste(b,c,d,sep='-'))comme ils l'ont illustré.
David Arenburg
Je suis d'accord avec @DavidArenburg, cela ne résout pas la situation du PO. Je pense unite_(data, "b_c_d", cols)que, ou en fonction de leur data.frame réel, unite(data, b_c_d, -a)pourrait également être un candidat.
Sam Firke
13

Je construirais un nouveau 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 = '-'))))
baptiste
la source
notez qu'au lieu de d[ , cols]vous pouvez utiliser d[ , names(d) != 'a']si tout sauf la acolonne doit être collé ensemble.
baptiste le
1
Une des solutions canoniques sur SO, je pense que vous pourriez raccourcir ceci cbind(a = d['a'], x = do.call(paste, c(d[cols], sep = '-'))), par exemple éviter les virgules, listet data.frameen utilisant la data.frameméthode decbind
David Arenburg
9

Juste pour ajouter une solution supplémentaire avec Reducequi est probablement plus lente que do.callmais mieux meilleure que applyparce qu'elle évitera la matrixconversion. En outre, à la place, une forboucle que nous pourrions simplement utiliser setdiffpour supprimer les colonnes indésirables

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

Sinon, nous pourrions mettre dataà jour sur place en utilisant le data.tablepackage (en supposant des données fraîches)

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

Une autre option consiste à utiliser au .SDcolslieu de mgetcomme dans

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

J'ai comparé les réponses d'Anthony Damico, Brian Diggs et data_steve sur un petit échantillon tbl_dfet j'ai obtenu les résultats suivants.

> 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

Cependant, lorsque j'ai évalué moi-même tbl_dfavec ~ 1 million de lignes et 10 colonnes, les résultats étaient assez différents.

> 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
la source
5

A mon avis, la sprintffonction mérite également une place parmi ces réponses. Vous pouvez utiliser sprintfcomme suit:

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

qui donne:

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

Et pour créer le dataframe requis:

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

donnant:

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

Bien qu'elle sprintfn'ait pas un avantage clair sur la combinaison do.call/ pastede @BrianDiggs, elle est particulièrement utile lorsque vous souhaitez également remplir certaines parties de la chaîne souhaitée ou lorsque vous souhaitez spécifier le nombre de chiffres. Voir ?sprintfles différentes options.

Une autre variante serait d'utiliser pmapde:

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

Remarque: cette pmapsolution ne fonctionne que lorsque les colonnes ne sont pas des facteurs.


Un benchmark sur un ensemble de données plus large:

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

résulte 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 

Données utilisées:

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

Voici une approche assez peu conventionnelle (mais rapide): utilisez fwritefrom data.tableto "coller" les colonnes ensemble, et freadpour les relire. Pour plus de commodité, j'ai écrit les étapes sous forme de fonction appelée fpaste:

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

Voici un exemple:

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

Comment ça marche?

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
la source
Et si vous écrivez et lisez sur le disque virtuel? La comparaison serait un peu plus juste.
jangorecki
@jangorecki, je ne sais pas si je le fais correctement (j'ai commencé R avec TMPDIR=/dev/shm R) mais je ne remarque pas une énorme différence par rapport à ces résultats. Je n'ai pas non plus joué du tout avec le nombre de threads utilisés pour freadou fwritepour voir comment cela affecte les résultats.
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
la source
0

Je sais que c'est une vieille question, mais j'ai pensé que je devrais de toute façon présenter la solution simple en utilisant la fonction paste () comme suggéré par l'interrogateur:

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
la source