有效地创建包含从不同列中的行连接的一系列值的列

Question

我想为给定 position 上方和下方的行创建一个新列，其中包含在不同列中给出的一系列值。 让我们用一个例子来更好地解决这个问题。

我的 dataframe 如下所示：

library("tidyverse")

df <- tibble(POS = c("A","C","G","G","C","C","C","A","A","G","T","C","A"),
             GET = c(FALSE,FALSE,FALSE,FALSE,TRUE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE,FALSE))

# A tibble: 13 x 2
   POS   GET  
   <chr> <lgl>
 1 A     FALSE
 2 C     FALSE
 3 G     FALSE
 4 G     FALSE
 5 C     TRUE 
 6 C     FALSE
 7 C     FALSE
 8 A     FALSE
 9 A     FALSE
10 G     FALSE
11 T     FALSE
12 C     TRUE 
13 A     FALSE

给定行号i和 window 大小，我想连接POS中的值以生成序列SEQ 。 例如，如果 window 扩展为 2（因为它在上面扩展了两行，在下面扩展了两行），则第一个观察的SEQ值将只是“ACG”，但第三个观察的 SEQ 值将是“ACGGCC”。

但是，我只想对一些观察进行此操作，即带有GET==TRUE的观察，因此理想情况下 output 如下所示：

# A tibble: 2 x 3
  POS   GET   SEQ  
  <chr> <lgl> <chr>
1 C     TRUE  GGCCC
2 C     TRUE  GTCA 

无论如何，所有行的SEQ值的解决方案也是有效的，我正在寻找的实际上不是问题本身的解决方案，而是一个有效的解决方案（见下文）。

我是怎么做的

这是我制定的代码：

window_extension <- 2
size <- window_extension * 2 + 1

for (i in 1:size) {
  if (i <= window_extension) {
     df <- df %>% dplyr::mutate(!!paste("SEQ", i, sep="") := dplyr::lag(POS, window_extension + 1 - i))
  } else if (i > window_extension + 1) {
    df <- df %>% dplyr::mutate(!!paste("SEQ", i, sep="") := dplyr::lead(POS, window_extension - (size-i)))
  } else {
    df <- df %>% dplyr::mutate(!!paste("SEQ", i, sep="") := POS)
  }
}

df %>% tidyr::unite("SEQ", tidyselect::starts_with("S"), sep="", remove = TRUE, na.rm=TRUE) %>% dplyr::filter(GET)

这个解决方案的问题在于它生成了一个中间 dataframe （ df就在循环之后），其中列的数量与size变量所指示的一样多。 所以你可以想象，如果size很大，memory 的负担会变大。 这本身就是一个问题，特别是当只有几行是真正感兴趣的时候。 太多浪费了 memory。

希望会有一些专用的 function 来实现这一点。 我希望能解决 dplyr 滞后和领先的问题，但没有运气。 有任何想法吗？

Answer 1

也许这个解决方案可以提供帮助，你必须设置k ：

#Define k
k <- 2
#Create index
index <- which(df$GET==T)
index2 <- 1:length(index)
index3 <- index-k
index4 <- index+k
#Replace
index3 <- ifelse(index3>dim(df)[1],dim(df)[1],index3)
index4 <- ifelse(index4>dim(df)[1],dim(df)[1],index4)
#Assign
df$i <- NA
#Loop
for(i in index2)
{
  df$i[index[i]] <- paste0(df$POS[index3[i]:index4[i]],collapse = '')
}
#Now filter
df2 <- df[!is.na(df$i),]
df2

# A tibble: 2 x 3
  POS   GET   i    
  <chr> <lgl> <chr>
1 C     TRUE  GGCCC
2 C     TRUE  GTCA 

Answer 2

library(tidyverse)


df <- tibble(POS = c("A","C","G","G","C","C","C","A","A","G","T","C","A"),
             GET = c(FALSE,FALSE,FALSE,FALSE,TRUE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE,FALSE))


df$SEQ <- slider::slide(df$POS, ~.x, .before = 2, .after = 2) %>% sapply(paste, collapse = "")

df %>%
  filter(GET)