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


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

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

кто-нибудь знает способ сделать это?

8 69

8 ответов:

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

как вариант баптист С 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

используя tidyr пакет, это может быть легко обработано в 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

Edit: исключить первый столбец, все остальное вставляется.

# 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

Я бы построил новые данные.кадр:

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

просто добавить дополнительное решение с 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]

на мой взгляд 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 С purrr:

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

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