在 data.frame 中压缩极端范围

Question

我有一个 data.frame，其中包含 3 个名为 start、end 和 width 的列。每条线代表一维空间上的一段，有一个起点、终点和一个宽度，例如“width = end - start + 1”

这是一个例子

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 的倍数，并且长度必须非零。

这是我当前的“挤压”段的函数

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。现在，我们只需要根据该行的情况从dd 中的每个行块（每个行的大小nrow(d)）中选择正确的行。为此，我们使用一系列ifelse 为案例（即1 到4）计算ind。 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