Блог

У меня есть проблема, из-за которой мне нужно выполнить некоторые манипуляции с вектором, для каждого значения внутри вектора мне нужно вычислить значения «увеличения» для этого значения с учетом диапазона увеличения 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
 

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

Первое, что я сделал, это оптимизировал свои 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() функцию, которая теперь может принимать вектор в качестве входных данных, используя операцию 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.