Сжать крайние диапазоны в data.frame

Question

У меня есть data.frame, который содержит 3 столбца с именем start, end и width. Каждая строка представляет собой сегмент над 1D пространства с началом и концом и ширину такие, как «ширина = конец - старт + 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. Теперь нам нужно выбрать правильную строку из каждого блока строк (каждый размер 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