R代码运行太慢，如何重写这段代码

Posted 2023-04-18

【中文标题】R代码运行太慢，如何重写这段代码

【英文标题】：R code runs too slow,how to rewrite this code

【发布时间】：2014-03-14 02:00:22

【问题描述】：

input.txt 包含 8000000 行和 4 列。前 2 列是文本。后 2 列是数字。第 1 列和第 2 列中唯一符号（例如“c33”）的数量不固定。第 3 列和第 4 列的值分别是用“]”分割后的第 1 列和第 2 列的唯一符号数。 input.txt文件的每一行都是这样的：

---

c33]c21]c5]c7]c8]c9  TPS2]MIC17]ERG3]NNF1]CIS3]CWP2  6  6

---

**期望的结果：

row[ , ] represents characters like "c33 c21 c5 c7 c8 c9" or "TPS2 MIC17 ERG3 NNF1 CIS3 CWP2", | .| represents the number of characters, |c33 c21 c5 c7 c8 c9|=6

如果两行重叠 (>=0.6)，则输出 NO。这两行中的一个文件。**

这段代码如下，但是运行速度太慢了。

代码：

 library(compiler)
 enableJIT(3)
 data<-read.table("input.txt",header=FALSE)
 row<-8000000
for (i in 1:(row-1))
    row11<-unlist(strsplit(as.character(data[i,1]),"]"))
     row12<-unlist(strsplit(as.character(data[i,2]),"]"))
    s1<-data[i,3]*data[i,4]
    zz<-file(paste("output",i,".txt",sep=""),"w")
   for (j in (i+1):row)
       row21<-unlist(strsplit(as.character(data[j,1]),"]"))
        row22<-unlist(strsplit(as.character(data[j,2]),"]"))
        up<-length(intersect(row11,row21))*length(intersect(row12,row22))
        s2<-data[j,3]*data[j,4]
        down<-min(s1,s2)
       if ((up/down)>=0.6) cat(i,"\t",j,"\n",file=zz,append=TRUE)
      
   close(zz)

运行结果： 每行可以产生一个文件，是这样的：

1 23
1 67
1 562
1 78
...

为了跑得快，我重写了代码。代码如下

input.txt 包含 16000000 行。列数不固定。第 1 列和第 2 列中唯一符号（例如“c33”）的数量不固定。每两行input.txt文件是这样的：

The 1st row  (odd row1):  c33 c21 c5 c7 c8
The 2nd row (even row1): TPS2 MIC17 ERG3 NNF1 CIS3 CWP2 MCM6
The 3rd row  (odd row2): c33 c21 c5 c21 c18 c4 c58
The 4th row (even row2): TPS12 MIC3 ERG2 NNF1 CIS4

**想要的结果：

如果两行与其他两行重叠 (>=0.6)，则输出 NO。这两行中的一个文件。**

代码：

 library(compiler)
    enableJIT(3)
    con <- file("input.txt", "r")
    zz<-file("output.txt","w")
    oddrow1<-readLines(con,n=1)  
    j<-0
    i<-0 
    while( length(oddrow1) != 0 )
    oddrow1<-strsplit(oddrow1," ")
    evenrow1<-readLines(con,n=1)
    evenrow1<-strsplit(evenrow1," ")
    j<-j+1
    con2 <- file("input.txt", "r")
    readLines(con2,n=(j*2))
    oddrow2<-readLines(con2,n=1) 
    i<-j
    while( length(oddrow2) != 0 )
       i<-i+1
       oddrow2<-strsplit(oddrow2," ")
       evenrow2<-readLines(con2,n=1)
       evenrow2<-strsplit(evenrow2," ")
       oddrow1<-unlist(oddrow1)
       oddrow2<-unlist(oddrow2)
       evenrow1<-unlist(evenrow1)
       evenrow2<-unlist(evenrow2)
       up<-length(intersect(oddrow1,oddrow2))*length(intersect(evenrow1,evenrow2))
       down<-min(length(oddrow1)*length(evenrow1),length(oddrow2)*length(evenrow2))

       if ((up/down)>=0.6) cat(j,"\t",i,"\n",file=zz,append=TRUE)   
       oddrow2<-readLines(con2,n=1)
       
    close(con2)
    oddrow1<-readLines(con,n=1)
    
    close(con)  
    close(zz)

运行结果： 它可以产生一个文件，它是这样的：

1 23
1 67
1 562
1 78
2 25
2 89
3 56
3 79
 ...

以上两种方法都太慢了，为了跑得快，如何重写这段代码。谢谢！

【问题讨论】：

想要的结果是什么？

@RScriv 运行结果：每一行可以产生一个文件，是这样的：1 23 1 67 1 562 1 78

第 1 列和第 2 列中有多少个唯一符号（例如“c33”）？

虽然有一些改进可能，但您至少需要进行（8e6 选择 2 ≈ 3.2e13）逐行比较。我没有找到快速的方法。

但是重叠 >0.6 是什么意思？并且大致计算有多少独特符号会有所帮助；有 10 个、100 个还是 1000 个？

【参考方案1】：

好吧，我怀疑你的数据量占用了太多内存，但也许它会激发一些想法。

组成一些数据，总共有 20 个唯一值，每个单元格中有 5 到 10 个。

set.seed(5)
n <- 1000L
ng <- 20
g1 <- paste(sample(10000:99999, ng))
g2 <- paste(sample(10000:99999, ng))
n1 <- sample(5:10, n, replace=TRUE)
n2 <- sample(5:10, n, replace=TRUE)
x1 <- sapply(n1, function(i) paste(g1[sample(ng, i)], collapse="|"))
x2 <- sapply(n2, function(i) paste(g2[sample(ng, i)], collapse="|"))

加载 Matrix 库和一个辅助函数，该函数接受字符串向量列表并将它们转换为列数等于唯一字符串数且其所在位置为 1 的矩阵。

library(Matrix)
str2mat <- function(s) 
  n <- length(s)
  ni <- sapply(s, length)
  s <- unlist(s)
  u <- unique(s)
  spMatrix(nrow=n, ncol=length(u), i=rep(1L:n, ni), j=match(s, u), x=rep(1, length(s)))

好的，现在我们可以做点什么了。首先创建矩阵并获取每行中存在的总数。

m1 <- str2mat(strsplit(x1, "|", fixed=TRUE))
m2 <- str2mat(strsplit(x2, "|", fixed=TRUE))
n1 <- rowSums(m1)
n2 <- rowSums(m2)

现在我们可以使用这些矩阵的叉积来获得分子，并使用外积来获得最小值来获得分子。然后我们可以计算重叠并测试是否 > 0.6。由于我们有整个矩阵，我们对对角线或下半部分不感兴趣。 （有一些方法可以使用 Matrix 库更有效地存储这种矩阵，但我不确定如何。）然后我们得到与 which 有足够重叠的行。

num <- tcrossprod(m1)*tcrossprod(m2)
n12 <- n1*n2
den <- outer(n12, n12, pmin)
use <- num/den > 0.6
diag(use) <- FALSE
use[lower.tri(use)] <- FALSE
out <- which(use, arr.ind=TRUE)

> head(out)
     [,1] [,2]
[1,]   64   65
[2,]   27   69
[3,]   34   81
[4,]   26   82
[5,]    5   85
[6,]   21  115

【讨论】：

感谢您的回复。输入数据每行唯一符号的数量不固定。如何解决？

它应该按原样工作；请注意，它计算 length(u)，其中 u 是唯一符号列表。

如何使用 GPU 并行计算或多核计算重写您的代码。使用您的代码进行的计算已经运行了两周，但仍未完成。如何加快它的速度。谢谢

***.com/questions/22756129/…

我的猜测是您已经使用了所有内存并且正在交换。正如 Roland 在你的新问题的答案中所建议的那样，我首先尝试用 C 语言编写它（使用 Rcpp 可能是最简单的）。