在 R 中选择二进制向量中的位置（我怎样才能固定？）答案

【问题标题】：Selecting positions in a binary vector (how can I fasten up?) in R在 R 中选择二进制向量中的位置（我怎样才能固定？）
【发布时间】：2020-01-09 15:52:47
【问题描述】：

我有一个如下所示的数据框：

SNP1 01010101000000100000010010001010011001010101
SNP2 01010010101000100000000000000001100001001000
SNP3 01010101000000000000000000000100011111111111

...但实际上包含约 800 万行，每个二进制向量的长度为 1000。

我需要选择这些二进制向量中的特定位置（跨所有行）。我发现这样做的肮脏方法是删除行名，将每个数字转换为一列，然后创建一个包含我感兴趣的位置的对象。

以下内容适用于示例数据，但对于我的真实数据来说效率不是很高（它已经运行了很长时间）。有什么想法可以让它更快吗？

library(data.table)
library(stringr)
setwd("test/")
DATADIR="datadir/"
OUTPUTDIR="outputdir/"
dir.create(OUTPUTDIR, showWarnings = FALSE)

baseline<-read.table(paste0(DATADIR,"input.file"), colClasses = "character")
  # Pass BP name to row name (so that I can split the binary vector into multiple columns)
  row.names(baseline) <- baseline$V1
  baseline$V1 <- NULL

  # split cells containing the binary vectors into multiple columns - thank you @Onyambu for this!
  baseline_new <-  read.table(text = gsub('(.)','\\1 ',baseline$V2),fill=TRUE)

  # select columns of interest
  columns_to_keep <- c(1, 4, 8, 10)
  baseline_new_ss <- baseline_new[, columns_to_keep]

  # create new object containing a column with the original row names, then recreate binary vector based on subsetted binary positions. 
  baseline_final <- as.data.frame(row.names(baseline))
  baseline_final$V2 <- as.character(interaction(baseline_new_ss,sep=""))

输出（仅选择位置 1、4、8 和 10）应如下所示：

SNP1 0110
SNP2 0100
SNP3 0110

我确信有一种不那么复杂的方法。

谢谢！！

【问题讨论】：

认为它是一个固定宽度的文件，有 1000 列，每列宽度为一，use one of these approaches to read it that way directly。你有library(data.table) 这是一个好主意，但你根本没有使用它。 data.table::fread 是在我的链接中读取固定宽度文件的最快选择之一，它将创建一个 data.table 对象，这对于后续操作也应该是最快的。但是您需要阅读 data.table vignette 的介绍以了解如何使用它。
也就是说，根据您的后续操作，您最好使用我链接中最快的固定宽度阅读器iotools，并将其设为matrix 而不是data.table。或者一个稀疏矩阵，如果这些矩阵是稀缺的（从你的例子来看，它们看起来很常见，所以坚持使用常规矩阵。）
vroom::vroom_fwf() 可能也值得一看。不确定它在 Gregor 链接的基准测试中的表现如何，但它是另一个（可能很快）选项。 Link for more info on vroom::vroom_fwf()

标签： r vector data.table binary-data

【解决方案1】：

你可以试试这个：

at <- function(binary_strings, positions)
{
  charvec <- character(length(binary_strings))
  for(i in seq_along(positions))
  {
    charvec <- paste0(charvec, substr(binary_strings, positions[i], positions[i]))
  }
  return(charvec)
}

现在你可以做

at(baseline$`whatever your binary column is called`, c(1, 4, 8, 10))
#> [1] "0110" "0100" "0110"

所以你可以用管道做

library(magrittr)

baseline$`whatever your binary column is called` %<>% at(c(1, 4, 8, 10))

print(baseline)
#>      whatever your binary column is called
#> SNP1                                  0110
#> SNP2                                  0100
#> SNP3                                  0110

我使用一台速度非常慢的 Windows PC 对 800 万行进行了 7 秒的基准测试。

【讨论】：

这段代码太棒了，谢谢！它的工作方式完全符合我的要求，而且速度非常快！它也比我的旧代码更简单（我需要开始学习如何创建这些函数！）

【解决方案2】：

您可以使用strsplit，将带有mapply 和paste 的元素重新组合到一个数据框中。虽然不知道这有多快，但它很简洁:)

`rownames<-`(data.frame(values=
                          mapply(function(x) Reduce(paste0, x[c(1, 4, 8, 10)]), 
                                 sapply(dat$V2, strsplit, ""))),
         dat$V1)
#      values
# SNP1   0110
# SNP2   0100
# SNP3   0110

也许有一个 data.table 解决方案不会在内部复制 -> 快速。

数据：

"SNP1 01010101000000100000010010001010011001010101
SNP2 01010010101000100000000000000001100001001000
SNP3 01010101000000000000000000000100011111111111"->tx
dat <- data.table::fread(text=tx, header=F)

【讨论】：

【解决方案3】：

另一种选择是使用stringi：

计时码：

nr <- 1e6
nc <- 1e3
l <- rep(paste(rep(1L, nc), collapse=""), nr)
writeLines(l, "test.txt")

cols <- c(1,4,8,10)

library(stringi)
library(iotools)    
microbenchmark::microbenchmark(times=1L,
    stringi=lapply(cols, function(n) stri_sub(l, n, n)),
    iotools=input.file("test.txt", formatter=dstrfw, 
        col_types=rep("character", nc), widths=rep(1L, nc))[, cols]
)

时间安排：

Unit: seconds
    expr       min        lq      mean    median        uq       max neval
 stringi  1.329223  1.329223  1.329223  1.329223  1.329223  1.329223     1
 iotools 76.250773 76.250773 76.250773 76.250773 76.250773 76.250773     1

【讨论】：