Вычисление каждого значения внутри вектора и агрегирование результатов в вектор

Question

У меня есть проблема, в связи с которой мне нужно выполнить некоторые манипуляции с вектором, для каждого значения внутри вектора мне нужно вычислить значения «линейного увеличения» для этого значения с учетом диапазона линейного увеличения L.

Например, значение 10 в позиции 3rd, функция линейного нарастания вернет [2.5, 5], что должно быть значением нарастания для этого значения 10, и онив позициях 1st, 2nd.

Я хочу получить результаты одного вектора, который также является вектором, но со всеми эффектами увеличения.

Я использовал несколько способов, чтобы успешно получить правильные результаты.

Потому что мне нужно сделать много таких операций, поэтому мне интересно, есть ли более быстрый способ добиться этого.(profvis показывает, что эта операция является узким местом моего сценария)

Вот простой пример

x = c(0, 0, 5, 10, 10, 20, 10)
L = 2

r = matrix(0, L, length(x))
for(i in 1: L)
{
       r[i, ] = map(x, ramp, L) %>% 
                map_dbl(i) %>% 
                lead(L-i+1, default = 0)
}

r
         [,1]     [,2]     [,3]     [,4]      [,5]     [,6] [,7]
[1,] 1.250000 2.500000 2.500000 5.000000  2.500000 0.000000    0
[2,] 0.000000 2.500000 5.000000 5.000000 10.000000 5.000000    0

Первая строка полученной матрицы r - это первое линейное изменение-перед значениями после смещения в правую позицию, второй ряд является вторым повышением значений.

Конечный вектор возврата, который я хочу получить:

colSums(r) 

Любое предложение приветствуется, оцените его.

для ясности, вот функция ramp(), которую я использовал, наполовину скатывание - просто пример для легкого понимания.

ramp <- function(Value, Len, R = 0.5)
{
  out <- c(1:(Len+1)) 
  if(R != 0) { out <- exp(R*c(1:(Len+1)))*Value/exp(R*(Len+1)) } 
  else { out <- c(rep(0, Len), Value) } 
  return(out)
}

x = c(0, 0, 5, 10, 10, 20, 10)
L = 2

r = matrix(0, L, length(x))
for(i in 1: L)
{
   r[i, ] = map(x, ramp, L) %>% map_dbl(i) %>% lead(L-i+1, default = 0)
}
r
         [,1]     [,2]     [,3]     [,4]      [,5]     [,6] [,7]
[1,] 1.839397 3.678794 3.678794 7.357589  3.678794 0.000000    0
[2,] 0.000000 3.032653 6.065307 6.065307 12.130613 6.065307    0

Это результат

colSums(r)
[1]  1.839397  6.711448  9.744101 13.422895 15.809408  6.065307  0.000000

Answer 1

Я бы хотел опубликовать несколько своих попыток улучшить эффективность процесса.

Первое, что я сделал, это оптимизировал мои ramp.all() шаги, которые являются второй частью моего сценария в моем примере.

ramp.all.old.1 <- function(x, L)
{
  r = rep(0, length(x))
  for(i in 1: L)
  {
    r = rbind(r, map(x, ramp, L) %>% map_dbl(i) %>% lead(L-i+1, default = 0))
  }
  return(colSums(r))
}

Когда я читал другие статьи, я заметил, что rbind() может быть не лучшим выбором для моих целей. Итак, первая попытка состоит в том, чтобы предварительно выделить матрицу результатов r, поэтому я получил вторую версию.

ramp.all.old.2 <- function(x, L)
{
   r = matrix(0, L, length(x))
   for(i in 1: L)
   {
       r[i, ] = map(x, ramp, L) %>% map_dbl(i) %>% lead(L-i+1, default = 0)
   }
   return(colSums(r))
}

Затем, когда я внимательно посмотрел на мой код внутри цикла, я заметил, что map() на самом деле избыточен, его нужно вычислить только один раз перед циклом. Поэтому я переместил map () и заменил ее на lapply().

ramp.all.old.3 <- function(x, L)
{
  r = matrix(0, L, length(x))
  tmp = lapply(x, ramp, L)
  for(i in 1: L)
  {
      r[i, ] = tmp %>% map_dbl(i) %>% lead(L-i+1, default = 0)
  }
  return(colSums(r))
}  

Точно так же похоже, что map_dbl() не оптимизирован, есть лучшие способы. Итак, я вышел с версией 4.

ramp.all.old.4 <- function(x, L)
{
  r = matrix(0, L, length(x))
  tmp = as.data.frame(data.table::transpose(lapply(x, ramp, L)), col.names = letters[1:(L+1)])
  for(i in 1: L)
  {
    r[i, ] = lead(tmp[, i], L-i+1, default = 0)
  }
  return(colSums(r))
}  

Как предложил @Gregor, ускорение функции ramp() очень важно и здесь. Я нашел способ изменить мою ramp() функцию, которая теперь может принимать vector в качестве входа, используя операцию out-product . Я придумал ramp.new() функцию

ramp.new <- function(Value, Len, R = 0.5)
{
   out = Value %*% t(exp(R*c(1:(Len+1)))/exp(R*(Len+1))) 
   return(out)
}

Новая функция ramp.all()

ramp.all <- function(x, L)
{
   r = matrix(0, L, length(x))
   tmp = ramp.new(x, L)
   for(i in 1: L)
   {
     r[i, ] = lead(tmp[, i], L-i+1, default = 0)
   }
   return(colSums(r))
}

Вот результаты тестирования производительности.

x
[1]  0  0  5 10 10 20 10

microbenchmark(ramp.all.old.1(x, 2)->res.1, ramp.all.old.2(x, 2)->res.2, ramp.all.old.3(x, 2)->res.3, ramp.all.old.4(x, 2)->res.4,ramp.all(x, 2)->res.5)
Unit: microseconds
                          expr     min       lq     mean  median       uq      max neval  cld
 res.1 <- ramp.all.old.1(x, 2) 529.461 565.0145 603.9836 589.810 618.7990  816.800   100    d
 res.2 <- ramp.all.old.2(x, 2) 526.909 565.1965 619.6961 590.357 623.7215 1684.649   100    d
 res.3 <- ramp.all.old.3(x, 2) 441.582 472.0305 512.1629 500.655 525.0860  859.463   100   c 
 res.4 <- ramp.all.old.4(x, 2) 299.736 331.4610 375.3600 350.422 385.7930 1232.857   100  b  
       res.5 <- ramp.all(x, 2)  34.277  47.7680  56.4947  50.504  56.3385  137.470   100 a   

identical(res.1, res.2, res.3, res.4, res.5)
[1] TRUE

Пока я очень счастлив. При проверке profvis, мне кажется, я должен сосредоточиться на функции lead() на следующем шаге.

Любые другие предложения приветствуются, и спасибо всем @akrun, @ Gregor.