0

I have a section of code (see below) drawn from a larger model I am working on. This seems to be the bottle neck and I can see optim has been an issue for many others in the past. I know nothing about C++ and I can see this has been a recommended fix using the Rcpp package.

All my attempts to do this have failed so its time to bite the bullet and ask for some help and hopefully someone can help me. My optimisation code is as follows (with dummy data):

if(!require(TruncatedDistributions)){#_                                         
  install.packages("TruncatedDistributions", 
                   repos="http://R-Forge.R-project.org")
}#_____________________________________
library(TruncatedDistributions)

if(!require(Rcpp)){#___________________                                        
  install.packages("Rcpp")
}#_____________________________________
library(Rcpp)



# Inputs

Starting_Values    <- 0.15
labour_wage_elast  <- 0.45
wage               <- 0.15
employment         <- 152000
alpha              <- 1.5
sd                 <- 1.24
rowNum             <- 1
labour_value       <- 2531
max_workers        <- 352000
salary_lower_bound <- 0.01
salary_upper_bound <- 2


CLASSICAL_OPTIMISE_WAGE_EMPLOYEES <- function(Starting_Values,
                                              labour_wage_elast,
                                              wage,
                                              employment,
                                              alpha,
                                              sd,
                                              rowNum,
                                              labour_value,
                                              max_workers,
                                              salary_lower_bound,
                                              salary_upper_bound) {#~~~~~~~~~~~~    
  set.seed(rowNum)                                              
  
  # QL (Quantity of Labour)
  
  QL = ((Starting_Values[1] - wage) / wage * labour_wage_elast ) * employment + employment       
  
  QL = min(QL, max_workers)
  
  
  # Labour Value Function
  
  value = sum(rtgamma(seq(1:QL), 
                      shape = alpha, 
                      scale = (Starting_Values[1]  / sd ^ 2),
                      a = salary_lower_bound, 
                      b = salary_upper_bound))                                  
  
  difference  = abs(labour_value - value)                                       
  
  
  return(difference)
  
}#~~~~~~~~~ END of CLASSICAL_OPTIMISE_WAGE_EMPLOYEES  ~~~~~~~~~~~~~~~~~~~~~~~~~~




Estimates   <- optim(Starting_Values, CLASSICAL_OPTIMISE_WAGE_EMPLOYEES,
                     labour_wage_elast  = labour_wage_elast,
                     wage               = wage,
                     employment         = employment,
                     alpha              = alpha,
                     sd                 = sd, 
                     rowNum             = rowNum, 
                     labour_value       = labour_value, 
                     max_workers        = max_workers, 
                     salary_lower_bound = salary_lower_bound,
                     salary_upper_bound = salary_upper_bound,
                     method = "L-BFGS-B", lower = 0.001, 
                     upper = 2)

last_wage   <- wage 

wage        <- Estimates$par[1]

employment  =  ((wage - last_wage) / last_wage) * labour_wage_elast * employment + employment

Thank you very much in advance.

EDIT:

I have written the following:

Objective Function (which seems to work ok)

cppFunction('

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

  #include<cmath>
  #include<iostream>
  #include<Rcpp.h>
  #include<algorithm>
  #include<cstdlib>
  
  //[[Rcpp::export]]
  
 double classical_optimise_wage_employees(Rcpp::NumericVector Starting_Values,
                                         double labour_wage_elast,
                                         double wage,
                                         double employment,
                                         double alpha,
                                         double sd,
                                         int rowNum,
                                         double labour_value,
                                         double max_workers,
                                         double salary_lower_bound,
                                         double salary_upper_bound) {
                                         
  
  std::srand(rowNum);
  

  double QL = ((Starting_Values[0] - wage) / wage * labour_wage_elast ) * employment + employment;
  QL = std::min(QL, max_workers);
  
    
  Rcpp::Environment pkg = Rcpp::Environment::namespace_env("TruncatedDistributions");


  Rcpp::Function rtgamma_1 = Rcpp::as<Rcpp::Function>(pkg["rtgamma"]);
  

  NumericVector values = rtgamma_1(QL, alpha, Starting_Values[0] / pow(sd, 2) , salary_lower_bound, salary_upper_bound);
  
  double value = Rcpp::sum(values);
  

  return std::abs(labour_value - value);}')


# Calling it in R
classical_optimise_wage_employees(Starting_Values,
                                  labour_wage_elast,
                                  wage,
                                  employment,
                                  alpha,
                                  sd,
                                  rowNum,
                                  labour_value,
                                  max_workers,
                                  salary_lower_bound,
                                  salary_upper_bound)

And a function to use the optim function (which for some reason is not working)


cppFunction('

#include<Rcpp.h>
  
  //[[Rcpp::export]]
  
double solving_function(Rcpp::NumericVector Starting_Values,
                                         double labour_wage_elast,
                                         double wage,
                                         double employment,
                                         double alpha,
                                         double sd,
                                         int rowNum,
                                         double labour_value,
                                         double max_workers,
                                         double salary_lower_bound,
                                         double salary_upper_bound) {
                                         
  

            Rcpp::Environment stats("package:stats"); 
            Rcpp::Function optim = stats["optim"];
            
            
              Rcpp::List opt_results = optim(Rcpp::_["par"]    = Starting_Values,
                                             Rcpp::_["fn"]     = Rcpp::InternalFunction(&classical_optimise_wage_employees),
                                             Rcpp::_["method"] = "L-BFGS-B",
                                             Rcpp::_["labour_wage_elast"]  = labour_wage_elast,
                                             Rcpp::_["wage"]               = wage,
                                             Rcpp::_["employment"]         = employment,
                                             Rcpp::_["alpha"]              = alpha,
                                             Rcpp::_["sd"]                 = sd, 
                                             Rcpp::_["rowNum"]             = rowNum, 
                                             Rcpp::_["labour_value"]       = labour_value, 
                                             Rcpp::_["max_workers"]        = max_workers, 
                                             Rcpp::_["salary_lower_bound"] = salary_lower_bound,
                                             Rcpp::_["salary_upper_bound"] = salary_upper_bound,
                                             Rcpp::_["lower"] = 0.001,
                                             Rcpp::_["upper"] = 2);
            
            
            return opt_results[0];}')

I hope these edits help others to solve this problem. Thank you.

Zac
  • 45
  • 5
  • Could you show your attempts at converting this to Rcpp, and show any errors please. – user20650 Dec 12 '22 at 17:40
  • Thank you @user20650 i had added additional information above. I really hope this helps. the string of errors is huge. – Zac Dec 14 '22 at 04:23

0 Answers0