导入R函数时，Rcpp中的实现速度比R慢

我试着用Rcpp重写一些R代码。但是，我发现性能有所下降。我的目标是代码中有问题的特定部分。在这一部分中，我从R中的stats包导入Optimize函数

我试图重写的R代码是：

###################################
# R implementation

phi_R <- function(x, mean = 0, beta) {
  return(2*(beta^2)*((x-mean)^6) - 3*beta*((x-mean)^2))
}

bound_phi_R <- function(beta, mean = 0, lower, upper) {
  # finding maxima and minimma in the interval
  maxim <- optimise(function(x) phi_R(x, mean, beta), interval = c(lower, upper), 
                    maximum = TRUE)$objective
  minim <- optimise(function(x) phi_R(x, mean, beta), interval = c(lower, upper), 
                    maximum = FALSE)$objective

  # checking end points
  at_lower <- phi_R(lower, mean, beta)
  at_upper <- phi_R(upper, mean, beta)

  # obtaining upper and lower bounds
  upper_bound <- max(maxim, at_lower, at_upper)
  lower_bound <- min(minim, at_lower, at_upper)

  return(list('low_bound' = lower_bound, 'up_bound' = upper_bound))
}

---

从stats导入函数似乎有相当大的开销。有没有办法加快这个过程或者在Rcpp中有一个等价的优化函数吗？

< P> >你的C++代码很慢，这并不奇怪，因为你要往回走，并且在R和C++之间进行了很多次的力。每一次这样的转变都有其代价。然而，可以使用仅在C++中实现的优化算法，例如，看起来是与R所使用的相同的算法，并且被包含在BH包中。事实证明，它也很容易使用：

包括 //[[Rcpp:：pluginSCP11]] //[[Rcpp:：dependsBH]] 包括 类phi_rcpp{ 私人： 双均值； 双β； 公众： phi_rcppdouble _均值，double _β：均值，β{} 双运算符CONST double&x{ 双y=x-平均值； 返回2*beta*beta*powy，6-3*beta*y*y； } }; 样板 类否定：公共T{ 公众： 使用T：：T； 双运算符constdouble&x{ return-T:：operatorx； } }; //[[Rcpp:：导出]] Rcpp：：列表边界φrcppconst double&mean， 常数双和贝塔， 常数双和更低， 双上常数{ 使用boost:：math:：tools:：brent_find_minima； const int double_bits=std:：numeric_limits:：digits； phi_rcpp funcmean，β； 否定平均值，β； std:：pair min=brent\u find\u minimafunc，低位、高位、双位； std:：pair max=brent\u find\u minimanfunc，低位、高位、双位； 双at_upper=双upper； 双倍at_lower=双倍lower； 返回Rcpp:：List:：createRcpp:：Namedlow_bound=std:：minmin.second，std:：minat_upper，at_lower， Rcpp:：Namedup_bound=std:：maxmax.second，std:：maxat_upper，at_lower； } /***R

---

请检查在C++内部调用优化调用的时间。在R和C++之间来回切换。这是没有效率的。试试C++中实现的优化算法，例如应该是BH包的一部分。谢谢！我收到一个编译错误，它找不到头文件“boost/math/tools/minima.hpp”。我在哪里可以找到这个？@user-2147482565它是BH包的一部分，c.f。你安装了吗？

#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::plugins("cpp17")]]
// [[Rcpp::depends(stats)]]

double phi_rcpp(const double &x,
                             const double &mean,
                             const double &beta) {
  return ((2*beta*beta*pow(x-mean, 6))-(3*beta*(x-mean)*(x-mean)));
}

// [[Rcpp::export]]
Rcpp::List bound_phi_rcpp(const double &mean,
                                const double &beta,
                                const double &lower,
                                const double &upper) {
  // Obtaining namespace of stats package in R
  Rcpp::Environment stats("package:stats");
  // Picking up optimise function
  Function optimise = stats["optimise"];

  // using optimise to find the maximum and minimum of phi within the interval
  Rcpp::List maxim = optimise(_["f"] = Rcpp::InternalFunction(&phi_rcpp),
                              _["lower"] = lower,
                              _["upper"] = upper,
                              _["maximum"] = true,
                              _["mean"] = mean,
                              _["beta"] = beta);
  Rcpp::List minim = optimise(_["f"] = Rcpp::InternalFunction(&phi_rcpp),
                              _["lower"] = lower,
                              _["upper"] = upper,
                              _["maximum"] = false,
                              _["mean"] = mean,
                              _["beta"] = beta);

  // check the end points are not greater or less than the minimum and maximums from optimise
  double at_upper = phi_rcpp(upper, mean, beta);
  double at_lower = phi_rcpp(lower, mean, beta);

  double upper_bound = std::max(as<double>(maxim[1]), std::max(at_lower, at_upper));
  double lower_bound = std::min(as<double>(minim[1]), std::min(at_lower, at_upper));

  // return bounds as vector
  return Rcpp::List::create(Named("low_bound") = lower_bound,
                            Named("up_bound") = upper_bound);
}

library(Rcpp)
sourceCpp(file = 'rcpp.cpp')

pcm <- proc.time()
set.seed(42)
for (i in 1:10000) {
  limits <- runif(2, -2, 2)
  bound_phi_rcpp(beta = 1/4, mean = 0, lower = min(limits), upper = max(limits))
}
test1_time <- proc.time()-pcm

pcm <- proc.time()
set.seed(42)
for (i in 1:10000) {
  limits <- runif(2, -2, 2)
  bound_phi_R(beta = 1/4, mean = 0, lower = min(limits), upper = max(limits))
}
test2time <- proc.time()-pcm

print(paste('rcpp:', test1_time['elapsed'])) # 5.69 on my machine
print(paste('R:', test2_time['elapsed'])) # 0.0749 on my machine

# benchmarking with rbenchmark
set.seed(42)
limits <- runif(2, -2, 2)
identical(bound_phi_rcpp(beta = 1/4, mean = 0, lower = min(limits), upper = max(limits)),
          bound_phi_R(beta = 1/4, mean = 0, lower = min(limits), upper = max(limits)))
rbenchmark::benchmark(cpp = bound_phi_rcpp(beta = 1/4, mean = 0, lower = min(limits), upper = max(limits)),
                      R = bound_phi_R(beta = 1/4, mean = 0, lower = min(limits), upper = max(limits)), 
                      replications = 1000)

  test replications elapsed relative user.self sys.self user.child sys.child
1  cpp         1000   0.532   10.231     0.532    0.001          0         0
2    R         1000   0.052    1.000     0.052    0.000          0         0

# A tibble: 2 x 13
  expression     min  median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result memory time 
  <bch:expr> <bch:t> <bch:t>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list> <list> <lis>
1 cpp         6.26µs  7.94µs   117496.    2.49KB     11.8  9999     1     85.1ms <list… <Rpro… <bch…
2 R          61.51µs 72.31µs    11279.  124.98KB     11.1  5102     5    452.4ms <list… <Rpro… <bch…
# … with 1 more variable: gc <list>