(tidyverse)为给定位置的列中的每个字符串分组提取子字符串以包含

(tidyverse) Extract substring groupwise for each string in column given positions to include

我有一个 DNA 比对数据框。每个比对都有一个标签,可以由 3 个或更多分离株组成。我的目标是将对齐列突变为 消除每个对齐的隔离 1、3 和 4 中所有间隙(用“-”表示)的位置。所有比对都将始终包含隔离物 1、3 和 4,有时只有这三个会在比对中。

我有:

test_df <- data.frame(isolate=c(1,2,3,4,1,2,3,4,5),label=c(1,1,1,1,2,2,2,2,2),alignment=c("--atc-a","at----a","--ataga","--attga","a---ggg","acgttgg","a---tgg","a---tgg", "aggatgg"))

> test_df
  isolate label alignment
1       1     1   --atc-a
2       2     1   at----a
3       3     1   --ataga
4       4     1   --attga
5       1     2   a---ggg
6       2     2   acgttgg
7       3     2   a---tgg
8       4     2   a---tgg
9       5     2   aggatgg

我想要的:

> test_df
  isolate label alignment
1       1     1   atc-a
2       2     1   ----a
3       3     1   ataga
4       4     1   attga
5       1     2   aggg
6       2     2   atgg
7       3     2   atgg
8       4     2   atgg
9       5     2   atgg

我试过的:

我可以获得一个站点列表,我想为每个对齐保留这些站点,如下所示:

library(tidyverse)
library(stringr)
test_df %>% 
    mutate(positions=str_locate_all(alignment, "[^-]")) %>%
    group_by(label) %>%
    filter(isolate %in% c(1,3,4)) %>%
    summarise(pos_to_keep=list(unique(unlist(Reduce(rbind, positions)))))

但后来我不确定如何进行以切分所有对齐。

这是我找到您的解决方案的一种方式。可能有更快的出路。

library(dplyr)
test_df <- data.frame(isolate=c(1,2,3,4,1,2,3,4,5),label=c(1,1,1,1,2,2,2,2,2),alignment=c("--atc-a","at----a","--ataga","--attga","a---ggg","acgttgg","a---tgg","a---tgg", "aggatgg"),stringsAsFactors = FALSE)

# Get the correct positions
labelGroups <- test_df %>% mutate(positions=(str_locate_all(alignment, "[^-]"))) %>% filter(isolate %in% c(1,3,4)) %>% group_by(label) %>% summarise(pos_to_keep=list(unique(sort(unlist(positions)))))

# Make a function to extract the relevant letters
getletters <- function(wordlist,indexlist){n <- length(indexlist);lapply(1:n,function(i) paste0(sapply(indexlist[[i]], function(x) substr(wordlist[i],x,x)),collapse=""))}

# Try it
test_df %>% left_join(labelGroups,by="label") %>% mutate(newAlignment=getletters(alignment,pos_to_keep))

# isolate label alignment   pos_to_keep newAlignment
# 1       1     1   --atc-a 3, 4, 5, 6, 7        atc-a
# 2       2     1   at----a 3, 4, 5, 6, 7        ----a
# 3       3     1   --ataga 3, 4, 5, 6, 7        ataga
# 4       4     1   --attga 3, 4, 5, 6, 7        attga
# 5       1     2   a---ggg    1, 5, 6, 7         aggg
# 6       2     2   acgttgg    1, 5, 6, 7         atgg
# 7       3     2   a---tgg    1, 5, 6, 7         atgg
# 8       4     2   a---tgg    1, 5, 6, 7         atgg
# 9       5     2   aggatgg    1, 5, 6, 7         atgg