В настоящее время я работаю над байесовским методом, который требует нескольких этапов оптимизации полиномиальной логит-модели на одну итерацию. Я использую optim () для выполнения этих оптимизаций, и целевая функция, написанная на R. Профилирование показало, что optim () является основным узким местом.

Покопавшись, я нашел вопрос, в котором они предполагают, что перекодирование целевой функции Rcppможет ускорить процесс. Я последовал предложению и перекодировал свою целевую функцию Rcpp, но в итоге он оказался медленнее (примерно в два раза медленнее!).

Это был мой первый раз Rcpp(или что-то связанное с C ++), и я не смог найти способ векторизации кода. Есть идеи, как сделать это быстрее?

Tl; dr: текущая реализация функции в Rcpp не такая быстрая, как векторизация R; как сделать это быстрее?

Воспроизводимый пример :

1) Определить целевые функции в Rи Rcpp: логарифмическая вероятность перехвата только полиномиальной модели

library(Rcpp)
library(microbenchmark)

llmnl_int <- function(beta, Obs, n_cat) {
  n_Obs     <- length(Obs)
  Xint      <- matrix(c(0, beta), byrow = T, ncol = n_cat, nrow = n_Obs)
  ind       <- cbind(c(1:n_Obs), Obs)
  Xby       <- Xint[ind]
  Xint      <- exp(Xint)
  iota      <- c(rep(1, (n_cat)))
  denom     <- log(Xint %*% iota)
  return(sum(Xby - denom))
}

cppFunction('double llmnl_int_C(NumericVector beta, NumericVector Obs, int n_cat) {

    int n_Obs = Obs.size();

    NumericVector betas = (beta.size()+1);
    for (int i = 1; i < n_cat; i++) {
        betas[i] = beta[i-1];
    };

    NumericVector Xby = (n_Obs);
    NumericMatrix Xint(n_Obs, n_cat);
    NumericVector denom = (n_Obs);
    for (int i = 0; i < Xby.size(); i++) {
        Xint(i,_) = betas;
        Xby[i] = Xint(i,Obs[i]-1.0);
        Xint(i,_) = exp(Xint(i,_));
        denom[i] = log(sum(Xint(i,_)));
    };

    return sum(Xby - denom);
}')

2) Сравните их эффективность:

## Draw sample from a multinomial distribution
set.seed(2020)
mnl_sample <- t(rmultinom(n = 1000,size = 1,prob = c(0.3, 0.4, 0.2, 0.1)))
mnl_sample <- apply(mnl_sample,1,function(r) which(r == 1))

## Benchmarking
microbenchmark("llmml_int" = llmnl_int(beta = c(4,2,1), Obs = mnl_sample, n_cat = 4),
               "llmml_int_C" = llmnl_int_C(beta = c(4,2,1), Obs = mnl_sample, n_cat = 4),
               times = 100)
## Results
# Unit: microseconds
#         expr     min       lq     mean   median       uq     max neval
#    llmnl_int  76.809  78.6615  81.9677  79.7485  82.8495 124.295   100
#  llmnl_int_C 155.405 157.7790 161.7677 159.2200 161.5805 201.655   100

3) Теперь звоню им optim:

## Benchmarking with optim
microbenchmark("llmnl_int" = optim(c(4,2,1), llmnl_int, Obs = mnl_sample, n_cat = 4, method = "BFGS", hessian = T, control = list(fnscale = -1)),
               "llmnl_int_C" = optim(c(4,2,1), llmnl_int_C, Obs = mnl_sample, n_cat = 4, method = "BFGS", hessian = T, control = list(fnscale = -1)),
               times = 100)
## Results
# Unit: milliseconds
#         expr      min       lq     mean   median       uq      max neval
#    llmnl_int 12.49163 13.26338 15.74517 14.12413 18.35461 26.58235   100
#  llmnl_int_C 25.57419 25.97413 28.05984 26.34231 30.44012 37.13442   100

Я был несколько удивлен, что векторизованная реализация в R оказалась быстрее. Реализация более эффективной версии в Rcpp (скажем, с RcppArmadillo?) Может принести какую-либо выгоду? Это лучшая идея, чтобы перекодировать все в Rcpp с помощью оптимизатора C ++?

PS: первая публикация в Stackoverflow!

В общем, если вы можете использовать векторизованные функции, вы обнаружите, что это (почти) так же быстро, как и запуск кода прямо в Rcpp. Это связано с тем, что многие векторизованные функции в R (почти все векторизованные функции в Base R) написаны на C, Cpp или Fortran, и поэтому зачастую мало что можно выиграть.

Тем не менее, есть улучшения, чтобы получить как в вашем, так Rи в Rcppкоде. Оптимизация происходит благодаря тщательному изучению кода и удалению ненужных шагов (распределение памяти, суммы и т. Д.).

Начнем с Rcppоптимизации кода.

В вашем случае основной оптимизацией является удаление ненужных матричных и векторных вычислений. Код по сути

1. Shift beta
2. вычислить лог суммы exp (сдвиг бета) [log-sum-exp]
3. использовать Obs в качестве индекса для сдвинутой бета-версии и суммировать по всем вероятностям
4. вычесть лог-сумма-эксп

Используя это наблюдение, мы можем сократить ваш код до двух циклов for. Обратите внимание, что sumэто просто еще один цикл for (более или менее for(i = 0; i < max; i++){ sum += x }:), поэтому избегание сумм может еще больше ускорить выполнение кода (в большинстве случаев это ненужная оптимизация!). Кроме того, ваш ввод Obsпредставляет собой целочисленный вектор, и мы можем дополнительно оптимизировать код, используя IntegerVectorтип, чтобы избежать приведения doubleэлементов к integerзначениям (ответ Ральфу Стубнеру).

cppFunction('double llmnl_int_C_v2(NumericVector beta, IntegerVector Obs, int n_cat)
 {

    int n_Obs = Obs.size();

    NumericVector betas = (beta.size()+1);
    //1: shift beta
    for (int i = 1; i < n_cat; i++) {
        betas[i] = beta[i-1];
    };
    //2: Calculate log sum only once:
    double expBetas_log_sum = log(sum(exp(betas)));
    // pre allocate sum
    double ll_sum = 0;

    //3: Use n_Obs, to avoid calling Xby.size() every time 
    for (int i = 0; i < n_Obs; i++) {
        ll_sum += betas(Obs[i] - 1.0) ;
    };
    //4: Use that we know denom is the same for all I:
    ll_sum = ll_sum - expBetas_log_sum * n_Obs;
    return ll_sum;
}')

Обратите внимание, что я удалил довольно много выделений памяти и удалил ненужные вычисления в цикле for. Также я использовал то denomже самое для всех итераций и просто умножил для конечного результата.

Мы можем выполнить аналогичные оптимизации в вашем R-коде, что приводит к следующей функции:

llmnl_int_R_v2 <- function(beta, Obs, n_cat) {
    n_Obs <- length(Obs)
    betas <- c(0, beta)
    #note: denom = log(sum(exp(betas)))
    sum(betas[Obs]) - log(sum(exp(betas))) * n_Obs
}

Обратите внимание, что сложность функции была значительно уменьшена, что облегчило чтение другими пользователями. Просто чтобы убедиться, что я где-то не ошибся в коде, давайте проверим, чтобы они возвращали одинаковые результаты:

set.seed(2020)
mnl_sample <- t(rmultinom(n = 1000,size = 1,prob = c(0.3, 0.4, 0.2, 0.1)))
mnl_sample <- apply(mnl_sample,1,function(r) which(r == 1))

beta = c(4,2,1)
Obs = mnl_sample 
n_cat = 4
xr <- llmnl_int(beta = beta, Obs = mnl_sample, n_cat = n_cat)
xr2 <- llmnl_int_R_v2(beta = beta, Obs = mnl_sample, n_cat = n_cat)
xc <- llmnl_int_C(beta = beta, Obs = mnl_sample, n_cat = n_cat)
xc2 <- llmnl_int_C_v2(beta = beta, Obs = mnl_sample, n_cat = n_cat)
all.equal(c(xr, xr2), c(xc, xc2))
TRUE

ну, это облегчение.

Представление:

Я буду использовать микробенчмарк для иллюстрации производительности. Оптимизированные функции работают быстро, поэтому я буду запускать функции 1e5раз, чтобы уменьшить эффект сборщика мусора

microbenchmark("llmml_int_R" = llmnl_int(beta = beta, Obs = mnl_sample, n_cat = n_cat),
               "llmml_int_C" = llmnl_int_C(beta = beta, Obs = mnl_sample, n_cat = n_cat),
               "llmnl_int_R_v2" = llmnl_int_R_v2(beta = beta, Obs = mnl_sample, n_cat = n_cat),
               "llmml_int_C_v2" = llmnl_int_C_v2(beta = beta, Obs = mnl_sample, n_cat = n_cat),
               times = 1e5)
#Output:
#Unit: microseconds
#           expr     min      lq       mean  median      uq        max neval
#    llmml_int_R 202.701 206.801 288.219673 227.601 334.301  57368.902 1e+05
#    llmml_int_C 250.101 252.802 342.190342 272.001 399.251 112459.601 1e+05
# llmnl_int_R_v2   4.800   5.601   8.930027   6.401   9.702   5232.001 1e+05
# llmml_int_C_v2   5.100   5.801   8.834646   6.700  10.101   7154.901 1e+05

Здесь мы видим тот же результат, что и раньше. Теперь новые функции примерно в 35 раз быстрее (R) и в 40 раз быстрее (Cpp) по сравнению с их первыми аналогами. Интересно, что оптимизированная Rфункция все еще немного (на 0,3 мс или 4%) быстрее, чем моя оптимизированная Cppфункция. Моя лучшая ставка здесь состоит в том, что есть некоторые накладные расходы от Rcppпакета, и если бы это было удалено, оба были бы идентичны или R.

Точно так же мы можем проверить производительность с помощью Optim.

microbenchmark("llmnl_int" = optim(beta, llmnl_int, Obs = mnl_sample, 
                                   n_cat = n_cat, method = "BFGS", hessian = F, 
                                   control = list(fnscale = -1)),
               "llmnl_int_C" = optim(beta, llmnl_int_C, Obs = mnl_sample, 
                                     n_cat = n_cat, method = "BFGS", hessian = F, 
                                     control = list(fnscale = -1)),
               "llmnl_int_R_v2" = optim(beta, llmnl_int_R_v2, Obs = mnl_sample, 
                                     n_cat = n_cat, method = "BFGS", hessian = F, 
                                     control = list(fnscale = -1)),
               "llmnl_int_C_v2" = optim(beta, llmnl_int_C_v2, Obs = mnl_sample, 
                                     n_cat = n_cat, method = "BFGS", hessian = F, 
                                     control = list(fnscale = -1)),
               times = 1e3)
#Output:
#Unit: microseconds
#           expr       min        lq      mean    median         uq      max neval
#      llmnl_int 29541.301 53156.801 70304.446 76753.851  83528.101 196415.5  1000
#    llmnl_int_C 36879.501 59981.901 83134.218 92419.551 100208.451 190099.1  1000
# llmnl_int_R_v2   667.802  1253.452  1962.875  1585.101   1984.151  22718.3  1000
# llmnl_int_C_v2   704.401  1248.200  1983.247  1671.151   2033.401  11540.3  1000

Еще раз результат тот же.

Вывод:

В качестве краткого заключения стоит отметить, что это один из примеров, когда преобразование вашего кода в Rcpp не стоит больших усилий. Это не всегда так, но часто стоит еще раз взглянуть на вашу функцию, чтобы увидеть, есть ли области вашего кода, где выполняются ненужные вычисления. Особенно в ситуациях, когда используются встроенные векторизованные функции, часто не стоит тратить время на преобразование кода в Rcpp. Чаще всего можно увидеть большие улучшения, если использовать for-loopsкод, который нельзя легко векторизовать, чтобы удалить цикл for.

Ваша функция C ++ может быть сделана быстрее, используя следующие наблюдения. По крайней мере, первое также может быть использовано с вашей функцией R:

• То, как вы рассчитываете, denom[i]одинаково для всех i. Поэтому имеет смысл использовать double denomи делать это вычисление только один раз. Я также исключаю вычитание этого общего термина в конце.

• Ваши наблюдения на самом деле являются целочисленным вектором на стороне R, и вы используете их также как целые числа в C ++. Использование IntegerVectorдля начала делает ненужным много приведения.

• Вы также можете индексировать с NumericVectorпомощью IntegerVectorC ++. Я не уверен, если это помогает производительности, но это делает код немного короче.

• Еще несколько изменений, которые больше связаны со стилем, чем с производительностью.

Результат:

double llmnl_int_C(NumericVector beta, IntegerVector Obs, int n_cat) {

    int n_Obs = Obs.size();

    NumericVector betas(beta.size()+1);
    for (int i = 1; i < n_cat; ++i) {
        betas[i] = beta[i-1];
    };

    double denom = log(sum(exp(betas)));
    NumericVector Xby = betas[Obs - 1];

    return sum(Xby) - n_Obs * denom;
}

Для меня эта функция примерно в десять раз быстрее, чем ваша R-функция.

Я могу вспомнить четыре возможных оптимизации ответов Ральфа и Оливера.

(Вы должны принять их ответы, но я просто хотел добавить свои 2 цента).

1) Использовать // [[Rcpp::export(rng = false)]]в качестве заголовка комментария к функции в отдельном файле C ++. Это приводит к увеличению скорости моей машины на 80%. (Это самое важное предложение из 4).

2) Предпочитаю, cmathкогда это возможно. (В этом случае это не имеет значения).

3) Избегайте выделения, когда это возможно, например, не переходите betaв новый вектор.

4) Растянуть цель: использовать SEXPпараметры, а не векторы Rcpp. (Оставлено как упражнение для читателя). Векторы Rcpp - это очень тонкие оболочки, но они по-прежнему являются оболочками и имеют небольшие накладные расходы.

Эти предложения не были бы важны, если бы не тот факт, что вы вызываете функцию в тесном цикле optim. Поэтому любые накладные расходы очень важны.

Скамейка:

microbenchmark("llmnl_int_R_v1" = optim(beta, llmnl_int, Obs = mnl_sample, 
                                      n_cat = n_cat, method = "BFGS", hessian = F, 
                                      control = list(fnscale = -1)),
             "llmnl_int_R_v2" = optim(beta, llmnl_int_R_v2, Obs = mnl_sample, 
                                      n_cat = n_cat, method = "BFGS", hessian = F, 
                                      control = list(fnscale = -1)),
             "llmnl_int_C_v2" = optim(beta, llmnl_int_C_v2, Obs = mnl_sample, 
                                      n_cat = n_cat, method = "BFGS", hessian = F, 
                                      control = list(fnscale = -1)),
             "llmnl_int_C_v3" = optim(beta, llmnl_int_C_v3, Obs = mnl_sample, 
                                      n_cat = n_cat, method = "BFGS", hessian = F, 
                                      control = list(fnscale = -1)),
             "llmnl_int_C_v4" = optim(beta, llmnl_int_C_v4, Obs = mnl_sample, 
                                      n_cat = n_cat, method = "BFGS", hessian = F, 
                                      control = list(fnscale = -1)),
             times = 1000)


Unit: microseconds
expr      min         lq       mean     median         uq        max neval cld
llmnl_int_R_v1 9480.780 10662.3530 14126.6399 11359.8460 18505.6280 146823.430  1000   c
llmnl_int_R_v2  697.276   735.7735  1015.8217   768.5735   810.6235  11095.924  1000  b 
llmnl_int_C_v2  997.828  1021.4720  1106.0968  1031.7905  1078.2835  11222.803  1000  b 
llmnl_int_C_v3  284.519   295.7825   328.5890   304.0325   328.2015   9647.417  1000 a  
llmnl_int_C_v4  245.650   256.9760   283.9071   266.3985   299.2090   1156.448  1000 a 

v3 - это ответ Оливера rng=false. v4 с предложениями № 2 и № 3 включены.

Функция:

#include <Rcpp.h>
#include <cmath>
using namespace Rcpp;

// [[Rcpp::export(rng = false)]]
double llmnl_int_C_v4(NumericVector beta, IntegerVector Obs, int n_cat) {

  int n_Obs = Obs.size();
  //2: Calculate log sum only once:
  // double expBetas_log_sum = log(sum(exp(betas)));
  double expBetas_log_sum = 1.0; // std::exp(0)
  for (int i = 1; i < n_cat; i++) {
    expBetas_log_sum += std::exp(beta[i-1]);
  };
  expBetas_log_sum = std::log(expBetas_log_sum);

  double ll_sum = 0;
  //3: Use n_Obs, to avoid calling Xby.size() every time 
  for (int i = 0; i < n_Obs; i++) {
    if(Obs[i] == 1L) continue;
    ll_sum += beta[Obs[i]-2L];
  };
  //4: Use that we know denom is the same for all I:
  ll_sum = ll_sum - expBetas_log_sum * n_Obs;
  return ll_sum;
}