Вставить несколько столбцов вместе
у меня есть куча столбцов в фрейме данных, которые я хочу вставить вместе (разделенные" -") следующим образом:
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 ответов:
# 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="-"))))