R：查找匹配的字符串然后复制行

Question

我有一个多步骤问题。第一步：将一个字符串 (df1) 中的文本从一列匹配到另一列范围 (df2)。没有匹配的列的顺序，并且匹配可以发生在范围内的任何位置。找到匹配后，将 df2 行匹配复制到 df1。最后，对整列重复。

df1= structure(list(Assay = c("ATG_AR_trans_up","NVS_PXR_cis","BSK_VCAM1_up"), p.value = c(0.01,0.05,0.0001)), .Names = c("Assay", "p.value"),row.names = c(NA, 3L), class = "data.frame") 

df1
Assay               p.value
ATG_AR_trans_up       0.01
NVS_hPXR              0.065
BSK_VCAM1_up          0.001

df2=structure(list(GeneID = c("AR", "VACM1", "TR", "ER", "PXR"), Assay1= c("ATG_ARE_cis", "BSK_hEDG_VCAM1", "NVS_TR_tran", "ATG_ER_UP", "NVS_PXRE_UP"), Assay2= c("ATG_AR_trans_up", "BSK_BE3K_VCAM1", "NA", "ATG_ERE_cis", "ATG_PXRE_cis"), Assay3= c("NVS_AR_trans", "BSK_VCAM1_UP", "NA", "NVS_ERa_CIS", "NVS_PXR_cis"), Assay4= c("Tox21_AR_ARE","NA", "NA", "Tox21_ERaERb_lig", "NA")),  .Names = c("GeneID", "Assay1", "Assay2", "Assay3", "Assay4"),row.names = c(NA, 5L), class = "data.frame")

df2  
    GeneID             Assay1            Assay 2           Assay3
    AR                 ATG_ARE_cis       NVS_hAR          ATG_AR_trans_up
    VACM1              BSK_hEGF_CAM1     BSK_VCAM1_up      BSK_VCAM1_down
    TR                 NVS_TR_tran       NA                  NA
    ER                 ATG_ER_UP         ATG_ERE_cis     NVS_ERa_CIS     
    PXR                ATG_PXR_down      ATG_PXRE_cis      NVS_hPXR

基本上变成

df
Assay           p.value   GeneID    Assay1       Assay2      Assay3
ATG_AR_trans_up  0.01      AR      ATG_ARE_cis  NVS_hAR      ATG_AR_trans_up
NVS_hPXR         0.065    PXR    ATG_PXR_down   ATG_PXRE_cis NVS_hPXR
BSK_VCAM1_up     0.001    VCAM1  BSK_hEGF_CAM1  BSK_VCAM1_up BSK_VCAM1_down

为简洁起见，我大大缩短了 df，但它大约需要 88 个 Assays 和 4,000 行才能进行一场比赛（大约有 30 行）。所以我最初的直觉是循环，但有人告诉我grep 可能是一个有用的包（即使它不适用于 R 3.2.2）。任何帮助都将不胜感激。

Answer 1

由于 OP 对 grep 解决方案感兴趣，另一种方法是，

asDF2 <- apply(df2, 1, function(r) do.call(paste, as.list(r)))

do.call(rbind, lapply(1:nrow(df1), 
                  function(i){
                    matchIX <- grepl(df1$Assay[i], asDF2, ignore.case=T)
                    if(any(matchIX))
                      cbind(df1[i, ], df2[matchIX, ])
                  }))

第一行创建一个字符向量，其连接的行分析名称为df2。第二行循环通过df1 并使用grepl 在asDF2 中找到匹配项

或者等价的，

do.call(rbind, lapply(1:nrow(df1), 
                  function(i){
                    matchIX <- grepl(df1$Assay[i], 
                                     data.frame(t(df2), stringsAsFactors=F), 
                                     ignore.case=T)
                    if(any(matchIX))
                      cbind(df1[i, ], df2[matchIX, ])
                    } ))

请注意，上述变体，可以匹配df2 到df1 中的多行。

注意 为了测试，我将新行添加到原始数据帧中

df1 <- rbind(df1, data.frame(Assay="NoMatch", p.value=.2))
df2 <- rbind(df2,
         data.frame(GeneID="My", Assay1="NVS_PXR_cis", Assay2="NA", Assay3="NA", Assay4="NA"))

Answer 2

这可以通过重塑轻松完成。我把所有的化验都写成大写，因为那会弄乱匹配。

library(dplyr)
library(tidyr)
library(stringi)

df2_ID = df %>% mutate(new_ID = 1:n() )

result = 
  df2_ID %>%
  select(new_ID, Assay1:Assay85) %>%
  gather(assay_number, Assay, Assay1:Assay85) %>%
  mutate(Assay = 
           Assay %>% 
           iconv(to = "ASCII") %>%
           stri_trans_toupper) %>%
  inner_join(df1 %>%
               mutate(Assay = 
                        Assay %>% 
                        iconv(to = "ASCII") %>%
                        stri_trans_toupper)) %>%
  inner_join(df2_ID)

Answer 3

由于您是 R 新手，我认为您是对的，最直观的方法是使用 for 循环。这不是最简洁或最有效的方法，但应该清楚发生了什么。

# Creating example data
df1 <- as.data.frame(matrix(data=c("aa", "bb", "ee", .9, .5, .7), nrow=3))
names(df1) <- c("assay", "p")

df2 <- as.data.frame(matrix(data=c("G1", "G2", "aa", "dd", "bb", "ee", "cc", "ff"), nrow=2))
names(df2) <- c("GeneID", "assay1", "assay2", "assay3")

# Building a dataframe to store output

df3 <- as.data.frame(matrix(data=NA, nrow=dim(df1)[1], ncol=dim(df2)[2]))
names(df3) <- names(df2)

# Populating dataframe with output
for(i in 1:dim(df1)[1]){
  index <- which(df2==as.character(df1$assay[i]), arr.ind = TRUE)[1]
  for(j in 1:dim(df3)[2]){
  df3[i,j] <- as.character(df2[index,j])
  }
}

df <- cbind(df1, df3)

Answer 4

在用户澄清后编辑：

我刚刚创建了一个三重 for 循环来检查您的值。基本上它所做的就是寻找匹配项。它通过循环遍历所有列和该列中的所有值来做到这一点。

但是我的代码还不完美（也是 R 的初学者），我只是想发布它，以便我们可以一起解决问题:)。

所以我首先将您的数据转换为 data.frame。之后，我创建了一个空输出，稍后我会根据找到的匹配项进行填充。

此方法的改进在于，使用此解决方案，函数 append 还将附加列名，这将导致多个无用的列名。

df3 <- as.data.frame(df1)
df4 <- as.data.frame(df2)
output <- data.frame()



for(j in 1:nrow(df3)) {
    match <- FALSE
    for(i in 2:(ncol(df4))) {
        for(p in 1:nrow(df4)) {
            if((df3[j, 1] == df4[p, i]) && (match == FALSE)) {
                output <- append(output, c(df3[j, ], df4[j, ]))
                match <- TRUE
            }
        }
    }
}

Answer 5

假设，您没有与 df1 中的条目对应的任何重复条目。以下是您的问题的解决方案：

assay <-as.matrix(df1[,1])
m1 <- as.numeric(sapply(assay, function(x){grep(x,df2[,2], ignore.case = T)}, simplify = FALSE))
m2 <- as.numeric(sapply(assay, function(x){grep(x,df2[,3], ignore.case = T)}, simplify = FALSE))
m3 <- as.numeric(sapply(assay, function(x){grep(x,df2[,4], ignore.case = T)}, simplify = FALSE))
m4 <- as.numeric(sapply(assay, function(x){grep(x,df2[,5], ignore.case = T)}, simplify = FALSE))

m1[is.na(m1)] <- 0
m2[is.na(m2)] <- 0
m3[is.na(m3)] <- 0
m4[is.na(m4)] <- 0

m0 <- (m1+m2+m3+m4)
df <- NULL
for(i in 1:nrow(df1){
  df3 = cbind(df1[i,],df2[m0[i],])
  df = rbind(df,df3)
}

编辑：概括

由于您有超过 80 行，您可以将其概括为：

assay <-as.matrix(df1[,1])

# Storing Assay column in a list
m <- vector('list',ncol(df2[, 2:ncol(df2)]))
for(i in 1:length(m)){
  m[[i]] <- as.numeric(sapply(assay, function(x){grep(x,df2[,(i+1)], ignore.case = T)}, simplify = FALSE))

}
# Getting row subscript for df2
m1 <- as.data.frame(m)
m1[is.na(m1)] <- 0
m2 <- rowSums(m1)

df <- NULL
for(i in 1:nrow(df1)){
  df3 = cbind(df1[i,],df2[m2[i],])
  df = rbind(df,df3)
}