R:创建一组变量，只有在满足条件时才打印一系列列中所有匹配的值

Question

我正在尝试创建一组变量，如果值符合条件，则从另一系列列中打印出非冗余值。

例如，我的数据库看起来像这样(但是有更多的列):

Var_1   Var_2   Var_3
C21    S066X0A  S069X9A
I618    D06     I629
H2710   J1029   C71
S066X9D S066X9D I618

如果一个值以[S][0][6][4-6]或[I][6]开头，那么我希望打印它们，前提是相同的值以前没有打印过。因此输出看起来像:

Var_1   Var_2   Var_3     Out_1    Out_2    
C21     S066X0A S069X9A  S066X0A
I618    D06     I629     I618      I629
H2710   J1029   C71
S066X9D S066X9D I618     S066X9D   I618

Answer 1

我冒昧地添加了第三个输出列Out_3，以处理一行中有3个未打印匹配的场景

df <- textConnection('
Var_1,Var_2,Var_3
C21,S066X0A,S069X9A
I618,D06,I629
H2710,J1029,C71
S066X9D,S066X9D,I618
') |> 
read.csv(header = TRUE)
df$Out_1 <- ''
df$Out_2 <- ''
df$Out_3 <- ''
lapply(seq_along(df), function(x) {
print(df[ x, ])
matches <- str_extract_all(df[ x, ], '^S06[4-6].*|^I6.*') |>
unlist() |>
na.omit() |>
as.character()
idx <- which((matches %in% c(df$Out_1, df$Out_2, df$Out_3)) == FALSE)
if (length(idx) > 0) {
matches <- matches[ idx ]
lapply(seq_along(matches), function(i) {
cn <- sprintf('Out_%s', i)
df[ x, cn ] <<- matches[ i ]
})
}
}) |> invisible()
print(df)

Var_1   Var_2   Var_3   Out_1   Out_2 Out_3
1     C21 S066X0A S069X9A S066X0A              
2    I618     D06    I629    I618    I629      
3   H2710   J1029     C71                      
4 S066X9D S066X9D    I618 S066X9D S066X9D 

Answer 2

我认为这将更容易在长格式中处理，因为您可以避免循环遍历变量或需要处理不断变化的数据结构以及宽格式中潜在的大量空单元格。

longdat <- data.frame(id=seq(nrow(dat)), values=unlist(dat), row.names=NULL)
longdat <- longdat[order(longdat$id),]
##   id  values
##1   1     C21
##5   1 S066X0A
##9   1 S069X9A
##2   2    I618
##6   2     D06
##10  2    I629
##3   3   H2710
##7   3   J1029
##11  3     C71
##4   4 S066X9D
##8   4 S066X9D
##12  4    I618

标记特定值或确定组中的唯一性也非常直接:

longdat$flag <- grepl("S06[4-6]|I6", longdat$values)
unique(longdat[longdat$flag,])
##       id  values flag
##Var_21  1 S066X0A TRUE
##Var_12  2    I618 TRUE
##Var_32  2    I629 TRUE
##Var_14  4 S066X9D TRUE
##Var_34  4    I618 TRUE

其中dat为:

dat <- read.table(text="Var_1   Var_2   Var_3
C21    S066X0A  S069X9A
I618    D06     I629
H2710   J1029   C71
S066X9D S066X9D I618", header=TRUE)

Answer 3

给定:

df <- data.frame(
Var_1 = c("C21", "I618", "H2710", "S066X9D"),
Var_2 = c("S066X0A", "D06", "J1029", "S066X9D"),
Var_3 = c("S069X9A", "I629", "C71", "I618")
)
s06_ptrn <- "S06[4-6]"
i6_ptrn <- "I6"

加载这些包:

library(dplyr)
library(magrittr)
library(purrr)
library(stringr)

现在遍历每一行以删除重复的值(逐行)和删除不匹配的字符串:

out <- pmap_dfr(
df,
~ {
values <- c(...)

x <- values %>%
extract(
!duplicated(.) &
(str_starts(., s06_ptrn) | str_starts(., i6_ptrn))
)

# `pmap_dfr` requires that all output vectors are the same length and named:
length(x) <- length(values)
names(x) <- paste0("Out_", seq(length(x)))

x
}  
) %>%
# We run this to remove empty columns:
select(
where(~ !all(is.na(.x)))
)

并绑定两个dataframe:

bind_cols(df, out)

#>     Var_1   Var_2   Var_3   Out_1 Out_2
#> 1     C21 S066X0A S069X9A S066X0A  <NA>
#> 2    I618     D06    I629    I618  I629
#> 3   H2710   J1029     C71    <NA>  <NA>
#> 4 S066X9D S066X9D    I618 S066X9D  I618