R - 嵌套for循环和性能降低

时间:2016-03-23 23:10:21

标签: r

我正在尝试实现一个函数来从一个表中获取基于另一个表的值。实际的数据帧有> 50,000次观察,因此实现此嵌套for循环无效。在过去的几天里,我一直在努力寻找能够发挥作用的东西,但是还没有能力。我的数据没有特定的顺序(个人,细分等),因此即使出现问题,它也需要能够正常工作。

以下是我要处理的数据的玩具示例:

region_map <- data.frame(Start = c(721290, 1688193), End= c(1688192, 2926555))
individual <- c("Ind1","Ind2","Ind3","Ind4")
segment <- data.frame(SampleID = c("Ind1","Ind1","Ind2","Ind2","Ind3","Ind3","Ind4","Ind4","Ind4"),
                      Start = c(721290, 1688194, 721290, 1688200, 721290, 2926600, 721290, 1688193, 690),
                      End = c(1688192, 2926555,1688190, 2900000, 2926555, 3000000, 1500000, 2005000, 500000),
                      State = c(1,2,2,5,4,2,2,6,5))

以下是我尝试做的简单示例:

Generate.FullSegmentList <- function(segments, individuals, regionmap){
     FullSegments <- data.frame()
     for(region in 1:nrow(regionmap)){

          for(ind in individuals){
               # If there is not a segment within that region for that individual
               if(nrow(
                    segments[segments$start >= regionmap$Start[region] & 
                                  segments$End <= regionmap$End[region] &
                                  segments$SampleID == ind , ]
               ) == 0){
                    Temp <- data.frame(SampleID = ind, 
                                       Start = regionmap$Start[region],
                                       End = regionmap$End[region],
                                       State = 3
                    )
               }
               # If there is a segment within that region for that individual
               if(nrow(
                    segments[segments$Start >= regionmap$Start[region] & 
                                  segments$End <= regionmap$End[region] &
                                  segments$SampleID == ind , ]
               ) == 1){
                    Temp <- data.frame(SampleID = segments$SampleID, 
                                       Start = regionmap$Start[region],
                                       End = regionmap$End[region],
                                       State = segments$State[segments$Start >= regionmap$Start[region] & 
                                                                  segments$SampleID == ind ]
                    )
               }
               FullSegments <- list(FullSegments, Temp)              
          }
     }
     FullSegments
}

总之,我需要查看每个区域(~53,000),并为每个State分配一个值(individual,如果不存在,给3的值),然后为每个人创建一个包含每个区域的新data.frame。为此,我循环遍历区域,然后是个体,找到与该区域重叠的segment(其中约有25,000个),然后将其附加到表格中。

以上是玩具数据的输出结果:

SampleID       Start       End        State
Ind1          721290      1688192      1
Ind1          1688193     2926555      2
Ind2          721290      1688192      2
Ind2          1688193     2926555      5
Ind3          721290      1688192      4
Ind3          1688193     2926555      4
Ind4          721290      1688192      2
Ind4          1688193     2926555      6

这个函数as-as正是我需要它的工作方式,除了它需要很长时间才能运行(使用system.time,我知道运行需要3个月)。我知道必须有更好的方法来做到这一点。我尝试过实现应用函数,我在其他一些问题中看到使用列表而不是data.frame。我还看到有data.table和plyr选项来简化这一点。我尝试过这些但是还没有成功地使用if语句的嵌套循环。

我很感激对所给出的任何答案的解释,因为这是我第一次写出这么复杂的内容。

我认为相关的问题:

关于嵌套for循环的许多其他问题涉及进行适用于执行应用函数的计算(例如apply(df, 1, function(x){ mean(x) }),但我还没有能够采用它来将值从data.frame映射到data.frame。

3 个答案:

答案 0 :(得分:2)

Bioconductor包IRanges适用于“整数范围”,例如区域和段开始和结束坐标。使用

安装软件包
source("https://bioconductor.org/biocLite.R")
biocLite("IRanges")

加载并创建感兴趣范围的表示

library(IRanges)
r <- with(region_map, IRanges(Start, End))
s <- with(segments, IRanges(Start, End))

到目前为止的结果是

> r
IRanges object with 2 ranges and 0 metadata columns:
          start       end     width
      <integer> <integer> <integer>
  [1]    721290   1688192    966903
  [2]   1688193   2926555   1238363
> s
IRanges object with 9 ranges and 0 metadata columns:
          start       end     width
      <integer> <integer> <integer>
  [1]    721290   1688193    966904
  [2]   1688194   2926555   1238362
  [3]    721290   1688190    966901
  [4]   1688200   2900000   1211801
  [5]    721290   2926555   2205266
  [6]   2926600   3000000     73401
  [7]    721290   1500000    778711
  [8]   1688193   2005000    316808
  [9]       690    500000    499311

您有兴趣找到“查询”细分和“主题”region_map之间的重叠

olaps <- findOverlaps(s, r)

> olaps
Hits object with 9 hits and 0 metadata columns:
      queryHits subjectHits
      <integer>   <integer>
  [1]         1           1
  [2]         1           2
  [3]         2           2
  [4]         3           1
  [5]         4           2
  [6]         5           1
  [7]         5           2
  [8]         7           1
  [9]         8           2
  -------
  queryLength: 9 / subjectLength: 2

这将很好地扩展到数百万的重叠。

你说你对所有地区的所有人的状态感兴趣,并且从你的代码中看起来像一个不在一个地区的个人有状态3.我创建了一个所有状态3的矩阵

state <- matrix(3, nrow(region_map), length(individual),
                dimnames=list(NULL, individual))

然后根据我们找到的重叠在矩阵中创建了一个双列索引

idx <- matrix(c(subjectHits(olaps),
                match(segments$SampleID[queryHits(olaps)], individual)),
              ncol=2)

并使用索引矩阵更新状态

state[idx] <- segments$State[queryHits(olaps)]

这实际上总结了您想要的结果 - 每个地区的状态x个人组合。一个可能的问题是当同一个体的两个片段重叠单个区域时,片段具有不同的状态;只会分配一个州。

> state
     Ind1 Ind2 Ind3 Ind4
[1,]    1    2    4    2
[2,]    2    5    4    6

将其作为data.frame投射,例如,

data.frame(SampleID=colnames(state)[col(state)],
           Start=region_map[row(state), "Start"],
           End=region_map[row(state), "End"],
           State=as.vector(state))

答案 1 :(得分:1)

您的代码中有很多行读取nrow(some-subset-of-your-data)。如果将其切换为sum(the-conditions),您会看到性能快速提升。例如:

转到:

nrow(segments[segments$start >= regionmap$Start[region] & 
                                   segments$End <= regionmap$End[region] &
                                  segments$SampleID == ind , ]) == 0

进入

sum(segments$start >= regionmap$Start[region] & 
                                   segments$End <= regionmap$End[region] &
                                  segments$SampleID == ind) == 0

这样,R每次都不会将子集化数据帧存储在内存中。

此外,将此操作存储为布尔值,因此您只需在每个循环中调用一次。

isEmpty <- sum(segments$start >= regionmap$Start[region] & 
                                   segments$End <= regionmap$End[region] &
                                  segments$SampleID == ind) == 0

if(isEmpty){
### do something
} else if(!isEmpty) {
### do something else
}

答案 2 :(得分:0)

我认为你不需要任何'这种复杂'。通过几个连接,您可以完成所有事情。在这种情况下,我将使用data.table

你已经要求对任何答案作出解释,但是,对于这个我来说,除了指向data.table homepage之外,我做得更好。了解set*:=命令的作用以及“按引用更新”的工作原理非常重要。

将您的数据设置为data.table秒。

library(data.table)

dt_individual <- data.table(SampleID = individual)
dt_region <- data.table(region_map)
dt_segment <- data.table(segment)

一起加入

## Change some column names of `dt_segment` so we can identify them after the joins
setnames(dt_segment, c("Start", "End"), c("seg_Start", "seg_End"))

## create a 'key_col' to join all the individuals to the regions
dt_join <- dt_individual[, key_col := 1][ dt_region[, key_col := 1], on="key_col", allow.cartesian=T][, key_col := NULL]
#    SampleID   Start     End
# 1:     Ind1  721290 1688192
# 2:     Ind2  721290 1688192
# 3:     Ind3  721290 1688192
# 4:     Ind4  721290 1688192
# 5:     Ind1 1688193 2926555
# 6:     Ind2 1688193 2926555
# 7:     Ind3 1688193 2926555
# 8:     Ind4 1688193 2926555

现在使用foverlaps功能查找重叠区域

setkey(dt_join, SampleID, Start, End)
setkey(dt_segment, SampleID, seg_Start, seg_End)

foverlaps(dt_join,
          dt_segment,
          type="any")

#    SampleID seg_Start seg_End State   Start     End
# 1:     Ind1    721290 1688192     1  721290 1688192
# 2:     Ind1   1688194 2926555     2 1688193 2926555
# 3:     Ind2    721290 1688190     2  721290 1688192
# 4:     Ind2   1688200 2900000     5 1688193 2926555
# 5:     Ind3    721290 2926555     4  721290 1688192
# 6:     Ind3    721290 2926555     4 1688193 2926555
# 7:     Ind4    721290 1500000     2  721290 1688192
# 8:     Ind4   1688193 2005000     6 1688193 2926555

要查看所有数据(即属于区域内的数据和不属于区域的数据),您可以执行cartesian连接,然后将值分配给区域内的数据以及区域外的数据。你希望

dt_join[dt_segment, on="SampleID", nomatch=0, allow.cartesian=T]
相关问题