Coller plusieurs colonnes ensemble
J'ai un tas de colonnes dans une base de données 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, mais uniquement un nom collectif pour toutes les colonnes, par exemple. Je saurais que cols <- c('b','c','d')
Est-ce que quelqu'un connaît un moyen de faire cela?
# 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 ) ]
En variante sur la réponse de baptiste , avec data défini comme vous l'avez et les colonnes que vous voulez assembler sont définies dans cols
cols <- c("b", "c", "d")
Vous pouvez ajouter la nouvelle colonne à data et 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
En utilisant le paquet tidyr, cela peut être facilement traité 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: Exclure 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
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 = '-'))))
Juste pour ajouter une solution supplémentaire avec Reduce qui est probablement plus lent que do.call mais nettement mieux que apply car cela évitera la conversion matrix. De plus, à la place d'une boucle for, nous pourrions simplement utiliser setdiff afin de supprimer les colonnes non désirées.
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
Alternativement, nous pourrions mettre à jour data à la place en utilisant le data.table package (en supposant de nouvelles données)
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 .SDcols au lieu de mget comme dans
setDT(data)[, x := Reduce(function(...) paste(..., sep = "-"), .SD), .SDcols = cols]
A mon avis, la fonction sprintf- mérite également une place parmi ces réponses. Vous pouvez utiliser sprintf comme 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 que sprintf n’ait pas d’avantage sur le do.call/paste combinaison de @BrianDiggs, il est particulièrement utile lorsque vous souhaitez également compléter certaines parties de la chaîne souhaitée ou lorsque vous souhaitez spécifier le nombre de chiffres. Voir ?sprintf pour les différentes options.
Une autre variante consisterait à utiliser pmap de purrr :
pmap(d[2:4], paste, sep = '-')
Remarque: cette solution pmap ne fonctionne que lorsque les colonnes ne sont pas des facteurs.
Un repère sur un jeu de données plus grand:
# 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'))
J'ai comparé les réponses d'Anthony Damico, Brian Diggs et data_steve sur un petit échantillon tbl_df et a 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, quand j’ai évalué moi-même tbl_df avec environ 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
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="-"))))