R中的data.frames與sapply之間的高效坐標匹配

Question

我正在嘗試獲取一個向量，告訴我data.frame（transcriptcoords）中的哪些行

              chr  start  end
NONHSAT000001 chr1 11868 14409
NONHSAT000002 chr1 11871 14412
NONHSAT000003 chr1 11873 14409
NONHSAT000004 chr1 12009 13670
NONHSAT000005 chr1 14777 16668
NONHSAT000006 chr1 15602 29370

在另一個data.frame（genecoords）中松散地包含開始/結束坐標（具有+/- 10容差）

              chr  start  end
NONHSAG000001 chr1 11869 14412
NONHSAG000002 chr1 14778 29370
NONHSAG000003 chr1 29554 31109
NONHSAG000004 chr1 34554 36081
NONHSAG000005 chr1 36273 50281
NONHSAG000006 chr1 62948 63887

為此，我在第一個data.frame的行indece上進行sapply循環，將坐標與第二個data.frame中的任何行匹配。 我有一個解決方案（如下所述），但它似乎相當慢（大約六秒鍾，一條2000行）：

   user  system elapsed 
   6.02    0.00    6.04

我試圖了解可以優化哪些部分的sapply。 是if / else塊嗎？ 或比較線（==，<=，> =）？ 或者更簡單地說，它是一種本質上很慢的算法嗎？

謝謝！ 我生成的代碼如下：

load(url("http://www.giorgilab.org/stuff/data.rda"))

# Pre-vectorize the data frames
g0<-rownames(genecoords)
g1<-genecoords[,1]
g2<-as.integer(genecoords[,2])
g3<-as.integer(genecoords[,3])

t0<-rownames(transcriptcoords)
t1<-transcriptcoords[,1]
t2<-as.integer(transcriptcoords[,2])
t3<-as.integer(transcriptcoords[,3])

system.time(gs<-sapply(1:2000,function(i){
            t<-t0[i]
            chr<-t1[i]
            start<-t2[i]
            end<-t3[i]

            # Find a match (loose boundaries +/- 10)
            right1<-which(g1==chr)
            right2<-which(g2<=start+10)
            right3<-which(g3>=end-10)
            right<-intersect(right3,intersect(right1,right2))
            right<-g0[right]

            if(length(right)==1){
                g<-right
            } else if(length(right)>1){
                # Get the smallest match
                heregenecoords<-genecoords[right,]
                size<-apply(heregenecoords,1,function(x){abs(as.numeric(x[3])-as.numeric(x[2]))})
                g<-names(which.min(size))
            } else {
                g<-t
            }
            return(g)           
        }
))

Answer 1

隨你的數據

tx0 <- read.table(textConnection("chr  start  end
NONHSAT000001 chr1 11868 14409
NONHSAT000002 chr1 11871 14412
NONHSAT000003 chr1 11873 14409
NONHSAT000004 chr1 12009 13670
NONHSAT000005 chr1 14777 16668
NONHSAT000006 chr1 15602 29370"))

gene0 <- read.table(textConnection("chr  start  end
NONHSAG000001 chr1 11869 14412
NONHSAG000002 chr1 14778 29370
NONHSAG000003 chr1 29554 31109
NONHSAG000004 chr1 34554 36081
NONHSAG000005 chr1 36273 50281
NONHSAG000006 chr1 62948 63887"))

Bioconductor中的GenomicRanges軟件包可以輕松高效地完成此任務（數百萬次重疊）。

library(GenomicRanges)
tx <- with(tx0, GRanges(chr, IRanges(start, end)))
gene <- with(gene0, GRanges(chr, IRanges(start, end)))

## increase width by 10 on both sides of the center of the gene range
gene <- resize(gene, width=width(gene) + 20, fix="center")
## find overlaps of 'query' tx and 'subject' gene, where query is within subject
olaps <- findOverlaps(tx, gene, type="within")

顯示，例如，'查詢'（tx）1,2,3和4在'受試者'（基因）1內。

> findOverlaps(tx, gene, type="within")
Hits of length 6
queryLength: 6
subjectLength: 6
  queryHits subjectHits 
   <integer>   <integer> 
 1         1           1 
 2         2           1 
 3         3           1 
 4         4           1 
 5         5           2 
 6         6           2

基因1與4個轉錄本重疊，基因2與2個轉錄本重疊。

> table(subjectHits(olaps))

1 2 
4 2

另見本出版物。 使用更大的數據集：

tx <- with(transcriptcoords, GRanges(V1, IRanges(V2, V3, names=rownames(tx0))))
gene <- with(genecoords, GRanges(V1, IRanges(V2, V3, names=rownames(gene0))))

有一些時間：

system.time(gene <- resize(gene, width=width(gene) + 20, fix="center"))
##   user  system elapsed 
##  0.056   0.000   0.057 
system.time(findOverlaps(tx, gene, type="within"))
##   user  system elapsed 
##  2.248   0.000   2.250

我認為現在大約是來自@ danas.zuokos的data.table解決方案的時間，只有1000個成績單

system.time({
    dt <- genecoords[transcriptcoords, allow.cartesian = TRUE]; 
    res <- dt[start <= start.1 + tol & end >= end.1 - tol, 
         list(gene = gene[which.min(size)]), by = transcript]
})
##    user  system elapsed 
##   2.148   0.244   2.400

Answer 2

哈！ 馬丁用更好的答案打敗了我。 在一個完善的庫中使用經過測試的代碼而不是自己編寫代碼幾乎總是更好。 絕對使用馬丁的解決方案，而不是這個。

但是，只是為了笑，這是另一種方式。

首先，編寫一些基因和成績單：

gs = 1:10*500
genes = data.frame(start=gs, end=gs+400)
rownames(genes) = sprintf('g%05d', 1:nrow(genes))

ts = sample(1:max(genes$end), size=10)
transcripts = data.frame(start=ts, end=ts+60)
rownames(transcripts) = sprintf('t%05d', 1:nrow(transcripts))

我們可以使用外部對比較進行矢量化，將函數應用於其兩個矢量參數的每個組合。

overlaps = function(genes, transcripts, min_overlap=1) {
  b1 = outer(genes$end, transcripts$start, min_overlap=min_overlap, 
             function(e,s,min_overlap) e-s+1>min_overlap)
  b2 = outer(genes$start, transcripts$end, min_overlap=min_overlap,
             function(s,e,min_overlap) e-s+1>min_overlap)
  result = b1 & b2
  rownames(result) = rownames(genes)
  colnames(result) = rownames(transcripts)
  return(result)
}

對於我們的基因和成績單，我們可能會得到類似的結果：

> genes
       start  end
g00001   500  900
g00002  1000 1400
g00003  1500 1900
g00004  2000 2400
g00005  2500 2900
g00006  3000 3400
g00007  3500 3900
g00008  4000 4400
g00009  4500 4900
g00010  5000 5400

> transcripts
       start  end
t00001   535  595
t00002  2502 2562
t00003  4757 4817
t00004  3570 3630
t00005  3094 3154
t00006  1645 1705
t00007  5202 5262
t00008    13   73
t00009   788  848
t00010  4047 4107

o1 = overlaps(genes, transcripts, 1)

結果是一個布爾矩陣，告訴您每個轉錄本是否與每個基因重疊。

> o1
       t00001 t00002 t00003 t00004 t00005 t00006 t00007 t00008 t00009 t00010
g00001   TRUE  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE   TRUE  FALSE
g00002  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE
g00003  FALSE  FALSE  FALSE  FALSE  FALSE   TRUE  FALSE  FALSE  FALSE  FALSE
g00004  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE
g00005  FALSE   TRUE  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE
g00006  FALSE  FALSE  FALSE  FALSE   TRUE  FALSE  FALSE  FALSE  FALSE  FALSE
g00007  FALSE  FALSE  FALSE   TRUE  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE
g00008  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE   TRUE
g00009  FALSE  FALSE   TRUE  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE
g00010  FALSE  FALSE  FALSE  FALSE  FALSE  FALSE   TRUE  FALSE  FALSE  FALSE

Answer 3

我正在使用data.table庫。

rm(list = ls())
load(url("http://www.giorgilab.org/stuff/data.rda"))
library(data.table)
tol <- 10 # tolerance
id <- 1:2000 # you can comment this out, but make sure you have big RAM

轉換為data.table格式。 另外計算尺寸（我不確定你為什么選擇abs ，結束總是比開始大？）。

genecoords <- data.table(genecoords, keep.rownames = TRUE)
setnames(genecoords, c("gene", "chr", "start", "end"))
genecoords[, size := end - start]
transcriptcoords <- data.table(transcriptcoords, keep.rownames = TRUE)[id] # comment out [id] when running on all trascripts
setnames(transcriptcoords, c("transcript", "chr", "start", "end"))

這給出了結果。

setkeyv(genecoords, "chr")
setkeyv(transcriptcoords, "chr")
dt <- genecoords[transcriptcoords, allow.cartesian = TRUE]
res <- dt[start <= start.1 + tol & end >= end.1 - tol, list(gene = gene[which.min(size)]), by = transcript]

意識到這不包括不符合條件的成績單（代碼中的g<-t ）。

R中的data.frames與sapply之間的高效坐標匹配

問題描述

3 個解決方案

解決方案1
2 已采納 2014-01-31 06:30:53

解決方案2
1 2014-01-31 06:54:52

解決方案3
1 2014-01-31 10:02:25

R中的data.frames與sapply之間的高效坐標匹配

問題描述

3 個解決方案

解決方案1 2 已采納 2014-01-31 06:30:53

解決方案2 1 2014-01-31 06:54:52

解決方案3 1 2014-01-31 10:02:25

解決方案1
2 已采納 2014-01-31 06:30:53

解決方案2
1 2014-01-31 06:54:52

解決方案3
1 2014-01-31 10:02:25