Question

我有一个data.frame，其中包含名为start，end和width的3列。每一行代表1D空间上的一个段，带有一个开始，结束和宽度，例如＆＃34; width = end - start + 1＆＃34;

这是一个例子

d = data.frame(
start = c(12, 50, 100, 130, 190),
end   = c(16, 80, 102, 142, 201)
)
d$width = d$end - d$start + 1
print(d)
  start end width
1    12  16     5
2    50  80    31
3   100 102     3
4   130 142    13
5   190 201    12

考虑两个断点和一个除法因子

UpperPos = 112
LowerPos = 61
factor   = 2

我想减少两个断点之外的每个段的宽度，以便将它们的宽度减小factor倍。如果一个段与一个断点重叠，那么只有该断点之外的段的一部分应该减小宽度。此外，每个段的宽度必须是3的倍数，并且必须是非零长度。

这是我当前的功能＆＃34;挤压＆＃34;细分

squeeze = function(d, factor, LowerPos, UpperPos)
{
    for (row in 1:nrow(d))
    {
        if (d[row,]$end <= LowerPos | d[row,]$end >= UpperPos) # Complete squeeze
        {
            middlePos     = round(d[row,]$start + d[row,]$width/2)
            d[row,]$width = round(d[row,]$width / factor)
            d[row,]$width = d[row,]$width - d[row,]$width %% 3 + 3
            d[row,]$start = round(middlePos - d[row,]$width/2)
            d[row,]$end   = d[row,]$start + d[row,]$width -1
        } else if (d[row,]$start <= LowerPos & d[row,]$end >= LowerPos)  # Partial squeeze (Lower)
        {
            d[row,]$start = round(LowerPos - (LowerPos - d[row,]$start)/factor)
            d[row,]$width = d[row,]$end - d[row,]$start + 1
            if (d[row,]$width %% 3 != 0)
            {
                add = 3 - d[row,]$width %% 3
                d[row,]$width = d[row,]$width + add
                d[row,]$start = d[row,]$start - add
            }
        } else if (d[row,]$start >= UpperPos & d[row,]$end <= UpperPos) # Partial squeeze (Upper)
        {
            d[row,]$end     = round(UpperPos + (d[row,]$end - UpperPos)/factor)
            d[row,]$width = d[row,]$end - d[row,]$start + 1
            if (d[row,]$width %% 3 != 0)
            {
                add                     = 3 - d[row,]$width %% 3
                d[row,]$width = d[row,]$width + add
                d[row,]$end   = d[row,]$start + add
            }
        } else if (!(d[row,]$end < UpperPos & d[row,]$start > LowerPos) ) 
        {
            print(d)
            print(paste("row is ",row))
            print(paste("LowerPos is ",LowerPos))
            print(paste("UpperPos is ",UpperPos))
            stop("In MyRanges_squeeze: Should not run this line!")
        }
    }
    return(d)
}

并返回预期的输出

squeeze(d)
  start end width
1    12  14     3
2    54  80    27
3   100 102     3
4   132 140     9
5   192 200     9

然而，我的函数squeeze太慢了。你能帮我改进一下吗？

Answer 1

请注意，此答案仅说明了如何加速您的功能，这是您在问题中提出的问题，而不是您的逻辑在您的要求方面的有效性。

据我所知，您的所有操作都使用向量化运算符。因此，无需在squeeze中循环遍历行。在下文中，我将if-else块中的所有代码封装为单独的矢量化函数：

## This computes the case where d$end <= LowerPos | d$end >= UpperPos
f1 <- function(d, factor) {
  middlePos = round(d$start + d$width/2)
  d$width = round(d$width / factor)
  d$width = d$width - d$width %% 3 + 3
  d$start = round(middlePos - d$width/2)
  d$end   = d$start + d$width -1
  d
}

## This is used below in f2
f4 <- function(d) {
  add = 3 - d$width %% 3
  d$width = d$width + add
  d$start = d$start - add
  d
}

## This computes the case where d$start <= LowerPos & d$end >= LowerPos
f2 <- function(d, factor, LowerPos) {
  d$start = round(LowerPos - (LowerPos - d$start)/factor)
  d$width = d$end - d$start + 1
  ifelse(d$width %% 3 != 0, f4(d), d)
}

## This is used below in f3    
f5 <- function(d) {
  add     = 3 - d$width %% 3
  d$width = d$width + add
  d$end   = d$start + add
  d
}

## This computes the case where d$start >= UpperPos & d$end <= UpperPos
f3 <- function(d, factor, UpperPos) {
  d$end   = round(UpperPos + (d$end - UpperPos)/factor)
  d$width = d$end - d$start + 1
  ifelse (d$width %% 3 != 0, f5(d), d)
}

现在，在squeeze中，我们使用f1，f2和f3分别计算所有三种情况的挤压情况。我们还将不挤压的情况包括在内d。然后，我们rbind将它们转换为一个大数据框dd。现在，我们所需要的是根据该行的大小，从nrow(d)中的每个行块（每个大小为dd）中选择正确的行。为此，我们使用一系列ind为该案例计算1（即4到ifelse）。 ind的值是要选择的块，其位置是该块中可供选择的行。我们使用它来子集dd来获取输出。

squeeze <- function(d, factor, LowerPos, UpperPos) {
  d1 <- f1(d, factor)
  d2 <- f2(d, factor, LowerPos)
  d3 <- f3(d, factor, UpperPos)
  dd <- do.call(rbind,list(d1,d2,d3,d))
  ind <- ifelse(d$end <= LowerPos | d$end >= UpperPos, 1,
                 ifelse(d$start <= LowerPos & d$end >= LowerPos, 2,
                        ifelse(d$start >= UpperPos & d$end <= UpperPos, 3, 4)))
  dd[(ind-1) * nrow(d) + 1:nrow(d),]
}

使用此版本，结果与您的相同：

out <- squeeze(d, factor, LowerPos, UpperPos)
##   start end width
##1     12  14     3
##7     54  80    27
##18   100 102     3
##4    132 140     9
##5    192 200     9

挤压data.frame中的极端范围

1 个答案: