r - 使用Rcpp在C++中的R中应用优化函数

Question

我正在尝试在Rcpp中调用R函数optim()。我在Calling R's optim function from within C++ using Rcpp中看到了一个示例，但是无法针对我的用例正确修改它。基本上，目标函数取决于x和y，但我想针对b对其进行优化。

这是执行我想要的R代码：

example_r = function(b, x, y) {
  phi = rnorm(length(x))

  tar_val = (x ^ 2 + y ^ 2) * b * phi

  objftn_r = function(beta, x, y) {
    obj_val = (x ^ 2 + y ^ 2) * beta

    return(obj_val)
  }

  b1 = optim(b, function(beta) {
    sum((objftn_r(beta, x, y) - tar_val) ^ 2)
  }, method = "BFGS")$par

  result = (x ^ 2 + y ^ 2) * b1

  return(b1)
}

这是我尝试将其翻译为_RcppArmadillo的尝试：

#include <RcppArmadillo.h>
using namespace Rcpp;

// [[Rcpp::depends(RcppArmadillo)]]

arma::vec example_rcpp(arma::vec b, arma::vec x, arma::vec y){

  arma::vec tar_val = pow(x,2)%b-pow(y,2);

  return tar_val;
}

// [[Rcpp::export]]
arma::vec optim_rcpp(const arma::vec& init_val, arma::vec& x, arma::vec& y){

  Rcpp::Environment stats("package:stats"); 
  Rcpp::Function optim = stats["optim"];

  Rcpp::List opt_results = optim(Rcpp::_["par"]    = init_val,
                                 Rcpp::_["fn"]     = Rcpp::InternalFunction(&example_rcpp),
                                 Rcpp::_["method"] = "BFGS");

  arma::vec out = Rcpp::as<arma::vec>(opt_results[0]);

  return out;
} 

但是，此代码返回：

> optim_rcpp(1:3,2:4,3:5)
Error in optim_rcpp(1:3, 2:4, 3:5) : not compatible with requested type

我不确定这是什么错误。

Answer 1

在开始之前，我有几句话：


请显示您的所有尝试。


特别是，请确保您的示例是minimal reproducible example

除非另有要求，否则请勿删除或缩短代码。
缩小问题范围。


在C ++中使用R中的optim与在C ++中使用opt()中nlopt的基础C ++代码非常不同。

避免发送垃圾邮件。


如果您发现自己连续快速地提出了3个以上的问题，请阅读文档或与熟悉此内容的人面谈。



结果，我已经清理了您的问题...但是，将来可能不会发生这种情况。

数据生成过程

数据生成过程似乎分两个步骤完成：首先，在example_r函数外部，然后在函数内部。

应该简化此过程，以使其在优化功能之外完成。例如：

generate_data = function(n, x_mu = 0, y_mu = 1, beta = 1.5) {

  x = rnorm(n, x_mu)
  y = rnorm(n, y_mu)

  phi = rnorm(length(x))

  tar_val = (x ^ 2 + y ^ 2) * beta * phi

  simulated_data = list(x = x, y = y, beta = beta, tar_val = tar_val)
  return(simulated_data)
}

目标函数和R的 optim

目标函数必须返回单个值，例如在发布的R代码下，实际上有两个功能被设计为按顺序充当目标函数，例如

objftn_r = function(beta, x, y) {
  obj_val = (x ^ 2 + y ^ 2) * beta

  return(obj_val)
}

b1 = optim(b, function(beta) {
  sum((objftn_r(beta, x, y) - tar_val) ^ 2)
}, method = "BFGS")$par

因此，该目标函数应重写为：

objftn_r = function(beta_hat, x, y, tar_val) {

  # The predictions generate will be a vector
  est_val = (x ^ 2 + y ^ 2) * beta_hat

  # Here we apply sum of squares which changes it
  # from a vector into a single "objective" value
  # that optim can work with.
  obj_val = sum( ( est_val  - tar_val) ^ 2)

  return(obj_val)
}

从那里，调用应对齐为：

sim_data = generate_data(10, 1, 2, .3)

b1 = optim(sim_data$beta, fn = objftn_r, method = "BFGS",
           x = sim_data$x, y = sim_data$y, tar_val = sim_data$tar_val)$par

RcppArmadillo目标函数

固定了R代码的范围和行为之后，我们集中精力将其翻译为RcppArmadillo。

特别要注意的是，转换后定义的异议函数将向量而不是标量返回到 optim中，该值不是单个值。另外值得关注的是目标函数中缺少 tar_val参数。考虑到这一点，目标函数将转换为：

// changed function return type and 
// the return type of first parameter
double obj_fun_rcpp(double& beta_hat, 
                    arma::vec& x, arma::vec& y, arma::vec& tar_val){

  // Changed from % to * as it is only appropriate if  
  // `beta_hat` is the same length as x and y.
  // This is because it performs element-wise multiplication
  // instead of a scalar multiplication on a vector
  arma::vec est_val = (pow(x, 2) - pow(y, 2)) * beta_hat;

  // Compute objective value
  double obj_val = sum( pow( est_val - tar_val, 2) );

  // Return a single value
  return obj_val;
}

现在，在设置了目标函数的情况下，让我们将C ++中的 optim()的Rcpp调用寻址到R中。在此功能中，
必须明确提供功能。因此， x， y和 tar_val必须出现在 optim调用中。因此，我们将得到：

// [[Rcpp::export]]
arma::vec optim_rcpp(double& init_val,
                     arma::vec& x, arma::vec& y, arma::vec& tar_val){

  // Extract R's optim function
  Rcpp::Environment stats("package:stats"); 
  Rcpp::Function optim = stats["optim"];

  // Call the optim function from R in C++ 
  Rcpp::List opt_results = optim(Rcpp::_["par"]    = init_val,
                                 // Make sure this function is not exported!
                                 Rcpp::_["fn"]     = Rcpp::InternalFunction(&obj_fun_rcpp),
                                 Rcpp::_["method"] = "BFGS",
                                 // Pass in the other parameters as everything
                                 // is scoped environmentally
                                 Rcpp::_["x"] = x,
                                 Rcpp::_["y"] = y,
                                 Rcpp::_["tar_val"] = tar_val);

  // Extract out the estimated parameter values
  arma::vec out = Rcpp::as<arma::vec>(opt_results[0]);

  // Return estimated values
  return out;
}

全部一起

可以使用 test_optim.cpp编写完整功能的代码，并通过 sourceCpp()编译为：

#include <RcppArmadillo.h>

// [[Rcpp::depends(RcppArmadillo)]]

// changed function return type and 
// the return type of first parameter
// DO NOT EXPORT THIS FUNCTION VIA RCPP ATTRIBUTES
double obj_fun_rcpp(double& beta_hat, 
                    arma::vec& x, arma::vec& y, arma::vec& tar_val){

  // Changed from % to * as it is only appropriate if  
  // `beta_hat` is the same length as x and y.
  // This is because it performs element-wise multiplication
  // instead of a scalar multiplication on a vector
  arma::vec est_val = (pow(x, 2) - pow(y, 2)) * beta_hat;

  // Compute objective value
  double obj_val = sum( pow( est_val - tar_val, 2) );

  // Return a single value
  return obj_val;
}


// [[Rcpp::export]]
arma::vec optim_rcpp(double& init_val,
                     arma::vec& x, arma::vec& y, arma::vec& tar_val){

  // Extract R's optim function
  Rcpp::Environment stats("package:stats"); 
  Rcpp::Function optim = stats["optim"];

  // Call the optim function from R in C++ 
  Rcpp::List opt_results = optim(Rcpp::_["par"]    = init_val,
                                 // Make sure this function is not exported!
                                 Rcpp::_["fn"]     = Rcpp::InternalFunction(&obj_fun_rcpp),
                                 Rcpp::_["method"] = "BFGS",
                                 // Pass in the other parameters as everything
                                 // is scoped environmentally
                                 Rcpp::_["x"] = x,
                                 Rcpp::_["y"] = y,
                                 Rcpp::_["tar_val"] = tar_val);

  // Extract out the estimated parameter values
  arma::vec out = Rcpp::as<arma::vec>(opt_results[0]);

  // Return estimated values
  return out;
}

测试用例

# Setup some values
beta = 2
x = 2:4
y = 3:5

# Set a seed for reproducibility
set.seed(111)

phi = rnorm(length(x))

tar_val = (x ^ 2 + y ^ 2) * beta * phi

optim_rcpp(beta, x, y, tar_val)
#          [,1]
# [1,] 2.033273

注意：如果要避免返回大小为1 x1的矩阵，请使用 double作为 optim_rcpp的返回参数，并将 Rcpp::as<arma::vec>切换为 Rcpp::as<double>