使用R将多列拆分成多个列

3

我有一个包含20列和300行的txt文件。以下是我的数据样本。

id  sub     A1                      A2      B1           B2                    C1   
96  AAA 01:01:01:01/01:01:01:02N        29:02:01    08:01:01/08:19N 44:03:01/44:03:03/44:03:04  07:01:01/07:01:02
97  AAA 03:01:01:01/03:01:01:02N        30:08:01    09:02:01/08:19N 44:03:01/44:03:03/44:03:04  07:01:01/07:01:02
98 AAA  01:01:01:01/01:01:01:02N/01:22N 29:02:01    08:01:01/08:19N 44:03:01/44:03:03/44:03:04  07:09:01/07:01:02
99  AAA 03:01:01:01                     30:08:01    09:02:01/08:19N 44:03:01/44:03:03/44:03:04  07:08:01/07:01:02 

我需要使用r将列(A1,A2,B1...)与分隔符“/”分开。 输出将是:
   id   sub A1_1      A1_2         A2       B1_1     B1_2    B2_1  B2_2   ..
96  AAA 01:01:01:01   01:01:01:02N      29:02:01    08:01:01     08:19N      44:03:01  44:03:03   44:03:04  ...

我可以找到将单个列拆分为多个列的功能。但我找不到实现这一点的解决方案。

1
你的 HLA_A1 的第三行有两个分隔符 - 那么你会期望什么呢? - Zahiro Mor
separate(mydata, HLA_A2, into =c("HLA_A1_1", "HLA_A1_2"), sep ="/") 将按照描述执行,但会跳过后面的任何字段,例如第二行。 - Stephen Henderson
那么你事先不知道每个原始列会产生多少输出列吗? - Zahiro Mor
@ Stephen Henderson 是的。这就是为什么我无法进一步进行的原因。 - user9295444
1
@MonicaSteffiMatchado 请对所给答案提供反馈,并不要忘记点赞/勾选那些解决了您的问题的答案。 - JdeMello
显示剩余3条评论
4个回答

8

这里提供一个tidyverse解决方案。

library(tidyverse)
df %>% 
 gather(key, value, -c(1:2)) %>% 
 separate_rows(value, sep = "/") %>% 
 group_by(key, id) %>% 
 mutate(key2 = paste0(key, "_", seq_along(key))) %>%
 ungroup() %>% 
 select(-key) %>% 
 spread(key2, value)

# A tibble: 4 x 13
# id      sub   A1_1    A1_2     A1_3 A2_1 B1_1 B1_2 B2_1 B2_2 B2_3 C1_1 C1_2
#* <fct>   <fct> <chr>       <chr>        <chr>    <chr>    <chr>    <chr>    <chr>    <chr>    <chr>    <chr>    <chr>   
#1 96 AAA   01:01:01:01 01:01:01:02N <NA>     29:02:01 08:01:01 08:19N   44:03:01 44:03:03 44:03:04 07:01:01 07:01:02
#2 97 AAA   03:01:01:01 03:01:01:02N <NA>     30:08:01 09:02:01 08:19N   44:03:01 44:03:03 44:03:04 07:01:01 07:01:02
#3 98 AAA   01:01:01:01 01:01:01:02N 01:22N   29:02:01 08:01:01 08:19N   44:03:01 44:03:03 44:03:04 07:09:01 07:01:02
#4 99 AAA   03:01:01:01 <NA>         <NA>     30:08:01 09:02:01 08:19N   44:03:01 44:03:03 44:03:04 07:08:01 07:01:02

在除了第一列和第二列(-c(1:2))之外的所有列中收集数据后,我使用tidyr::separate_rows将新创建的列value中的值按"/"分隔。创建一个名为key2的新列,它是带有扩展名_1:number of separators的列key,然后取消选择列key并通过value展开列key2

数据

df <- structure(list(id = structure(1:4, .Label = c("96", "97", 
"98", "99"), class = "factor"), sub = structure(c(1L, 
1L, 1L, 1L), .Label = "AAA", class = "factor"), A_A1 = structure(c(1L, 
4L, 2L, 3L), .Label = c("01:01:01:01/01:01:01:02N", "01:01:01:01/01:01:01:02N/01:22N", 
"03:01:01:01", "03:01:01:01/03:01:01:02N"), class = "factor"), 
A_A2 = structure(c(1L, 2L, 1L, 2L), .Label = c("29:02:01", 
"30:08:01"), class = "factor"), B_B1 = structure(c(1L, 
2L, 1L, 2L), .Label = c("08:01:01/08:19N", "09:02:01/08:19N"
), class = "factor"), B_B2 = structure(c(1L, 1L, 1L, 1L
), .Label = "44:03:01/44:03:03/44:03:04", class = "factor"), 
C1 = structure(c(1L, 1L, 3L, 2L), .Label = c("07:01:01/07:01:02", 
"07:08:01/07:01:02", "07:09:01/07:01:02"), class = "factor")), .Names = c("id", 
"sub", "A_A1", "A_A2", "B_B1", "B_B2", "C_C1"), class = "data.frame", row.names = c(NA, 
-4L))

3
我会采取以下方法:

我会采取以下方法:

library(data.table)
setDT(df) # convert to a data.table

# identify the columns you want to split
cols <- grep("^HLA", names(df), value = TRUE)

# loop through them and split them
# assign them back to the data.table, by reference
for (i in cols) {
  temp <- tstrsplit(df[[i]], "/")
  set(df, j = sprintf("%s_%d", i, seq_along(temp)), value = temp)
  set(df, j = i, value = NULL)
}

以下是结果:

df[]
#         id sub    HLA_A1_1     HLA_A1_2 HLA_A1_3 HLA_A2_1 HLA_B1_1 HLA_B1_2 HLA_B2_1 HLA_B2_2 HLA_B2_3 HLA_C1_1 HLA_C1_2
# 1: HG00096 GBR 01:01:01:01 01:01:01:02N       NA 29:02:01 08:01:01   08:19N 44:03:01 44:03:03 44:03:04 07:01:01 07:01:02
# 2: HG00097 GBR 03:01:01:01 03:01:01:02N       NA 30:08:01 09:02:01   08:19N 44:03:01 44:03:03 44:03:04 07:01:01 07:01:02
# 3: HG00098 GBR 01:01:01:01 01:01:01:02N   01:22N 29:02:01 08:01:01   08:19N 44:03:01 44:03:03 44:03:04 07:09:01 07:01:02
# 4: HG00099 GBR 03:01:01:01           NA       NA 30:08:01 09:02:01   08:19N 44:03:01 44:03:03 44:03:04 07:08:01 07:01:02

除了比起被接受的答案更容易扩展(事物并没有真正地硬编码),这个方法至少比那个方法快两倍,而且比"整洁宇宙"方法要快得多,因为它首先将数据变得非常长,然后再返回到宽格式。


基准测试

为了了解性能差异,请尝试以下操作:

测试功能

myfun <- function(df) {
  cols <- grep("^HLA", names(df), value = TRUE)
  for (i in cols) {
    temp <- tstrsplit(df[[i]], "/")
    set(df, j = sprintf("%s_%d", i, seq_along(temp)), value = temp)
    set(df, j = i, value = NULL)
  }
  df[]
}

tidyfun <- function(df) {
  df %>% 
    gather(key, value, -c(1:2)) %>% 
    separate_rows(value, sep = "/") %>% 
    group_by(key, id) %>% 
    mutate(key2 = paste0(key, "_", seq_along(key))) %>%
    ungroup() %>% 
    select(-key) %>% 
    spread(key2, value)
}

getIt <- function(df,col) {    
  x <- max(sapply(strsplit(as.character(df[,col]),split="/"),length))
  q <- colsplit(string = as.character(df[,col]),pattern="/",
                names = paste0(names(df)[col],"_",LETTERS[1:x]))
  return(q)
}    

reshape2fun <- function(dfdf) {
  cbind(dfdf[,1:2], getIt(dfdf,3), getIt(dfdf,4), getIt(dfdf,5), getIt(dfdf,6))
}

4 rows....

library(microbenchmark)
dfdf <- as.data.frame(df)
microbenchmark(myfun(copy(df)), reshape2fun(dfdf), tidyfun(df))
# Unit: microseconds
#               expr      min         lq       mean    median         uq      max neval
#    myfun(copy(df))   241.55   272.5965   625.7634   359.148   380.0395 28632.94   100
#  reshape2fun(dfdf)  5076.24  5368.3835  5841.8784  5539.577  5639.8765 34176.13   100
#        tidyfun(df) 37864.68 39435.1915 41152.5916 39801.499 40489.7055 70019.04   100

10,000行......


biggerdf <- rbindlist(replicate(2500, df, FALSE)) # nrow = 10,000
dfdf <- as.data.frame(biggerdf)
microbenchmark(myfun(copy(biggerdf)), reshape2fun(dfdf), tidyfun(biggerdf), times = 10)
# Unit: milliseconds
#                   expr        min        lq       mean     median         uq        max neval
#  myfun(copy(biggerdf))   50.87452   52.0059   54.59288   53.03503   53.79347   68.69892    10
#      reshape2fun(dfdf)  120.90291  124.3893  137.54154  126.06213  157.50532  159.15069    10
#      tidyfun(biggerdf) 1312.75422 1350.6651 1394.93082 1358.21612 1373.86793 1732.86521    10

1,000,000 rows....

BIGGERdf <- rbindlist(replicate(100, biggerdf, FALSE)) # nrow = 1,000,000
dfdf <- as.data.frame(BIGGERdf)
system.time(tidyfun(BIGGERdf)) # > 2 minutes!
#    user  system elapsed 
# 141.373   1.048 142.403 

microbenchmark(myfun(copy(BIGGERdf)), reshape2fun(dfdf), times = 5)
# Unit: seconds
#                   expr      min       lq     mean   median        uq       max neval
#  myfun(copy(BIGGERdf)) 5.180048 5.574677 6.026515 5.764467  6.498967  7.114415     5
#      reshape2fun(dfdf) 8.858202 9.095027 9.629969 9.264896 10.192161 10.739560     5

这显然是一个非常好的解决方案,虽然我必须承认,在循环中发生了什么让我难以理解。 (+1) - markus
1
@markus,“data.table”中的set()函数可以在不复制的情况下替换值。因此,从需要拆分的列("cols")开始,我们(1)使用tstrsplit()将它们拆分,这会创建一个列表,每个项目都具有相同的长度(因此可以视为列)。(2)使用列表的长度,我们指定在“j”参数中要创建的列的名称以及要插入“value”参数中的值。(3)在另一个set()调用中使用“j”参数,还需删除被拆分的原始列。对于循环中的每个列重复以上步骤。 - A5C1D2H2I1M1N2O1R2T1

2

我建议使用reshape2解决方案,注意不知道部分数量的情况:

> dput(pz1)
structure(list(id = c("HG00096", "HG00097", "HG00098", "HG00099"
), sub = c("GBR", "GBR", "GBR", "GBR"), HLA_A1 = c("01:01:01:01/01:01:01:02N", 
"03:01:01:01/03:01:01:02N", "01:01:01:01/01:01:01:02N/01:22N", 
"03:01:01:01"), HLA_A2 = c("29:02:01", "30:08:01", "29:02:01", 
"30:08:01"), HLA_B1 = c("08:01:01/08:19N", "09:02:01/08:19N", 
"08:01:01/08:19N", "09:02:01/08:19N"), HLA_B2 = c("44:03:01/44:03:03/44:03:04", 
"44:03:01/44:03:03/44:03:04", "44:03:01/44:03:03/44:03:04", "44:03:01/44:03:03/44:03:04"
), HLA_C1 = c("07:01:01/07:01:02", "07:01:01/07:01:02", "07:09:01/07:01:02", 
"07:08:01/07:01:02")), .Names = c("id", "sub", "HLA_A1", "HLA_A2", 
"HLA_B1", "HLA_B2", "HLA_C1"), row.names = c(NA, -4L), class = "data.frame")

添加此功能:
library("reshape2", lib.loc="~/R/win-library/3.3")

getIt <- function(df,col) {    
x <- max(sapply(strsplit(df[,col],split="/"),length))   ### get the max parts for column
q <- colsplit(string = df[,col],pattern="/",names = paste0(names(df)[col],"_",LETTERS[1:x]))
return(q) }

有了这个函数,您就可以轻松地执行以下操作:

> getIt(pz1,3)
     HLA_A1_A     HLA_A1_B HLA_A1_C
1 01:01:01:01 01:01:01:02N         
2 03:01:01:01 03:01:01:02N         
3 01:01:01:01 01:01:01:02N   01:22N
4 03:01:01:01                      

并且可以使用原始数据框(带有或不带有原始列)进行简单的cbind:

> cbind(pz1[,1:2],getIt(pz1,3),getIt(pz1,4),getIt(pz1,5),getIt(pz1,6))
       id sub    HLA_A1_A     HLA_A1_B HLA_A1_C HLA_A2_A HLA_B1_A HLA_B1_B HLA_B2_A HLA_B2_B HLA_B2_C
1 HG00096 GBR 01:01:01:01 01:01:01:02N          29:02:01 08:01:01   08:19N 44:03:01 44:03:03 44:03:04
2 HG00097 GBR 03:01:01:01 03:01:01:02N          30:08:01 09:02:01   08:19N 44:03:01 44:03:03 44:03:04
3 HG00098 GBR 01:01:01:01 01:01:01:02N   01:22N 29:02:01 08:01:01   08:19N 44:03:01 44:03:03 44:03:04
4 HG00099 GBR 03:01:01:01                       30:08:01 09:02:01   08:19N 44:03:01 44:03:03 44:03:04

0

我支持@Sotos的建议,编写可重现的示例非常重要,这样可以确保问题的关注点只在于手头的问题。

我使用了以下虚假数据来尝试回答你的问题:

> df <- data.frame(
+   id = c(1:5),
+   sub = sample(c("GBR", "BRA"), size = 5, replace = T),
+   HLA_A = paste0(rep("01:01", 5), "/", rep("01:02N")), 
+   HLA_B = paste0(rep("01:03", 5), "/", "01:42N", "/", "32:20"), 
+   HLA_C = paste0(rep("01:03", 5)), stringsAsFactors = F)
> 
> 
> df
  id sub        HLA_A              HLA_B HLA_C
1  1 GBR 01:01/01:02N 01:03/01:42N/32:20 01:03
2  2 BRA 01:01/01:02N 01:03/01:42N/32:20 01:03
3  3 GBR 01:01/01:02N 01:03/01:42N/32:20 01:03
4  4 GBR 01:01/01:02N 01:03/01:42N/32:20 01:03
5  5 BRA 01:01/01:02N 01:03/01:42N/32:20 01:03

你可以使用strsplit()函数按给定字符(在本例中为"/")拆分列。使用do.call(rbind, .)将列表绑定为列格式。对于要处理的列,重复此过程并使用idsub列将它们全部绑定在一起。以下是解决方案:
不使用任何依赖项:
> col.ind <- grep(x = names(df), pattern = "HLA", value = T, ignore.case = T) # your target columns
> 
> # lapply to loop the column split process, output is a list, so you need to columb-bind the resulting objects
> 
> cols.list <- lapply(seq_along(col.ind), function(x){
+ 
+   p1 <- do.call(rbind, strsplit(df[[col.ind[[x]]]], split = "/")) # split col by "/" 
+   
+   p2 <- data.frame(p1, stringsAsFactors = F)  # make it into a data.frame
+   
+   i <- ncol(p2) # this is an index placeholder that will enable you to rename the recently split columns in a sequential manner
+   
+   colnames(p2) <- paste0(col.ind[[x]], c(1:i)) # rename columns 
+   
+   return(p2) # return the object of interest
+ }
+ )
> 
> 
> new.df <- cbind(df[1:2], do.call(cbind, cols.list)) # do.call once again to bind the lapply object and column-bind those with the first two columns of your initial data.frame
> new.df
  id sub HLA_A1 HLA_A2 HLA_B1 HLA_B2 HLA_B3 HLA_C1
1  1 GBR  01:01 01:02N  01:03 01:42N  32:20  01:03
2  2 BRA  01:01 01:02N  01:03 01:42N  32:20  01:03
3  3 GBR  01:01 01:02N  01:03 01:42N  32:20  01:03
4  4 GBR  01:01 01:02N  01:03 01:42N  32:20  01:03
5  5 BRA  01:01 01:02N  01:03 01:42N  32:20  01:03

谢谢您提供的解决方案。我收到了以下警告信息:警告消息: 1:在(function(...,deparse.level = 1)中:结果的列数不是向量长度的倍数(arg 1)1 - user9295444

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接