向量化包含循环和if子句的搜索函数

Question

我得到了两个非常大的数据集，并且我一直在尝试构建一个函数，该函数可以从一个集合中找到某些坐标，这些坐标尊重关于另一个数据集的if子句。 我的问题是我编写的功能非常慢 ，尽管我一直在以类似的方式阅读类似问题的答案，但我仍未能使其正常工作。
因此，如果给我：

>head(CTSS)    
    V1     V2     V3
1 chr1 564563 564598 
2 chr1 564620 564649
3 chr1 565369 565404
4 chr1 565463 565541
5 chr1 565653 565697
6 chr1 565861 565922

和

> head(href)
   chr      region    start      end strand nu   gene_id transcript_id
1 chr1 start_codon 67000042 67000044      +  . NM_032291     NM_032291
2 chr1         CDS 67000042 67000051      +  0 NM_032291     NM_032291
3 chr1        exon 66999825 67000051      +  . NM_032291     NM_032291
4 chr1         CDS 67091530 67091593      +  2 NM_032291     NM_032291
5 chr1        exon 67091530 67091593      +  . NM_032291     NM_032291
6 chr1         CDS 67098753 67098777      +  1 NM_032291     NM_032291

对于href数据集中start列中的每个值，我想在CTSS数据集的第3列中查找小于或等于它的前两个值，并将其保存在新的数据框中。
我写的循环：

y <- CTSS[order(-CTSS$V3), ]     
find_CTSS <- function(x, y) {
    n <- length(x$start)
    foo <- data.frame(matrix(0, n, 6))
    for (i in 1:n)
    {
        a <- which(y$V3 <= x$start[i])
        foo[i, ] = c(x$start[i], x$stop[i], y$V2[a[1]], y$V3[a[1]] , y$V2[a[2]], y$V3[a[2]])
    }

print(foo)

}

Answer 1

您提供的数据很少（ 但请参阅此处 ），因此很难对您的解决方案进行基准测试。 查看以下解决方案是否满足您的需求。

#make some fake data
href <- data.frame(start = runif(10), stop = runif(10), other_col = sample(letters, 10))
CTSS <- data.frame(col1 = runif(100), col2 = runif(100))

# for each row in href (but extract only stop and start columns)
result <- apply(X = href[, c("start", "stop")], MARGIN = 1, FUN = function(x, ctss) {
            criterion <- x["start"] #make a criterion
            #see which values are smaller or equal to this criterion (and sort them)
            extracted <- sort(ctss[ctss$col2 <= criterion, "col2"])
            #extract last and one to last value
            get.values <- extracted[c(length(extracted) - 1, length(extracted))] 
            #put values in data frame
            out <- as.data.frame(matrix(get.values, ncol = 2)) 
            return(out)
        }, ctss = CTSS)

#pancake a list into a data.frame
result <- do.call("rbind", result) 

Answer 2

我看到您想要的主要是这里的加速。 我从Roman Lustrik的代码中大量借用，我看不出将排序放到应用中的任何优势。 那真的会减慢速度。 实际上，您希望尽可能多地退出Apply（循环）。 因此，以下命令应运行得更快。

#all code using Roman Lustrik's made up data

CTSSs <- CTSS[order(CTSS$col2),] #presort CTSS
result <- lapply(X = href$start, FUN = function(x, ctss) {
    extracted <- ctss$col2[ctss$col2 <= x]
    get.values <- tail(extracted,2)
    out <- matrix(get.values, ncol = 2)
    return(out)}, ctss = CTSSs)
#pancake a list into a data.frame
result <- as.data.frame(do.call("rbind", result))

或者，我可以进一步遵循矢量化的精神，并真正使功能尽可能小。

CTSSs <- CTSS[order(CTSS$col2),] #presort CTSS
extracted <- lapply(href$start, function(x, ctss) {
    ctss$col2[ctss$col2 <= x]}, ctss = CTSSs)
get.values <- lapply(extracted, tail, n = 2 )
result <- t( sapply(get.values, matrix, ncol = 2) )

#convert to a data.frame
result <- as.data.frame(result)

这可能会更快，或者可能不是您的情况，但是，如果您需要添加一个中间步骤，该步骤可能会利用真正的矢量化内置函数的优势，比如说您想先对值进行数学运算，然后再将其放入数据框，那么您可以轻松地做到这一点。 另外，您会注意到，现在我可以在矩阵阶段使用sapply / transpose，它比lapply / rbind更快。 这通常是矢量代码加速的来源，而不仅仅是围绕它的应用进行大循环。 （顺便说一句，它可以使您在思考的每个步骤中更容易检查错误……或者这不是顺便说一句？）

修订：

经过进一步的思考，我意识到这可以完全向量化。 以下代码将比任何先前示例更快地生成您想要的内容。 诀窍是使用cut（）和Aggregate（）命令。

href <- href[order(href$start),] #just sorted so that the 0 at the beginning makes sense and the labels then match
margin <- cut(CTSS$col2, breaks = c(0,href$start), labels = href$start, right = TRUE)
result <- aggregate(col2 ~ margin, data = CTSS, FUN = function(x) tail(x,2))

您可以按自己想要的方式重新格式化结果，但这应该可以解决问题。 您可能需要将margin列更改为数值，以便它与href $ start匹配，并使用与上面中间示例中的sapply相似的代码将上面的项目对列表变成两个单独的列。 是循环或应用语句中的if（）语句之前使您放慢速度，而cut（）消除了这一点。

Answer 3

我不知道自己会花多长时间，所以我会继续前进。 当这种问题在《 APL杂志》上获得单行答案时，我还是APL的家伙。 后来我成为一名C ++ / STL专家，并在新的着装规范中学习了所有相同的知识。 有时，R让我认为APL与PHP匹配。

在这个问题中，数据帧会分散注意力。 这是一个简单的向量搜索，有些结合在一起。

对于性能至关重要的矢量搜索，您需要findInterval 。 需要搜索范围。 搜索对象可以按任何顺序排列，但对于大型列表，则需要排序。

    V <- sort (runif(10*1000*1000))
    U <- sort (runif(10*1000*1000)) 
    W <- findInterval (U, V) 

摇动三下小羊的尾巴。 现在，您有一对整数。 第一列为1:length(U) ，第二列的V值为W内的整数索引。

    sum(u==sort(u)[sort.int (sort.int (u, index.return=TRUE)$ix, index.return=TRUE)$ix])

好的，我的APL脑干有贡献。 答案是length（u），并说明“胶合在一起”所需的逆向排序。

令人不寒而栗的事实：R中sort函数的特殊情况仅返回索引向量。 在APL中，这是从升级/降级获得的唯一答案。 但是，嘿，这并不是他们第一次就做对了。

您必须调整findInterval的结果以在匹配位置的小于一侧选择两个元素，并且必须撤消这两种排序以重新粘合在一起。 我怀疑您的运行时将由两种类型（对于很长的列表）主导，或者组装结果数据框（对于较小的列表）。 在我的系统上，对长度为100 * 1000 * 1000的数字列表进行排序开始出现问题。

介于两者之间的findInterval的运行时间将是一小片生菜，这使我想起了为什么我不打算游荡。