R 将字符串列分隔为多个列,并按列名对齐

  • 本文关键字:对齐 字符串 分隔 r dplyr
  • 更新时间 :
  • 英文 :


我的问题很简单。我想按分隔符拆分列,但与列名对齐。

例:

library(tidyr)
library(dplyr)
df <- data.frame(col = c("A", "B", "A,B", "C"))
df %>% separate(col, c("A", "B", "C"))

我得到:

A    B    C
1 A <NA> <NA>
2 B <NA> <NA>
3 A    B <NA>
4 C <NA> <NA>

我期待:

A    B    C
1 A   <NA> <NA>
2 <NA> B   <NA>
3 A    B   <NA>
4 <NA><NA>  C

A 到A 列,B 到 B 列...等。如何完成?

使用数据更新

我的实际数据如下:

structure(list(Shortcuts = structure(c(37L, 5L, 9L, 27L, 28L, 
27L, 8L, 19L, 15L, 11L, 29L, 7L, 38L, 18L, 23L, 27L, 27L, 24L, 
19L, 21L, 4L, 27L, 34L, 2L, 28L, 33L, 26L, 27L, 14L, 27L, 37L, 
8L, 17L, 40L, 37L, 27L, 25L, 22L, 36L, 27L, 34L, 27L, 27L, 19L, 
32L, 6L, 14L, 27L, 30L, 21L, 12L, 15L, 27L, 14L, 39L, 16L, 27L, 
19L, 21L, 6L, 20L, 35L, 27L, 31L, 8L, 27L, 27L, 10L, 27L, 13L, 
28L), .Label = c("ALL", "ALL, NS, N, SS", "ALL, NS, SS", "LG", 
"LG, NG, RH, ONM", "LG, RH, NMC", "LG, RH, NS", "N", "N, ONM, LG", 
"NG", "NMC", "NMC, NS", "NMC, RH", "NS", "NS, RH", "NS, SS", 
"NS, WTW", "NS, WTW, SS", "O", "OBN, RH", "ONM", "ONM, LG", "ONM, LG, RH", 
"ONM, LG, RH, N, Aut", "ONM, N", "ONM, NS", "ONN", "RH", "RH, LG", 
"RH, LG, NG, ONM", "RH, NS", "RH, NS, NMC", "RH, ONM", "SS", 
"SS, RH", "SS, SW", "WTW", "WTW, NS, N", "WTW, SS, RH, NS", "ZNM, RH, WTW, NW, NMC"
), class = "factor")), row.names = c(NA, -71L), class = c("tbl_df", 
"tbl", "data.frame"))

这将产生您正在寻找的结果。我不确定它是否可以很好地满足您的应用程序目的。我修改了您的数据以解释"A,C"案例。

df <- data.frame(col = c("A,C", "B", "A,B", "C"))
df %>%
separate(col, c("A", "B", "C")) %>% 
mutate(C=ifelse(is.na(C) & A=="C" | B=="C", "C", NA_character_),
B=ifelse(A=="B" | B=="B", "B", NA_character_),
A=ifelse(A!="A", NA_character_, A))
A    B    C
1    A <NA> <NA>
2 <NA>    B <NA>
3    A    B <NA>
4 <NA> <NA>    C

另类

我编写了一个小函数,它将为您提供所需内容的逐行布尔值。您可以使用dplyr::rowwise()将其应用于您的数据框,如下所示

df %>%
rowwise() %>% 
mutate(adjust_col(col)) %>% 
mutate(A=ifelse(A, "A", NA_character_), 
B=ifelse(B, "B", NA_character_), 
C=ifelse(C, "C", NA_character_)) %>%
select(-col)

可能有一种聪明的方法可以使用dplyr::across()来选择和编码函数,以将 TRUE 值更改为相应的列名。

这是我编码的帮助程序,修改字典以达到您的目的。

adjust_col <- function(x, dictionary = LETTERS[1:3]){
x <- as.character(x)
df <- data.frame(matrix(ncol=length(dictionary)))
names(df) <- dictionary

contents <- unlist(strsplit(x, split = ","))
results <- sapply(contents, function(letter) letter %in% dictionary)
return(bind_rows(df[-1, ], results))
}

更新

让我们先创建布尔data.frame

df %>% rowwise() %>%
mutate(adjust_col(col)) %>% 
select(-col) -> tt 
tt
tt
# A tibble: 4 x 3
# Rowwise: 
A     B     C    
<lgl> <lgl> <lgl>
1 TRUE  NA    TRUE 
2 NA    TRUE  NA   
3 TRUE  TRUE  NA   
4 NA    NA    TRUE 

然后使用purrr::map2_df()以编程方式替换列名的 TRUE 值

purrr::map2_df(tt, names(tt), ~  replace(.x, .x==1, .y))
A     B     C    
<chr> <chr> <chr>
1 A     NA    C    
2 NA    B     NA   
3 A     B     NA   
4 NA    NA    C 

替换的要点来自对相关问题的另一个答案。

使用数据:)进行更新

因此,现在我们有了您的数据,我们可以正确获取字典。检查您的数据是否具有,(逗号空格),而不仅仅是逗号作为 sep。这就是您收到错误的原因。

以下是我如何让它在我的终端工作(请注意,我调整了辅助函数以添加空间!

adjust_col <- function(x, dictionary = LETTERS[1:3]){
x <- as.character(x)
df <- data.frame(matrix(ncol=length(dictionary)))
names(df) <- dictionary

contents <- unlist(strsplit(x, split = ", "))
results <- sapply(contents, function(letter) letter %in% dictionary)
return(bind_rows(df[-1, ], results))
}
my_dict <- unlist(str_split(df$Shortcuts, ", ")) %>%
unique()
df %>%
rowwise() %>%
mutate(adjust_col(Shortcuts, my_dict)) %>% 
select(-Shortcuts) -> tt
purrr::map2_df(tt, names(tt), ~  replace(.x, .x==1, .y))

它产生

# A tibble: 71 x 17
WTW   LG    NG    RH    ONM   N     ONN   O     NS   
<chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
1 WTW   NA    NA    NA    NA    NA    NA    NA    NA   
2 NA    LG    NG    RH    ONM   NA    NA    NA    NA   
3 NA    LG    NA    NA    ONM   N     NA    NA    NA   
4 NA    NA    NA    NA    NA    NA    ONN   NA    NA   
5 NA    NA    NA    RH    NA    NA    NA    NA    NA   
6 NA    NA    NA    NA    NA    NA    ONN   NA    NA   
7 NA    NA    NA    NA    NA    N     NA    NA    NA   
8 NA    NA    NA    NA    NA    NA    NA    O     NA   
9 NA    NA    NA    RH    NA    NA    NA    NA    NS   
10 NA    NA    NA    NA    NA    NA    NA    NA    NA   
# … with 61 more rows, and 8 more variables: NMC <chr>,
#   SS <chr>, Aut <chr>, ALL <chr>, ZNM <chr>, NW <chr>,
#   SW <chr>, OBN <chr>

您可以使用separate_rows+pivot_wider-

library(dplyr)
library(tidyr)
df %>%
mutate(row = row_number()) %>%
separate_rows(Shortcuts, sep = ',\s+') %>%
pivot_wider(names_from = Shortcuts, values_from = Shortcuts) %>%
select(-row)
#   WTW   LG    NG    RH    ONM   N     ONN   O     NS    NMC   SS    Aut   ALL   ZNM  
#   <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
# 1 WTW   NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA   
# 2 NA    LG    NG    RH    ONM   NA    NA    NA    NA    NA    NA    NA    NA    NA   
# 3 NA    LG    NA    NA    ONM   N     NA    NA    NA    NA    NA    NA    NA    NA   
# 4 NA    NA    NA    NA    NA    NA    ONN   NA    NA    NA    NA    NA    NA    NA   
# 5 NA    NA    NA    RH    NA    NA    NA    NA    NA    NA    NA    NA    NA    NA   
# 6 NA    NA    NA    NA    NA    NA    ONN   NA    NA    NA    NA    NA    NA    NA   
# 7 NA    NA    NA    NA    NA    N     NA    NA    NA    NA    NA    NA    NA    NA   
# 8 NA    NA    NA    NA    NA    NA    NA    O     NA    NA    NA    NA    NA    NA   
# 9 NA    NA    NA    RH    NA    NA    NA    NA    NS    NA    NA    NA    NA    NA   
#10 NA    NA    NA    NA    NA    NA    NA    NA    NA    NMC   NA    NA    NA    NA   
# … with 61 more rows, and 3 more variables: NW <chr>, SW <chr>, OBN <chr>

我不知道这个问题现在是否已经解决,但由于没有答案被标记为最终答案,我想向您展示我应该适合您的方法。

# Pull all the different categories and in your case shortcuts
conditions <- separate_rows(df,Shortcuts,convert=T) %>%
distinct(Shortcuts) %>%
pull(Shortcuts)
clean <- function(data,cond){
ls <- apply(data,1,function(x) sapply(cond,function(y) str_detect(x,paste0("\b",y,"\b")))) %>%
t() %>%
as.data.frame() %>%
setNames(.,cond) %>%
mutate_all(function(x) ifelse(x==T,1,0)) %>%
cbind(data,.) %>%
as_tibble() %>%
return(ls)
}
final_df <- clean(df,conditions)

结果看起来像这样(我使用虚拟变量来显示可以找到哪些快捷方式。您可以轻松更改它以给 1 列的名称):

Shortcuts         WTW    LG    NG    RH   ONM     N   ONN     O    NS   NMC    SS   Aut   ALL   ZNM    NW    SW   OBN
<fct>           <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 WTW                 1     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0     0
2 LG, NG, RH, ONM     0     1     1     1     1     0     0     0     0     0     0     0     0     0     0     0     0
3 N, ONM, LG          0     1     0     0     1     1     0     0     0     0     0     0     0     0     0     0     0
4 ONN                 0     0     0     0     0     0     1     0     0     0     0     0     0     0     0     0     0
5 RH                  0     0     0     1     0     0     0     0     0     0     0     0     0     0     0     0     0
6 ONN                 0     0     0     0     0     0     1     0     0     0     0     0     0     0     0     0     0
7 N                   0     0     0     0     0     1     0     0     0     0     0     0     0     0     0     0     0
8 O                   0     0     0     0     0     0     0     1     0     0     0     0     0     0     0     0     0
9 NS, RH              0     0     0     1     0     0     0     0     1     0     0     0     0     0     0     0     0
10 NMC                 0     0     0     0     0     0     0     0     0     1     0     0     0     0     0     0     0

最新更新