├── .Rbuildignore ├── .github └── workflows │ └── RcppDeepState.yaml ├── .gitignore ├── DESCRIPTION ├── NAMESPACE ├── R ├── RcppExports.R └── fastLR.R ├── README.md ├── RcppNumerical.Rproj ├── inst ├── AUTHORS ├── COPYRIGHTS ├── NEWS.Rd └── include │ ├── Func.h │ ├── RcppNumerical.h │ ├── integration │ ├── GaussKronrodNodesWeights.h │ ├── Integrator.h │ ├── cuba.h │ └── wrapper.h │ └── optimization │ ├── LBFGS.h │ ├── LBFGSB.h │ ├── LBFGSpp │ ├── BFGSMat.h │ ├── BKLDLT.h │ ├── Cauchy.h │ ├── LineSearchBacktracking.h │ ├── LineSearchBracketing.h │ ├── LineSearchMoreThuente.h │ ├── LineSearchNocedalWright.h │ ├── Param.h │ └── SubspaceMin.h │ └── wrapper.h ├── man └── fastLR.Rd ├── src ├── Cuhre.c ├── Makevars ├── RcppExports.cpp ├── cuhre │ ├── CSample.c │ ├── ChiSquare.c │ ├── Erf.c │ ├── Integrate.c │ ├── Rule.c │ ├── common.c │ ├── decl.h │ └── stddecl.h ├── fastLR.cpp └── register_routines.c └── vignettes └── introduction.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | -------------------------------------------------------------------------------- /.github/workflows/RcppDeepState.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | pull_request: 3 | branches: 4 | - '*' 5 | 6 | name: 'RcppDeepState analysis' 7 | jobs: 8 | RcppDeepState: 9 | runs-on: ubuntu-latest 10 | 11 | env: 12 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 13 | 14 | steps: 15 | - uses: actions/checkout@v2 16 | 17 | - uses: FabrizioSandri/RcppDeepState-action@main 18 | with: 19 | fail_ci_if_error: true 20 | location: / 21 | seed: -1 22 | max_seconds_per_function: 2 23 | max_inputs: 3 24 | comment: true 25 | verbose: true 26 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | src/*.o 6 | src/*.so 7 | src/*.dll 8 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: RcppNumerical 2 | Type: Package 3 | Title: 'Rcpp' Integration for Numerical Computing Libraries 4 | Version: 0.6-0 5 | Date: 2023-09-06 6 | Authors@R: c( 7 | person("Yixuan", "Qiu", email = "yixuan.qiu@cos.name", role = c("aut", "cre")), 8 | person("Ralf", "Stubner", email = "ralf.stubner@gmail.com", role = "ctb", 9 | comment = "Integration on infinite intervals"), 10 | person("Sreekumar", "Balan", role = "aut", 11 | comment = "Numerical integration library"), 12 | person("Matt", "Beall", role = "aut", 13 | comment = "Numerical integration library"), 14 | person("Mark", "Sauder", role = "aut", 15 | comment = "Numerical integration library"), 16 | person("Naoaki", "Okazaki", role = "aut", 17 | comment = "The libLBFGS library"), 18 | person("Thomas", "Hahn", role = "aut", 19 | comment = "The Cuba library") 20 | ) 21 | Maintainer: Yixuan Qiu 22 | Description: A collection of open source libraries for numerical computing 23 | (numerical integration, optimization, etc.) and their integration with 24 | 'Rcpp'. 25 | License: GPL (>= 2) 26 | Copyright: See file COPYRIGHTS 27 | URL: https://github.com/yixuan/RcppNumerical 28 | BugReports: https://github.com/yixuan/RcppNumerical/issues 29 | LazyData: TRUE 30 | Imports: Rcpp 31 | LinkingTo: Rcpp, RcppEigen 32 | Suggests: knitr, rmarkdown, prettydoc, mvtnorm, RcppEigen 33 | VignetteBuilder: knitr, rmarkdown 34 | RoxygenNote: 7.2.3 35 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | import(Rcpp) 2 | export(fastLR) 3 | useDynLib(RcppNumerical) 4 | -------------------------------------------------------------------------------- /R/RcppExports.R: -------------------------------------------------------------------------------- 1 | # Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | fastLR_ <- function(x, y, start, eps_f, eps_g, maxit) { 5 | .Call('_RcppNumerical_fastLR_', PACKAGE = 'RcppNumerical', x, y, start, eps_f, eps_g, maxit) 6 | } 7 | 8 | -------------------------------------------------------------------------------- /R/fastLR.R: -------------------------------------------------------------------------------- 1 | ##' Fast Logistic Regression Fitting Using L-BFGS Algorithm 2 | ##' 3 | ##' \code{fastLR()} uses the L-BFGS algorithm to efficiently fit logistic 4 | ##' regression. It is in fact an application of the C++ function 5 | ##' \code{optim_lbfgs()} provided by \pkg{RcppNumerical} to perform L-BFGS 6 | ##' optimization. 7 | ##' 8 | ##' @param x The model matrix. 9 | ##' @param y The response vector. 10 | ##' @param start The initial guess of the coefficient vector. 11 | ##' @param eps_f Iteration stops if \eqn{|f-f'|/|f|<\epsilon_f}{|f-f'|/|f| 2 | 3 | - [Introduction](#introduction) 4 | - [Numerical Integration](#numerical-integration) 5 | - [One-dimensional](#one-dimensional) 6 | - [Multi-dimensional](#multi-dimensional) 7 | - [Numerical Optimization](#numerical-optimization) 8 | - [A More Interesting Example](#a-more-interesting-example) 9 | 10 | ### Introduction 11 | 12 | [Rcpp](https://CRAN.R-project.org/package=Rcpp) is a 13 | powerful tool to write fast C++ code to speed up R programs. However, 14 | it is not easy, or at least not straightforward, to compute numerical 15 | integration or do optimization using pure C++ code inside Rcpp. 16 | 17 | **RcppNumerical** integrates a number of open source numerical computing 18 | libraries into Rcpp, so that users can call convenient functions to 19 | accomplish such tasks. 20 | 21 | - To use **RcppNumerical** with `Rcpp::sourceCpp()`, add 22 | ```cpp 23 | // [[Rcpp::depends(RcppEigen)]] 24 | // [[Rcpp::depends(RcppNumerical)]] 25 | ``` 26 | in the C++ source file. 27 | - To use **RcppNumerical** in your package, add `Imports: RcppNumerical` 28 | and `LinkingTo: Rcpp, RcppEigen, RcppNumerical` to the `DESCRIPTION` file, 29 | and `import(RcppNumerical)` to the `NAMESPACE` file. 30 | 31 | ### Numerical Integration 32 | 33 | #### One-dimensional 34 | 35 | The one-dimensional numerical integration code contained in **RcppNumerical** 36 | is based on the [NumericalIntegration](https://github.com/tbs1980/NumericalIntegration) 37 | library developed by [Sreekumar Thaithara Balan](https://github.com/tbs1980), 38 | [Mark Sauder](https://github.com/mcsauder), and Matt Beall. 39 | 40 | To compute integration of a function, first define a functor derived from 41 | the `Func` class (under the namespace `Numer`): 42 | 43 | ```cpp 44 | class Func 45 | { 46 | public: 47 | virtual double operator()(const double& x) const = 0; 48 | virtual void eval(double* x, const int n) const 49 | { 50 | for(int i = 0; i < n; i++) 51 | x[i] = this->operator()(x[i]); 52 | } 53 | 54 | virtual ~Func() {} 55 | }; 56 | ``` 57 | 58 | The first function evaluates one point at a time, and the second version 59 | overwrites each point in the array by the corresponding function values. 60 | Only the second function will be used by the integration code, but usually it 61 | is easier to implement the first one. 62 | 63 | **RcppNumerical** provides a wrapper function for the **NumericalIntegration** 64 | library with the following interface: 65 | 66 | ```cpp 67 | inline double integrate( 68 | const Func& f, const double& lower, const double& upper, 69 | double& err_est, int& err_code, 70 | const int subdiv = 100, const double& eps_abs = 1e-8, const double& eps_rel = 1e-6, 71 | const Integrator::QuadratureRule rule = Integrator::GaussKronrod41 72 | ) 73 | ``` 74 | 75 | - `f`: The functor of integrand. 76 | - `lower`, `upper`: Limits of integral. 77 | - `err_est`: Estimate of the error (output). 78 | - `err_code`: Error code (output). See `inst/include/integration/Integrator.h` 79 | [Line 676-704](https://github.com/yixuan/RcppNumerical/blob/master/inst/include/integration/Integrator.h#L676). 80 | - `subdiv`: Maximum number of subintervals. 81 | - `eps_abs`, `eps_rel`: Absolute and relative tolerance. 82 | - `rule`: Integration rule. Possible values are 83 | `GaussKronrod{15, 21, 31, 41, 51, 61, 71, 81, 91, 101, 121, 201}`. Rules with 84 | larger values have better accuracy, but may involve more function calls. 85 | - Return value: The final estimate of the integral. 86 | 87 | See a full example below, which can be compiled using the `Rcpp::sourceCpp` 88 | function in Rcpp. 89 | 90 | ```cpp 91 | // [[Rcpp::depends(RcppEigen)]] 92 | // [[Rcpp::depends(RcppNumerical)]] 93 | #include 94 | using namespace Numer; 95 | 96 | // P(0.3 < X < 0.8), X ~ Beta(a, b) 97 | class BetaPDF: public Func 98 | { 99 | private: 100 | double a; 101 | double b; 102 | public: 103 | BetaPDF(double a_, double b_) : a(a_), b(b_) {} 104 | 105 | double operator()(const double& x) const 106 | { 107 | return R::dbeta(x, a, b, 0); 108 | } 109 | }; 110 | 111 | // [[Rcpp::export]] 112 | Rcpp::List integrate_test() 113 | { 114 | const double a = 3, b = 10; 115 | const double lower = 0.3, upper = 0.8; 116 | const double true_val = R::pbeta(upper, a, b, 1, 0) - 117 | R::pbeta(lower, a, b, 1, 0); 118 | 119 | BetaPDF f(a, b); 120 | double err_est; 121 | int err_code; 122 | const double res = integrate(f, lower, upper, err_est, err_code); 123 | return Rcpp::List::create( 124 | Rcpp::Named("true") = true_val, 125 | Rcpp::Named("approximate") = res, 126 | Rcpp::Named("error_estimate") = err_est, 127 | Rcpp::Named("error_code") = err_code 128 | ); 129 | } 130 | ``` 131 | 132 | Runing the `integrate_test()` function in R gives 133 | 134 | ```r 135 | integrate_test() 136 | ## $true 137 | ## [1] 0.2528108 138 | ## 139 | ## $approximate 140 | ## [1] 0.2528108 141 | ## 142 | ## $error_estimate 143 | ## [1] 2.806764e-15 144 | ## 145 | ## $error_code 146 | ## [1] 0 147 | ``` 148 | 149 | #### Multi-dimensional 150 | 151 | Multi-dimensional integration in **RcppNumerical** is done by the 152 | [Cuba](https://feynarts.de/cuba/) library developed by 153 | [Thomas Hahn](https://wwwth.mpp.mpg.de/members/hahn/). 154 | 155 | To calculate the integration of a multivariate function, one needs to define 156 | a functor that inherits from the `MFunc` class: 157 | 158 | ```cpp 159 | class MFunc 160 | { 161 | public: 162 | virtual double operator()(Constvec& x) = 0; 163 | 164 | virtual ~MFunc() {} 165 | }; 166 | ``` 167 | 168 | Here `Constvec` represents a read-only vector with the definition 169 | 170 | ```cpp 171 | // Constant reference to a vector 172 | typedef const Eigen::Ref Constvec; 173 | ``` 174 | 175 | (Basically you can treat `Constvec` as a `const Eigen::VectorXd`. Using 176 | `Eigen::Ref` is mainly to avoid memory copy. See the explanation 177 | [here](https://eigen.tuxfamily.org/dox/classEigen_1_1Ref.html).) 178 | 179 | The function provided by **RcppNumerical** for multi-dimensional 180 | integration is 181 | 182 | ```cpp 183 | inline double integrate( 184 | MFunc& f, Constvec& lower, Constvec& upper, 185 | double& err_est, int& err_code, 186 | const int maxeval = 1000, 187 | const double& eps_abs = 1e-6, const double& eps_rel = 1e-6 188 | ) 189 | ``` 190 | 191 | - `f`: The functor of integrand. 192 | - `lower`, `upper`: Limits of integral. Both are vectors of the same 193 | dimension of `f`. 194 | - `err_est`: Estimate of the error (output). 195 | - `err_code`: Error code (output). Non-zero values indicate failure of 196 | convergence. 197 | - `maxeval`: Maximum number of function evaluations. 198 | - `eps_abs`, `eps_rel`: Absolute and relative tolerance. 199 | - Return value: The final estimate of the integral. 200 | 201 | See the example below: 202 | 203 | ```cpp 204 | // [[Rcpp::depends(RcppEigen)]] 205 | // [[Rcpp::depends(RcppNumerical)]] 206 | #include 207 | using namespace Numer; 208 | 209 | // P(a1 < X1 < b1, a2 < X2 < b2), (X1, X2) ~ N([0], [1 rho]) 210 | // ([0], [rho 1]) 211 | class BiNormal: public MFunc 212 | { 213 | private: 214 | const double rho; 215 | double const1; // 2 * (1 - rho^2) 216 | double const2; // 1 / (2 * PI) / sqrt(1 - rho^2) 217 | public: 218 | BiNormal(const double& rho_) : rho(rho_) 219 | { 220 | const1 = 2.0 * (1.0 - rho * rho); 221 | const2 = 1.0 / (2 * M_PI) / std::sqrt(1.0 - rho * rho); 222 | } 223 | 224 | // PDF of bivariate normal 225 | double operator()(Constvec& x) 226 | { 227 | double z = x[0] * x[0] - 2 * rho * x[0] * x[1] + x[1] * x[1]; 228 | return const2 * std::exp(-z / const1); 229 | } 230 | }; 231 | 232 | // [[Rcpp::export]] 233 | Rcpp::List integrate_test2() 234 | { 235 | BiNormal f(0.5); // rho = 0.5 236 | Eigen::VectorXd lower(2); 237 | lower << -1, -1; 238 | Eigen::VectorXd upper(2); 239 | upper << 1, 1; 240 | double err_est; 241 | int err_code; 242 | const double res = integrate(f, lower, upper, err_est, err_code); 243 | return Rcpp::List::create( 244 | Rcpp::Named("approximate") = res, 245 | Rcpp::Named("error_estimate") = err_est, 246 | Rcpp::Named("error_code") = err_code 247 | ); 248 | } 249 | ``` 250 | 251 | We can test the result in R: 252 | 253 | ```r 254 | library(mvtnorm) 255 | trueval = pmvnorm(c(-1, -1), c(1, 1), sigma = matrix(c(1, 0.5, 0.5, 1), 2)) 256 | integrate_test2() 257 | ## $approximate 258 | ## [1] 0.4979718 259 | ## 260 | ## $error_estimate 261 | ## [1] 4.612333e-09 262 | ## 263 | ## $error_code 264 | ## [1] 0 265 | trueval - integrate_test2()$approximate 266 | ## [1] 2.893336e-11 267 | ``` 268 | 269 | ### Numerical Optimization 270 | 271 | Currently **RcppNumerical** contains the L-BFGS algorithm for unconstrained 272 | minimization problems based on the 273 | [LBFGS++](https://github.com/yixuan/LBFGSpp) library. 274 | 275 | Again, one needs to first define a functor to represent the multivariate 276 | function to be minimized. 277 | 278 | ```cpp 279 | class MFuncGrad 280 | { 281 | public: 282 | virtual double f_grad(Constvec& x, Refvec grad) = 0; 283 | 284 | virtual ~MFuncGrad() {} 285 | }; 286 | ``` 287 | 288 | Same as the case in multi-dimensional integration, `Constvec` represents a 289 | read-only vector and `Refvec` a writable vector. Their definitions are 290 | 291 | ```cpp 292 | // Reference to a vector 293 | typedef Eigen::Ref Refvec; 294 | typedef const Eigen::Ref Constvec; 295 | ``` 296 | 297 | The `f_grad()` member function returns the function value on vector `x`, 298 | and overwrites `grad` by the gradient. 299 | 300 | The wrapper function for **LBFGS++** is 301 | 302 | ```cpp 303 | inline int optim_lbfgs( 304 | MFuncGrad& f, Refvec x, double& fx_opt, 305 | const int maxit = 300, const double& eps_f = 1e-6, const double& eps_g = 1e-5 306 | ) 307 | ``` 308 | 309 | - `f`: The function to be minimized. 310 | - `x`: In: the initial guess. Out: best value of variables found. 311 | - `fx_opt`: Out: Function value on the output `x`. 312 | - `maxit`: Maximum number of iterations. 313 | - `eps_f`: Algorithm stops if `|f_{k+1} - f_k| < eps_f * |f_k|`. 314 | - `eps_g`: Algorithm stops if `||g|| < eps_g * max(1, ||x||)`. 315 | - Return value: Error code. Negative values indicate errors. 316 | 317 | Below is an example that illustrates the optimization of the Rosenbrock function 318 | `f(x1, x2) = 100 * (x2 - x1^2)^2 + (1 - x1)^2`: 319 | 320 | ```cpp 321 | // [[Rcpp::depends(RcppEigen)]] 322 | // [[Rcpp::depends(RcppNumerical)]] 323 | 324 | #include 325 | 326 | using namespace Numer; 327 | 328 | // f = 100 * (x2 - x1^2)^2 + (1 - x1)^2 329 | // True minimum: x1 = x2 = 1 330 | class Rosenbrock: public MFuncGrad 331 | { 332 | public: 333 | double f_grad(Constvec& x, Refvec grad) 334 | { 335 | double t1 = x[1] - x[0] * x[0]; 336 | double t2 = 1 - x[0]; 337 | grad[0] = -400 * x[0] * t1 - 2 * t2; 338 | grad[1] = 200 * t1; 339 | return 100 * t1 * t1 + t2 * t2; 340 | } 341 | }; 342 | 343 | // [[Rcpp::export]] 344 | Rcpp::List optim_test() 345 | { 346 | Eigen::VectorXd x(2); 347 | x[0] = -1.2; 348 | x[1] = 1; 349 | double fopt; 350 | Rosenbrock f; 351 | int res = optim_lbfgs(f, x, fopt); 352 | return Rcpp::List::create( 353 | Rcpp::Named("xopt") = x, 354 | Rcpp::Named("fopt") = fopt, 355 | Rcpp::Named("status") = res 356 | ); 357 | } 358 | ``` 359 | 360 | Calling the generated R function `optim_test()` gives 361 | 362 | ```r 363 | optim_test() 364 | ## $xopt 365 | ## [1] 1 1 366 | ## 367 | ## $fopt 368 | ## [1] 3.12499e-15 369 | ## 370 | ## $status 371 | ## [1] 0 372 | ``` 373 | 374 | ### A More Practical Example 375 | 376 | It may be more meaningful to look at a real application of the **RcppNumerical** 377 | package. Below is an example to fit logistic regression using the L-BFGS 378 | algorithm. It also demonstrates the performance of the library. 379 | 380 | ```cpp 381 | // [[Rcpp::depends(RcppEigen)]] 382 | // [[Rcpp::depends(RcppNumerical)]] 383 | 384 | #include 385 | 386 | using namespace Numer; 387 | 388 | typedef Eigen::Map MapMat; 389 | typedef Eigen::Map MapVec; 390 | 391 | class LogisticReg: public MFuncGrad 392 | { 393 | private: 394 | const MapMat X; 395 | const MapVec Y; 396 | public: 397 | LogisticReg(const MapMat x_, const MapVec y_) : X(x_), Y(y_) {} 398 | 399 | double f_grad(Constvec& beta, Refvec grad) 400 | { 401 | // Negative log likelihood 402 | // sum(log(1 + exp(X * beta))) - y' * X * beta 403 | 404 | Eigen::VectorXd xbeta = X * beta; 405 | const double yxbeta = Y.dot(xbeta); 406 | // X * beta => exp(X * beta) 407 | xbeta = xbeta.array().exp(); 408 | const double f = (xbeta.array() + 1.0).log().sum() - yxbeta; 409 | 410 | // Gradient 411 | // X' * (p - y), p = exp(X * beta) / (1 + exp(X * beta)) 412 | 413 | // exp(X * beta) => p 414 | xbeta.array() /= (xbeta.array() + 1.0); 415 | grad.noalias() = X.transpose() * (xbeta - Y); 416 | 417 | return f; 418 | } 419 | }; 420 | 421 | // [[Rcpp::export]] 422 | Rcpp::NumericVector logistic_reg(Rcpp::NumericMatrix x, Rcpp::NumericVector y) 423 | { 424 | const MapMat xx = Rcpp::as(x); 425 | const MapVec yy = Rcpp::as(y); 426 | // Negative log likelihood 427 | LogisticReg nll(xx, yy); 428 | // Initial guess 429 | Eigen::VectorXd beta(xx.cols()); 430 | beta.setZero(); 431 | 432 | double fopt; 433 | int status = optim_lbfgs(nll, beta, fopt); 434 | if(status < 0) 435 | Rcpp::stop("fail to converge"); 436 | 437 | return Rcpp::wrap(beta); 438 | } 439 | ``` 440 | 441 | Here is the R code to test the function: 442 | 443 | ```r 444 | set.seed(123) 445 | n = 5000 446 | p = 100 447 | x = matrix(rnorm(n * p), n) 448 | beta = runif(p) 449 | xb = c(x %*% beta) 450 | p = exp(xb) / (1 + exp(xb)) 451 | y = rbinom(n, 1, p) 452 | 453 | system.time(res1 <- glm.fit(x, y, family = binomial())$coefficients) 454 | ## user system elapsed 455 | ## 0.229 0.006 0.234 456 | system.time(res2 <- logistic_reg(x, y)) 457 | ## user system elapsed 458 | ## 0.005 0.000 0.006 459 | max(abs(res1 - res2)) 460 | ## [1] 0.0001873564 461 | ``` 462 | 463 | It is much faster than the standard `glm.fit()` function in R! (Although 464 | `glm.fit()` calculates some other quantities besides beta.) 465 | 466 | **RcppNumerical** also provides the `fastLR()` function to run fast logistic 467 | regression, which is a modified and more stable version of the code above. 468 | 469 | ```r 470 | system.time(res3 <- fastLR(x, y)$coefficients) 471 | ## user system elapsed 472 | ## 0.007 0.001 0.008 473 | max(abs(res1 - res3)) 474 | ## [1] 7.066969e-06 475 | ``` 476 | -------------------------------------------------------------------------------- /RcppNumerical.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 4 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: XeLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd 22 | -------------------------------------------------------------------------------- /inst/AUTHORS: -------------------------------------------------------------------------------- 1 | The files 2 | inst/include/integration/GaussKronrodNodesWeights.h 3 | inst/include/integration/Integrator.h 4 | were modified from library NumericalIntegration 5 | (https://github.com/tbs1980/NumericalIntegration, MPL-2) 6 | written by Sreekumar T. Balan, Matt Beall, and Mark Sauder. 7 | 8 | The files 9 | inst/include/optimization/lbfgs.h 10 | src/arithmetic_ansi.h 11 | src/lbfgs.c 12 | contained in RcppNumerical (< 0.3-0) were copied from the libLBFGS library 13 | (https://www.chokkan.org/software/liblbfgs/, MIT) 14 | written by Naoaki Okazaki. 15 | 16 | The files 17 | inst/include/integration/cuba.h 18 | src/Cuhre.c 19 | src/cuhre/* 20 | were modified from the Cuba library 21 | (https://feynarts.de/cuba/, LGPL-3) 22 | written by Thomas Hahn. 23 | 24 | The code for numerical integration on infinite intervals was contributed by 25 | Ralf Stubner . 26 | 27 | Other part of this package was written by Yixuan Qiu. 28 | -------------------------------------------------------------------------------- /inst/COPYRIGHTS: -------------------------------------------------------------------------------- 1 | For the libLBFGS library contained in RcppNumerical (< 0.3-0) 2 | 3 | Copyright (c) 1990, Jorge Nocedal 4 | Copyright (c) 2007-2010, Naoaki Okazaki 5 | -------------------------------------------------------------------------------- /inst/NEWS.Rd: -------------------------------------------------------------------------------- 1 | \name{NEWS} 2 | \title{News for Package "RcppNumerical"} 3 | 4 | \section{Changes in RcppNumerical version 0.6-0}{ 5 | \subsection{NEW FEATURES}{ 6 | \itemize{ 7 | \item Updated LBFGS++ to v0.3.0. 8 | } 9 | } 10 | } 11 | 12 | \section{Changes in RcppNumerical version 0.5-0}{ 13 | \subsection{BUG FIXES}{ 14 | \itemize{ 15 | \item Removed the C function \code{sprintf()} calls according to CRAN's policy. 16 | } 17 | } 18 | \subsection{NEW FEATURES}{ 19 | \itemize{ 20 | \item Updated LBFGS++ to v0.2.0. 21 | } 22 | } 23 | } 24 | 25 | \section{Changes in RcppNumerical version 0.4-0}{ 26 | \subsection{NEW FEATURES}{ 27 | \itemize{ 28 | \item Added one-dimensional numerical integration on infinite intervals, 29 | contributed by \href{https://github.com/rstub}{@rstub} 30 | (\href{https://github.com/yixuan/RcppNumerical/pull/11}{#11}). 31 | } 32 | } 33 | } 34 | 35 | \section{Changes in RcppNumerical version 0.3-3}{ 36 | \subsection{BUG FIXES}{ 37 | \itemize{ 38 | \item Updated LBFGS++ to the newest version. 39 | \item Fixed the \code{VignetteBuilder} entry in the \code{DESCRIPTION} file 40 | according to CRAN's policy. 41 | } 42 | } 43 | } 44 | 45 | \section{Changes in RcppNumerical version 0.3-2}{ 46 | \subsection{BUG FIXES}{ 47 | \itemize{ 48 | \item Fixed a convergence test bug in LBFGS++. 49 | \item Registered native routines per CRAN's policy. 50 | } 51 | } 52 | } 53 | 54 | \section{Changes in RcppNumerical version 0.3-1}{ 55 | \subsection{BUG FIXES}{ 56 | \itemize{ 57 | \item Fixed a bug of name hiding in C++. 58 | } 59 | } 60 | } 61 | 62 | \section{Changes in RcppNumerical version 0.3-0}{ 63 | \subsection{NEW FEATURES}{ 64 | \itemize{ 65 | \item Now using the LBFGS++ library for L-BFGS optimization. 66 | \item Added a vignette. 67 | } 68 | } 69 | \subsection{BUG FIXES}{ 70 | \itemize{ 71 | \item Fixed an index-out-of-bound bug in one dimensional integration (#1), 72 | thanks to Greg Finak. 73 | \item Added virtual destructors for classes \code{Func}, \code{MFunc}, and 74 | \code{MFuncGrad}. 75 | } 76 | } 77 | } 78 | 79 | \section{Changes in RcppNumerical version 0.2-0}{ 80 | \subsection{NEW FEATURES}{ 81 | \itemize{ 82 | \item Added the Cuba library for multi-dimensional integration. 83 | } 84 | } 85 | } 86 | 87 | \section{Changes in RcppNumerical version 0.1-0}{ 88 | \subsection{NEW FEATURES}{ 89 | \itemize{ 90 | \item Initial release. 91 | \item Provides C++ interface for one-dimensional numerical integration 92 | and L-BFGS optimization. 93 | \item R function \code{fastLR()} for fast logistic regression using 94 | L-BFGS. 95 | } 96 | } 97 | } 98 | -------------------------------------------------------------------------------- /inst/include/Func.h: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2016 Yixuan Qiu 2 | // 3 | // This Source Code Form is subject to the terms of the Mozilla 4 | // Public License v. 2.0. If a copy of the MPL was not distributed 5 | // with this file, You can obtain one at http://mozilla.org/MPL/2.0/. 6 | 7 | #ifndef FUNC_H 8 | #define FUNC_H 9 | 10 | #include 11 | 12 | 13 | namespace Numer 14 | { 15 | 16 | 17 | // Reference to a vector 18 | typedef Eigen::Ref Refvec; 19 | typedef const Eigen::Ref Constvec; 20 | 21 | 22 | // For 1-D numerical integration 23 | class Func 24 | { 25 | public: 26 | virtual double operator()(const double& x) const = 0; 27 | virtual void eval(double* x, const int n) const 28 | { 29 | for(int i = 0; i < n; i++) 30 | x[i] = this->operator()(x[i]); 31 | } 32 | 33 | virtual ~Func() {} 34 | }; 35 | 36 | 37 | // For multi-dimensional numerical integration and 38 | // optimization that does not require gradient 39 | class MFunc 40 | { 41 | public: 42 | virtual double operator()(Constvec& x) = 0; 43 | 44 | virtual ~MFunc() {} 45 | }; 46 | 47 | 48 | // For optimization that requires gradient 49 | class MFuncGrad 50 | { 51 | public: 52 | virtual double f_grad(Constvec& x, Refvec grad) = 0; 53 | 54 | virtual ~MFuncGrad() {} 55 | }; 56 | 57 | 58 | } // namespace Numer 59 | 60 | #endif // FUNC_H 61 | -------------------------------------------------------------------------------- /inst/include/RcppNumerical.h: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2016 Yixuan Qiu 2 | // 3 | // This Source Code Form is subject to the terms of the Mozilla 4 | // Public License v. 2.0. If a copy of the MPL was not distributed 5 | // with this file, You can obtain one at http://mozilla.org/MPL/2.0/. 6 | 7 | #ifndef RCPPNUMERICAL_H 8 | #define RCPPNUMERICAL_H 9 | 10 | #include 11 | 12 | // Integration 13 | #include "integration/GaussKronrodNodesWeights.h" 14 | #include "integration/Integrator.h" 15 | #include "integration/cuba.h" 16 | #include "integration/wrapper.h" 17 | 18 | // Optimization 19 | #include "optimization/LBFGS.h" 20 | #include "optimization/wrapper.h" 21 | 22 | 23 | #endif // RCPPNUMERICAL_H 24 | -------------------------------------------------------------------------------- /inst/include/integration/cuba.h: -------------------------------------------------------------------------------- 1 | /* 2 | cuba.h 3 | Prototypes for the Cuba library 4 | this file is part of Cuba 5 | last modified 13 Mar 15 th 6 | */ 7 | 8 | #ifndef CUBA_H 9 | #define CUBA_H 10 | 11 | 12 | typedef double cubareal; 13 | 14 | /* integrand_t is intentionally a minimalistic integrand type. 15 | It includes neither the nvec and core arguments nor the 16 | extra arguments passed by Vegas/Suave (weight, iter) and 17 | Divonne (phase). 18 | In most cases, integrand_t is just what you want, otherwise 19 | simply use an explicit typecast to integrand_t in the Cuba 20 | invocation. */ 21 | typedef int (*integrand_t)(const int *ndim, const cubareal x[], 22 | const int *ncomp, cubareal f[], void *userdata); 23 | 24 | typedef void (*peakfinder_t)(const int *ndim, const cubareal b[], 25 | int *n, cubareal x[], void *userdata); 26 | 27 | #ifdef __cplusplus 28 | extern "C" { 29 | #endif 30 | 31 | 32 | void Cuhre(const int ndim, const int ncomp, 33 | integrand_t integrand, void *userdata, const int nvec, 34 | const cubareal epsrel, const cubareal epsabs, 35 | const int flags, const int mineval, const int maxeval, 36 | const int key, 37 | const char *statefile, void *spin, 38 | int *nregions, int *neval, int *fail, 39 | cubareal integral[], cubareal err[], cubareal prob[]); 40 | 41 | 42 | #ifdef __cplusplus 43 | } 44 | #endif 45 | 46 | 47 | #endif // CUBA_H 48 | -------------------------------------------------------------------------------- /inst/include/integration/wrapper.h: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2016-2019 Yixuan Qiu 2 | // Copyright (C) 2019 Ralf Stubner 3 | // 4 | // This Source Code Form is subject to the terms of the Mozilla 5 | // Public License v. 2.0. If a copy of the MPL was not distributed 6 | // with this file, You can obtain one at http://mozilla.org/MPL/2.0/. 7 | 8 | #ifndef INTEGRATION_WRAPPER_H 9 | #define INTEGRATION_WRAPPER_H 10 | 11 | #include "GaussKronrodNodesWeights.h" 12 | #include "Integrator.h" 13 | #include "cuba.h" 14 | #include "../Func.h" 15 | 16 | namespace Numer 17 | { 18 | 19 | 20 | 21 | // Internal implementation 22 | namespace detail 23 | { 24 | 25 | class transform_infinite: public Func 26 | { 27 | private: 28 | const Func& func; 29 | const double lower; 30 | const double upper; 31 | const bool lower_finite; 32 | const bool upper_finite; 33 | 34 | public: 35 | transform_infinite(const Func& _func, double _lower, double _upper) : 36 | func(_func), lower(_lower), upper(_upper), 37 | lower_finite(lower > -std::numeric_limits::infinity()), 38 | upper_finite(upper < std::numeric_limits::infinity()) 39 | {} 40 | 41 | // Map infinite interval to (0, 1) 42 | double operator() (const double& t) const 43 | { 44 | const double x = (1 - t) / t; 45 | if (upper_finite && lower_finite) 46 | Rcpp::stop("At least one limit must be infinite."); 47 | else if (lower_finite) 48 | return func(lower + x) / (t * t); 49 | else if (upper_finite) 50 | return func(upper - x) / (t * t); 51 | else 52 | return (func(x) + func(-x)) / (t * t); 53 | } 54 | }; 55 | 56 | } // namespace detail 57 | 58 | 59 | 60 | // 61 | // [RcppNumerical API] 1-D numerical integration 62 | // 63 | inline double integrate( 64 | const Func& f, const double& lower, const double& upper, 65 | double& err_est, int& err_code, 66 | const int subdiv = 100, const double& eps_abs = 1e-8, const double& eps_rel = 1e-6, 67 | const Integrator::QuadratureRule rule = Integrator::GaussKronrod41 68 | ) 69 | { 70 | // Early exit if lower and upper limits are identical 71 | if (upper == lower) 72 | { 73 | err_est = 0.0; 74 | err_code = 0; 75 | return 0.0; 76 | } 77 | 78 | // Finite interval 79 | if (std::abs(upper) < std::numeric_limits::infinity() && 80 | std::abs(lower) < std::numeric_limits::infinity()) 81 | { 82 | Integrator intgr(subdiv); 83 | double res = intgr.quadratureAdaptive(f, lower, upper, eps_abs, eps_rel, rule); 84 | err_est = intgr.estimatedError(); 85 | err_code = intgr.errorCode(); 86 | return res; 87 | } 88 | 89 | // Infinite interval 90 | double sign = 1.0, lb = lower, ub = upper; 91 | if (ub < lb) 92 | { 93 | std::swap(ub, lb); 94 | sign = -1.0; 95 | } 96 | detail::transform_infinite g(f, lb, ub); 97 | 98 | Integrator intgr(subdiv); 99 | double res = intgr.quadratureAdaptive(g, 0.0, 1.0, eps_abs, eps_rel, rule); 100 | err_est = intgr.estimatedError(); 101 | err_code = intgr.errorCode(); 102 | return sign * res; 103 | } 104 | 105 | /****************************************************************************/ 106 | 107 | // Internal implementation 108 | namespace detail 109 | { 110 | 111 | // Integrate R function 112 | class RFunc: public Func 113 | { 114 | private: 115 | Rcpp::Function fun; 116 | Rcpp::RObject args; 117 | public: 118 | RFunc(Rcpp::Function fun_, Rcpp::RObject args_) : 119 | fun(fun_), 120 | args(args_) 121 | {} 122 | 123 | double operator()(const double& x) const 124 | { 125 | Rcpp::NumericVector xv = Rcpp::NumericVector::create(x); 126 | Rcpp::NumericVector res = fun(xv, args); 127 | if(res.length() != 1) 128 | Rcpp::stop("integrand must return a vector of the same length of x"); 129 | 130 | return Rcpp::as(res); 131 | } 132 | 133 | void operator()(double* x, const int n) const 134 | { 135 | Rcpp::NumericVector xv(n); 136 | std::copy(x, x + n, xv.begin()); 137 | Rcpp::NumericVector res = fun(xv, args); 138 | if(res.length() != n) 139 | Rcpp::stop("integrand must return a vector of the same length of x"); 140 | 141 | std::copy(res.begin(), res.end(), x); 142 | } 143 | }; 144 | 145 | } // namespace detail 146 | 147 | 148 | 149 | // 150 | // [RcppNumerical API] 1-D numerical integration for R function 151 | // 152 | inline double integrate( 153 | Rcpp::Function f, Rcpp::RObject args, const double& lower, const double& upper, 154 | double& err_est, int& err_code, 155 | const int subdiv = 100, const double& eps_abs = 1e-8, const double& eps_rel = 1e-6, 156 | const Integrator::QuadratureRule rule = Integrator::GaussKronrod41 157 | ) 158 | { 159 | Integrator intgr(subdiv); 160 | detail::RFunc rfun(f, args); 161 | double res = intgr.quadratureAdaptive(rfun, lower, upper, eps_abs, eps_rel, rule); 162 | err_est = intgr.estimatedError(); 163 | err_code = intgr.errorCode(); 164 | return res; 165 | } 166 | 167 | /****************************************************************************/ 168 | 169 | // Internal implementation 170 | namespace detail 171 | { 172 | 173 | // Function type for Cuhre() 174 | typedef void (*CFUN_Cuhre_TYPE)(const int ndim, const int ncomp, 175 | integrand_t integrand, void *userdata, const int nvec, 176 | const cubareal epsrel, const cubareal epsabs, 177 | const int flags, const int mineval, const int maxeval, 178 | const int key, 179 | const char *statefile, void *spin, 180 | int *nregions, int *neval, int *fail, 181 | cubareal integral[], cubareal err[], cubareal prob[]); 182 | 183 | // Evaluation function for Cuhre() 184 | inline int cuhre_integrand(const int *ndim, const cubareal x[], 185 | const int *ncomp, cubareal f[], void *userdata) 186 | { 187 | MFunc* func = (MFunc*) userdata; 188 | const Eigen::Map xval(x, *ndim); 189 | *f = func->operator()(xval); 190 | 191 | return 0; 192 | } 193 | 194 | // Transform function according to integral limits 195 | class MFuncWithBound: public MFunc 196 | { 197 | private: 198 | const double scalefac; 199 | MFunc& fun; 200 | Constvec& lb; 201 | Eigen::VectorXd range; 202 | Eigen::VectorXd scalex; 203 | public: 204 | MFuncWithBound(MFunc& f, Constvec& lower, Constvec& upper) : 205 | scalefac((upper - lower).prod()), 206 | fun(f), lb(lower), 207 | range(upper - lower), scalex(lower.size()) 208 | {} 209 | 210 | inline double operator()(Constvec& x) 211 | { 212 | scalex.noalias() = lb + range.cwiseProduct(x); 213 | return fun(scalex); 214 | } 215 | 216 | inline double scale_factor() const { return scalefac; } 217 | 218 | }; 219 | 220 | } // namespace detail 221 | 222 | 223 | 224 | // 225 | // [RcppNumerical API] Multi-dimensional integration 226 | // 227 | inline double integrate( 228 | MFunc& f, Constvec& lower, Constvec& upper, 229 | double& err_est, int& err_code, 230 | const int maxeval = 1000, const double& eps_abs = 1e-6, const double& eps_rel = 1e-6 231 | ) 232 | { 233 | // Find the Cuhre() function 234 | detail::CFUN_Cuhre_TYPE cfun_Cuhre = (detail::CFUN_Cuhre_TYPE) R_GetCCallable("RcppNumerical", "Cuhre"); 235 | 236 | detail::MFuncWithBound fb(f, lower, upper); 237 | int nregions; 238 | int neval; 239 | double integral; 240 | double prob; 241 | 242 | cfun_Cuhre(lower.size(), 1, detail::cuhre_integrand, &fb, 1, 243 | eps_rel, eps_abs, 244 | 4, 1, maxeval, 245 | 0, 246 | NULL, NULL, 247 | &nregions, &neval, &err_code, &integral, &err_est, &prob); 248 | 249 | integral *= fb.scale_factor(); 250 | err_est *= std::abs(fb.scale_factor()); 251 | 252 | return integral; 253 | } 254 | 255 | 256 | 257 | } // namespace Numer 258 | 259 | 260 | #endif // INTEGRATION_WRAPPER_H 261 | -------------------------------------------------------------------------------- /inst/include/optimization/LBFGS.h: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2016-2023 Yixuan Qiu 2 | // Under MIT license 3 | 4 | #ifndef LBFGSPP_LBFGS_H 5 | #define LBFGSPP_LBFGS_H 6 | 7 | #include 8 | #include "LBFGSpp/Param.h" 9 | #include "LBFGSpp/BFGSMat.h" 10 | #include "LBFGSpp/LineSearchBacktracking.h" 11 | #include "LBFGSpp/LineSearchBracketing.h" 12 | #include "LBFGSpp/LineSearchNocedalWright.h" 13 | #include "LBFGSpp/LineSearchMoreThuente.h" 14 | 15 | namespace LBFGSpp { 16 | 17 | /// 18 | /// L-BFGS solver for unconstrained numerical optimization 19 | /// 20 | template class LineSearch = LineSearchNocedalWright> 22 | class LBFGSSolver 23 | { 24 | private: 25 | using Vector = Eigen::Matrix; 26 | using Matrix = Eigen::Matrix; 27 | using MapVec = Eigen::Map; 28 | 29 | const LBFGSParam& m_param; // Parameters to control the LBFGS algorithm 30 | BFGSMat m_bfgs; // Approximation to the Hessian matrix 31 | Vector m_fx; // History of the objective function values 32 | Vector m_xp; // Old x 33 | Vector m_grad; // New gradient 34 | Scalar m_gnorm; // Norm of the gradient 35 | Vector m_gradp; // Old gradient 36 | Vector m_drt; // Moving direction 37 | 38 | // Reset internal variables 39 | // n: dimension of the vector to be optimized 40 | inline void reset(int n) 41 | { 42 | const int m = m_param.m; 43 | m_bfgs.reset(n, m); 44 | m_xp.resize(n); 45 | m_grad.resize(n); 46 | m_gradp.resize(n); 47 | m_drt.resize(n); 48 | if (m_param.past > 0) 49 | m_fx.resize(m_param.past); 50 | } 51 | 52 | public: 53 | /// 54 | /// Constructor for the L-BFGS solver. 55 | /// 56 | /// \param param An object of \ref LBFGSParam to store parameters for the 57 | /// algorithm 58 | /// 59 | LBFGSSolver(const LBFGSParam& param) : 60 | m_param(param) 61 | { 62 | m_param.check_param(); 63 | } 64 | 65 | /// 66 | /// Minimizing a multivariate function using the L-BFGS algorithm. 67 | /// Exceptions will be thrown if error occurs. 68 | /// 69 | /// \param f A function object such that `f(x, grad)` returns the 70 | /// objective function value at `x`, and overwrites `grad` with 71 | /// the gradient. 72 | /// \param x In: An initial guess of the optimal point. Out: The best point 73 | /// found. 74 | /// \param fx Out: The objective function value at `x`. 75 | /// 76 | /// \return Number of iterations used. 77 | /// 78 | template 79 | inline int minimize(Foo& f, Vector& x, Scalar& fx) 80 | { 81 | using std::abs; 82 | 83 | // Dimension of the vector 84 | const int n = x.size(); 85 | reset(n); 86 | 87 | // The length of lag for objective function value to test convergence 88 | const int fpast = m_param.past; 89 | 90 | // Evaluate function and compute gradient 91 | fx = f(x, m_grad); 92 | m_gnorm = m_grad.norm(); 93 | if (fpast > 0) 94 | m_fx[0] = fx; 95 | 96 | // std::cout << "x0 = " << x.transpose() << std::endl; 97 | // std::cout << "f(x0) = " << fx << ", ||grad|| = " << m_gnorm << std::endl << std::endl; 98 | 99 | // Early exit if the initial x is already a minimizer 100 | if (m_gnorm <= m_param.epsilon || m_gnorm <= m_param.epsilon_rel * x.norm()) 101 | { 102 | return 1; 103 | } 104 | 105 | // Initial direction 106 | m_drt.noalias() = -m_grad; 107 | // Initial step size 108 | Scalar step = Scalar(1) / m_drt.norm(); 109 | // Tolerance for s'y >= eps * (y'y) 110 | constexpr Scalar eps = std::numeric_limits::epsilon(); 111 | // s and y vectors 112 | Vector vecs(n), vecy(n); 113 | 114 | // Number of iterations used 115 | int k = 1; 116 | for (;;) 117 | { 118 | // std::cout << "Iter " << k << " begins" << std::endl << std::endl; 119 | 120 | // Save the curent x and gradient 121 | m_xp.noalias() = x; 122 | m_gradp.noalias() = m_grad; 123 | Scalar dg = m_grad.dot(m_drt); 124 | const Scalar step_max = m_param.max_step; 125 | 126 | // Line search to update x, fx and gradient 127 | LineSearch::LineSearch(f, m_param, m_xp, m_drt, step_max, step, fx, m_grad, dg, x); 128 | 129 | // New gradient norm 130 | m_gnorm = m_grad.norm(); 131 | 132 | // std::cout << "Iter " << k << " finished line search" << std::endl; 133 | // std::cout << " x = " << x.transpose() << std::endl; 134 | // std::cout << " f(x) = " << fx << ", ||grad|| = " << m_gnorm << std::endl << std::endl; 135 | 136 | // Convergence test -- gradient 137 | if (m_gnorm <= m_param.epsilon || m_gnorm <= m_param.epsilon_rel * x.norm()) 138 | { 139 | return k; 140 | } 141 | // Convergence test -- objective function value 142 | if (fpast > 0) 143 | { 144 | const Scalar fxd = m_fx[k % fpast]; 145 | if (k >= fpast && abs(fxd - fx) <= m_param.delta * std::max(std::max(abs(fx), abs(fxd)), Scalar(1))) 146 | return k; 147 | 148 | m_fx[k % fpast] = fx; 149 | } 150 | // Maximum number of iterations 151 | if (m_param.max_iterations != 0 && k >= m_param.max_iterations) 152 | { 153 | return k; 154 | } 155 | 156 | // Update s and y 157 | // s_{k+1} = x_{k+1} - x_k 158 | // y_{k+1} = g_{k+1} - g_k 159 | vecs.noalias() = x - m_xp; 160 | vecy.noalias() = m_grad - m_gradp; 161 | if (vecs.dot(vecy) > eps * vecy.squaredNorm()) 162 | m_bfgs.add_correction(vecs, vecy); 163 | 164 | // Recursive formula to compute d = -H * g 165 | m_bfgs.apply_Hv(m_grad, -Scalar(1), m_drt); 166 | 167 | // Reset step = 1.0 as initial guess for the next line search 168 | step = Scalar(1); 169 | k++; 170 | } 171 | 172 | return k; 173 | } 174 | 175 | /// 176 | /// Returning the gradient vector on the last iterate. 177 | /// Typically used to debug and test convergence. 178 | /// Should only be called after the `minimize()` function. 179 | /// 180 | /// \return A const reference to the gradient vector. 181 | /// 182 | const Vector& final_grad() const { return m_grad; } 183 | 184 | /// 185 | /// Returning the Euclidean norm of the final gradient. 186 | /// 187 | Scalar final_grad_norm() const { return m_gnorm; } 188 | }; 189 | 190 | } // namespace LBFGSpp 191 | 192 | #endif // LBFGSPP_LBFGS_H 193 | -------------------------------------------------------------------------------- /inst/include/optimization/LBFGSB.h: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2020-2023 Yixuan Qiu 2 | // Under MIT license 3 | 4 | #ifndef LBFGSPP_LBFGSB_H 5 | #define LBFGSPP_LBFGSB_H 6 | 7 | #include // std::invalid_argument 8 | #include 9 | #include 10 | #include "LBFGSpp/Param.h" 11 | #include "LBFGSpp/BFGSMat.h" 12 | #include "LBFGSpp/Cauchy.h" 13 | #include "LBFGSpp/SubspaceMin.h" 14 | #include "LBFGSpp/LineSearchMoreThuente.h" 15 | 16 | namespace LBFGSpp { 17 | 18 | /// 19 | /// L-BFGS-B solver for box-constrained numerical optimization 20 | /// 21 | template class LineSearch = LineSearchMoreThuente> 23 | class LBFGSBSolver 24 | { 25 | private: 26 | using Vector = Eigen::Matrix; 27 | using Matrix = Eigen::Matrix; 28 | using MapVec = Eigen::Map; 29 | using IndexSet = std::vector; 30 | 31 | const LBFGSBParam& m_param; // Parameters to control the LBFGS algorithm 32 | BFGSMat m_bfgs; // Approximation to the Hessian matrix 33 | Vector m_fx; // History of the objective function values 34 | Vector m_xp; // Old x 35 | Vector m_grad; // New gradient 36 | Scalar m_projgnorm; // Projected gradient norm 37 | Vector m_gradp; // Old gradient 38 | Vector m_drt; // Moving direction 39 | 40 | // Reset internal variables 41 | // n: dimension of the vector to be optimized 42 | inline void reset(int n) 43 | { 44 | const int m = m_param.m; 45 | m_bfgs.reset(n, m); 46 | m_xp.resize(n); 47 | m_grad.resize(n); 48 | m_gradp.resize(n); 49 | m_drt.resize(n); 50 | if (m_param.past > 0) 51 | m_fx.resize(m_param.past); 52 | } 53 | 54 | // Project the vector x to the bound constraint set 55 | static void force_bounds(Vector& x, const Vector& lb, const Vector& ub) 56 | { 57 | x.noalias() = x.cwiseMax(lb).cwiseMin(ub); 58 | } 59 | 60 | // Norm of the projected gradient 61 | // ||P(x-g, l, u) - x||_inf 62 | static Scalar proj_grad_norm(const Vector& x, const Vector& g, const Vector& lb, const Vector& ub) 63 | { 64 | return ((x - g).cwiseMax(lb).cwiseMin(ub) - x).cwiseAbs().maxCoeff(); 65 | } 66 | 67 | // The maximum step size alpha such that x0 + alpha * d stays within the bounds 68 | static Scalar max_step_size(const Vector& x0, const Vector& drt, const Vector& lb, const Vector& ub) 69 | { 70 | const int n = x0.size(); 71 | Scalar step = std::numeric_limits::infinity(); 72 | 73 | for (int i = 0; i < n; i++) 74 | { 75 | if (drt[i] > Scalar(0)) 76 | { 77 | step = std::min(step, (ub[i] - x0[i]) / drt[i]); 78 | } 79 | else if (drt[i] < Scalar(0)) 80 | { 81 | step = std::min(step, (lb[i] - x0[i]) / drt[i]); 82 | } 83 | } 84 | 85 | return step; 86 | } 87 | 88 | public: 89 | /// 90 | /// Constructor for the L-BFGS-B solver. 91 | /// 92 | /// \param param An object of \ref LBFGSParam to store parameters for the 93 | /// algorithm 94 | /// 95 | LBFGSBSolver(const LBFGSBParam& param) : 96 | m_param(param) 97 | { 98 | m_param.check_param(); 99 | } 100 | 101 | /// 102 | /// Minimizing a multivariate function subject to box constraints, using the L-BFGS-B algorithm. 103 | /// Exceptions will be thrown if error occurs. 104 | /// 105 | /// \param f A function object such that `f(x, grad)` returns the 106 | /// objective function value at `x`, and overwrites `grad` with 107 | /// the gradient. 108 | /// \param x In: An initial guess of the optimal point. Out: The best point 109 | /// found. 110 | /// \param fx Out: The objective function value at `x`. 111 | /// \param lb Lower bounds for `x`. 112 | /// \param ub Upper bounds for `x`. 113 | /// 114 | /// \return Number of iterations used. 115 | /// 116 | template 117 | inline int minimize(Foo& f, Vector& x, Scalar& fx, const Vector& lb, const Vector& ub) 118 | { 119 | using std::abs; 120 | 121 | // Dimension of the vector 122 | const int n = x.size(); 123 | if (lb.size() != n || ub.size() != n) 124 | throw std::invalid_argument("'lb' and 'ub' must have the same size as 'x'"); 125 | 126 | // Check whether the initial vector is within the bounds 127 | // If not, project to the feasible set 128 | force_bounds(x, lb, ub); 129 | 130 | // Initialization 131 | reset(n); 132 | 133 | // The length of lag for objective function value to test convergence 134 | const int fpast = m_param.past; 135 | 136 | // Evaluate function and compute gradient 137 | fx = f(x, m_grad); 138 | m_projgnorm = proj_grad_norm(x, m_grad, lb, ub); 139 | if (fpast > 0) 140 | m_fx[0] = fx; 141 | 142 | // std::cout << "x0 = " << x.transpose() << std::endl; 143 | // std::cout << "f(x0) = " << fx << ", ||proj_grad|| = " << m_projgnorm << std::endl << std::endl; 144 | 145 | // Early exit if the initial x is already a minimizer 146 | if (m_projgnorm <= m_param.epsilon || m_projgnorm <= m_param.epsilon_rel * x.norm()) 147 | { 148 | return 1; 149 | } 150 | 151 | // Compute generalized Cauchy point 152 | Vector xcp(n), vecc; 153 | IndexSet newact_set, fv_set; 154 | Cauchy::get_cauchy_point(m_bfgs, x, m_grad, lb, ub, xcp, vecc, newact_set, fv_set); 155 | 156 | /* Vector gcp(n); 157 | Scalar fcp = f(xcp, gcp); 158 | Scalar projgcpnorm = proj_grad_norm(xcp, gcp, lb, ub); 159 | std::cout << "xcp = " << xcp.transpose() << std::endl; 160 | std::cout << "f(xcp) = " << fcp << ", ||proj_grad|| = " << projgcpnorm << std::endl << std::endl; */ 161 | 162 | // Initial direction 163 | m_drt.noalias() = xcp - x; 164 | m_drt.normalize(); 165 | // Tolerance for s'y >= eps * (y'y) 166 | constexpr Scalar eps = std::numeric_limits::epsilon(); 167 | // s and y vectors 168 | Vector vecs(n), vecy(n); 169 | // Number of iterations used 170 | int k = 1; 171 | for (;;) 172 | { 173 | // Save the curent x and gradient 174 | m_xp.noalias() = x; 175 | m_gradp.noalias() = m_grad; 176 | Scalar dg = m_grad.dot(m_drt); 177 | 178 | // Maximum step size to make x feasible 179 | Scalar step_max = max_step_size(x, m_drt, lb, ub); 180 | 181 | // In some cases, the direction returned by the subspace minimization procedure 182 | // in the previous iteration is pathological, leading to issues such as 183 | // step_max~=0 and dg>=0. If this happens, we use xcp-x as the search direction, 184 | // and reset the BFGS matrix. This is because xsm (the subspace minimizer) 185 | // heavily depends on the BFGS matrix. If xsm is corrupted, then we may suspect 186 | // there is something wrong in the BFGS matrix, and it is safer to reset the matrix. 187 | // In contrast, xcp is obtained from a line search, which tends to be more robust 188 | if (dg >= Scalar(0) || step_max <= m_param.min_step) 189 | { 190 | // Reset search direction 191 | m_drt.noalias() = xcp - x; 192 | // Reset BFGS matrix 193 | m_bfgs.reset(n, m_param.m); 194 | // Recompute dg and step_max 195 | dg = m_grad.dot(m_drt); 196 | step_max = max_step_size(x, m_drt, lb, ub); 197 | } 198 | 199 | // Line search to update x, fx and gradient 200 | step_max = std::min(m_param.max_step, step_max); 201 | Scalar step = Scalar(1); 202 | step = std::min(step, step_max); 203 | LineSearch::LineSearch(f, m_param, m_xp, m_drt, step_max, step, fx, m_grad, dg, x); 204 | 205 | // New projected gradient norm 206 | m_projgnorm = proj_grad_norm(x, m_grad, lb, ub); 207 | 208 | /* std::cout << "** Iteration " << k << std::endl; 209 | std::cout << " x = " << x.transpose() << std::endl; 210 | std::cout << " f(x) = " << fx << ", ||proj_grad|| = " << m_projgnorm << std::endl << std::endl; */ 211 | 212 | // Convergence test -- gradient 213 | if (m_projgnorm <= m_param.epsilon || m_projgnorm <= m_param.epsilon_rel * x.norm()) 214 | { 215 | return k; 216 | } 217 | // Convergence test -- objective function value 218 | if (fpast > 0) 219 | { 220 | const Scalar fxd = m_fx[k % fpast]; 221 | if (k >= fpast && abs(fxd - fx) <= m_param.delta * std::max(std::max(abs(fx), abs(fxd)), Scalar(1))) 222 | return k; 223 | 224 | m_fx[k % fpast] = fx; 225 | } 226 | // Maximum number of iterations 227 | if (m_param.max_iterations != 0 && k >= m_param.max_iterations) 228 | { 229 | return k; 230 | } 231 | 232 | // Update s and y 233 | // s_{k+1} = x_{k+1} - x_k 234 | // y_{k+1} = g_{k+1} - g_k 235 | vecs.noalias() = x - m_xp; 236 | vecy.noalias() = m_grad - m_gradp; 237 | if (vecs.dot(vecy) > eps * vecy.squaredNorm()) 238 | m_bfgs.add_correction(vecs, vecy); 239 | 240 | force_bounds(x, lb, ub); 241 | Cauchy::get_cauchy_point(m_bfgs, x, m_grad, lb, ub, xcp, vecc, newact_set, fv_set); 242 | 243 | /*Vector gcp(n); 244 | Scalar fcp = f(xcp, gcp); 245 | Scalar projgcpnorm = proj_grad_norm(xcp, gcp, lb, ub); 246 | std::cout << "xcp = " << xcp.transpose() << std::endl; 247 | std::cout << "f(xcp) = " << fcp << ", ||proj_grad|| = " << projgcpnorm << std::endl << std::endl;*/ 248 | 249 | SubspaceMin::subspace_minimize(m_bfgs, x, xcp, m_grad, lb, ub, 250 | vecc, newact_set, fv_set, m_param.max_submin, m_drt); 251 | 252 | /*Vector gsm(n); 253 | Scalar fsm = f(x + m_drt, gsm); 254 | Scalar projgsmnorm = proj_grad_norm(x + m_drt, gsm, lb, ub); 255 | std::cout << "xsm = " << (x + m_drt).transpose() << std::endl; 256 | std::cout << "f(xsm) = " << fsm << ", ||proj_grad|| = " << projgsmnorm << std::endl << std::endl;*/ 257 | 258 | k++; 259 | } 260 | 261 | return k; 262 | } 263 | 264 | /// 265 | /// Returning the gradient vector on the last iterate. 266 | /// Typically used to debug and test convergence. 267 | /// Should only be called after the `minimize()` function. 268 | /// 269 | /// \return A const reference to the gradient vector. 270 | /// 271 | const Vector& final_grad() const { return m_grad; } 272 | 273 | /// 274 | /// Returning the infinity norm of the final projected gradient. 275 | /// The projected gradient is defined as \f$P(x-g,l,u)-x\f$, where \f$P(v,l,u)\f$ stands for 276 | /// the projection of a vector \f$v\f$ onto the box specified by the lower bound vector \f$l\f$ and 277 | /// upper bound vector \f$u\f$. 278 | /// 279 | Scalar final_grad_norm() const { return m_projgnorm; } 280 | }; 281 | 282 | } // namespace LBFGSpp 283 | 284 | #endif // LBFGSPP_LBFGSB_H 285 | -------------------------------------------------------------------------------- /inst/include/optimization/LBFGSpp/BFGSMat.h: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2020-2023 Yixuan Qiu 2 | // Under MIT license 3 | 4 | #ifndef LBFGSPP_BFGS_MAT_H 5 | #define LBFGSPP_BFGS_MAT_H 6 | 7 | #include 8 | #include 9 | #include "BKLDLT.h" 10 | 11 | /// \cond 12 | 13 | namespace LBFGSpp { 14 | 15 | // 16 | // An *implicit* representation of the BFGS approximation to the Hessian matrix B 17 | // 18 | // B = theta * I - W * M * W' 19 | // H = inv(B) 20 | // 21 | // Reference: 22 | // [1] D. C. Liu and J. Nocedal (1989). On the limited memory BFGS method for large scale optimization. 23 | // [2] R. H. Byrd, P. Lu, and J. Nocedal (1995). A limited memory algorithm for bound constrained optimization. 24 | // 25 | template 26 | class BFGSMat 27 | { 28 | private: 29 | using Vector = Eigen::Matrix; 30 | using Matrix = Eigen::Matrix; 31 | using RefConstVec = Eigen::Ref; 32 | using IndexSet = std::vector; 33 | 34 | int m_m; // Maximum number of correction vectors 35 | Scalar m_theta; // theta * I is the initial approximation to the Hessian matrix 36 | Matrix m_s; // History of the s vectors 37 | Matrix m_y; // History of the y vectors 38 | Vector m_ys; // History of the s'y values 39 | Vector m_alpha; // Temporary values used in computing H * v 40 | int m_ncorr; // Number of correction vectors in the history, m_ncorr <= m 41 | int m_ptr; // A Pointer to locate the most recent history, 1 <= m_ptr <= m 42 | // Details: s and y vectors are stored in cyclic order. 43 | // For example, if the current s-vector is stored in m_s[, m-1], 44 | // then in the next iteration m_s[, 0] will be overwritten. 45 | // m_s[, m_ptr-1] points to the most recent history, 46 | // and m_s[, m_ptr % m] points to the most distant one. 47 | 48 | //========== The following members are only used in L-BFGS-B algorithm ==========// 49 | Matrix m_permMinv; // Permutated M inverse 50 | BKLDLT m_permMsolver; // Represents the permutated M matrix 51 | 52 | public: 53 | // Constructor 54 | BFGSMat() {} 55 | 56 | // Reset internal variables 57 | // n: dimension of the vector to be optimized 58 | // m: maximum number of corrections to approximate the Hessian matrix 59 | inline void reset(int n, int m) 60 | { 61 | m_m = m; 62 | m_theta = Scalar(1); 63 | m_s.resize(n, m); 64 | m_y.resize(n, m); 65 | m_ys.resize(m); 66 | m_alpha.resize(m); 67 | m_ncorr = 0; 68 | m_ptr = m; // This makes sure that m_ptr % m == 0 in the first step 69 | 70 | if (LBFGSB) 71 | { 72 | m_permMinv.resize(2 * m, 2 * m); 73 | m_permMinv.setZero(); 74 | m_permMinv.diagonal().setOnes(); 75 | } 76 | } 77 | 78 | // Add correction vectors to the BFGS matrix 79 | inline void add_correction(const RefConstVec& s, const RefConstVec& y) 80 | { 81 | const int loc = m_ptr % m_m; 82 | 83 | m_s.col(loc).noalias() = s; 84 | m_y.col(loc).noalias() = y; 85 | 86 | // ys = y's = 1/rho 87 | const Scalar ys = m_s.col(loc).dot(m_y.col(loc)); 88 | m_ys[loc] = ys; 89 | 90 | m_theta = m_y.col(loc).squaredNorm() / ys; 91 | 92 | if (m_ncorr < m_m) 93 | m_ncorr++; 94 | 95 | m_ptr = loc + 1; 96 | 97 | if (LBFGSB) 98 | { 99 | // Minv = [-D L'] 100 | // [ L theta*S'S] 101 | 102 | // Copy -D 103 | // Let S=[s[0], ..., s[m-1]], Y=[y[0], ..., y[m-1]] 104 | // D = [s[0]'y[0], ..., s[m-1]'y[m-1]] 105 | m_permMinv(loc, loc) = -ys; 106 | 107 | // Update S'S 108 | // We only store S'S in Minv, and multiply theta when LU decomposition is performed 109 | Vector Ss = m_s.leftCols(m_ncorr).transpose() * m_s.col(loc); 110 | m_permMinv.block(m_m + loc, m_m, 1, m_ncorr).noalias() = Ss.transpose(); 111 | m_permMinv.block(m_m, m_m + loc, m_ncorr, 1).noalias() = Ss; 112 | 113 | // Compute L 114 | // L = [ 0 ] 115 | // [ s[1]'y[0] 0 ] 116 | // [ s[2]'y[0] s[2]'y[1] ] 117 | // ... 118 | // [s[m-1]'y[0] ... ... ... ... ... s[m-1]'y[m-2] 0] 119 | // 120 | // L_next = [ 0 ] 121 | // [s[2]'y[1] 0 ] 122 | // [s[3]'y[1] s[3]'y[2] ] 123 | // ... 124 | // [s[m]'y[1] ... ... ... ... ... s[m]'y[m-1] 0] 125 | const int len = m_ncorr - 1; 126 | // First zero out the column of oldest y 127 | if (m_ncorr >= m_m) 128 | m_permMinv.block(m_m, loc, m_m, 1).setZero(); 129 | // Compute the row associated with new s 130 | // The current row is loc 131 | // End with column (loc + m - 1) % m 132 | // Length is len 133 | int yloc = (loc + m_m - 1) % m_m; 134 | for (int i = 0; i < len; i++) 135 | { 136 | m_permMinv(m_m + loc, yloc) = m_s.col(loc).dot(m_y.col(yloc)); 137 | yloc = (yloc + m_m - 1) % m_m; 138 | } 139 | 140 | // Matrix LDLT factorization 141 | m_permMinv.block(m_m, m_m, m_m, m_m) *= m_theta; 142 | m_permMsolver.compute(m_permMinv); 143 | m_permMinv.block(m_m, m_m, m_m, m_m) /= m_theta; 144 | } 145 | } 146 | 147 | // Recursive formula to compute a * H * v, where a is a scalar, and v is [n x 1] 148 | // H0 = (1/theta) * I is the initial approximation to H 149 | // Algorithm 7.4 of Nocedal, J., & Wright, S. (2006). Numerical optimization. 150 | inline void apply_Hv(const Vector& v, const Scalar& a, Vector& res) 151 | { 152 | res.resize(v.size()); 153 | 154 | // L-BFGS two-loop recursion 155 | 156 | // Loop 1 157 | res.noalias() = a * v; 158 | int j = m_ptr % m_m; 159 | for (int i = 0; i < m_ncorr; i++) 160 | { 161 | j = (j + m_m - 1) % m_m; 162 | m_alpha[j] = m_s.col(j).dot(res) / m_ys[j]; 163 | res.noalias() -= m_alpha[j] * m_y.col(j); 164 | } 165 | 166 | // Apply initial H0 167 | res /= m_theta; 168 | 169 | // Loop 2 170 | for (int i = 0; i < m_ncorr; i++) 171 | { 172 | const Scalar beta = m_y.col(j).dot(res) / m_ys[j]; 173 | res.noalias() += (m_alpha[j] - beta) * m_s.col(j); 174 | j = (j + 1) % m_m; 175 | } 176 | } 177 | 178 | //========== The following functions are only used in L-BFGS-B algorithm ==========// 179 | 180 | // Return the value of theta 181 | inline Scalar theta() const { return m_theta; } 182 | 183 | // Return current number of correction vectors 184 | inline int num_corrections() const { return m_ncorr; } 185 | 186 | // W = [Y, theta * S] 187 | // W [n x (2*ncorr)], v [n x 1], res [(2*ncorr) x 1] 188 | // res preserves the ordering of Y and S columns 189 | inline void apply_Wtv(const Vector& v, Vector& res) const 190 | { 191 | res.resize(2 * m_ncorr); 192 | res.head(m_ncorr).noalias() = m_y.leftCols(m_ncorr).transpose() * v; 193 | res.tail(m_ncorr).noalias() = m_theta * m_s.leftCols(m_ncorr).transpose() * v; 194 | } 195 | 196 | // The b-th row of the W matrix 197 | // Preserves the ordering of Y and S columns 198 | // Return as a column vector 199 | inline Vector Wb(int b) const 200 | { 201 | Vector res(2 * m_ncorr); 202 | for (int j = 0; j < m_ncorr; j++) 203 | { 204 | res[j] = m_y(b, j); 205 | res[m_ncorr + j] = m_s(b, j); 206 | } 207 | res.tail(m_ncorr) *= m_theta; 208 | return res; 209 | } 210 | 211 | // Extract rows of W 212 | inline Matrix Wb(const IndexSet& b) const 213 | { 214 | const int nb = b.size(); 215 | const int* bptr = b.data(); 216 | Matrix res(nb, 2 * m_ncorr); 217 | 218 | for (int j = 0; j < m_ncorr; j++) 219 | { 220 | const Scalar* Yptr = &m_y(0, j); 221 | const Scalar* Sptr = &m_s(0, j); 222 | Scalar* resYptr = res.data() + j * nb; 223 | Scalar* resSptr = resYptr + m_ncorr * nb; 224 | for (int i = 0; i < nb; i++) 225 | { 226 | const int row = bptr[i]; 227 | resYptr[i] = Yptr[row]; 228 | resSptr[i] = Sptr[row]; 229 | } 230 | } 231 | return res; 232 | } 233 | 234 | // M is [(2*ncorr) x (2*ncorr)], v is [(2*ncorr) x 1] 235 | inline void apply_Mv(const Vector& v, Vector& res) const 236 | { 237 | res.resize(2 * m_ncorr); 238 | if (m_ncorr < 1) 239 | return; 240 | 241 | Vector vpadding = Vector::Zero(2 * m_m); 242 | vpadding.head(m_ncorr).noalias() = v.head(m_ncorr); 243 | vpadding.segment(m_m, m_ncorr).noalias() = v.tail(m_ncorr); 244 | 245 | // Solve linear equation 246 | m_permMsolver.solve_inplace(vpadding); 247 | 248 | res.head(m_ncorr).noalias() = vpadding.head(m_ncorr); 249 | res.tail(m_ncorr).noalias() = vpadding.segment(m_m, m_ncorr); 250 | } 251 | 252 | // Compute W'Pv 253 | // W [n x (2*ncorr)], v [nP x 1], res [(2*ncorr) x 1] 254 | // res preserves the ordering of Y and S columns 255 | // Returns false if the result is known to be zero 256 | inline bool apply_WtPv(const IndexSet& P_set, const Vector& v, Vector& res, bool test_zero = false) const 257 | { 258 | const int* Pptr = P_set.data(); 259 | const Scalar* vptr = v.data(); 260 | int nP = P_set.size(); 261 | 262 | // Remove zeros in v to save computation 263 | IndexSet P_reduced; 264 | std::vector v_reduced; 265 | if (test_zero) 266 | { 267 | P_reduced.reserve(nP); 268 | for (int i = 0; i < nP; i++) 269 | { 270 | if (vptr[i] != Scalar(0)) 271 | { 272 | P_reduced.push_back(Pptr[i]); 273 | v_reduced.push_back(vptr[i]); 274 | } 275 | } 276 | Pptr = P_reduced.data(); 277 | vptr = v_reduced.data(); 278 | nP = P_reduced.size(); 279 | } 280 | 281 | res.resize(2 * m_ncorr); 282 | if (m_ncorr < 1 || nP < 1) 283 | { 284 | res.setZero(); 285 | return false; 286 | } 287 | 288 | for (int j = 0; j < m_ncorr; j++) 289 | { 290 | Scalar resy = Scalar(0), ress = Scalar(0); 291 | const Scalar* yptr = &m_y(0, j); 292 | const Scalar* sptr = &m_s(0, j); 293 | for (int i = 0; i < nP; i++) 294 | { 295 | const int row = Pptr[i]; 296 | resy += yptr[row] * vptr[i]; 297 | ress += sptr[row] * vptr[i]; 298 | } 299 | res[j] = resy; 300 | res[m_ncorr + j] = ress; 301 | } 302 | res.tail(m_ncorr) *= m_theta; 303 | return true; 304 | } 305 | 306 | // Compute s * P'WMv 307 | // Assume that v[2*ncorr x 1] has the same ordering (permutation) as W and M 308 | // Returns false if the result is known to be zero 309 | inline bool apply_PtWMv(const IndexSet& P_set, const Vector& v, Vector& res, const Scalar& scale) const 310 | { 311 | const int nP = P_set.size(); 312 | res.resize(nP); 313 | res.setZero(); 314 | if (m_ncorr < 1 || nP < 1) 315 | return false; 316 | 317 | Vector Mv; 318 | apply_Mv(v, Mv); 319 | // WP * Mv 320 | Mv.tail(m_ncorr) *= m_theta; 321 | for (int j = 0; j < m_ncorr; j++) 322 | { 323 | const Scalar* yptr = &m_y(0, j); 324 | const Scalar* sptr = &m_s(0, j); 325 | const Scalar Mvy = Mv[j], Mvs = Mv[m_ncorr + j]; 326 | for (int i = 0; i < nP; i++) 327 | { 328 | const int row = P_set[i]; 329 | res[i] += Mvy * yptr[row] + Mvs * sptr[row]; 330 | } 331 | } 332 | res *= scale; 333 | return true; 334 | } 335 | // If the P'W matrix has been explicitly formed, do a direct matrix multiplication 336 | inline bool apply_PtWMv(const Matrix& WP, const Vector& v, Vector& res, const Scalar& scale) const 337 | { 338 | const int nP = WP.rows(); 339 | res.resize(nP); 340 | if (m_ncorr < 1 || nP < 1) 341 | { 342 | res.setZero(); 343 | return false; 344 | } 345 | 346 | Vector Mv; 347 | apply_Mv(v, Mv); 348 | // WP * Mv 349 | Mv.tail(m_ncorr) *= m_theta; 350 | res.noalias() = scale * (WP * Mv); 351 | return true; 352 | } 353 | 354 | // Compute F'BAb = -(F'W)M(W'AA'd) 355 | // W'd is known, and AA'+FF'=I, so W'AA'd = W'd - W'FF'd 356 | // Usually d contains many zeros, so we fist compute number of nonzero elements in A set and F set, 357 | // denoted as nnz_act and nnz_fv, respectively 358 | // If nnz_act is smaller, compute W'AA'd = WA' (A'd) directly 359 | // If nnz_fv is smaller, compute W'AA'd = W'd - WF' * (F'd) 360 | inline void compute_FtBAb( 361 | const Matrix& WF, const IndexSet& fv_set, const IndexSet& newact_set, const Vector& Wd, const Vector& drt, 362 | Vector& res) const 363 | { 364 | const int nact = newact_set.size(); 365 | const int nfree = WF.rows(); 366 | res.resize(nfree); 367 | if (m_ncorr < 1 || nact < 1 || nfree < 1) 368 | { 369 | res.setZero(); 370 | return; 371 | } 372 | 373 | // W'AA'd 374 | Vector rhs(2 * m_ncorr); 375 | if (nact <= nfree) 376 | { 377 | // Construct A'd 378 | Vector Ad(nfree); 379 | for (int i = 0; i < nact; i++) 380 | Ad[i] = drt[newact_set[i]]; 381 | apply_WtPv(newact_set, Ad, rhs); 382 | } 383 | else 384 | { 385 | // Construct F'd 386 | Vector Fd(nfree); 387 | for (int i = 0; i < nfree; i++) 388 | Fd[i] = drt[fv_set[i]]; 389 | // Compute W'AA'd = W'd - WF' * (F'd) 390 | rhs.noalias() = WF.transpose() * Fd; 391 | rhs.tail(m_ncorr) *= m_theta; 392 | rhs.noalias() = Wd - rhs; 393 | } 394 | 395 | apply_PtWMv(WF, rhs, res, Scalar(-1)); 396 | } 397 | 398 | // Compute inv(P'BP) * v 399 | // P represents an index set 400 | // inv(P'BP) * v = v / theta + WP * inv(inv(M) - WP' * WP / theta) * WP' * v / theta^2 401 | // 402 | // v is [nP x 1] 403 | inline void solve_PtBP(const Matrix& WP, const Vector& v, Vector& res) const 404 | { 405 | const int nP = WP.rows(); 406 | res.resize(nP); 407 | if (m_ncorr < 1 || nP < 1) 408 | { 409 | res.noalias() = v / m_theta; 410 | return; 411 | } 412 | 413 | // Compute the matrix in the middle (only the lower triangular part is needed) 414 | // Remember that W = [Y, theta * S], but we do not store theta in WP 415 | Matrix mid(2 * m_ncorr, 2 * m_ncorr); 416 | // [0:(ncorr - 1), 0:(ncorr - 1)] 417 | for (int j = 0; j < m_ncorr; j++) 418 | { 419 | mid.col(j).segment(j, m_ncorr - j).noalias() = m_permMinv.col(j).segment(j, m_ncorr - j) - 420 | WP.block(0, j, nP, m_ncorr - j).transpose() * WP.col(j) / m_theta; 421 | } 422 | // [ncorr:(2 * ncorr - 1), 0:(ncorr - 1)] 423 | mid.block(m_ncorr, 0, m_ncorr, m_ncorr).noalias() = m_permMinv.block(m_m, 0, m_ncorr, m_ncorr) - 424 | WP.rightCols(m_ncorr).transpose() * WP.leftCols(m_ncorr); 425 | // [ncorr:(2 * ncorr - 1), ncorr:(2 * ncorr - 1)] 426 | for (int j = 0; j < m_ncorr; j++) 427 | { 428 | mid.col(m_ncorr + j).segment(m_ncorr + j, m_ncorr - j).noalias() = m_theta * 429 | (m_permMinv.col(m_m + j).segment(m_m + j, m_ncorr - j) - WP.rightCols(m_ncorr - j).transpose() * WP.col(m_ncorr + j)); 430 | } 431 | // Factorization 432 | BKLDLT midsolver(mid); 433 | // Compute the final result 434 | Vector WPv = WP.transpose() * v; 435 | WPv.tail(m_ncorr) *= m_theta; 436 | midsolver.solve_inplace(WPv); 437 | WPv.tail(m_ncorr) *= m_theta; 438 | res.noalias() = v / m_theta + (WP * WPv) / (m_theta * m_theta); 439 | } 440 | 441 | // Compute P'BQv, where P and Q are two mutually exclusive index selection operators 442 | // P'BQv = -WP * M * WQ' * v 443 | // Returns false if the result is known to be zero 444 | inline bool apply_PtBQv(const Matrix& WP, const IndexSet& Q_set, const Vector& v, Vector& res, bool test_zero = false) const 445 | { 446 | const int nP = WP.rows(); 447 | const int nQ = Q_set.size(); 448 | res.resize(nP); 449 | if (m_ncorr < 1 || nP < 1 || nQ < 1) 450 | { 451 | res.setZero(); 452 | return false; 453 | } 454 | 455 | Vector WQtv; 456 | bool nonzero = apply_WtPv(Q_set, v, WQtv, test_zero); 457 | if (!nonzero) 458 | { 459 | res.setZero(); 460 | return false; 461 | } 462 | 463 | Vector MWQtv; 464 | apply_Mv(WQtv, MWQtv); 465 | MWQtv.tail(m_ncorr) *= m_theta; 466 | res.noalias() = -WP * MWQtv; 467 | return true; 468 | } 469 | // If the Q'W matrix has been explicitly formed, do a direct matrix multiplication 470 | inline bool apply_PtBQv(const Matrix& WP, const Matrix& WQ, const Vector& v, Vector& res) const 471 | { 472 | const int nP = WP.rows(); 473 | const int nQ = WQ.rows(); 474 | res.resize(nP); 475 | if (m_ncorr < 1 || nP < 1 || nQ < 1) 476 | { 477 | res.setZero(); 478 | return false; 479 | } 480 | 481 | // Remember that W = [Y, theta * S], so we need to multiply theta to the second half 482 | Vector WQtv = WQ.transpose() * v; 483 | WQtv.tail(m_ncorr) *= m_theta; 484 | Vector MWQtv; 485 | apply_Mv(WQtv, MWQtv); 486 | MWQtv.tail(m_ncorr) *= m_theta; 487 | res.noalias() = -WP * MWQtv; 488 | return true; 489 | } 490 | }; 491 | 492 | } // namespace LBFGSpp 493 | 494 | /// \endcond 495 | 496 | #endif // LBFGSPP_BFGS_MAT_H 497 | -------------------------------------------------------------------------------- /inst/include/optimization/LBFGSpp/BKLDLT.h: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2020-2023 Yixuan Qiu 2 | // Under MIT license 3 | 4 | #ifndef LBFGSPP_BK_LDLT_H 5 | #define LBFGSPP_BK_LDLT_H 6 | 7 | #include 8 | #include 9 | #include 10 | 11 | /// \cond 12 | 13 | namespace LBFGSpp { 14 | 15 | enum COMPUTATION_INFO 16 | { 17 | SUCCESSFUL = 0, 18 | NOT_COMPUTED, 19 | NUMERICAL_ISSUE 20 | }; 21 | 22 | // Bunch-Kaufman LDLT decomposition 23 | // References: 24 | // 1. Bunch, J. R., & Kaufman, L. (1977). Some stable methods for calculating inertia and solving symmetric linear systems. 25 | // Mathematics of computation, 31(137), 163-179. 26 | // 2. Golub, G. H., & Van Loan, C. F. (2012). Matrix computations (Vol. 3). JHU press. Section 4.4. 27 | // 3. Bunch-Parlett diagonal pivoting 28 | // 4. Ashcraft, C., Grimes, R. G., & Lewis, J. G. (1998). Accurate symmetric indefinite linear equation solvers. 29 | // SIAM Journal on Matrix Analysis and Applications, 20(2), 513-561. 30 | template 31 | class BKLDLT 32 | { 33 | private: 34 | using Index = Eigen::Index; 35 | using Matrix = Eigen::Matrix; 36 | using Vector = Eigen::Matrix; 37 | using MapVec = Eigen::Map; 38 | using MapConstVec = Eigen::Map; 39 | 40 | using IntVector = Eigen::Matrix; 41 | using GenericVector = Eigen::Ref; 42 | using GenericMatrix = Eigen::Ref; 43 | using ConstGenericMatrix = const Eigen::Ref; 44 | using ConstGenericVector = const Eigen::Ref; 45 | 46 | Index m_n; 47 | Vector m_data; // storage for a lower-triangular matrix 48 | std::vector m_colptr; // pointers to columns 49 | IntVector m_perm; // [-2, -1, 3, 1, 4, 5]: 0 <-> 2, 1 <-> 1, 2 <-> 3, 3 <-> 1, 4 <-> 4, 5 <-> 5 50 | std::vector > m_permc; // compressed version of m_perm: [(0, 2), (2, 3), (3, 1)] 51 | 52 | bool m_computed; 53 | int m_info; 54 | 55 | // Access to elements 56 | // Pointer to the k-th column 57 | Scalar* col_pointer(Index k) { return m_colptr[k]; } 58 | // A[i, j] -> m_colptr[j][i - j], i >= j 59 | Scalar& coeff(Index i, Index j) { return m_colptr[j][i - j]; } 60 | const Scalar& coeff(Index i, Index j) const { return m_colptr[j][i - j]; } 61 | // A[i, i] -> m_colptr[i][0] 62 | Scalar& diag_coeff(Index i) { return m_colptr[i][0]; } 63 | const Scalar& diag_coeff(Index i) const { return m_colptr[i][0]; } 64 | 65 | // Compute column pointers 66 | void compute_pointer() 67 | { 68 | m_colptr.clear(); 69 | m_colptr.reserve(m_n); 70 | Scalar* head = m_data.data(); 71 | 72 | for (Index i = 0; i < m_n; i++) 73 | { 74 | m_colptr.push_back(head); 75 | head += (m_n - i); 76 | } 77 | } 78 | 79 | // Copy mat - shift * I to m_data 80 | void copy_data(ConstGenericMatrix& mat, int uplo, const Scalar& shift) 81 | { 82 | if (uplo == Eigen::Lower) 83 | { 84 | for (Index j = 0; j < m_n; j++) 85 | { 86 | const Scalar* begin = &mat.coeffRef(j, j); 87 | const Index len = m_n - j; 88 | std::copy(begin, begin + len, col_pointer(j)); 89 | diag_coeff(j) -= shift; 90 | } 91 | } 92 | else 93 | { 94 | Scalar* dest = m_data.data(); 95 | for (Index i = 0; i < m_n; i++) 96 | { 97 | for (Index j = i; j < m_n; j++, dest++) 98 | { 99 | *dest = mat.coeff(i, j); 100 | } 101 | diag_coeff(i) -= shift; 102 | } 103 | } 104 | } 105 | 106 | // Compute compressed permutations 107 | void compress_permutation() 108 | { 109 | for (Index i = 0; i < m_n; i++) 110 | { 111 | // Recover the permutation action 112 | const Index perm = (m_perm[i] >= 0) ? (m_perm[i]) : (-m_perm[i] - 1); 113 | if (perm != i) 114 | m_permc.push_back(std::make_pair(i, perm)); 115 | } 116 | } 117 | 118 | // Working on the A[k:end, k:end] submatrix 119 | // Exchange k <-> r 120 | // Assume r >= k 121 | void pivoting_1x1(Index k, Index r) 122 | { 123 | // No permutation 124 | if (k == r) 125 | { 126 | m_perm[k] = r; 127 | return; 128 | } 129 | 130 | // A[k, k] <-> A[r, r] 131 | std::swap(diag_coeff(k), diag_coeff(r)); 132 | 133 | // A[(r+1):end, k] <-> A[(r+1):end, r] 134 | std::swap_ranges(&coeff(r + 1, k), col_pointer(k + 1), &coeff(r + 1, r)); 135 | 136 | // A[(k+1):(r-1), k] <-> A[r, (k+1):(r-1)] 137 | Scalar* src = &coeff(k + 1, k); 138 | for (Index j = k + 1; j < r; j++, src++) 139 | { 140 | std::swap(*src, coeff(r, j)); 141 | } 142 | 143 | m_perm[k] = r; 144 | } 145 | 146 | // Working on the A[k:end, k:end] submatrix 147 | // Exchange [k+1, k] <-> [r, p] 148 | // Assume p >= k, r >= k+1 149 | void pivoting_2x2(Index k, Index r, Index p) 150 | { 151 | pivoting_1x1(k, p); 152 | pivoting_1x1(k + 1, r); 153 | 154 | // A[k+1, k] <-> A[r, k] 155 | std::swap(coeff(k + 1, k), coeff(r, k)); 156 | 157 | // Use negative signs to indicate a 2x2 block 158 | // Also minus one to distinguish a negative zero from a positive zero 159 | m_perm[k] = -m_perm[k] - 1; 160 | m_perm[k + 1] = -m_perm[k + 1] - 1; 161 | } 162 | 163 | // A[r1, c1:c2] <-> A[r2, c1:c2] 164 | // Assume r2 >= r1 > c2 >= c1 165 | void interchange_rows(Index r1, Index r2, Index c1, Index c2) 166 | { 167 | if (r1 == r2) 168 | return; 169 | 170 | for (Index j = c1; j <= c2; j++) 171 | { 172 | std::swap(coeff(r1, j), coeff(r2, j)); 173 | } 174 | } 175 | 176 | // lambda = |A[r, k]| = max{|A[k+1, k]|, ..., |A[end, k]|} 177 | // Largest (in magnitude) off-diagonal element in the first column of the current reduced matrix 178 | // r is the row index 179 | // Assume k < end 180 | Scalar find_lambda(Index k, Index& r) 181 | { 182 | using std::abs; 183 | 184 | const Scalar* head = col_pointer(k); // => A[k, k] 185 | const Scalar* end = col_pointer(k + 1); 186 | // Start with r=k+1, lambda=A[k+1, k] 187 | r = k + 1; 188 | Scalar lambda = abs(head[1]); 189 | // Scan remaining elements 190 | for (const Scalar* ptr = head + 2; ptr < end; ptr++) 191 | { 192 | const Scalar abs_elem = abs(*ptr); 193 | if (lambda < abs_elem) 194 | { 195 | lambda = abs_elem; 196 | r = k + (ptr - head); 197 | } 198 | } 199 | 200 | return lambda; 201 | } 202 | 203 | // sigma = |A[p, r]| = max {|A[k, r]|, ..., |A[end, r]|} \ {A[r, r]} 204 | // Largest (in magnitude) off-diagonal element in the r-th column of the current reduced matrix 205 | // p is the row index 206 | // Assume k < r < end 207 | Scalar find_sigma(Index k, Index r, Index& p) 208 | { 209 | using std::abs; 210 | 211 | // First search A[r+1, r], ..., A[end, r], which has the same task as find_lambda() 212 | // If r == end, we skip this search 213 | Scalar sigma = Scalar(-1); 214 | if (r < m_n - 1) 215 | sigma = find_lambda(r, p); 216 | 217 | // Then search A[k, r], ..., A[r-1, r], which maps to A[r, k], ..., A[r, r-1] 218 | for (Index j = k; j < r; j++) 219 | { 220 | const Scalar abs_elem = abs(coeff(r, j)); 221 | if (sigma < abs_elem) 222 | { 223 | sigma = abs_elem; 224 | p = j; 225 | } 226 | } 227 | 228 | return sigma; 229 | } 230 | 231 | // Generate permutations and apply to A 232 | // Return true if the resulting pivoting is 1x1, and false if 2x2 233 | bool permutate_mat(Index k, const Scalar& alpha) 234 | { 235 | using std::abs; 236 | 237 | Index r = k, p = k; 238 | const Scalar lambda = find_lambda(k, r); 239 | 240 | // If lambda=0, no need to interchange 241 | if (lambda > Scalar(0)) 242 | { 243 | const Scalar abs_akk = abs(diag_coeff(k)); 244 | // If |A[k, k]| >= alpha * lambda, no need to interchange 245 | if (abs_akk < alpha * lambda) 246 | { 247 | const Scalar sigma = find_sigma(k, r, p); 248 | 249 | // If sigma * |A[k, k]| >= alpha * lambda^2, no need to interchange 250 | if (sigma * abs_akk < alpha * lambda * lambda) 251 | { 252 | if (abs_akk >= alpha * sigma) 253 | { 254 | // Permutation on A 255 | pivoting_1x1(k, r); 256 | 257 | // Permutation on L 258 | interchange_rows(k, r, 0, k - 1); 259 | return true; 260 | } 261 | else 262 | { 263 | // There are two versions of permutation here 264 | // 1. A[k+1, k] <-> A[r, k] 265 | // 2. A[k+1, k] <-> A[r, p], where p >= k and r >= k+1 266 | // 267 | // Version 1 and 2 are used by Ref[1] and Ref[2], respectively 268 | 269 | // Version 1 implementation 270 | p = k; 271 | 272 | // Version 2 implementation 273 | // [r, p] and [p, r] are symmetric, but we need to make sure 274 | // p >= k and r >= k+1, so it is safe to always make r > p 275 | // One exception is when min{r,p} == k+1, in which case we make 276 | // r = k+1, so that only one permutation needs to be performed 277 | /* const Index rp_min = std::min(r, p); 278 | const Index rp_max = std::max(r, p); 279 | if(rp_min == k + 1) 280 | { 281 | r = rp_min; p = rp_max; 282 | } else { 283 | r = rp_max; p = rp_min; 284 | } */ 285 | 286 | // Right now we use Version 1 since it reduces the overhead of interchange 287 | 288 | // Permutation on A 289 | pivoting_2x2(k, r, p); 290 | // Permutation on L 291 | interchange_rows(k, p, 0, k - 1); 292 | interchange_rows(k + 1, r, 0, k - 1); 293 | return false; 294 | } 295 | } 296 | } 297 | } 298 | 299 | return true; 300 | } 301 | 302 | // E = [e11, e12] 303 | // [e21, e22] 304 | // Overwrite E with inv(E) 305 | void inverse_inplace_2x2(Scalar& e11, Scalar& e21, Scalar& e22) const 306 | { 307 | // inv(E) = [d11, d12], d11 = e22/delta, d21 = -e21/delta, d22 = e11/delta 308 | // [d21, d22] 309 | const Scalar delta = e11 * e22 - e21 * e21; 310 | std::swap(e11, e22); 311 | e11 /= delta; 312 | e22 /= delta; 313 | e21 = -e21 / delta; 314 | } 315 | 316 | // Return value is the status, SUCCESSFUL/NUMERICAL_ISSUE 317 | int gaussian_elimination_1x1(Index k) 318 | { 319 | // D = 1 / A[k, k] 320 | const Scalar akk = diag_coeff(k); 321 | // Return NUMERICAL_ISSUE if not invertible 322 | if (akk == Scalar(0)) 323 | return NUMERICAL_ISSUE; 324 | 325 | diag_coeff(k) = Scalar(1) / akk; 326 | 327 | // B -= l * l' / A[k, k], B := A[(k+1):end, (k+1):end], l := L[(k+1):end, k] 328 | Scalar* lptr = col_pointer(k) + 1; 329 | const Index ldim = m_n - k - 1; 330 | MapVec l(lptr, ldim); 331 | for (Index j = 0; j < ldim; j++) 332 | { 333 | MapVec(col_pointer(j + k + 1), ldim - j).noalias() -= (lptr[j] / akk) * l.tail(ldim - j); 334 | } 335 | 336 | // l /= A[k, k] 337 | l /= akk; 338 | 339 | return SUCCESSFUL; 340 | } 341 | 342 | // Return value is the status, SUCCESSFUL/NUMERICAL_ISSUE 343 | int gaussian_elimination_2x2(Index k) 344 | { 345 | // D = inv(E) 346 | Scalar& e11 = diag_coeff(k); 347 | Scalar& e21 = coeff(k + 1, k); 348 | Scalar& e22 = diag_coeff(k + 1); 349 | // Return NUMERICAL_ISSUE if not invertible 350 | if (e11 * e22 - e21 * e21 == Scalar(0)) 351 | return NUMERICAL_ISSUE; 352 | 353 | inverse_inplace_2x2(e11, e21, e22); 354 | 355 | // X = l * inv(E), l := L[(k+2):end, k:(k+1)] 356 | Scalar* l1ptr = &coeff(k + 2, k); 357 | Scalar* l2ptr = &coeff(k + 2, k + 1); 358 | const Index ldim = m_n - k - 2; 359 | MapVec l1(l1ptr, ldim), l2(l2ptr, ldim); 360 | 361 | Eigen::Matrix X(ldim, 2); 362 | X.col(0).noalias() = l1 * e11 + l2 * e21; 363 | X.col(1).noalias() = l1 * e21 + l2 * e22; 364 | 365 | // B -= l * inv(E) * l' = X * l', B = A[(k+2):end, (k+2):end] 366 | for (Index j = 0; j < ldim; j++) 367 | { 368 | MapVec(col_pointer(j + k + 2), ldim - j).noalias() -= (X.col(0).tail(ldim - j) * l1ptr[j] + X.col(1).tail(ldim - j) * l2ptr[j]); 369 | } 370 | 371 | // l = X 372 | l1.noalias() = X.col(0); 373 | l2.noalias() = X.col(1); 374 | 375 | return SUCCESSFUL; 376 | } 377 | 378 | public: 379 | BKLDLT() : 380 | m_n(0), m_computed(false), m_info(NOT_COMPUTED) 381 | {} 382 | 383 | // Factorize mat - shift * I 384 | BKLDLT(ConstGenericMatrix& mat, int uplo = Eigen::Lower, const Scalar& shift = Scalar(0)) : 385 | m_n(mat.rows()), m_computed(false), m_info(NOT_COMPUTED) 386 | { 387 | compute(mat, uplo, shift); 388 | } 389 | 390 | void compute(ConstGenericMatrix& mat, int uplo = Eigen::Lower, const Scalar& shift = Scalar(0)) 391 | { 392 | using std::abs; 393 | 394 | m_n = mat.rows(); 395 | if (m_n != mat.cols()) 396 | throw std::invalid_argument("BKLDLT: matrix must be square"); 397 | 398 | m_perm.setLinSpaced(m_n, 0, m_n - 1); 399 | m_permc.clear(); 400 | 401 | // Copy data 402 | m_data.resize((m_n * (m_n + 1)) / 2); 403 | compute_pointer(); 404 | copy_data(mat, uplo, shift); 405 | 406 | const Scalar alpha = (1.0 + std::sqrt(17.0)) / 8.0; 407 | Index k = 0; 408 | for (k = 0; k < m_n - 1; k++) 409 | { 410 | // 1. Interchange rows and columns of A, and save the result to m_perm 411 | bool is_1x1 = permutate_mat(k, alpha); 412 | 413 | // 2. Gaussian elimination 414 | if (is_1x1) 415 | { 416 | m_info = gaussian_elimination_1x1(k); 417 | } 418 | else 419 | { 420 | m_info = gaussian_elimination_2x2(k); 421 | k++; 422 | } 423 | 424 | // 3. Check status 425 | if (m_info != SUCCESSFUL) 426 | break; 427 | } 428 | // Invert the last 1x1 block if it exists 429 | if (k == m_n - 1) 430 | { 431 | const Scalar akk = diag_coeff(k); 432 | if (akk == Scalar(0)) 433 | m_info = NUMERICAL_ISSUE; 434 | 435 | diag_coeff(k) = Scalar(1) / diag_coeff(k); 436 | } 437 | 438 | compress_permutation(); 439 | 440 | m_computed = true; 441 | } 442 | 443 | // Solve Ax=b 444 | void solve_inplace(GenericVector b) const 445 | { 446 | if (!m_computed) 447 | throw std::logic_error("BKLDLT: need to call compute() first"); 448 | 449 | // PAP' = LDL' 450 | // 1. b -> Pb 451 | Scalar* x = b.data(); 452 | MapVec res(x, m_n); 453 | Index npermc = m_permc.size(); 454 | for (Index i = 0; i < npermc; i++) 455 | { 456 | std::swap(x[m_permc[i].first], x[m_permc[i].second]); 457 | } 458 | 459 | // 2. Lz = Pb 460 | // If m_perm[end] < 0, then end with m_n - 3, otherwise end with m_n - 2 461 | const Index end = (m_perm[m_n - 1] < 0) ? (m_n - 3) : (m_n - 2); 462 | for (Index i = 0; i <= end; i++) 463 | { 464 | const Index b1size = m_n - i - 1; 465 | const Index b2size = b1size - 1; 466 | if (m_perm[i] >= 0) 467 | { 468 | MapConstVec l(&coeff(i + 1, i), b1size); 469 | res.segment(i + 1, b1size).noalias() -= l * x[i]; 470 | } 471 | else 472 | { 473 | MapConstVec l1(&coeff(i + 2, i), b2size); 474 | MapConstVec l2(&coeff(i + 2, i + 1), b2size); 475 | res.segment(i + 2, b2size).noalias() -= (l1 * x[i] + l2 * x[i + 1]); 476 | i++; 477 | } 478 | } 479 | 480 | // 3. Dw = z 481 | for (Index i = 0; i < m_n; i++) 482 | { 483 | const Scalar e11 = diag_coeff(i); 484 | if (m_perm[i] >= 0) 485 | { 486 | x[i] *= e11; 487 | } 488 | else 489 | { 490 | const Scalar e21 = coeff(i + 1, i), e22 = diag_coeff(i + 1); 491 | const Scalar wi = x[i] * e11 + x[i + 1] * e21; 492 | x[i + 1] = x[i] * e21 + x[i + 1] * e22; 493 | x[i] = wi; 494 | i++; 495 | } 496 | } 497 | 498 | // 4. L'y = w 499 | // If m_perm[end] < 0, then start with m_n - 3, otherwise start with m_n - 2 500 | Index i = (m_perm[m_n - 1] < 0) ? (m_n - 3) : (m_n - 2); 501 | for (; i >= 0; i--) 502 | { 503 | const Index ldim = m_n - i - 1; 504 | MapConstVec l(&coeff(i + 1, i), ldim); 505 | x[i] -= res.segment(i + 1, ldim).dot(l); 506 | 507 | if (m_perm[i] < 0) 508 | { 509 | MapConstVec l2(&coeff(i + 1, i - 1), ldim); 510 | x[i - 1] -= res.segment(i + 1, ldim).dot(l2); 511 | i--; 512 | } 513 | } 514 | 515 | // 5. x = P'y 516 | for (i = npermc - 1; i >= 0; i--) 517 | { 518 | std::swap(x[m_permc[i].first], x[m_permc[i].second]); 519 | } 520 | } 521 | 522 | Vector solve(ConstGenericVector& b) const 523 | { 524 | Vector res = b; 525 | solve_inplace(res); 526 | return res; 527 | } 528 | 529 | int info() const { return m_info; } 530 | }; 531 | 532 | } // namespace LBFGSpp 533 | 534 | /// \endcond 535 | 536 | #endif // LBFGSPP_BK_LDLT_H 537 | -------------------------------------------------------------------------------- /inst/include/optimization/LBFGSpp/Cauchy.h: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2020-2023 Yixuan Qiu 2 | // Under MIT license 3 | 4 | #ifndef LBFGSPP_CAUCHY_H 5 | #define LBFGSPP_CAUCHY_H 6 | 7 | #include 8 | #include 9 | #include "BFGSMat.h" 10 | 11 | /// \cond 12 | 13 | namespace LBFGSpp { 14 | 15 | // 16 | // Class to compute the generalized Cauchy point (GCP) for the L-BFGS-B algorithm, 17 | // mainly for internal use. 18 | // 19 | // The target of the GCP procedure is to find a step size t such that 20 | // x(t) = x0 - t * g is a local minimum of the quadratic function m(x), 21 | // where m(x) is a local approximation to the objective function. 22 | // 23 | // First determine a sequence of break points t0=0, t1, t2, ..., tn. 24 | // On each interval [t[i-1], t[i]], x is changing linearly. 25 | // After passing a break point, one or more coordinates of x will be fixed at the bounds. 26 | // We search the first local minimum of m(x) by examining the intervals [t[i-1], t[i]] sequentially. 27 | // 28 | // Reference: 29 | // [1] R. H. Byrd, P. Lu, and J. Nocedal (1995). A limited memory algorithm for bound constrained optimization. 30 | // 31 | template 32 | class ArgSort 33 | { 34 | private: 35 | using Vector = Eigen::Matrix; 36 | using IndexSet = std::vector; 37 | 38 | const Scalar* values; 39 | 40 | public: 41 | ArgSort(const Vector& value_vec) : 42 | values(value_vec.data()) 43 | {} 44 | 45 | inline bool operator()(int key1, int key2) { return values[key1] < values[key2]; } 46 | inline void sort_key(IndexSet& key_vec) const 47 | { 48 | std::sort(key_vec.begin(), key_vec.end(), *this); 49 | } 50 | }; 51 | 52 | template 53 | class Cauchy 54 | { 55 | private: 56 | typedef Eigen::Matrix Vector; 57 | typedef Eigen::Matrix IntVector; 58 | typedef Eigen::Matrix Matrix; 59 | typedef std::vector IndexSet; 60 | 61 | // Find the smallest index i such that brk[ord[i]] > t, assuming brk[ord] is already sorted. 62 | // If the return value equals n, then all values are <= t. 63 | static int search_greater(const Vector& brk, const IndexSet& ord, const Scalar& t, int start = 0) 64 | { 65 | const int nord = ord.size(); 66 | int i; 67 | for (i = start; i < nord; i++) 68 | { 69 | if (brk[ord[i]] > t) 70 | break; 71 | } 72 | 73 | return i; 74 | } 75 | 76 | public: 77 | // bfgs: An object that represents the BFGS approximation matrix. 78 | // x0: Current parameter vector. 79 | // g: Gradient at x0. 80 | // lb: Lower bounds for x. 81 | // ub: Upper bounds for x. 82 | // xcp: The output generalized Cauchy point. 83 | // vecc: c = W'(xcp - x0), used in the subspace minimization routine. 84 | // newact_set: Coordinates that newly become active during the GCP procedure. 85 | // fv_set: Free variable set. 86 | static void get_cauchy_point( 87 | const BFGSMat& bfgs, const Vector& x0, const Vector& g, const Vector& lb, const Vector& ub, 88 | Vector& xcp, Vector& vecc, IndexSet& newact_set, IndexSet& fv_set) 89 | { 90 | // std::cout << "========================= Entering GCP search =========================\n\n"; 91 | 92 | // Initialization 93 | const int n = x0.size(); 94 | xcp.resize(n); 95 | xcp.noalias() = x0; 96 | vecc.resize(2 * bfgs.num_corrections()); 97 | vecc.setZero(); 98 | newact_set.clear(); 99 | newact_set.reserve(n); 100 | fv_set.clear(); 101 | fv_set.reserve(n); 102 | 103 | // Construct break points 104 | Vector brk(n), vecd(n); 105 | // If brk[i] == 0, i belongs to active set 106 | // If brk[i] == Inf, i belongs to free variable set 107 | // Others are currently undecided 108 | IndexSet ord; 109 | ord.reserve(n); 110 | const Scalar inf = std::numeric_limits::infinity(); 111 | for (int i = 0; i < n; i++) 112 | { 113 | if (lb[i] == ub[i]) 114 | brk[i] = Scalar(0); 115 | else if (g[i] < Scalar(0)) 116 | brk[i] = (x0[i] - ub[i]) / g[i]; 117 | else if (g[i] > Scalar(0)) 118 | brk[i] = (x0[i] - lb[i]) / g[i]; 119 | else 120 | brk[i] = inf; 121 | 122 | const bool iszero = (brk[i] == Scalar(0)); 123 | vecd[i] = iszero ? Scalar(0) : -g[i]; 124 | 125 | if (brk[i] == inf) 126 | fv_set.push_back(i); 127 | else if (!iszero) 128 | ord.push_back(i); 129 | } 130 | 131 | // Sort indices of break points 132 | ArgSort sorting(brk); 133 | sorting.sort_key(ord); 134 | 135 | // Break points `brko := brk[ord]` are in increasing order 136 | // `ord` contains the coordinates that define the corresponding break points 137 | // brk[i] == 0 <=> The i-th coordinate is on the boundary 138 | const int nord = ord.size(); 139 | const int nfree = fv_set.size(); 140 | if ((nfree < 1) && (nord < 1)) 141 | { 142 | /* std::cout << "** All coordinates at boundary **\n"; 143 | std::cout << "\n========================= Leaving GCP search =========================\n\n"; */ 144 | return; 145 | } 146 | 147 | // First interval: [il=0, iu=brk[ord[0]]] 148 | // In case ord is empty, we take iu=Inf 149 | 150 | // p = W'd, c = 0 151 | Vector vecp; 152 | bfgs.apply_Wtv(vecd, vecp); 153 | // f' = -d'd 154 | Scalar fp = -vecd.squaredNorm(); 155 | // f'' = -theta * f' - p'Mp 156 | Vector cache; 157 | bfgs.apply_Mv(vecp, cache); // cache = Mp 158 | Scalar fpp = -bfgs.theta() * fp - vecp.dot(cache); 159 | 160 | // Theoretical step size to move 161 | Scalar deltatmin = -fp / fpp; 162 | 163 | // Limit on the current interval 164 | Scalar il = Scalar(0); 165 | // We have excluded the case that max(brk) <= 0 166 | int b = 0; 167 | Scalar iu = (nord < 1) ? inf : brk[ord[b]]; 168 | Scalar deltat = iu - il; 169 | 170 | /* int iter = 0; 171 | std::cout << "** Iter " << iter << " **\n"; 172 | std::cout << " fp = " << fp << ", fpp = " << fpp << ", deltatmin = " << deltatmin << std::endl; 173 | std::cout << " il = " << il << ", iu = " << iu << ", deltat = " << deltat << std::endl; */ 174 | 175 | // If deltatmin >= deltat, we need to do the following things: 176 | // 1. Update vecc 177 | // 2. Since we are going to cross iu, the coordinates that define iu become active 178 | // 3. Update some quantities on these new active coordinates (xcp, vecd, vecp) 179 | // 4. Move to the next interval and compute the new deltatmin 180 | bool crossed_all = false; 181 | const int ncorr = bfgs.num_corrections(); 182 | Vector wact(2 * ncorr); 183 | while (deltatmin >= deltat) 184 | { 185 | // Step 1 186 | vecc.noalias() += deltat * vecp; 187 | 188 | // Step 2 189 | // First check how many coordinates will be active when we cross the previous iu 190 | // b is the smallest number such that brko[b] == iu 191 | // Let bp be the largest number such that brko[bp] == iu 192 | // Then coordinates ord[b] to ord[bp] will be active 193 | const int act_begin = b; 194 | const int act_end = search_greater(brk, ord, iu, b) - 1; 195 | 196 | // If nfree == 0 and act_end == nord-1, then we have crossed all coordinates 197 | // We only need to update xcp from ord[b] to ord[bp], and then exit 198 | if ((nfree == 0) && (act_end == nord - 1)) 199 | { 200 | // std::cout << "** [ "; 201 | for (int i = act_begin; i <= act_end; i++) 202 | { 203 | const int act = ord[i]; 204 | xcp[act] = (vecd[act] > Scalar(0)) ? ub[act] : lb[act]; 205 | newact_set.push_back(act); 206 | // std::cout << act + 1 << " "; 207 | } 208 | // std::cout << "] become active **\n\n"; 209 | // std::cout << "** All break points visited **\n\n"; 210 | 211 | crossed_all = true; 212 | break; 213 | } 214 | 215 | // Step 3 216 | // Update xcp and d on active coordinates 217 | // std::cout << "** [ "; 218 | fp += deltat * fpp; 219 | for (int i = act_begin; i <= act_end; i++) 220 | { 221 | const int act = ord[i]; 222 | xcp[act] = (vecd[act] > Scalar(0)) ? ub[act] : lb[act]; 223 | // z = xcp - x0 224 | const Scalar zact = xcp[act] - x0[act]; 225 | const Scalar gact = g[act]; 226 | const Scalar ggact = gact * gact; 227 | wact.noalias() = bfgs.Wb(act); 228 | bfgs.apply_Mv(wact, cache); // cache = Mw 229 | fp += ggact + bfgs.theta() * gact * zact - gact * cache.dot(vecc); 230 | fpp -= (bfgs.theta() * ggact + 2 * gact * cache.dot(vecp) + ggact * cache.dot(wact)); 231 | vecp.noalias() += gact * wact; 232 | vecd[act] = Scalar(0); 233 | newact_set.push_back(act); 234 | // std::cout << act + 1 << " "; 235 | } 236 | // std::cout << "] become active **\n\n"; 237 | 238 | // Step 4 239 | // Theoretical step size to move 240 | deltatmin = -fp / fpp; 241 | // Update interval bound 242 | il = iu; 243 | b = act_end + 1; 244 | // If we have visited all finite-valued break points, and have not exited earlier, 245 | // then the next iu will be infinity. Simply exit the loop now 246 | if (b >= nord) 247 | break; 248 | iu = brk[ord[b]]; 249 | // Width of the current interval 250 | deltat = iu - il; 251 | 252 | /* iter++; 253 | std::cout << "** Iter " << iter << " **\n"; 254 | std::cout << " fp = " << fp << ", fpp = " << fpp << ", deltatmin = " << deltatmin << std::endl; 255 | std::cout << " il = " << il << ", iu = " << iu << ", deltat = " << deltat << std::endl; */ 256 | } 257 | 258 | // In some rare cases fpp is numerically zero, making deltatmin equal to Inf 259 | // If this happens, force fpp to be the machine precision 260 | const Scalar eps = std::numeric_limits::epsilon(); 261 | if (fpp < eps) 262 | deltatmin = -fp / eps; 263 | 264 | // Last step 265 | if (!crossed_all) 266 | { 267 | deltatmin = std::max(deltatmin, Scalar(0)); 268 | vecc.noalias() += deltatmin * vecp; 269 | const Scalar tfinal = il + deltatmin; 270 | // Update xcp on free variable coordinates 271 | for (int i = 0; i < nfree; i++) 272 | { 273 | const int coord = fv_set[i]; 274 | xcp[coord] = x0[coord] + tfinal * vecd[coord]; 275 | } 276 | for (int i = b; i < nord; i++) 277 | { 278 | const int coord = ord[i]; 279 | xcp[coord] = x0[coord] + tfinal * vecd[coord]; 280 | fv_set.push_back(coord); 281 | } 282 | } 283 | // std::cout << "\n========================= Leaving GCP search =========================\n\n"; 284 | } 285 | }; 286 | 287 | } // namespace LBFGSpp 288 | 289 | /// \endcond 290 | 291 | #endif // LBFGSPP_CAUCHY_H 292 | -------------------------------------------------------------------------------- /inst/include/optimization/LBFGSpp/LineSearchBacktracking.h: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2016-2023 Yixuan Qiu 2 | // Under MIT license 3 | 4 | #ifndef LBFGSPP_LINE_SEARCH_BACKTRACKING_H 5 | #define LBFGSPP_LINE_SEARCH_BACKTRACKING_H 6 | 7 | #include 8 | #include // std::runtime_error 9 | 10 | namespace LBFGSpp { 11 | 12 | /// 13 | /// The backtracking line search algorithm for L-BFGS. Mainly for internal use. 14 | /// 15 | template 16 | class LineSearchBacktracking 17 | { 18 | private: 19 | using Vector = Eigen::Matrix; 20 | 21 | public: 22 | /// 23 | /// Line search by backtracking. 24 | /// 25 | /// \param f A function object such that `f(x, grad)` returns the 26 | /// objective function value at `x`, and overwrites `grad` with 27 | /// the gradient. 28 | /// \param param Parameters for the L-BFGS algorithm. 29 | /// \param xp The current point. 30 | /// \param drt The current moving direction. 31 | /// \param step_max The upper bound for the step size that makes x feasible. 32 | /// Can be ignored for the L-BFGS solver. 33 | /// \param step In: The initial step length. 34 | /// Out: The calculated step length. 35 | /// \param fx In: The objective function value at the current point. 36 | /// Out: The function value at the new point. 37 | /// \param grad In: The current gradient vector. 38 | /// Out: The gradient at the new point. 39 | /// \param dg In: The inner product between drt and grad. 40 | /// Out: The inner product between drt and the new gradient. 41 | /// \param x Out: The new point moved to. 42 | /// 43 | template 44 | static void LineSearch(Foo& f, const LBFGSParam& param, 45 | const Vector& xp, const Vector& drt, const Scalar& step_max, 46 | Scalar& step, Scalar& fx, Vector& grad, Scalar& dg, Vector& x) 47 | { 48 | // Decreasing and increasing factors 49 | const Scalar dec = 0.5; 50 | const Scalar inc = 2.1; 51 | 52 | // Check the value of step 53 | if (step <= Scalar(0)) 54 | throw std::invalid_argument("'step' must be positive"); 55 | 56 | // Save the function value at the current x 57 | const Scalar fx_init = fx; 58 | // Projection of gradient on the search direction 59 | const Scalar dg_init = grad.dot(drt); 60 | // Make sure d points to a descent direction 61 | if (dg_init > 0) 62 | throw std::logic_error("the moving direction increases the objective function value"); 63 | 64 | const Scalar test_decr = param.ftol * dg_init; 65 | Scalar width; 66 | 67 | int iter; 68 | for (iter = 0; iter < param.max_linesearch; iter++) 69 | { 70 | // x_{k+1} = x_k + step * d_k 71 | x.noalias() = xp + step * drt; 72 | // Evaluate this candidate 73 | fx = f(x, grad); 74 | 75 | if (fx > fx_init + step * test_decr || (fx != fx)) 76 | { 77 | width = dec; 78 | } 79 | else 80 | { 81 | dg = grad.dot(drt); 82 | 83 | // Armijo condition is met 84 | if (param.linesearch == LBFGS_LINESEARCH_BACKTRACKING_ARMIJO) 85 | break; 86 | 87 | if (dg < param.wolfe * dg_init) 88 | { 89 | width = inc; 90 | } 91 | else 92 | { 93 | // Regular Wolfe condition is met 94 | if (param.linesearch == LBFGS_LINESEARCH_BACKTRACKING_WOLFE) 95 | break; 96 | 97 | if (dg > -param.wolfe * dg_init) 98 | { 99 | width = dec; 100 | } 101 | else 102 | { 103 | // Strong Wolfe condition is met 104 | break; 105 | } 106 | } 107 | } 108 | 109 | if (step < param.min_step) 110 | throw std::runtime_error("the line search step became smaller than the minimum value allowed"); 111 | 112 | if (step > param.max_step) 113 | throw std::runtime_error("the line search step became larger than the maximum value allowed"); 114 | 115 | step *= width; 116 | } 117 | 118 | if (iter >= param.max_linesearch) 119 | throw std::runtime_error("the line search routine reached the maximum number of iterations"); 120 | } 121 | }; 122 | 123 | } // namespace LBFGSpp 124 | 125 | #endif // LBFGSPP_LINE_SEARCH_BACKTRACKING_H 126 | -------------------------------------------------------------------------------- /inst/include/optimization/LBFGSpp/LineSearchBracketing.h: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2016-2023 Yixuan Qiu 2 | // Copyright (C) 2016-2023 Dirk Toewe 3 | // Under MIT license 4 | 5 | #ifndef LBFGSPP_LINE_SEARCH_BRACKETING_H 6 | #define LBFGSPP_LINE_SEARCH_BRACKETING_H 7 | 8 | #include 9 | #include // std::runtime_error 10 | 11 | namespace LBFGSpp { 12 | 13 | /// 14 | /// The bracketing line search algorithm for L-BFGS. Mainly for internal use. 15 | /// 16 | template 17 | class LineSearchBracketing 18 | { 19 | private: 20 | using Vector = Eigen::Matrix; 21 | 22 | public: 23 | /// 24 | /// Line search by bracketing. Similar to the backtracking line search 25 | /// except that it actively maintains an upper and lower bound of the 26 | /// current search range. 27 | /// 28 | /// \param f A function object such that `f(x, grad)` returns the 29 | /// objective function value at `x`, and overwrites `grad` with 30 | /// the gradient. 31 | /// \param param Parameters for the L-BFGS algorithm. 32 | /// \param xp The current point. 33 | /// \param drt The current moving direction. 34 | /// \param step_max The upper bound for the step size that makes x feasible. 35 | /// Can be ignored for the L-BFGS solver. 36 | /// \param step In: The initial step length. 37 | /// Out: The calculated step length. 38 | /// \param fx In: The objective function value at the current point. 39 | /// Out: The function value at the new point. 40 | /// \param grad In: The current gradient vector. 41 | /// Out: The gradient at the new point. 42 | /// \param dg In: The inner product between drt and grad. 43 | /// Out: The inner product between drt and the new gradient. 44 | /// \param x Out: The new point moved to. 45 | /// 46 | template 47 | static void LineSearch(Foo& f, const LBFGSParam& param, 48 | const Vector& xp, const Vector& drt, const Scalar& step_max, 49 | Scalar& step, Scalar& fx, Vector& grad, Scalar& dg, Vector& x) 50 | { 51 | // Check the value of step 52 | if (step <= Scalar(0)) 53 | throw std::invalid_argument("'step' must be positive"); 54 | 55 | // Save the function value at the current x 56 | const Scalar fx_init = fx; 57 | // Projection of gradient on the search direction 58 | const Scalar dg_init = grad.dot(drt); 59 | // Make sure d points to a descent direction 60 | if (dg_init > 0) 61 | throw std::logic_error("the moving direction increases the objective function value"); 62 | 63 | const Scalar test_decr = param.ftol * dg_init; 64 | 65 | // Upper and lower end of the current line search range 66 | Scalar step_lo = 0, 67 | step_hi = std::numeric_limits::infinity(); 68 | 69 | int iter; 70 | for (iter = 0; iter < param.max_linesearch; iter++) 71 | { 72 | // x_{k+1} = x_k + step * d_k 73 | x.noalias() = xp + step * drt; 74 | // Evaluate this candidate 75 | fx = f(x, grad); 76 | 77 | if (fx > fx_init + step * test_decr || (fx != fx)) 78 | { 79 | step_hi = step; 80 | } 81 | else 82 | { 83 | dg = grad.dot(drt); 84 | 85 | // Armijo condition is met 86 | if (param.linesearch == LBFGS_LINESEARCH_BACKTRACKING_ARMIJO) 87 | break; 88 | 89 | if (dg < param.wolfe * dg_init) 90 | { 91 | step_lo = step; 92 | } 93 | else 94 | { 95 | // Regular Wolfe condition is met 96 | if (param.linesearch == LBFGS_LINESEARCH_BACKTRACKING_WOLFE) 97 | break; 98 | 99 | if (dg > -param.wolfe * dg_init) 100 | { 101 | step_hi = step; 102 | } 103 | else 104 | { 105 | // Strong Wolfe condition is met 106 | break; 107 | } 108 | } 109 | } 110 | 111 | assert(step_lo < step_hi); 112 | 113 | if (step < param.min_step) 114 | throw std::runtime_error("the line search step became smaller than the minimum value allowed"); 115 | 116 | if (step > param.max_step) 117 | throw std::runtime_error("the line search step became larger than the maximum value allowed"); 118 | 119 | // continue search in mid of current search range 120 | step = std::isinf(step_hi) ? 2 * step : step_lo / 2 + step_hi / 2; 121 | } 122 | 123 | if (iter >= param.max_linesearch) 124 | throw std::runtime_error("the line search routine reached the maximum number of iterations"); 125 | } 126 | }; 127 | 128 | } // namespace LBFGSpp 129 | 130 | #endif // LBFGSPP_LINE_SEARCH_BRACKETING_H 131 | -------------------------------------------------------------------------------- /inst/include/optimization/LBFGSpp/LineSearchNocedalWright.h: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2016-2023 Yixuan Qiu 2 | // Copyright (C) 2016-2023 Dirk Toewe 3 | // Under MIT license 4 | 5 | #ifndef LBFGSPP_LINE_SEARCH_NOCEDAL_WRIGHT_H 6 | #define LBFGSPP_LINE_SEARCH_NOCEDAL_WRIGHT_H 7 | 8 | #include 9 | #include 10 | 11 | namespace LBFGSpp { 12 | 13 | /// 14 | /// A line search algorithm for the strong Wolfe condition. Implementation based on: 15 | /// 16 | /// "Numerical Optimization" 2nd Edition, 17 | /// Jorge Nocedal and Stephen J. Wright, 18 | /// Chapter 3. Line Search Methods, page 60. 19 | /// 20 | template 21 | class LineSearchNocedalWright 22 | { 23 | private: 24 | using Vector = Eigen::Matrix; 25 | 26 | // Use {fx_lo, fx_hi, dg_lo} to make a quadratic interpolation of 27 | // the function, and the fitted quadratic function is used to 28 | // estimate the minimum 29 | static Scalar quad_interp(const Scalar& step_lo, const Scalar& step_hi, 30 | const Scalar& fx_lo, const Scalar& fx_hi, const Scalar& dg_lo) 31 | { 32 | using std::abs; 33 | 34 | // polynomial: p (x) = c0*(x - step)² + c1 35 | // conditions: p (step_hi) = fx_hi 36 | // p (step_lo) = fx_lo 37 | // p'(step_lo) = dg_lo 38 | 39 | // We allow fx_hi to be Inf, so first compute a candidate for step size, 40 | // and test whether NaN occurs 41 | const Scalar fdiff = fx_hi - fx_lo; 42 | const Scalar sdiff = step_hi - step_lo; 43 | const Scalar smid = (step_hi + step_lo) / Scalar(2); 44 | Scalar step_candid = fdiff * step_lo - smid * sdiff * dg_lo; 45 | step_candid = step_candid / (fdiff - sdiff * dg_lo); 46 | 47 | // In some cases the interpolation is not a good choice 48 | // This includes (a) NaN values; (b) too close to the end points; (c) outside the interval 49 | // In such cases, a bisection search is used 50 | const bool candid_nan = !(std::isfinite(step_candid)); 51 | const Scalar end_dist = std::min(abs(step_candid - step_lo), abs(step_candid - step_hi)); 52 | const bool near_end = end_dist < Scalar(0.01) * abs(sdiff); 53 | const bool bisect = candid_nan || 54 | (step_candid <= std::min(step_lo, step_hi)) || 55 | (step_candid >= std::max(step_lo, step_hi)) || 56 | near_end; 57 | const Scalar step = bisect ? smid : step_candid; 58 | return step; 59 | } 60 | 61 | public: 62 | /// 63 | /// Line search by Nocedal and Wright (2006). 64 | /// 65 | /// \param f A function object such that `f(x, grad)` returns the 66 | /// objective function value at `x`, and overwrites `grad` with 67 | /// the gradient. 68 | /// \param param Parameters for the L-BFGS algorithm. 69 | /// \param xp The current point. 70 | /// \param drt The current moving direction. 71 | /// \param step_max The upper bound for the step size that makes x feasible. 72 | /// Can be ignored for the L-BFGS solver. 73 | /// \param step In: The initial step length. 74 | /// Out: The calculated step length. 75 | /// \param fx In: The objective function value at the current point. 76 | /// Out: The function value at the new point. 77 | /// \param grad In: The current gradient vector. 78 | /// Out: The gradient at the new point. 79 | /// \param dg In: The inner product between drt and grad. 80 | /// Out: The inner product between drt and the new gradient. 81 | /// \param x Out: The new point moved to. 82 | /// 83 | template 84 | static void LineSearch(Foo& f, const LBFGSParam& param, 85 | const Vector& xp, const Vector& drt, const Scalar& step_max, 86 | Scalar& step, Scalar& fx, Vector& grad, Scalar& dg, Vector& x) 87 | { 88 | // Check the value of step 89 | if (step <= Scalar(0)) 90 | throw std::invalid_argument("'step' must be positive"); 91 | 92 | if (param.linesearch != LBFGS_LINESEARCH_BACKTRACKING_STRONG_WOLFE) 93 | throw std::invalid_argument("'param.linesearch' must be 'LBFGS_LINESEARCH_BACKTRACKING_STRONG_WOLFE' for LineSearchNocedalWright"); 94 | 95 | // To make this implementation more similar to the other line search 96 | // methods in LBFGSpp, the symbol names from the literature 97 | // ("Numerical Optimizations") have been changed. 98 | // 99 | // Literature | LBFGSpp 100 | // -----------|-------- 101 | // alpha | step 102 | // phi | fx 103 | // phi' | dg 104 | 105 | // The expansion rate of the step size 106 | const Scalar expansion = Scalar(2); 107 | 108 | // Save the function value at the current x 109 | const Scalar fx_init = fx; 110 | // Projection of gradient on the search direction 111 | const Scalar dg_init = dg; 112 | // Make sure d points to a descent direction 113 | if (dg_init > Scalar(0)) 114 | throw std::logic_error("the moving direction increases the objective function value"); 115 | 116 | const Scalar test_decr = param.ftol * dg_init, // Sufficient decrease 117 | test_curv = -param.wolfe * dg_init; // Curvature 118 | 119 | // Ends of the line search range (step_lo > step_hi is allowed) 120 | // We can also define dg_hi, but it will never be used 121 | Scalar step_hi, fx_hi; 122 | Scalar step_lo = Scalar(0), fx_lo = fx_init, dg_lo = dg_init; 123 | // We also need to save x and grad for step=step_lo, since we want to return the best 124 | // step size along the path when strong Wolfe condition is not met 125 | Vector x_lo = xp, grad_lo = grad; 126 | 127 | // STEP 1: Bracketing Phase 128 | // Find a range guaranteed to contain a step satisfying strong Wolfe. 129 | // The bracketing phase exits if one of the following conditions is satisfied: 130 | // (1) Current step violates the sufficient decrease condition 131 | // (2) Current fx >= previous fx 132 | // (3) Current dg >= 0 133 | // (4) Strong Wolfe condition is met 134 | // 135 | // (4) terminates the whole line search, and (1)-(3) go to the zoom phase 136 | // 137 | // See also: 138 | // "Numerical Optimization", "Algorithm 3.5 (Line Search Algorithm)". 139 | int iter = 0; 140 | for (;;) 141 | { 142 | // Evaluate the current step size 143 | x.noalias() = xp + step * drt; 144 | fx = f(x, grad); 145 | dg = grad.dot(drt); 146 | 147 | // Test the sufficient decrease condition 148 | if (fx - fx_init > step * test_decr || (Scalar(0) < step_lo && fx >= fx_lo)) 149 | { 150 | // Case (1) and (2) 151 | step_hi = step; 152 | fx_hi = fx; 153 | // dg_hi = dg; 154 | break; 155 | } 156 | // If reaching here, then the sufficient decrease condition is satisfied 157 | 158 | // Test the curvature condition 159 | if (std::abs(dg) <= test_curv) 160 | return; // Case (4) 161 | 162 | step_hi = step_lo; 163 | fx_hi = fx_lo; 164 | // dg_hi = dg_lo; 165 | step_lo = step; 166 | fx_lo = fx; 167 | dg_lo = dg; 168 | // Move x and grad to x_lo and grad_lo, respectively 169 | x_lo.swap(x); 170 | grad_lo.swap(grad); 171 | 172 | if (dg >= Scalar(0)) 173 | break; // Case (3) 174 | 175 | iter++; 176 | // If we have used up all line search iterations in the bracketing phase, 177 | // it means every new step decreases the objective function. Of course, 178 | // the strong Wolfe condition is not met, but we choose not to raise an 179 | // exception; instead, we return the best step size so far. This means that 180 | // we exit the line search with the most recent step size, which has the 181 | // smallest objective function value during the line search 182 | if (iter >= param.max_linesearch) 183 | { 184 | // throw std::runtime_error("the line search routine reached the maximum number of iterations"); 185 | 186 | // At this point we can guarantee that {step, fx, dg}=={step, fx, dg}_lo 187 | // But we need to move {x, grad}_lo back before returning 188 | x.swap(x_lo); 189 | grad.swap(grad_lo); 190 | return; 191 | } 192 | 193 | // If we still stay in the loop, it means we can expand the current step 194 | step *= expansion; 195 | } 196 | 197 | // STEP 2: Zoom Phase 198 | // Given a range (step_lo,step_hi) that is guaranteed to 199 | // contain a valid strong Wolfe step value, this method 200 | // finds such a value. 201 | // 202 | // If step_lo > 0, then step_lo is, among all step sizes generated so far and 203 | // satisfying the sufficient decrease condition, the one giving the smallest 204 | // objective function value. 205 | // 206 | // See also: 207 | // "Numerical Optimization", "Algorithm 3.6 (Zoom)". 208 | for (;;) 209 | { 210 | // Use {fx_lo, fx_hi, dg_lo} to make a quadratic interpolation of 211 | // the function, and the fitted quadratic function is used to 212 | // estimate the minimum 213 | step = quad_interp(step_lo, step_hi, fx_lo, fx_hi, dg_lo); 214 | 215 | // Evaluate the current step size 216 | x.noalias() = xp + step * drt; 217 | fx = f(x, grad); 218 | dg = grad.dot(drt); 219 | 220 | // Test the sufficient decrease condition 221 | if (fx - fx_init > step * test_decr || fx >= fx_lo) 222 | { 223 | if (step == step_hi) 224 | throw std::runtime_error("the line search routine failed, possibly due to insufficient numeric precision"); 225 | 226 | step_hi = step; 227 | fx_hi = fx; 228 | // dg_hi = dg; 229 | } 230 | else 231 | { 232 | // Test the curvature condition 233 | if (std::abs(dg) <= test_curv) 234 | return; 235 | 236 | if (dg * (step_hi - step_lo) >= Scalar(0)) 237 | { 238 | step_hi = step_lo; 239 | fx_hi = fx_lo; 240 | // dg_hi = dg_lo; 241 | } 242 | 243 | if (step == step_lo) 244 | throw std::runtime_error("the line search routine failed, possibly due to insufficient numeric precision"); 245 | 246 | // If reaching here, then the current step satisfies sufficient decrease condition 247 | step_lo = step; 248 | fx_lo = fx; 249 | dg_lo = dg; 250 | // Move x and grad to x_lo and grad_lo, respectively 251 | x_lo.swap(x); 252 | grad_lo.swap(grad); 253 | } 254 | 255 | iter++; 256 | // If we have used up all line search iterations in the zoom phase, 257 | // then the strong Wolfe condition is not met. We choose not to raise an 258 | // exception (unless no step satisfying sufficient decrease is found), 259 | // but to return the best step size so far, i.e., step_lo 260 | if (iter >= param.max_linesearch) 261 | { 262 | // throw std::runtime_error("the line search routine reached the maximum number of iterations"); 263 | if (step_lo <= Scalar(0)) 264 | throw std::runtime_error("the line search routine failed, unable to sufficiently decrease the function value"); 265 | 266 | // Return everything with _lo 267 | step = step_lo; 268 | fx = fx_lo; 269 | dg = dg_lo; 270 | // Move {x, grad}_lo back 271 | x.swap(x_lo); 272 | grad.swap(grad_lo); 273 | return; 274 | } 275 | } 276 | } 277 | }; 278 | 279 | } // namespace LBFGSpp 280 | 281 | #endif // LBFGSPP_LINE_SEARCH_NOCEDAL_WRIGHT_H 282 | -------------------------------------------------------------------------------- /inst/include/optimization/LBFGSpp/Param.h: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2016-2023 Yixuan Qiu 2 | // Under MIT license 3 | 4 | #ifndef LBFGSPP_PARAM_H 5 | #define LBFGSPP_PARAM_H 6 | 7 | #include 8 | #include // std::invalid_argument 9 | 10 | namespace LBFGSpp { 11 | 12 | /// 13 | /// \defgroup Enumerations 14 | /// 15 | /// Enumeration types for line search. 16 | /// 17 | 18 | /// 19 | /// \ingroup Enumerations 20 | /// 21 | /// The enumeration of line search termination conditions. 22 | /// 23 | enum LINE_SEARCH_TERMINATION_CONDITION 24 | { 25 | /// 26 | /// Backtracking method with the Armijo condition. 27 | /// The backtracking method finds the step length such that it satisfies 28 | /// the sufficient decrease (Armijo) condition, 29 | /// \f$f(x + a \cdot d) \le f(x) + \beta' \cdot a \cdot g(x)^T d\f$, 30 | /// where \f$x\f$ is the current point, \f$d\f$ is the current search direction, 31 | /// \f$a\f$ is the step length, and \f$\beta'\f$ is the value specified by 32 | /// \ref LBFGSParam::ftol. \f$f\f$ and \f$g\f$ are the function 33 | /// and gradient values respectively. 34 | /// 35 | LBFGS_LINESEARCH_BACKTRACKING_ARMIJO = 1, 36 | 37 | /// 38 | /// The backtracking method with the defualt (regular Wolfe) condition. 39 | /// An alias of `LBFGS_LINESEARCH_BACKTRACKING_WOLFE`. 40 | /// 41 | LBFGS_LINESEARCH_BACKTRACKING = 2, 42 | 43 | /// 44 | /// Backtracking method with regular Wolfe condition. 45 | /// The backtracking method finds the step length such that it satisfies 46 | /// both the Armijo condition (`LBFGS_LINESEARCH_BACKTRACKING_ARMIJO`) 47 | /// and the curvature condition, 48 | /// \f$g(x + a \cdot d)^T d \ge \beta \cdot g(x)^T d\f$, where \f$\beta\f$ 49 | /// is the value specified by \ref LBFGSParam::wolfe. 50 | /// 51 | LBFGS_LINESEARCH_BACKTRACKING_WOLFE = 2, 52 | 53 | /// 54 | /// Backtracking method with strong Wolfe condition. 55 | /// The backtracking method finds the step length such that it satisfies 56 | /// both the Armijo condition (`LBFGS_LINESEARCH_BACKTRACKING_ARMIJO`) 57 | /// and the following condition, 58 | /// \f$\vert g(x + a \cdot d)^T d\vert \le \beta \cdot \vert g(x)^T d\vert\f$, 59 | /// where \f$\beta\f$ is the value specified by \ref LBFGSParam::wolfe. 60 | /// 61 | LBFGS_LINESEARCH_BACKTRACKING_STRONG_WOLFE = 3 62 | }; 63 | 64 | /// 65 | /// Parameters to control the L-BFGS algorithm. 66 | /// 67 | template 68 | class LBFGSParam 69 | { 70 | public: 71 | /// 72 | /// The number of corrections to approximate the inverse Hessian matrix. 73 | /// The L-BFGS routine stores the computation results of previous \ref m 74 | /// iterations to approximate the inverse Hessian matrix of the current 75 | /// iteration. This parameter controls the size of the limited memories 76 | /// (corrections). The default value is \c 6. Values less than \c 3 are 77 | /// not recommended. Large values will result in excessive computing time. 78 | /// 79 | int m; 80 | /// 81 | /// Absolute tolerance for convergence test. 82 | /// This parameter determines the absolute accuracy \f$\epsilon_{abs}\f$ 83 | /// with which the solution is to be found. A minimization terminates when 84 | /// \f$||g|| < \max\{\epsilon_{abs}, \epsilon_{rel}||x||\}\f$, 85 | /// where \f$||\cdot||\f$ denotes the Euclidean (L2) norm. The default value is 86 | /// \c 1e-5. 87 | /// 88 | Scalar epsilon; 89 | /// 90 | /// Relative tolerance for convergence test. 91 | /// This parameter determines the relative accuracy \f$\epsilon_{rel}\f$ 92 | /// with which the solution is to be found. A minimization terminates when 93 | /// \f$||g|| < \max\{\epsilon_{abs}, \epsilon_{rel}||x||\}\f$, 94 | /// where \f$||\cdot||\f$ denotes the Euclidean (L2) norm. The default value is 95 | /// \c 1e-5. 96 | /// 97 | Scalar epsilon_rel; 98 | /// 99 | /// Distance for delta-based convergence test. 100 | /// This parameter determines the distance \f$d\f$ to compute the 101 | /// rate of decrease of the objective function, 102 | /// \f$f_{k-d}(x)-f_k(x)\f$, where \f$k\f$ is the current iteration 103 | /// step. If the value of this parameter is zero, the delta-based convergence 104 | /// test will not be performed. The default value is \c 0. 105 | /// 106 | int past; 107 | /// 108 | /// Delta for convergence test. 109 | /// The algorithm stops when the following condition is met, 110 | /// \f$|f_{k-d}(x)-f_k(x)|<\delta\cdot\max(1, |f_k(x)|, |f_{k-d}(x)|)\f$, where \f$f_k(x)\f$ is 111 | /// the current function value, and \f$f_{k-d}(x)\f$ is the function value 112 | /// \f$d\f$ iterations ago (specified by the \ref past parameter). 113 | /// The default value is \c 0. 114 | /// 115 | Scalar delta; 116 | /// 117 | /// The maximum number of iterations. 118 | /// The optimization process is terminated when the iteration count 119 | /// exceeds this parameter. Setting this parameter to zero continues an 120 | /// optimization process until a convergence or error. The default value 121 | /// is \c 0. 122 | /// 123 | int max_iterations; 124 | /// 125 | /// The line search termination condition. 126 | /// This parameter specifies the line search termination condition that will be used 127 | /// by the LBFGS routine. The default value is `LBFGS_LINESEARCH_BACKTRACKING_STRONG_WOLFE`. 128 | /// 129 | int linesearch; 130 | /// 131 | /// The maximum number of trials for the line search. 132 | /// This parameter controls the number of function and gradients evaluations 133 | /// per iteration for the line search routine. The default value is \c 20. 134 | /// 135 | int max_linesearch; 136 | /// 137 | /// The minimum step length allowed in the line search. 138 | /// The default value is \c 1e-20. Usually this value does not need to be 139 | /// modified. 140 | /// 141 | Scalar min_step; 142 | /// 143 | /// The maximum step length allowed in the line search. 144 | /// The default value is \c 1e+20. Usually this value does not need to be 145 | /// modified. 146 | /// 147 | Scalar max_step; 148 | /// 149 | /// A parameter to control the accuracy of the line search routine. 150 | /// The default value is \c 1e-4. This parameter should be greater 151 | /// than zero and smaller than \c 0.5. 152 | /// 153 | Scalar ftol; 154 | /// 155 | /// The coefficient for the Wolfe condition. 156 | /// This parameter is valid only when the line-search 157 | /// algorithm is used with the Wolfe condition. 158 | /// The default value is \c 0.9. This parameter should be greater 159 | /// the \ref ftol parameter and smaller than \c 1.0. 160 | /// 161 | Scalar wolfe; 162 | 163 | public: 164 | /// 165 | /// Constructor for L-BFGS parameters. 166 | /// Default values for parameters will be set when the object is created. 167 | /// 168 | LBFGSParam() 169 | { 170 | // clang-format off 171 | m = 6; 172 | epsilon = Scalar(1e-5); 173 | epsilon_rel = Scalar(1e-5); 174 | past = 0; 175 | delta = Scalar(0); 176 | max_iterations = 0; 177 | linesearch = LBFGS_LINESEARCH_BACKTRACKING_STRONG_WOLFE; 178 | max_linesearch = 20; 179 | min_step = Scalar(1e-20); 180 | max_step = Scalar(1e+20); 181 | ftol = Scalar(1e-4); 182 | wolfe = Scalar(0.9); 183 | // clang-format on 184 | } 185 | 186 | /// 187 | /// Checking the validity of L-BFGS parameters. 188 | /// An `std::invalid_argument` exception will be thrown if some parameter 189 | /// is invalid. 190 | /// 191 | inline void check_param() const 192 | { 193 | if (m <= 0) 194 | throw std::invalid_argument("'m' must be positive"); 195 | if (epsilon < 0) 196 | throw std::invalid_argument("'epsilon' must be non-negative"); 197 | if (epsilon_rel < 0) 198 | throw std::invalid_argument("'epsilon_rel' must be non-negative"); 199 | if (past < 0) 200 | throw std::invalid_argument("'past' must be non-negative"); 201 | if (delta < 0) 202 | throw std::invalid_argument("'delta' must be non-negative"); 203 | if (max_iterations < 0) 204 | throw std::invalid_argument("'max_iterations' must be non-negative"); 205 | if (linesearch < LBFGS_LINESEARCH_BACKTRACKING_ARMIJO || 206 | linesearch > LBFGS_LINESEARCH_BACKTRACKING_STRONG_WOLFE) 207 | throw std::invalid_argument("unsupported line search termination condition"); 208 | if (max_linesearch <= 0) 209 | throw std::invalid_argument("'max_linesearch' must be positive"); 210 | if (min_step < 0) 211 | throw std::invalid_argument("'min_step' must be positive"); 212 | if (max_step < min_step) 213 | throw std::invalid_argument("'max_step' must be greater than 'min_step'"); 214 | if (ftol <= 0 || ftol >= 0.5) 215 | throw std::invalid_argument("'ftol' must satisfy 0 < ftol < 0.5"); 216 | if (wolfe <= ftol || wolfe >= 1) 217 | throw std::invalid_argument("'wolfe' must satisfy ftol < wolfe < 1"); 218 | } 219 | }; 220 | 221 | /// 222 | /// Parameters to control the L-BFGS-B algorithm. 223 | /// 224 | template 225 | class LBFGSBParam 226 | { 227 | public: 228 | /// 229 | /// The number of corrections to approximate the inverse Hessian matrix. 230 | /// The L-BFGS-B routine stores the computation results of previous \ref m 231 | /// iterations to approximate the inverse Hessian matrix of the current 232 | /// iteration. This parameter controls the size of the limited memories 233 | /// (corrections). The default value is \c 6. Values less than \c 3 are 234 | /// not recommended. Large values will result in excessive computing time. 235 | /// 236 | int m; 237 | /// 238 | /// Absolute tolerance for convergence test. 239 | /// This parameter determines the absolute accuracy \f$\epsilon_{abs}\f$ 240 | /// with which the solution is to be found. A minimization terminates when 241 | /// \f$||Pg||_{\infty} < \max\{\epsilon_{abs}, \epsilon_{rel}||x||\}\f$, 242 | /// where \f$||x||\f$ denotes the Euclidean (L2) norm of \f$x\f$, and 243 | /// \f$Pg=P(x-g,l,u)-x\f$ is the projected gradient. The default value is 244 | /// \c 1e-5. 245 | /// 246 | Scalar epsilon; 247 | /// 248 | /// Relative tolerance for convergence test. 249 | /// This parameter determines the relative accuracy \f$\epsilon_{rel}\f$ 250 | /// with which the solution is to be found. A minimization terminates when 251 | /// \f$||Pg||_{\infty} < \max\{\epsilon_{abs}, \epsilon_{rel}||x||\}\f$, 252 | /// where \f$||x||\f$ denotes the Euclidean (L2) norm of \f$x\f$, and 253 | /// \f$Pg=P(x-g,l,u)-x\f$ is the projected gradient. The default value is 254 | /// \c 1e-5. 255 | /// 256 | Scalar epsilon_rel; 257 | /// 258 | /// Distance for delta-based convergence test. 259 | /// This parameter determines the distance \f$d\f$ to compute the 260 | /// rate of decrease of the objective function, 261 | /// \f$f_{k-d}(x)-f_k(x)\f$, where \f$k\f$ is the current iteration 262 | /// step. If the value of this parameter is zero, the delta-based convergence 263 | /// test will not be performed. The default value is \c 1. 264 | /// 265 | int past; 266 | /// 267 | /// Delta for convergence test. 268 | /// The algorithm stops when the following condition is met, 269 | /// \f$|f_{k-d}(x)-f_k(x)|<\delta\cdot\max(1, |f_k(x)|, |f_{k-d}(x)|)\f$, where \f$f_k(x)\f$ is 270 | /// the current function value, and \f$f_{k-d}(x)\f$ is the function value 271 | /// \f$d\f$ iterations ago (specified by the \ref past parameter). 272 | /// The default value is \c 1e-10. 273 | /// 274 | Scalar delta; 275 | /// 276 | /// The maximum number of iterations. 277 | /// The optimization process is terminated when the iteration count 278 | /// exceeds this parameter. Setting this parameter to zero continues an 279 | /// optimization process until a convergence or error. The default value 280 | /// is \c 0. 281 | /// 282 | int max_iterations; 283 | /// 284 | /// The maximum number of iterations in the subspace minimization. 285 | /// This parameter controls the number of iterations in the subspace 286 | /// minimization routine. The default value is \c 10. 287 | /// 288 | int max_submin; 289 | /// 290 | /// The maximum number of trials for the line search. 291 | /// This parameter controls the number of function and gradients evaluations 292 | /// per iteration for the line search routine. The default value is \c 20. 293 | /// 294 | int max_linesearch; 295 | /// 296 | /// The minimum step length allowed in the line search. 297 | /// The default value is \c 1e-20. Usually this value does not need to be 298 | /// modified. 299 | /// 300 | Scalar min_step; 301 | /// 302 | /// The maximum step length allowed in the line search. 303 | /// The default value is \c 1e+20. Usually this value does not need to be 304 | /// modified. 305 | /// 306 | Scalar max_step; 307 | /// 308 | /// A parameter to control the accuracy of the line search routine. 309 | /// The default value is \c 1e-4. This parameter should be greater 310 | /// than zero and smaller than \c 0.5. 311 | /// 312 | Scalar ftol; 313 | /// 314 | /// The coefficient for the Wolfe condition. 315 | /// This parameter is valid only when the line-search 316 | /// algorithm is used with the Wolfe condition. 317 | /// The default value is \c 0.9. This parameter should be greater 318 | /// the \ref ftol parameter and smaller than \c 1.0. 319 | /// 320 | Scalar wolfe; 321 | 322 | public: 323 | /// 324 | /// Constructor for L-BFGS-B parameters. 325 | /// Default values for parameters will be set when the object is created. 326 | /// 327 | LBFGSBParam() 328 | { 329 | // clang-format off 330 | m = 6; 331 | epsilon = Scalar(1e-5); 332 | epsilon_rel = Scalar(1e-5); 333 | past = 1; 334 | delta = Scalar(1e-10); 335 | max_iterations = 0; 336 | max_submin = 10; 337 | max_linesearch = 20; 338 | min_step = Scalar(1e-20); 339 | max_step = Scalar(1e+20); 340 | ftol = Scalar(1e-4); 341 | wolfe = Scalar(0.9); 342 | // clang-format on 343 | } 344 | 345 | /// 346 | /// Checking the validity of L-BFGS-B parameters. 347 | /// An `std::invalid_argument` exception will be thrown if some parameter 348 | /// is invalid. 349 | /// 350 | inline void check_param() const 351 | { 352 | if (m <= 0) 353 | throw std::invalid_argument("'m' must be positive"); 354 | if (epsilon < 0) 355 | throw std::invalid_argument("'epsilon' must be non-negative"); 356 | if (epsilon_rel < 0) 357 | throw std::invalid_argument("'epsilon_rel' must be non-negative"); 358 | if (past < 0) 359 | throw std::invalid_argument("'past' must be non-negative"); 360 | if (delta < 0) 361 | throw std::invalid_argument("'delta' must be non-negative"); 362 | if (max_iterations < 0) 363 | throw std::invalid_argument("'max_iterations' must be non-negative"); 364 | if (max_submin < 0) 365 | throw std::invalid_argument("'max_submin' must be non-negative"); 366 | if (max_linesearch <= 0) 367 | throw std::invalid_argument("'max_linesearch' must be positive"); 368 | if (min_step < 0) 369 | throw std::invalid_argument("'min_step' must be positive"); 370 | if (max_step < min_step) 371 | throw std::invalid_argument("'max_step' must be greater than 'min_step'"); 372 | if (ftol <= 0 || ftol >= 0.5) 373 | throw std::invalid_argument("'ftol' must satisfy 0 < ftol < 0.5"); 374 | if (wolfe <= ftol || wolfe >= 1) 375 | throw std::invalid_argument("'wolfe' must satisfy ftol < wolfe < 1"); 376 | } 377 | }; 378 | 379 | } // namespace LBFGSpp 380 | 381 | #endif // LBFGSPP_PARAM_H 382 | -------------------------------------------------------------------------------- /inst/include/optimization/LBFGSpp/SubspaceMin.h: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2020-2023 Yixuan Qiu 2 | // Under MIT license 3 | 4 | #ifndef LBFGSPP_SUBSPACE_MIN_H 5 | #define LBFGSPP_SUBSPACE_MIN_H 6 | 7 | #include 8 | #include 9 | #include 10 | #include "BFGSMat.h" 11 | 12 | /// \cond 13 | 14 | namespace LBFGSpp { 15 | 16 | // 17 | // Subspace minimization procedure of the L-BFGS-B algorithm, 18 | // mainly for internal use. 19 | // 20 | // The target of subspace minimization is to minimize the quadratic function m(x) 21 | // over the free variables, subject to the bound condition. 22 | // Free variables stand for coordinates that are not at the boundary in xcp, 23 | // the generalized Cauchy point. 24 | // 25 | // In the classical implementation of L-BFGS-B [1], the minimization is done by first 26 | // ignoring the box constraints, followed by a line search. Our implementation is 27 | // an exact minimization subject to the bounds, based on the BOXCQP algorithm [2]. 28 | // 29 | // Reference: 30 | // [1] R. H. Byrd, P. Lu, and J. Nocedal (1995). A limited memory algorithm for bound constrained optimization. 31 | // [2] C. Voglis and I. E. Lagaris (2004). BOXCQP: An algorithm for bound constrained convex quadratic problems. 32 | // 33 | template 34 | class SubspaceMin 35 | { 36 | private: 37 | using Vector = Eigen::Matrix; 38 | using Matrix = Eigen::Matrix; 39 | using IndexSet = std::vector; 40 | 41 | // v[ind] 42 | static Vector subvec(const Vector& v, const IndexSet& ind) 43 | { 44 | const int nsub = ind.size(); 45 | Vector res(nsub); 46 | for (int i = 0; i < nsub; i++) 47 | res[i] = v[ind[i]]; 48 | return res; 49 | } 50 | 51 | // v[ind] = rhs 52 | static void subvec_assign(Vector& v, const IndexSet& ind, const Vector& rhs) 53 | { 54 | const int nsub = ind.size(); 55 | for (int i = 0; i < nsub; i++) 56 | v[ind[i]] = rhs[i]; 57 | } 58 | 59 | // Check whether the vector is within the bounds 60 | static bool in_bounds(const Vector& x, const Vector& lb, const Vector& ub) 61 | { 62 | const int n = x.size(); 63 | for (int i = 0; i < n; i++) 64 | { 65 | if (x[i] < lb[i] || x[i] > ub[i]) 66 | return false; 67 | } 68 | return true; 69 | } 70 | 71 | // Test convergence of P set 72 | static bool P_converged(const IndexSet& yP_set, const Vector& vecy, const Vector& vecl, const Vector& vecu) 73 | { 74 | const int nP = yP_set.size(); 75 | for (int i = 0; i < nP; i++) 76 | { 77 | const int coord = yP_set[i]; 78 | if (vecy[coord] < vecl[coord] || vecy[coord] > vecu[coord]) 79 | return false; 80 | } 81 | return true; 82 | } 83 | 84 | // Test convergence of L set 85 | static bool L_converged(const IndexSet& yL_set, const Vector& lambda) 86 | { 87 | const int nL = yL_set.size(); 88 | for (int i = 0; i < nL; i++) 89 | { 90 | const int coord = yL_set[i]; 91 | if (lambda[coord] < Scalar(0)) 92 | return false; 93 | } 94 | return true; 95 | } 96 | 97 | // Test convergence of L set 98 | static bool U_converged(const IndexSet& yU_set, const Vector& mu) 99 | { 100 | const int nU = yU_set.size(); 101 | for (int i = 0; i < nU; i++) 102 | { 103 | const int coord = yU_set[i]; 104 | if (mu[coord] < Scalar(0)) 105 | return false; 106 | } 107 | return true; 108 | } 109 | 110 | public: 111 | // bfgs: An object that represents the BFGS approximation matrix. 112 | // x0: Current parameter vector. 113 | // xcp: Computed generalized Cauchy point. 114 | // g: Gradient at x0. 115 | // lb: Lower bounds for x. 116 | // ub: Upper bounds for x. 117 | // Wd: W'(xcp - x0) 118 | // newact_set: Coordinates that newly become active during the GCP procedure. 119 | // fv_set: Free variable set. 120 | // maxit: Maximum number of iterations. 121 | // drt: The output direction vector, drt = xsm - x0. 122 | static void subspace_minimize( 123 | const BFGSMat& bfgs, const Vector& x0, const Vector& xcp, const Vector& g, 124 | const Vector& lb, const Vector& ub, const Vector& Wd, const IndexSet& newact_set, const IndexSet& fv_set, int maxit, 125 | Vector& drt) 126 | { 127 | // std::cout << "========================= Entering subspace minimization =========================\n\n"; 128 | 129 | // d = xcp - x0 130 | drt.noalias() = xcp - x0; 131 | // Size of free variables 132 | const int nfree = fv_set.size(); 133 | // If there is no free variable, simply return drt 134 | if (nfree < 1) 135 | { 136 | // std::cout << "========================= (Early) leaving subspace minimization =========================\n\n"; 137 | return; 138 | } 139 | 140 | // std::cout << "New active set = [ "; for(std::size_t i = 0; i < newact_set.size(); i++) std::cout << newact_set[i] << " "; std::cout << "]\n"; 141 | // std::cout << "Free variable set = [ "; for(std::size_t i = 0; i < fv_set.size(); i++) std::cout << fv_set[i] << " "; std::cout << "]\n\n"; 142 | 143 | // Extract the rows of W in the free variable set 144 | Matrix WF = bfgs.Wb(fv_set); 145 | // Compute F'BAb = -F'WMW'AA'd 146 | Vector vecc(nfree); 147 | bfgs.compute_FtBAb(WF, fv_set, newact_set, Wd, drt, vecc); 148 | // Set the vector c=F'BAb+F'g for linear term, and vectors l and u for the new bounds 149 | Vector vecl(nfree), vecu(nfree); 150 | for (int i = 0; i < nfree; i++) 151 | { 152 | const int coord = fv_set[i]; 153 | vecl[i] = lb[coord] - x0[coord]; 154 | vecu[i] = ub[coord] - x0[coord]; 155 | vecc[i] += g[coord]; 156 | } 157 | // Solve y = -inv(B[F, F]) * c 158 | Vector vecy(nfree); 159 | bfgs.solve_PtBP(WF, -vecc, vecy); 160 | // Test feasibility 161 | // If yes, then the solution has been found 162 | if (in_bounds(vecy, vecl, vecu)) 163 | { 164 | subvec_assign(drt, fv_set, vecy); 165 | return; 166 | } 167 | // Otherwise, enter the iterations 168 | 169 | // Make a copy of y as a fallback solution 170 | Vector yfallback = vecy; 171 | // Dual variables 172 | Vector lambda = Vector::Zero(nfree), mu = Vector::Zero(nfree); 173 | 174 | // Iterations 175 | IndexSet L_set, U_set, P_set, yL_set, yU_set, yP_set; 176 | L_set.reserve(nfree / 3); 177 | yL_set.reserve(nfree / 3); 178 | U_set.reserve(nfree / 3); 179 | yU_set.reserve(nfree / 3); 180 | P_set.reserve(nfree); 181 | yP_set.reserve(nfree); 182 | int k; 183 | for (k = 0; k < maxit; k++) 184 | { 185 | // Construct the L, U, and P sets, and then update values 186 | // Indices in original drt vector 187 | L_set.clear(); 188 | U_set.clear(); 189 | P_set.clear(); 190 | // Indices in y 191 | yL_set.clear(); 192 | yU_set.clear(); 193 | yP_set.clear(); 194 | for (int i = 0; i < nfree; i++) 195 | { 196 | const int coord = fv_set[i]; 197 | const Scalar li = vecl[i], ui = vecu[i]; 198 | if ((vecy[i] < li) || (vecy[i] == li && lambda[i] >= Scalar(0))) 199 | { 200 | L_set.push_back(coord); 201 | yL_set.push_back(i); 202 | vecy[i] = li; 203 | mu[i] = Scalar(0); 204 | } 205 | else if ((vecy[i] > ui) || (vecy[i] == ui && mu[i] >= Scalar(0))) 206 | { 207 | U_set.push_back(coord); 208 | yU_set.push_back(i); 209 | vecy[i] = ui; 210 | lambda[i] = Scalar(0); 211 | } 212 | else 213 | { 214 | P_set.push_back(coord); 215 | yP_set.push_back(i); 216 | lambda[i] = Scalar(0); 217 | mu[i] = Scalar(0); 218 | } 219 | } 220 | 221 | /* std::cout << "** Iter " << k << " **\n"; 222 | std::cout << " L = [ "; for(std::size_t i = 0; i < L_set.size(); i++) std::cout << L_set[i] << " "; std::cout << "]\n"; 223 | std::cout << " U = [ "; for(std::size_t i = 0; i < U_set.size(); i++) std::cout << U_set[i] << " "; std::cout << "]\n"; 224 | std::cout << " P = [ "; for(std::size_t i = 0; i < P_set.size(); i++) std::cout << P_set[i] << " "; std::cout << "]\n\n"; */ 225 | 226 | // Extract the rows of W in the P set 227 | Matrix WP = bfgs.Wb(P_set); 228 | // Solve y[P] = -inv(B[P, P]) * (B[P, L] * l[L] + B[P, U] * u[U] + c[P]) 229 | const int nP = P_set.size(); 230 | if (nP > 0) 231 | { 232 | Vector rhs = subvec(vecc, yP_set); 233 | Vector lL = subvec(vecl, yL_set); 234 | Vector uU = subvec(vecu, yU_set); 235 | Vector tmp(nP); 236 | bool nonzero = bfgs.apply_PtBQv(WP, L_set, lL, tmp, true); 237 | if (nonzero) 238 | rhs.noalias() += tmp; 239 | nonzero = bfgs.apply_PtBQv(WP, U_set, uU, tmp, true); 240 | if (nonzero) 241 | rhs.noalias() += tmp; 242 | 243 | bfgs.solve_PtBP(WP, -rhs, tmp); 244 | subvec_assign(vecy, yP_set, tmp); 245 | } 246 | 247 | // Solve lambda[L] = B[L, F] * y + c[L] 248 | const int nL = L_set.size(); 249 | const int nU = U_set.size(); 250 | Vector Fy; 251 | if (nL > 0 || nU > 0) 252 | bfgs.apply_WtPv(fv_set, vecy, Fy); 253 | if (nL > 0) 254 | { 255 | Vector res; 256 | bfgs.apply_PtWMv(L_set, Fy, res, Scalar(-1)); 257 | res.noalias() += subvec(vecc, yL_set) + bfgs.theta() * subvec(vecy, yL_set); 258 | subvec_assign(lambda, yL_set, res); 259 | } 260 | 261 | // Solve mu[U] = -B[U, F] * y - c[U] 262 | if (nU > 0) 263 | { 264 | Vector negRes; 265 | bfgs.apply_PtWMv(U_set, Fy, negRes, Scalar(-1)); 266 | negRes.noalias() += subvec(vecc, yU_set) + bfgs.theta() * subvec(vecy, yU_set); 267 | subvec_assign(mu, yU_set, -negRes); 268 | } 269 | 270 | // Test convergence 271 | if (L_converged(yL_set, lambda) && U_converged(yU_set, mu) && P_converged(yP_set, vecy, vecl, vecu)) 272 | break; 273 | } 274 | 275 | // If the iterations do not converge, try the projection 276 | if (k >= maxit) 277 | { 278 | vecy.noalias() = vecy.cwiseMax(vecl).cwiseMin(vecu); 279 | subvec_assign(drt, fv_set, vecy); 280 | // Test whether drt is a descent direction 281 | Scalar dg = drt.dot(g); 282 | // If yes, return the result 283 | if (dg <= -std::numeric_limits::epsilon()) 284 | return; 285 | 286 | // If not, fall back to the projected unconstrained solution 287 | vecy.noalias() = yfallback.cwiseMax(vecl).cwiseMin(vecu); 288 | subvec_assign(drt, fv_set, vecy); 289 | dg = drt.dot(g); 290 | if (dg <= -std::numeric_limits::epsilon()) 291 | return; 292 | 293 | // If still not, fall back to the unconstrained solution 294 | subvec_assign(drt, fv_set, yfallback); 295 | return; 296 | } 297 | 298 | // std::cout << "** Minimization finished in " << k + 1 << " iteration(s) **\n\n"; 299 | // std::cout << "========================= Leaving subspace minimization =========================\n\n"; 300 | 301 | subvec_assign(drt, fv_set, vecy); 302 | } 303 | }; 304 | 305 | } // namespace LBFGSpp 306 | 307 | /// \endcond 308 | 309 | #endif // LBFGSPP_SUBSPACE_MIN_H 310 | -------------------------------------------------------------------------------- /inst/include/optimization/wrapper.h: -------------------------------------------------------------------------------- 1 | // Copyright (C) 2016 Yixuan Qiu 2 | // 3 | // This Source Code Form is subject to the terms of the Mozilla 4 | // Public License v. 2.0. If a copy of the MPL was not distributed 5 | // with this file, You can obtain one at http://mozilla.org/MPL/2.0/. 6 | 7 | #ifndef OPTIMIZATION_WRAPPER_H 8 | #define OPTIMIZATION_WRAPPER_H 9 | 10 | #include 11 | #include "LBFGS.h" 12 | 13 | namespace Numer 14 | { 15 | 16 | 17 | class LBFGSFun 18 | { 19 | private: 20 | MFuncGrad& f; 21 | public: 22 | LBFGSFun(MFuncGrad& f_) : f(f_) {} 23 | inline double operator()(const Eigen::VectorXd& x, Eigen::VectorXd& grad) 24 | { 25 | return f.f_grad(x, grad); 26 | } 27 | }; 28 | 29 | 30 | // [RcppNumerical API] Optimization using L-BFGS algorithm 31 | inline int optim_lbfgs( 32 | MFuncGrad& f, Refvec x, double& fx_opt, 33 | const int maxit = 300, const double& eps_f = 1e-6, const double& eps_g = 1e-5 34 | ) 35 | { 36 | // Create functor 37 | LBFGSFun fun(f); 38 | 39 | // Prepare parameters 40 | LBFGSpp::LBFGSParam param; 41 | param.epsilon = eps_g; 42 | param.epsilon_rel = eps_g; 43 | param.past = 1; 44 | param.delta = eps_f; 45 | param.max_iterations = maxit; 46 | param.max_linesearch = 100; 47 | param.linesearch = LBFGSpp::LBFGS_LINESEARCH_BACKTRACKING_STRONG_WOLFE; 48 | 49 | // Solver 50 | LBFGSpp::LBFGSSolver solver(param); 51 | 52 | int status = 0; 53 | Eigen::VectorXd xx(x.size()); 54 | xx.noalias() = x; 55 | 56 | try { 57 | solver.minimize(fun, xx, fx_opt); 58 | } catch(const std::exception& e) { 59 | status = -1; 60 | Rcpp::warning(e.what()); 61 | } 62 | 63 | x.noalias() = xx; 64 | 65 | return status; 66 | } 67 | 68 | 69 | } // namespace Numer 70 | 71 | 72 | #endif // OPTIMIZATION_WRAPPER_H 73 | -------------------------------------------------------------------------------- /man/fastLR.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fastLR.R 3 | \name{fastLR} 4 | \alias{fastLR} 5 | \title{Fast Logistic Regression Fitting Using L-BFGS Algorithm} 6 | \usage{ 7 | fastLR( 8 | x, 9 | y, 10 | start = rep(0, ncol(x)), 11 | eps_f = 1e-08, 12 | eps_g = 1e-05, 13 | maxit = 300 14 | ) 15 | } 16 | \arguments{ 17 | \item{x}{The model matrix.} 18 | 19 | \item{y}{The response vector.} 20 | 21 | \item{start}{The initial guess of the coefficient vector.} 22 | 23 | \item{eps_f}{Iteration stops if \eqn{|f-f'|/|f|<\epsilon_f}{|f-f'|/|f| do not edit by hand 2 | // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | #include "../inst/include/RcppNumerical.h" 5 | #include 6 | #include 7 | 8 | using namespace Rcpp; 9 | 10 | #ifdef RCPP_USE_GLOBAL_ROSTREAM 11 | Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); 12 | Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); 13 | #endif 14 | 15 | // fastLR_ 16 | Rcpp::List fastLR_(Rcpp::NumericMatrix x, Rcpp::NumericVector y, Rcpp::NumericVector start, double eps_f, double eps_g, int maxit); 17 | RcppExport SEXP _RcppNumerical_fastLR_(SEXP xSEXP, SEXP ySEXP, SEXP startSEXP, SEXP eps_fSEXP, SEXP eps_gSEXP, SEXP maxitSEXP) { 18 | BEGIN_RCPP 19 | Rcpp::RObject rcpp_result_gen; 20 | Rcpp::RNGScope rcpp_rngScope_gen; 21 | Rcpp::traits::input_parameter< Rcpp::NumericMatrix >::type x(xSEXP); 22 | Rcpp::traits::input_parameter< Rcpp::NumericVector >::type y(ySEXP); 23 | Rcpp::traits::input_parameter< Rcpp::NumericVector >::type start(startSEXP); 24 | Rcpp::traits::input_parameter< double >::type eps_f(eps_fSEXP); 25 | Rcpp::traits::input_parameter< double >::type eps_g(eps_gSEXP); 26 | Rcpp::traits::input_parameter< int >::type maxit(maxitSEXP); 27 | rcpp_result_gen = Rcpp::wrap(fastLR_(x, y, start, eps_f, eps_g, maxit)); 28 | return rcpp_result_gen; 29 | END_RCPP 30 | } 31 | -------------------------------------------------------------------------------- /src/cuhre/CSample.c: -------------------------------------------------------------------------------- 1 | /* 2 | CSample.c 3 | the serial sampling routine 4 | for the C versions of the Cuba routines 5 | by Thomas Hahn 6 | last modified 9 Oct 14 th 7 | */ 8 | 9 | 10 | coreinit cubafun_; 11 | extern int cubaverb_; 12 | extern corespec cubaworkers_; 13 | 14 | 15 | static inline number SampleRaw(This *t, number n, creal *x, real *f, 16 | cint core VES_ONLY(, creal *w, ccount iter)) 17 | { 18 | number nvec; 19 | for( nvec = t->nvec; n > 0; n -= nvec ) { 20 | nvec = IMin(n, nvec); 21 | if( t->integrand(&t->ndim, x, &t->ncomp, f, t->userdata, &nvec, &core 22 | VES_ONLY(, w, &iter) 23 | DIV_ONLY(, &t->phase)) == ABORT ) return -1; 24 | VES_ONLY(w += nvec;) 25 | x += nvec*t->ndim; 26 | f += nvec*t->ncomp; 27 | } 28 | return 0; 29 | } 30 | 31 | /*********************************************************************/ 32 | 33 | static inline void DoSampleSerial(This *t, cnumber n, creal *x, real *f 34 | VES_ONLY(, creal *w, ccount iter)) 35 | { 36 | MasterInit(); 37 | t->neval += n; 38 | if( SampleRaw(t, n, x, f, -1 VES_ONLY(, w, iter)) ) 39 | longjmp(t->abort, -99); 40 | } 41 | 42 | /*********************************************************************/ 43 | 44 | #ifdef HAVE_FORK 45 | 46 | static void DoSample(This *t, number n, creal *x, real *f 47 | VES_ONLY(, creal *w, ccount iter)); 48 | DIV_ONLY(static int Explore(This *t, cint iregion);) 49 | 50 | #else 51 | 52 | #define DoSample DoSampleSerial 53 | #define Explore ExploreSerial 54 | #define ForkCores(t) 55 | 56 | static inline void WaitCores(This *t, Spin **pspin) 57 | { 58 | if( Invalid(pspin) ) MasterExit(); 59 | } 60 | 61 | #define WaitCores(t, pspin) 62 | 63 | #endif 64 | 65 | #ifdef DIVONNE 66 | static inline count SampleExtra(This *t, cBounds *b) 67 | { 68 | number n = t->nextra; 69 | t->peakfinder(&t->ndim, b, &n, t->xextra, t->userdata); 70 | DoSample(t, n, t->xextra, t->fextra); 71 | return n; 72 | } 73 | #endif 74 | 75 | #include "common.c" 76 | 77 | #ifdef HAVE_FORK 78 | #include "Parallel.c" 79 | #endif 80 | 81 | #include "Integrate.c" 82 | 83 | -------------------------------------------------------------------------------- /src/cuhre/ChiSquare.c: -------------------------------------------------------------------------------- 1 | /* 2 | ChiSquare.c 3 | the chi-square cdf 4 | after W.J. Kennedy and J.E. Gentle, 5 | Statistical computing, p. 116 6 | last modified 12 Mar 15 th 7 | */ 8 | 9 | #ifdef HAVE_ERF 10 | #define Erf erf 11 | #else 12 | #include "Erf.c" 13 | #endif 14 | 15 | static inline real Normal(creal x) 16 | { 17 | return .5*Erf(x/1.414213562373095048801689) + .5; 18 | } 19 | 20 | /*********************************************************************/ 21 | 22 | static real ChiSquare(creal x, cint df) 23 | { 24 | real y; 25 | 26 | if( df <= 0 ) return -999; 27 | 28 | if( x <= 0 ) return 0; 29 | if( x > 1000*df ) return 1; 30 | 31 | if( df > 1000 ) { 32 | if( x < 2 ) return 0; 33 | y = 2./(9*df); 34 | y = (powx(x/df, 1/3.) - (1 - y))/sqrtx(y); 35 | if( y > 5 ) return 1; 36 | if( y < -18.8055 ) return 0; 37 | return Normal(y); 38 | } 39 | 40 | y = .5*x; 41 | 42 | if( df & 1 ) { 43 | creal sqrty = sqrtx(y); 44 | real h = Erf(sqrty); 45 | count i; 46 | 47 | if( df == 1 ) return h; 48 | 49 | y = sqrty*expx(-y)/.8862269254527579825931; 50 | for( i = 3; i < df; i += 2 ) { 51 | h -= y; 52 | y *= x/i; 53 | } 54 | y = h - y; 55 | } 56 | else { 57 | real term = expx(-y), sum = term; 58 | count i; 59 | 60 | for( i = 1; i < df/2; ++i ) 61 | sum += term *= y/i; 62 | y = 1 - sum; 63 | } 64 | 65 | return Max(0., y); 66 | } 67 | 68 | -------------------------------------------------------------------------------- /src/cuhre/Erf.c: -------------------------------------------------------------------------------- 1 | /* 2 | Erf.c 3 | Gaussian error function 4 | = 2/Sqrt[Pi] Integrate[Exp[-t^2], {t, 0, x}] 5 | Code from Takuya Ooura's gamerf2a.f 6 | http://www.kurims.kyoto-u.ac.jp/~ooura/gamerf.html 7 | last modified 12 Mar 15 th 8 | */ 9 | 10 | 11 | static real Erfc(creal x) 12 | { 13 | static creal c[] = { 14 | 2.96316885199227378e-01, 6.12158644495538758e-02, 15 | 1.81581125134637070e-01, 5.50942780056002085e-01, 16 | 6.81866451424939493e-02, 1.53039662058770397e+00, 17 | 1.56907543161966709e-02, 2.99957952311300634e+00, 18 | 2.21290116681517573e-03, 4.95867777128246701e+00, 19 | 1.91395813098742864e-04, 7.41471251099335407e+00, 20 | 9.71013284010551623e-06, 1.04765104356545238e+01, 21 | 1.66642447174307753e-07, 1.48455557345597957e+01, 22 | 6.10399733098688199e+00, 1.26974899965115684e+01 }; 23 | real y = x*x; 24 | y = expx(-y)*x*( 25 | c[0]/(y + c[1]) + c[2]/(y + c[3]) + 26 | c[4]/(y + c[5]) + c[6]/(y + c[7]) + 27 | c[8]/(y + c[9]) + c[10]/(y + c[11]) + 28 | c[12]/(y + c[13]) + c[14]/(y + c[15]) ); 29 | if( x < c[16] ) y += 2/(expx(c[17]*x) + 1); 30 | return y; 31 | } 32 | 33 | 34 | static real Erf(creal x) 35 | { 36 | static creal c[] = { 37 | 1.12837916709551257e+00, 38 | -3.76126389031833602e-01, 39 | 1.12837916706621301e-01, 40 | -2.68661698447642378e-02, 41 | 5.22387877685618101e-03, 42 | -8.49202435186918470e-04 }; 43 | real y = fabsx(x); 44 | if( y > .125 ) { 45 | y = 1 - Erfc(y); 46 | return (x > 0) ? y : -y; 47 | } 48 | y *= y; 49 | return x*(c[0] + y*(c[1] + y*(c[2] + 50 | y*(c[3] + y*(c[4] + y*c[5]))))); 51 | } 52 | -------------------------------------------------------------------------------- /src/cuhre/Integrate.c: -------------------------------------------------------------------------------- 1 | /* 2 | Integrate.c 3 | integrate over the unit hypercube 4 | this file is part of Cuhre 5 | checkpointing by B. Chokoufe 6 | last modified 14 Mar 15 th 7 | */ 8 | 9 | 10 | #define POOLSIZE 1024 11 | 12 | typedef struct pool { 13 | struct pool *next; 14 | #if REALSIZE > 8 15 | void *dummy; /* for alignment */ 16 | #endif 17 | char region[]; 18 | } Pool; 19 | 20 | typedef struct { 21 | signature_t signature; 22 | count nregions, ncur; 23 | number neval; 24 | Totals totals[]; 25 | } State; 26 | 27 | static int Integrate(This *t, real *integral, real *err, real *prob) 28 | { 29 | StateDecl; 30 | csize_t statesize = sizeof(State) + NCOMP*sizeof(Totals); 31 | Sized(State, state, statesize); 32 | csize_t regionsize = RegionSize; 33 | csize_t poolsize = sizeof(Pool) + POOLSIZE*regionsize; 34 | Vector(Result, result, NCOMP); 35 | Vector(char, out, 128*NCOMP + 256); 36 | 37 | Totals *tot, *Tot = state->totals + t->ncomp; 38 | Result *res, *resL, *resR; 39 | Bounds *b, *B; 40 | Pool *cur = NULL, *pool; 41 | Region *region; 42 | count comp, ipool, npool; 43 | int fail; 44 | 45 | /* VERBOSE has been turned off in 46 | inst/include/integration/wrapper.h:integrate() 47 | with flags = 4, and CRAN does not allow using sprintf(), 48 | so we simply comment out the printing code here. -- Yixuan */ 49 | /* if( VERBOSE > 1 ) { 50 | sprintf(out, "Cuhre input parameters:\n" 51 | " ndim " COUNT "\n ncomp " COUNT "\n" 52 | ML_NOT(" nvec " NUMBER "\n") 53 | " epsrel " REAL "\n epsabs " REAL "\n" 54 | " flags %d\n mineval " NUMBER "\n maxeval " NUMBER "\n" 55 | " key " COUNT "\n" 56 | " statefile \"%s\"", 57 | t->ndim, t->ncomp, 58 | ML_NOT(t->nvec,) 59 | SHOW(t->epsrel), SHOW(t->epsabs), 60 | t->flags, t->mineval, t->maxeval, 61 | t->key, 62 | t->statefile); 63 | Print(out); 64 | } */ 65 | 66 | if( BadComponent(t) ) return -2; 67 | if( BadDimension(t) ) return -1; 68 | 69 | t->epsabs = Max(t->epsabs, NOTZERO); 70 | 71 | RuleAlloc(t); 72 | t->mineval = IMax(t->mineval, t->rule.n + 1); 73 | FrameAlloc(t, Master); 74 | ForkCores(t); 75 | 76 | if( (fail = setjmp(t->abort)) ) goto abort; 77 | 78 | /* Remove state related code. -- Yixuan */ 79 | /* 80 | StateSetup(t); 81 | 82 | if( StateReadTest(t) ) { 83 | StateReadOpen(t, fd) { 84 | Pool *prev = NULL; 85 | int size; 86 | if( read(fd, state, statesize) != statesize || 87 | state->signature != StateSignature(t, 4) ) break; 88 | t->neval = state->neval; 89 | t->nregions = state->nregions; 90 | do { 91 | MemAlloc(cur, poolsize); 92 | cur->next = prev; 93 | prev = cur; 94 | size = read(fd, cur, poolsize); 95 | } while( size == poolsize ); 96 | if( size != state->ncur*regionsize ) break; 97 | } StateReadClose(t, fd); 98 | } 99 | */ 100 | 101 | if( ini ) { 102 | MemAlloc(cur, poolsize); 103 | cur->next = NULL; 104 | state->ncur = t->nregions = 1; 105 | 106 | region = (Region *)cur->region; 107 | region->div = 0; 108 | for( B = (b = region->bounds) + t->ndim; b < B; ++b ) { 109 | b->lower = 0; 110 | b->upper = 1; 111 | } 112 | 113 | t->neval = 0; 114 | Sample(t, region); 115 | 116 | for( res = RegionResult(region), tot = state->totals; 117 | tot < Tot; ++res, ++tot ) { 118 | tot->avg = tot->lastavg = tot->guess = res->avg; 119 | tot->err = tot->lasterr = res->err; 120 | tot->weightsum = 1/Max(Sq(res->err), NOTZERO); 121 | tot->avgsum = tot->weightsum*res->avg; 122 | tot->chisq = tot->chisqsum = tot->chisum = 0; 123 | } 124 | } 125 | 126 | /* main iteration loop */ 127 | for( ; ; ) { 128 | count maxcomp, bisectdim; 129 | real maxratio, maxerr; 130 | Region *regionL, *regionR; 131 | Bounds *bL, *bR; 132 | 133 | /* VERBOSE has been turned off in 134 | inst/include/integration/wrapper.h:integrate() 135 | with flags = 4, and CRAN does not allow using sprintf(), 136 | so we simply comment out the printing code here. --Yixuan */ 137 | /* if( VERBOSE ) { 138 | char *oe = out + sprintf(out, "\n" 139 | "Iteration " COUNT ": " NUMBER " integrand evaluations so far", 140 | t->nregions, t->neval); 141 | for( tot = state->totals, comp = 0; tot < Tot; ++tot ) 142 | oe += sprintf(oe, "\n[" COUNT "] " 143 | REAL " +- " REAL " \tchisq " REAL " (" COUNT " df)", 144 | ++comp, SHOW(tot->avg), SHOW(tot->err), 145 | SHOW(tot->chisq), t->nregions - 1); 146 | Print(out); 147 | } */ 148 | 149 | maxratio = -INFTY; 150 | maxcomp = 0; 151 | for( tot = state->totals, comp = 0; tot < Tot; ++tot, ++comp ) { 152 | creal ratio = tot->err/MaxErr(tot->avg); 153 | if( ratio > maxratio ) { 154 | maxratio = ratio; 155 | maxcomp = comp; 156 | } 157 | } 158 | 159 | if( maxratio <= 1 && t->neval >= t->mineval ) break; 160 | 161 | if( t->neval >= t->maxeval ) { 162 | fail = 1; 163 | break; 164 | } 165 | 166 | maxerr = -INFTY; 167 | regionL = (Region *)cur->region; 168 | npool = state->ncur; 169 | for( pool = cur; pool; npool = POOLSIZE, pool = pool->next ) 170 | for( ipool = 0; ipool < npool; ++ipool ) { 171 | Region *region = RegionPtr(pool, ipool); 172 | creal err = RegionResult(region)[maxcomp].err; 173 | if( err > maxerr ) { 174 | maxerr = err; 175 | regionL = region; 176 | } 177 | } 178 | 179 | if( state->ncur == POOLSIZE ) { 180 | Pool *prev = cur; 181 | MemAlloc(cur, poolsize); 182 | cur->next = prev; 183 | state->ncur = 0; 184 | } 185 | regionR = RegionPtr(cur, state->ncur++); 186 | 187 | regionR->div = ++regionL->div; 188 | FCopy(result, RegionResult(regionL)); 189 | XCopy(regionR->bounds, regionL->bounds); 190 | 191 | bisectdim = result[maxcomp].bisectdim; 192 | bL = ®ionL->bounds[bisectdim]; 193 | bR = ®ionR->bounds[bisectdim]; 194 | bL->upper = bR->lower = .5*(bL->upper + bL->lower); 195 | 196 | Sample(t, regionL); 197 | Sample(t, regionR); 198 | 199 | for( res = result, 200 | resL = RegionResult(regionL), 201 | resR = RegionResult(regionR), 202 | tot = state->totals; 203 | tot < Tot; ++res, ++resL, ++resR, ++tot ) { 204 | real diff, err, w, avg, sigsq; 205 | 206 | tot->lastavg += diff = resL->avg + resR->avg - res->avg; 207 | 208 | diff = fabsx(.25*diff); 209 | err = resL->err + resR->err; 210 | if( err > 0 ) { 211 | creal c = 1 + 2*diff/err; 212 | resL->err *= c; 213 | resR->err *= c; 214 | } 215 | resL->err += diff; 216 | resR->err += diff; 217 | tot->lasterr += resL->err + resR->err - res->err; 218 | 219 | tot->weightsum += w = 1/Max(Sq(tot->lasterr), NOTZERO); 220 | sigsq = 1/tot->weightsum; 221 | tot->avgsum += w*tot->lastavg; 222 | avg = sigsq*tot->avgsum; 223 | tot->chisum += w *= tot->lastavg - tot->guess; 224 | tot->chisqsum += w*tot->lastavg; 225 | tot->chisq = tot->chisqsum - avg*tot->chisum; 226 | 227 | if( LAST ) { 228 | tot->avg = tot->lastavg; 229 | tot->err = tot->lasterr; 230 | } 231 | else { 232 | tot->avg = avg; 233 | tot->err = sqrtx(sigsq); 234 | } 235 | } 236 | ++t->nregions; 237 | 238 | /* Remove state related code. -- Yixuan */ 239 | /* 240 | if( StateWriteTest(t) ) { 241 | StateWriteOpen(t, fd) { 242 | Pool *prev = cur; 243 | state->signature = StateSignature(t, 4); 244 | state->nregions = t->nregions; 245 | state->neval = t->neval; 246 | StateWrite(fd, state, statesize); 247 | while( (prev = prev->next) ) StateWrite(fd, prev, poolsize); 248 | StateWrite(fd, cur, state->ncur*regionsize); 249 | } StateWriteClose(t, fd); 250 | } 251 | */ 252 | } 253 | 254 | for( tot = state->totals, comp = 0; tot < Tot; ++tot, ++comp ) { 255 | integral[comp] = tot->avg; 256 | err[comp] = tot->err; 257 | prob[comp] = ChiSquare(tot->chisq, t->nregions - 1); 258 | } 259 | 260 | #ifdef MLVERSION 261 | if( REGIONS ) { 262 | MLPutFunction(stdlink, "List", 2); 263 | MLPutFunction(stdlink, "List", t->nregions); 264 | 265 | npool = state->ncur; 266 | for( pool = cur; pool; npool = POOLSIZE, pool = pool->next ) 267 | for( ipool = 0; ipool < npool; ++ipool ) { 268 | Region const *region = RegionPtr(pool, ipool); 269 | Result *Res; 270 | 271 | MLPutFunction(stdlink, "Cuba`Cuhre`region", 2); 272 | MLPutRealxList(stdlink, (real *)region->bounds, 2*t->ndim); 273 | 274 | MLPutFunction(stdlink, "List", t->ncomp); 275 | for( Res = (res = RegionResult(region)) + t->ncomp; 276 | res < Res; ++res ) { 277 | real r[] = {res->avg, res->err}; 278 | MLPutRealxList(stdlink, r, Elements(r)); 279 | } 280 | } 281 | } 282 | #endif 283 | 284 | abort: 285 | while( (pool = cur) ) { 286 | cur = cur->next; 287 | free(pool); 288 | } 289 | FrameFree(t, Master); 290 | RuleFree(t); 291 | 292 | /* Remove state related code. -- Yixuan */ 293 | /* StateRemove(t); */ 294 | 295 | MemFree(out); 296 | MemFree(result); 297 | MemFree(state); 298 | 299 | return fail; 300 | } 301 | -------------------------------------------------------------------------------- /src/cuhre/common.c: -------------------------------------------------------------------------------- 1 | /* 2 | common.c 3 | includes most of the modules 4 | this file is part of Cuhre 5 | last modified 2 Aug 13 11 th 6 | */ 7 | 8 | 9 | #include "ChiSquare.c" 10 | #include "Rule.c" 11 | 12 | /* Use int for bool. -- Yixuan */ 13 | /* static inline bool BadDimension(cThis *t) */ 14 | static inline int BadDimension(cThis *t) 15 | { 16 | /* if( t->ndim > MAXDIM ) return true; */ 17 | if( t->ndim > MAXDIM ) return 1; 18 | return t->ndim < 2; 19 | } 20 | 21 | /* Use int for bool. -- Yixuan */ 22 | /* static inline bool BadComponent(cThis *t) */ 23 | static inline int BadComponent(cThis *t) 24 | { 25 | /* if( t->ncomp > MAXCOMP ) return true; */ 26 | if( t->ncomp > MAXCOMP ) return 1; 27 | return t->ncomp < 1; 28 | } 29 | 30 | -------------------------------------------------------------------------------- /src/cuhre/decl.h: -------------------------------------------------------------------------------- 1 | /* 2 | decl.h 3 | Type declarations 4 | this file is part of Cuhre 5 | last modified 21 Jul 14 th 6 | */ 7 | 8 | 9 | #include "stddecl.h" 10 | 11 | typedef struct { 12 | real avg, err; 13 | count bisectdim; 14 | } Result; 15 | 16 | typedef const Result cResult; 17 | 18 | typedef struct { 19 | real avg, err, lastavg, lasterr; 20 | real weightsum, avgsum; 21 | real guess, chisum, chisqsum, chisq; 22 | } Totals; 23 | 24 | typedef const Totals cTotals; 25 | 26 | typedef struct { 27 | real lower, upper; 28 | } Bounds; 29 | 30 | typedef const Bounds cBounds; 31 | 32 | enum { nrules = 5 }; 33 | 34 | typedef struct { 35 | count n; 36 | real weight[nrules], scale[nrules], norm[nrules]; 37 | real gen[]; 38 | } Set; 39 | 40 | #define SetSize (sizeof(Set) + t->ndim*sizeof(real)) 41 | 42 | typedef struct { 43 | Set *first, *last; 44 | real errcoeff[3]; 45 | count n; 46 | } Rule; 47 | 48 | typedef const Rule cRule; 49 | 50 | typedef int (*Integrand)(ccount *, creal *, ccount *, real *, 51 | void *, cnumber *, cint *); 52 | 53 | typedef struct _this { 54 | count ndim, ncomp; 55 | #ifndef MLVERSION 56 | Integrand integrand; 57 | void *userdata; 58 | number nvec; 59 | #ifdef HAVE_FORK 60 | SHM_ONLY(int shmid;) 61 | Spin *spin; 62 | #endif 63 | #endif 64 | real *frame; 65 | real epsrel, epsabs; 66 | int flags; 67 | number mineval, maxeval; 68 | count key, nregions; 69 | cchar *statefile; 70 | number neval; 71 | Rule rule; 72 | jmp_buf abort; 73 | } This; 74 | 75 | #define nframe rule.n 76 | 77 | typedef const This cThis; 78 | 79 | typedef struct region { 80 | count div; 81 | Bounds bounds[]; 82 | } Region; 83 | 84 | #define RegionSize (sizeof(Region) + t->ndim*sizeof(Bounds) + t->ncomp*sizeof(Result)) 85 | 86 | #define RegionResult(r) ((Result *)(r->bounds + t->ndim)) 87 | 88 | #define RegionPtr(p, n) ((Region *)((char *)p->region + (n)*regionsize)) 89 | 90 | -------------------------------------------------------------------------------- /src/cuhre/stddecl.h: -------------------------------------------------------------------------------- 1 | /* 2 | stddecl.h 3 | declarations common to all Cuba routines 4 | last modified 23 Apr 15 th 5 | */ 6 | 7 | 8 | #ifndef _stddecl_h_ 9 | #define _stddecl_h_ 10 | 11 | #ifdef HAVE_CONFIG_H 12 | #include "config.h" 13 | #endif 14 | 15 | /* These are deprecated. -- Yixuan */ 16 | /* 17 | #define _BSD_SOURCE 18 | #define _SVID_SOURCE 19 | */ 20 | 21 | #include 22 | #include 23 | #include 24 | #include 25 | #include 26 | #include 27 | /* 28 | #include 29 | #include 30 | #include 31 | */ 32 | #include 33 | /* 34 | #include 35 | #include 36 | */ 37 | #ifdef HAVE_FORK 38 | #include 39 | #include 40 | #include 41 | #ifdef HAVE_SHMGET 42 | #include 43 | #include 44 | #endif 45 | #endif 46 | 47 | #include /* For error handling */ 48 | 49 | /* Replace alloca by malloc. -- Yixuan */ 50 | /* 51 | #ifdef HAVE_ALLOCA_H 52 | #include 53 | #elif defined __GNUC__ 54 | #define alloca __builtin_alloca 55 | #elif defined _AIX 56 | #define alloca __alloca 57 | #elif defined _MSC_VER 58 | #include 59 | #define alloca _alloca 60 | #else 61 | #include 62 | #ifdef __cplusplus 63 | extern "C" 64 | #endif 65 | void *alloca (size_t); 66 | #endif 67 | */ 68 | 69 | #ifndef NDIM 70 | #define NDIM t->ndim 71 | #define MAXDIM 1024 72 | #else 73 | #define MAXDIM NDIM 74 | #endif 75 | 76 | #ifndef NCOMP 77 | #define NCOMP t->ncomp 78 | #define MAXCOMP 1024 79 | #else 80 | #define MAXCOMP NCOMP 81 | #endif 82 | 83 | #if defined(VEGAS) || defined(SUAVE) 84 | #define VES_ONLY(...) __VA_ARGS__ 85 | #define NW 1 86 | #else 87 | #define VES_ONLY(...) 88 | #define NW 0 89 | #endif 90 | 91 | #ifdef DIVONNE 92 | #define DIV_ONLY(...) __VA_ARGS__ 93 | #else 94 | #define DIV_ONLY(...) 95 | #endif 96 | 97 | #define SAMPLESIZE (NW + t->ndim + t->ncomp)*sizeof(real) 98 | 99 | 100 | enum { uninitialized = 0x61627563 }; 101 | 102 | #define EnvInit(var, name, default) \ 103 | if( var == uninitialized ) { \ 104 | cchar *env = getenv(name); \ 105 | if( env == NULL ) var = default; \ 106 | else { \ 107 | var = atoi(env); \ 108 | if( cubaverb_ ) { \ 109 | char out[64]; \ 110 | sprintf(out, "env " name " = %d", (int)var); \ 111 | Print(out); \ 112 | } \ 113 | } \ 114 | } 115 | 116 | /* No verbose. -- Yixuan */ 117 | /* #define VerboseInit() EnvInit(cubaverb_, "CUBAVERBOSE", 0) */ 118 | #define VerboseInit() 119 | #define MaxVerbose(flags) (flags + IDim(IMin(cubaverb_, 3) - ((flags) & 3))) 120 | 121 | #define VERBOSE (t->flags & 3) 122 | #define LAST (t->flags & 4) 123 | #define SHARPEDGES (t->flags & 8) 124 | #define KEEPFILE (t->flags & 16) 125 | #define ZAPSTATE (t->flags & 32) 126 | #define REGIONS (t->flags & 128) 127 | #define RNG (t->flags >> 8) 128 | 129 | #define INFTY DBL_MAX 130 | 131 | /* Do not use non-standard way. -- Yixuan */ 132 | /* 133 | #if __STDC_VERSION__ >= 199901L 134 | #define POW2(n) 0x1p-##n 135 | #else 136 | #define POW2(n) ldexp(1., -n) 137 | #endif 138 | */ 139 | #define POW2(n) ldexp(1., -n) 140 | 141 | #define NOTZERO POW2(104) 142 | 143 | #define ABORT -999 144 | 145 | #define Elements(x) (sizeof(x)/sizeof(*x)) 146 | 147 | #define Copy(d, s, n) memcpy(d, s, (n)*sizeof(*(d))) 148 | 149 | #define Move(d, s, n) memmove(d, s, (n)*sizeof(*(d))) 150 | 151 | #define XCopy(d, s) Copy(d, s, t->ndim) 152 | 153 | #define FCopy(d, s) Copy(d, s, t->ncomp) 154 | 155 | #define Clear(d, n) memset(d, 0, (n)*sizeof(*(d))) 156 | 157 | #define XClear(d) Clear(d, t->ndim) 158 | 159 | #define FClear(d) Clear(d, t->ncomp) 160 | 161 | #define Zap(d) memset(d, 0, sizeof(d)) 162 | 163 | #define MaxErr(avg) Max(t->epsrel*fabsx(avg), t->epsabs) 164 | 165 | #ifdef __cplusplus 166 | #define mallocset(p, n) (*(void **)&p = malloc(n)) 167 | #define reallocset(p, n) (*(void **)&p = realloc(p, n)) 168 | #else 169 | #define mallocset(p, n) (p = malloc(n)) 170 | #define reallocset(p, n) (p = realloc(p, n)) 171 | #endif 172 | 173 | /* Use R error handling. -- Yixuan */ 174 | /* 175 | #define Abort(s) abort1(s, __LINE__) 176 | #define abort1(s, line) abort2(s, line) 177 | #define abort2(s, line) { perror(s " " __FILE__ "(" #line ")"); exit(1); } 178 | */ 179 | #define Abort(s) { Rf_error("%s: %s(%d)", s, __FILE__, __LINE__); } 180 | 181 | #define Die(p) if( (p) == NULL ) Abort("malloc") 182 | 183 | #define MemAlloc(p, n) Die(mallocset(p, n)) 184 | #define ReAlloc(p, n) Die(reallocset(p, n)) 185 | #define Alloc(p, n) MemAlloc(p, (n)*sizeof(*p)) 186 | 187 | /* Replace alloca by malloc. -- Yixuan */ 188 | /* 189 | #if __STDC_VERSION__ >= 199901L 190 | #define Sized(type, var, size) char var##_[size]; type *var = (type *)var##_ 191 | #define Vector(type, var, n1) type var[n1] 192 | #define Array(type, var, n1, n2) type var[n1][n2] 193 | #else 194 | #define Sized(type, var, size) type *var = alloca(size) 195 | #define Vector(type, var, n1) type *var = alloca((n1)*sizeof(type)) 196 | #define Array(type, var, n1, n2) type (*var)[n2] = alloca((n1)*(n2)*sizeof(type)) 197 | #endif 198 | */ 199 | #define Sized(type, var, size) type *var = malloc(size) 200 | #define Vector(type, var, n1) type *var = malloc((n1)*sizeof(type)) 201 | #define Array(type, var, n1, n2) type (*var)[n2] = malloc((n1)*(n2)*sizeof(type)) 202 | #define MemFree(var) free(var) 203 | 204 | #define FORK_ONLY(...) 205 | #define SHM_ONLY(...) 206 | #define ShmAlloc(...) 207 | #define ShmFree(...) 208 | 209 | #ifdef MLVERSION 210 | #define ML_ONLY(...) __VA_ARGS__ 211 | #define ML_NOT(...) 212 | #else 213 | #define ML_ONLY(...) 214 | #define ML_NOT(...) __VA_ARGS__ 215 | 216 | #define CORE_MASTER (int []){32768} 217 | /* Use int for bool. -- Yixuan */ 218 | /* 219 | #define MasterInit() do if( !cubafun_.init ) { \ 220 | cubafun_.init = true; \ 221 | if( cubafun_.initfun ) cubafun_.initfun(cubafun_.initarg, CORE_MASTER); \ 222 | } while( 0 ) 223 | #define MasterExit() do if( cubafun_.init ) { \ 224 | cubafun_.init = false; \ 225 | if( cubafun_.exitfun ) cubafun_.exitfun(cubafun_.exitarg, CORE_MASTER); \ 226 | } while( 0 ) 227 | */ 228 | #define MasterInit() do if( !cubafun_.init ) { \ 229 | cubafun_.init = 1; \ 230 | if( cubafun_.initfun ) cubafun_.initfun(cubafun_.initarg, CORE_MASTER); \ 231 | } while( 0 ) 232 | #define MasterExit() do if( cubafun_.init ) { \ 233 | cubafun_.init = 0; \ 234 | if( cubafun_.exitfun ) cubafun_.exitfun(cubafun_.exitarg, CORE_MASTER); \ 235 | } while( 0 ) 236 | #define Invalid(s) ((s) == NULL || *(int *)(s) == -1) 237 | 238 | #ifdef HAVE_FORK 239 | #undef FORK_ONLY 240 | #define FORK_ONLY(...) __VA_ARGS__ 241 | 242 | #ifdef HAVE_SHMGET 243 | #undef SHM_ONLY 244 | #define SHM_ONLY(...) __VA_ARGS__ 245 | 246 | #define MasterAlloc(t) \ 247 | t->shmid = shmget(IPC_PRIVATE, t->nframe*SAMPLESIZE, IPC_CREAT | 0600) 248 | #define MasterFree(t) shmctl(t->shmid, IPC_RMID, NULL) 249 | #define WorkerAlloc(t) 250 | #define WorkerFree(r) 251 | 252 | #undef ShmAlloc 253 | #define ShmAlloc(t, who) \ 254 | who##Alloc(t); \ 255 | if( t->shmid != -1 ) { \ 256 | t->frame = shmat(t->shmid, NULL, 0); \ 257 | if( t->frame == (void *)-1 ) Abort("shmat"); \ 258 | } 259 | 260 | #undef ShmFree 261 | #define ShmFree(t, who) \ 262 | if( t->shmid != -1 ) { \ 263 | shmdt(t->frame); \ 264 | who##Free(t); \ 265 | } 266 | 267 | #endif 268 | #endif 269 | #endif 270 | 271 | #define FrameAlloc(t, who) \ 272 | SHM_ONLY(ShmAlloc(t, who) else) \ 273 | MemAlloc(t->frame, t->nframe*SAMPLESIZE); 274 | 275 | #define FrameFree(t, who) \ 276 | DIV_ONLY(if( t->nframe )) { \ 277 | SHM_ONLY(ShmFree(t, who) else) \ 278 | free(t->frame); \ 279 | } 280 | 281 | 282 | /* Remove state related code. -- Yixuan */ 283 | /* 284 | #define StateDecl \ 285 | char *statefile_tmp = NULL, *statefile_XXXXXX = NULL; \ 286 | int statemsg = VERBOSE; \ 287 | ssize_t ini = 1; \ 288 | struct stat st 289 | */ 290 | #define StateDecl \ 291 | int ini = 1; 292 | 293 | /* Remove state related code. -- Yixuan */ 294 | /* 295 | #define StateSetup(t) if( (t)->statefile ) { \ 296 | if( *(t)->statefile == 0 ) (t)->statefile = NULL; \ 297 | else { \ 298 | ccount len = strlen((t)->statefile); \ 299 | statefile_tmp = alloca(len + 8); \ 300 | strcpy(statefile_tmp, (t)->statefile); \ 301 | statefile_XXXXXX = statefile_tmp + len; \ 302 | } \ 303 | } 304 | */ 305 | 306 | typedef long long int signature_t; 307 | 308 | /* Remove state related code. -- Yixuan */ 309 | /* 310 | enum { signature = 0x41425543 }; 311 | 312 | #define StateSignature(t, i) (signature + \ 313 | ((signature_t)(i) << 60) + \ 314 | ((signature_t)(t)->ncomp << 48) + \ 315 | ((signature_t)(t)->ndim << 32)) 316 | 317 | #define StateReadTest(t) (t)->statefile && \ 318 | stat((t)->statefile, &st) == 0 && (st.st_mode & 0400) 319 | 320 | #define StateReadOpen(t, fd) do { \ 321 | int fd; \ 322 | if( (fd = open((t)->statefile, O_RDONLY)) != -1 ) { \ 323 | do 324 | 325 | #define StateRead(fd, buf, size) \ 326 | ini += size - read(fd, buf, size) 327 | 328 | #define StateReadClose(t, fd) \ 329 | while( (--ini, 0) ); \ 330 | close(fd); \ 331 | } \ 332 | if( ini | statemsg ) { \ 333 | char s[512]; \ 334 | sprintf(s, ini ? \ 335 | "\nError restoring state from %s, starting from scratch." : \ 336 | "\nRestored state from %s.", (t)->statefile); \ 337 | Print(s); \ 338 | } \ 339 | } while( 0 ) 340 | 341 | 342 | #define StateWriteTest(t) ((t)->statefile) 343 | 344 | #define StateWriteOpen(t, fd) do { \ 345 | ssize_t fail = 1; \ 346 | int fd; \ 347 | strcpy(statefile_XXXXXX, "-XXXXXX"); \ 348 | if( (fd = mkstemp(statefile_tmp)) != -1 ) { \ 349 | do 350 | 351 | #define StateWrite(fd, buf, size) \ 352 | fail += size - write(fd, buf, size) 353 | 354 | #define StateWriteClose(t, fd) \ 355 | while( (--fail, 0) ); \ 356 | close(fd); \ 357 | if( fail == 0 ) fail |= rename(statefile_tmp, (t)->statefile); \ 358 | } \ 359 | if( fail | statemsg ) { \ 360 | char s[512]; \ 361 | sprintf(s, fail ? \ 362 | "\nError saving state to %s." : \ 363 | "\nSaved state to %s.", (t)->statefile); \ 364 | Print(s); \ 365 | statemsg &= fail & -2; \ 366 | } \ 367 | } while( 0 ) 368 | 369 | 370 | #define StateRemove(t) \ 371 | if( fail == 0 && (t)->statefile && KEEPFILE == 0 ) unlink((t)->statefile) 372 | */ 373 | 374 | 375 | #ifdef __cplusplus 376 | #define Extern extern "C" 377 | #else 378 | #define Extern extern 379 | /* This is dangerous. -- Yixuan */ 380 | /* typedef enum { false, true } bool; */ 381 | #endif 382 | 383 | typedef const char cchar; 384 | 385 | /* Use int for bool. -- Yixuan */ 386 | /* typedef const bool cbool; */ 387 | typedef const int cbool; 388 | 389 | typedef const int cint; 390 | 391 | typedef const long clong; 392 | 393 | typedef const size_t csize_t; 394 | 395 | #define COUNT "%d" 396 | typedef /*unsigned*/ int count; 397 | typedef const count ccount; 398 | 399 | #ifdef LONGLONGINT 400 | #define PREFIX(s) ll##s 401 | #define NUMBER "%lld" 402 | #define NUMBER7 "%7lld" 403 | #define NUMBER_MAX LLONG_MAX 404 | typedef long long int number; 405 | #else 406 | #define PREFIX(s) s 407 | #define NUMBER "%d" 408 | #define NUMBER7 "%7d" 409 | #define NUMBER_MAX INT_MAX 410 | typedef int number; 411 | #endif 412 | typedef const number cnumber; 413 | 414 | #define REAL "%g" 415 | #define REALF "%f" 416 | #define SHOW(r) (double)(r) 417 | /* floating-point numbers are printed with SHOW */ 418 | 419 | #if REALSIZE == 16 420 | #include 421 | typedef __float128 real; 422 | #define RC(x) x##Q 423 | #define sqrtx sqrtq 424 | #define expx expq 425 | #define powx powq 426 | #define erfx erfq 427 | #define fabsx fabsq 428 | #define ldexpx ldexpq 429 | #define REAL_MAX_EXP FLT128_MAX_EXP 430 | #define REAL_MAX FLT128_MAX 431 | #elif REALSIZE == 10 432 | typedef long double real; 433 | #define RC(x) x##L 434 | #define sqrtx sqrtl 435 | #define expx expl 436 | #define powx powl 437 | #define erfx erfl 438 | #define fabsx fabsl 439 | #define ldexpx ldexpl 440 | #define REAL_MAX_EXP LDBL_MAX_EXP 441 | #define REAL_MAX LDBL_MAX 442 | #define MLPutRealxList MLPutReal128List 443 | #define MLGetRealxList MLGetReal128List 444 | #define MLReleaseRealxList MLReleaseReal128List 445 | #else 446 | typedef double real; 447 | #define RC(x) x 448 | #define sqrtx sqrt 449 | #define expx exp 450 | #define powx pow 451 | #define erfx erf 452 | #define fabsx fabs 453 | #define ldexpx ldexp 454 | #define REAL_MAX_EXP DBL_MAX_EXP 455 | #define REAL_MAX DBL_MAX 456 | #define MLPutRealxList MLPutReal64List 457 | #define MLGetRealxList MLGetReal64List 458 | #define MLReleaseRealxList MLReleaseReal64List 459 | #endif 460 | 461 | typedef const real creal; 462 | 463 | typedef void (*subroutine)(void *, cint *); 464 | 465 | typedef struct { 466 | subroutine initfun; 467 | void *initarg; 468 | subroutine exitfun; 469 | void *exitarg; 470 | /* Use int for bool. -- Yixuan */ 471 | /* bool init; */ 472 | int init; 473 | } coreinit; 474 | 475 | typedef struct { 476 | int ncores, naccel; 477 | int pcores, paccel; 478 | } corespec; 479 | 480 | typedef struct { 481 | int fd, pid; 482 | } fdpid; 483 | 484 | typedef struct { 485 | corespec spec; 486 | fdpid fp[]; 487 | } Spin; 488 | 489 | 490 | struct _this; 491 | 492 | typedef struct { 493 | void (*worker)(struct _this *, csize_t, cint, cint); 494 | struct _this *thisptr; 495 | size_t thissize; 496 | } dispatch; 497 | 498 | 499 | typedef unsigned int state_t; 500 | 501 | #define SOBOL_MINDIM 1 502 | #define SOBOL_MAXDIM 40 503 | 504 | /* length of state vector */ 505 | #define MERSENNE_N 624 506 | 507 | /* period parameter */ 508 | #define MERSENNE_M 397 509 | 510 | /* RNGState is not used in Cuhre, and the unnamed union generates 511 | compiler warnings. -- Yixuan */ 512 | /* 513 | typedef struct { 514 | void (*getrandom)(struct _this *t, real *x); 515 | void (*skiprandom)(struct _this *t, cnumber n); 516 | union { 517 | struct { 518 | real norm; 519 | number v[SOBOL_MAXDIM][30], prev[SOBOL_MAXDIM]; 520 | number seq; 521 | } sobol; 522 | struct { 523 | state_t state[MERSENNE_N]; 524 | count next; 525 | } mersenne; 526 | struct { 527 | count n24, i24, j24, nskip; 528 | int carry, state[24]; 529 | } ranlux; 530 | }; 531 | } RNGState; 532 | */ 533 | 534 | 535 | /* We do not need to consider FORTRAN interface. -- Yixuan */ 536 | /* 537 | #if NOUNDERSCORE 538 | #define SUFFIX(s) s 539 | #else 540 | #define SUFFIX(s) s##_ 541 | #endif 542 | */ 543 | #define SUFFIX(s) s 544 | 545 | #define EXPORT(s) EXPORT_(PREFIX(s)) 546 | #define EXPORT_(s) SUFFIX(s) 547 | 548 | 549 | /* This is only used in the FORTRAN version. -- Yixuan */ 550 | /* 551 | #define CString(cs, fs, len) { \ 552 | char *_s = NULL; \ 553 | if( fs ) { \ 554 | int _l = len; \ 555 | while( _l > 0 && fs[_l - 1] == ' ' ) --_l; \ 556 | if( _l > 0 && (_s = alloca(_l + 1)) ) { \ 557 | memcpy(_s, fs, _l); \ 558 | _s[_l] = 0; \ 559 | } \ 560 | } \ 561 | cs = _s; \ 562 | } 563 | */ 564 | 565 | static inline real Sq(creal x) { 566 | return x*x; 567 | } 568 | 569 | static inline real Min(creal a, creal b) { 570 | return (a < b) ? a : b; 571 | } 572 | 573 | static inline real Max(creal a, creal b) { 574 | return (a > b) ? a : b; 575 | } 576 | 577 | static inline real Weight(creal sum, creal sqsum, cnumber n) { 578 | creal w = sqrtx(sqsum*n); 579 | return (n - 1)/Max((w + sum)*(w - sum), NOTZERO); 580 | } 581 | 582 | 583 | /* (a < 0) ? -1 : 0 */ 584 | #define NegQ(a) ((a) >> (sizeof(a)*8 - 1)) 585 | 586 | /* (a < 0) ? -1 : 1 */ 587 | #define Sign(a) (1 + 2*NegQ(a)) 588 | 589 | /* (a < 0) ? 0 : a */ 590 | #define IDim(a) ((a) & NegQ(-(a))) 591 | 592 | /* (a < b) ? a : b */ 593 | #define IMin(a, b) ((a) - IDim((a) - (b))) 594 | 595 | /* (a > b) ? a : b */ 596 | #define IMax(a, b) ((b) + IDim((a) - (b))) 597 | 598 | /* (a == 0) ? 0 : -1 */ 599 | #define TrueQ(a) NegQ((a) | (-a)) 600 | 601 | /* a + (a == 0) */ 602 | #define Min1(a) ((a) + 1 + TrueQ(a)) 603 | 604 | /* abs(a) + (a == 0) */ 605 | #define Abs1(a) (((a) ^ NegQ(a)) - NegQ((a) - 1)) 606 | 607 | 608 | #ifdef MLVERSION 609 | 610 | static inline void Print(MLCONST char *s) 611 | { 612 | MLPutFunction(stdlink, "EvaluatePacket", 1); 613 | MLPutFunction(stdlink, "Print", 1); 614 | MLPutString(stdlink, s); 615 | MLEndPacket(stdlink); 616 | 617 | MLNextPacket(stdlink); 618 | MLNewPacket(stdlink); 619 | } 620 | 621 | #else 622 | 623 | /* Use R printing. -- Yixuan */ 624 | /* #define Print(s) puts(s); fflush(stdout) */ 625 | #define Print(s) Rprintf(s); 626 | 627 | #endif 628 | 629 | #endif 630 | -------------------------------------------------------------------------------- /src/fastLR.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | using namespace Numer; 4 | 5 | typedef Eigen::Map MapMat; 6 | typedef Eigen::Map MapVec; 7 | 8 | class LogisticReg: public MFuncGrad 9 | { 10 | private: 11 | const MapMat X; 12 | const MapVec Y; 13 | const int n; 14 | Eigen::VectorXd xbeta; // contains X*beta 15 | Eigen::VectorXd prob; // contains log(1+exp(X*beta)) and 1/(1+exp(-X*beta)) 16 | public: 17 | LogisticReg(const MapMat x_, const MapVec y_) : 18 | X(x_), 19 | Y(y_), 20 | n(X.rows()), 21 | xbeta(n), 22 | prob(n) 23 | {} 24 | 25 | double f_grad(Constvec& beta, Refvec grad) 26 | { 27 | // Negative log likelihood 28 | // sum(log(1 + exp(X * beta))) - y' * X * beta 29 | xbeta.noalias() = X * beta; 30 | const double yxbeta = Y.dot(xbeta); 31 | // Calculate log(1 + exp(X * beta)), avoiding overflow 32 | for(int i = 0; i < n; i++) 33 | prob[i] = R::log1pexp(xbeta[i]); 34 | const double f = prob.sum() - yxbeta; 35 | 36 | // Gradient 37 | // X' * (p - y), p = exp(X * beta) / (1 + exp(X * beta)) 38 | // = exp(X * beta - log(1 + exp(X * beta))) 39 | prob = (xbeta - prob).array().exp(); 40 | grad.noalias() = X.transpose() * (prob - Y); 41 | 42 | return f; 43 | } 44 | 45 | Eigen::VectorXd current_xb() const { return xbeta; } 46 | Eigen::VectorXd current_p() const { return prob; } 47 | }; 48 | 49 | // [[Rcpp::export]] 50 | Rcpp::List fastLR_(Rcpp::NumericMatrix x, Rcpp::NumericVector y, 51 | Rcpp::NumericVector start, 52 | double eps_f, double eps_g, int maxit) 53 | { 54 | const MapMat xx = Rcpp::as(x); 55 | const MapVec yy = Rcpp::as(y); 56 | // Negative log likelihood 57 | LogisticReg nll(xx, yy); 58 | // Initial guess 59 | Rcpp::NumericVector b = Rcpp::clone(start); 60 | MapVec beta(b.begin(), b.length()); 61 | 62 | double fopt; 63 | int status = optim_lbfgs(nll, beta, fopt, maxit, eps_f, eps_g); 64 | if(status < 0) 65 | Rcpp::warning("algorithm did not converge"); 66 | 67 | return Rcpp::List::create( 68 | Rcpp::Named("coefficients") = b, 69 | Rcpp::Named("fitted.values") = nll.current_p(), 70 | Rcpp::Named("linear.predictors") = nll.current_xb(), 71 | Rcpp::Named("loglikelihood") = -fopt, 72 | Rcpp::Named("converged") = (status >= 0) 73 | ); 74 | } 75 | -------------------------------------------------------------------------------- /src/register_routines.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | 6 | SEXP _RcppNumerical_fastLR_(SEXP xSEXP, SEXP ySEXP, SEXP startSEXP, SEXP eps_fSEXP, SEXP eps_gSEXP, SEXP maxitSEXP); 7 | 8 | static const R_CallMethodDef CallEntries[] = { 9 | {"_RcppNumerical_fastLR_", (DL_FUNC) &_RcppNumerical_fastLR_, 6}, 10 | {NULL, NULL, 0} 11 | }; 12 | 13 | void R_init_RcppNumerical(DllInfo *info) 14 | { 15 | R_RegisterCCallable("RcppNumerical", "Cuhre", (DL_FUNC) Cuhre); 16 | R_registerRoutines(info, NULL, CallEntries, NULL, NULL); 17 | R_useDynamicSymbols(info, FALSE); 18 | } 19 | -------------------------------------------------------------------------------- /vignettes/introduction.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "RcppNumerical: Rcpp Integration for Numerical Computing Libraries" 3 | author: "Yixuan Qiu" 4 | date: "`r Sys.Date()`" 5 | output: 6 | prettydoc::html_pretty: 7 | theme: architect 8 | highlight: github 9 | toc: true 10 | vignette: > 11 | %\VignetteIndexEntry{Rcpp Integration for Numerical Computing Libraries} 12 | %\VignetteEngine{knitr::rmarkdown} 13 | %\VignetteEncoding{UTF-8} 14 | --- 15 | 16 | ```{r setup, include=FALSE} 17 | library(Rcpp) 18 | library(RcppNumerical) 19 | knitr::opts_chunk$set(message = FALSE, warning = FALSE, 20 | comment = "#", collapse = TRUE) 21 | ``` 22 | 23 | ## Introduction 24 | 25 | [Rcpp](https://CRAN.R-project.org/package=Rcpp) is a 26 | powerful tool to write fast C++ code to speed up R programs. However, 27 | it is not easy, or at least not straightforward, to compute numerical 28 | integration or do optimization using pure C++ code inside Rcpp. 29 | 30 | **RcppNumerical** integrates a number of open source numerical computing 31 | libraries into Rcpp, so that users can call convenient functions to 32 | accomplish such tasks. 33 | 34 | - To use **RcppNumerical** with `Rcpp::sourceCpp()`, add 35 | ```cpp 36 | // [[Rcpp::depends(RcppEigen)]] 37 | // [[Rcpp::depends(RcppNumerical)]] 38 | ``` 39 | in the C++ source file. 40 | - To use **RcppNumerical** in your package, add `Imports: RcppNumerical` 41 | and `LinkingTo: Rcpp, RcppEigen, RcppNumerical` to the `DESCRIPTION` file, 42 | and `import(RcppNumerical)` to the `NAMESPACE` file. 43 | 44 | ## Numerical Integration 45 | 46 | ### One-dimensional 47 | 48 | The one-dimensional numerical integration code contained in **RcppNumerical** 49 | is based on the [NumericalIntegration](https://github.com/tbs1980/NumericalIntegration) 50 | library developed by [Sreekumar Thaithara Balan](https://github.com/tbs1980), 51 | [Mark Sauder](https://github.com/mcsauder), and Matt Beall. 52 | 53 | To compute integration of a function, first define a functor derived from 54 | the `Func` class (under the namespace `Numer`): 55 | 56 | ```cpp 57 | class Func 58 | { 59 | public: 60 | virtual double operator()(const double& x) const = 0; 61 | virtual void eval(double* x, const int n) const 62 | { 63 | for(int i = 0; i < n; i++) 64 | x[i] = this->operator()(x[i]); 65 | } 66 | 67 | virtual ~Func() {} 68 | }; 69 | ``` 70 | 71 | The first function evaluates one point at a time, and the second version 72 | overwrites each point in the array by the corresponding function values. 73 | Only the second function will be used by the integration code, but usually it 74 | is easier to implement the first one. 75 | 76 | **RcppNumerical** provides a wrapper function for the **NumericalIntegration** 77 | library with the following interface: 78 | 79 | ```cpp 80 | inline double integrate( 81 | const Func& f, const double& lower, const double& upper, 82 | double& err_est, int& err_code, 83 | const int subdiv = 100, const double& eps_abs = 1e-8, const double& eps_rel = 1e-6, 84 | const Integrator::QuadratureRule rule = Integrator::GaussKronrod41 85 | ) 86 | ``` 87 | 88 | - `f`: The functor of integrand. 89 | - `lower`, `upper`: Limits of integral. 90 | - `err_est`: Estimate of the error (output). 91 | - `err_code`: Error code (output). See `inst/include/integration/Integrator.h` 92 | [Line 676-704](https://github.com/yixuan/RcppNumerical/blob/master/inst/include/integration/Integrator.h#L676). 93 | - `subdiv`: Maximum number of subintervals. 94 | - `eps_abs`, `eps_rel`: Absolute and relative tolerance. 95 | - `rule`: Integration rule. Possible values are 96 | `GaussKronrod{15, 21, 31, 41, 51, 61, 71, 81, 91, 101, 121, 201}`. Rules with 97 | larger values have better accuracy, but may involve more function calls. 98 | - Return value: The final estimate of the integral. 99 | 100 | See a full example below, which can be compiled using the `Rcpp::sourceCpp` 101 | function in Rcpp. 102 | 103 | ```{Rcpp} 104 | // [[Rcpp::depends(RcppEigen)]] 105 | // [[Rcpp::depends(RcppNumerical)]] 106 | #include 107 | using namespace Numer; 108 | 109 | // P(0.3 < X < 0.8), X ~ Beta(a, b) 110 | class BetaPDF: public Func 111 | { 112 | private: 113 | double a; 114 | double b; 115 | public: 116 | BetaPDF(double a_, double b_) : a(a_), b(b_) {} 117 | 118 | double operator()(const double& x) const 119 | { 120 | return R::dbeta(x, a, b, 0); 121 | } 122 | }; 123 | 124 | // [[Rcpp::export]] 125 | Rcpp::List integrate_test() 126 | { 127 | const double a = 3, b = 10; 128 | const double lower = 0.3, upper = 0.8; 129 | const double true_val = R::pbeta(upper, a, b, 1, 0) - 130 | R::pbeta(lower, a, b, 1, 0); 131 | 132 | BetaPDF f(a, b); 133 | double err_est; 134 | int err_code; 135 | const double res = integrate(f, lower, upper, err_est, err_code); 136 | return Rcpp::List::create( 137 | Rcpp::Named("true") = true_val, 138 | Rcpp::Named("approximate") = res, 139 | Rcpp::Named("error_estimate") = err_est, 140 | Rcpp::Named("error_code") = err_code 141 | ); 142 | } 143 | ``` 144 | 145 | Runing the `integrate_test()` function in R gives 146 | 147 | ```{r} 148 | integrate_test() 149 | ``` 150 | 151 | Note that infinite intervals are also possible in the case of one-dimensional integration: 152 | 153 | ```{Rcpp} 154 | // [[Rcpp::depends(RcppEigen)]] 155 | // [[Rcpp::depends(RcppNumerical)]] 156 | #include 157 | using namespace Numer; 158 | 159 | class TestInf: public Func 160 | { 161 | public: 162 | double operator()(const double& x) const 163 | { 164 | return x * x * R::dnorm(x, 0.0, 1.0, 0); 165 | } 166 | }; 167 | 168 | // [[Rcpp::export]] 169 | Rcpp::List integrate_test2(const double& lower, const double& upper) 170 | { 171 | TestInf f; 172 | double err_est; 173 | int err_code; 174 | const double res = integrate(f, lower, upper, err_est, err_code); 175 | return Rcpp::List::create( 176 | Rcpp::Named("approximate") = res, 177 | Rcpp::Named("error_estimate") = err_est, 178 | Rcpp::Named("error_code") = err_code 179 | ); 180 | } 181 | ``` 182 | 183 | ```{r} 184 | integrate(function(x) x^2 * dnorm(x), 0.5, Inf) # integrate() in R 185 | integrate_test2(0.5, Inf) 186 | ``` 187 | 188 | ### Multi-dimensional 189 | 190 | Multi-dimensional integration in **RcppNumerical** is done by the 191 | [Cuba](https://feynarts.de/cuba/) library developed by 192 | [Thomas Hahn](https://wwwth.mpp.mpg.de/members/hahn/). 193 | 194 | To calculate the integration of a multivariate function, one needs to define 195 | a functor that inherits from the `MFunc` class: 196 | 197 | ```cpp 198 | class MFunc 199 | { 200 | public: 201 | virtual double operator()(Constvec& x) = 0; 202 | 203 | virtual ~MFunc() {} 204 | }; 205 | ``` 206 | 207 | Here `Constvec` represents a read-only vector with the definition 208 | 209 | ```cpp 210 | // Constant reference to a vector 211 | typedef const Eigen::Ref Constvec; 212 | ``` 213 | 214 | (Basically you can treat `Constvec` as a `const Eigen::VectorXd`. Using 215 | `Eigen::Ref` is mainly to avoid memory copy. See the explanation 216 | [here](https://eigen.tuxfamily.org/dox/classEigen_1_1Ref.html).) 217 | 218 | The function provided by **RcppNumerical** for multi-dimensional 219 | integration is 220 | 221 | ```cpp 222 | inline double integrate( 223 | MFunc& f, Constvec& lower, Constvec& upper, 224 | double& err_est, int& err_code, 225 | const int maxeval = 1000, 226 | const double& eps_abs = 1e-6, const double& eps_rel = 1e-6 227 | ) 228 | ``` 229 | 230 | - `f`: The functor of integrand. 231 | - `lower`, `upper`: Limits of integral. Both are vectors of the same 232 | dimension of `f`. 233 | - `err_est`: Estimate of the error (output). 234 | - `err_code`: Error code (output). Non-zero values indicate failure of 235 | convergence. 236 | - `maxeval`: Maximum number of function evaluations. 237 | - `eps_abs`, `eps_rel`: Absolute and relative tolerance. 238 | - Return value: The final estimate of the integral. 239 | 240 | See the example below: 241 | 242 | ```{Rcpp} 243 | // [[Rcpp::depends(RcppEigen)]] 244 | // [[Rcpp::depends(RcppNumerical)]] 245 | #include 246 | using namespace Numer; 247 | 248 | // P(a1 < X1 < b1, a2 < X2 < b2), (X1, X2) ~ N([0], [1 rho]) 249 | // ([0], [rho 1]) 250 | class BiNormal: public MFunc 251 | { 252 | private: 253 | const double rho; 254 | double const1; // 2 * (1 - rho^2) 255 | double const2; // 1 / (2 * PI) / sqrt(1 - rho^2) 256 | public: 257 | BiNormal(const double& rho_) : rho(rho_) 258 | { 259 | const1 = 2.0 * (1.0 - rho * rho); 260 | const2 = 1.0 / (2 * M_PI) / std::sqrt(1.0 - rho * rho); 261 | } 262 | 263 | // PDF of bivariate normal 264 | double operator()(Constvec& x) 265 | { 266 | double z = x[0] * x[0] - 2 * rho * x[0] * x[1] + x[1] * x[1]; 267 | return const2 * std::exp(-z / const1); 268 | } 269 | }; 270 | 271 | // [[Rcpp::export]] 272 | Rcpp::List integrate_test2() 273 | { 274 | BiNormal f(0.5); // rho = 0.5 275 | Eigen::VectorXd lower(2); 276 | lower << -1, -1; 277 | Eigen::VectorXd upper(2); 278 | upper << 1, 1; 279 | double err_est; 280 | int err_code; 281 | const double res = integrate(f, lower, upper, err_est, err_code); 282 | return Rcpp::List::create( 283 | Rcpp::Named("approximate") = res, 284 | Rcpp::Named("error_estimate") = err_est, 285 | Rcpp::Named("error_code") = err_code 286 | ); 287 | } 288 | ``` 289 | 290 | We can test the result in R: 291 | 292 | ```{r} 293 | library(mvtnorm) 294 | trueval = pmvnorm(c(-1, -1), c(1, 1), sigma = matrix(c(1, 0.5, 0.5, 1), 2)) 295 | integrate_test2() 296 | as.numeric(trueval) - integrate_test2()$approximate 297 | ``` 298 | 299 | ## Numerical Optimization 300 | 301 | Currently **RcppNumerical** contains the L-BFGS algorithm for unconstrained 302 | minimization problems based on the 303 | [LBFGS++](https://github.com/yixuan/LBFGSpp) library. 304 | 305 | Again, one needs to first define a functor to represent the multivariate 306 | function to be minimized. 307 | 308 | ```cpp 309 | class MFuncGrad 310 | { 311 | public: 312 | virtual double f_grad(Constvec& x, Refvec grad) = 0; 313 | 314 | virtual ~MFuncGrad() {} 315 | }; 316 | ``` 317 | 318 | Same as the case in multi-dimensional integration, `Constvec` represents a 319 | read-only vector and `Refvec` a writable vector. Their definitions are 320 | 321 | ```cpp 322 | // Reference to a vector 323 | typedef Eigen::Ref Refvec; 324 | typedef const Eigen::Ref Constvec; 325 | ``` 326 | 327 | The `f_grad()` member function returns the function value on vector `x`, 328 | and overwrites `grad` by the gradient. 329 | 330 | The wrapper function for **LBFGS++** is 331 | 332 | ```cpp 333 | inline int optim_lbfgs( 334 | MFuncGrad& f, Refvec x, double& fx_opt, 335 | const int maxit = 300, const double& eps_f = 1e-6, const double& eps_g = 1e-5 336 | ) 337 | ``` 338 | 339 | - `f`: The function to be minimized. 340 | - `x`: In: the initial guess. Out: best value of variables found. 341 | - `fx_opt`: Out: Function value on the output `x`. 342 | - `maxit`: Maximum number of iterations. 343 | - `eps_f`: Algorithm stops if `|f_{k+1} - f_k| < eps_f * |f_k|`. 344 | - `eps_g`: Algorithm stops if `||g|| < eps_g * max(1, ||x||)`. 345 | - Return value: Error code. Negative values indicate errors. 346 | 347 | Below is an example that illustrates the optimization of the Rosenbrock function 348 | `f(x1, x2) = 100 * (x2 - x1^2)^2 + (1 - x1)^2`: 349 | 350 | ```{Rcpp} 351 | // [[Rcpp::depends(RcppEigen)]] 352 | // [[Rcpp::depends(RcppNumerical)]] 353 | 354 | #include 355 | 356 | using namespace Numer; 357 | 358 | // f = 100 * (x2 - x1^2)^2 + (1 - x1)^2 359 | // True minimum: x1 = x2 = 1 360 | class Rosenbrock: public MFuncGrad 361 | { 362 | public: 363 | double f_grad(Constvec& x, Refvec grad) 364 | { 365 | double t1 = x[1] - x[0] * x[0]; 366 | double t2 = 1 - x[0]; 367 | grad[0] = -400 * x[0] * t1 - 2 * t2; 368 | grad[1] = 200 * t1; 369 | return 100 * t1 * t1 + t2 * t2; 370 | } 371 | }; 372 | 373 | // [[Rcpp::export]] 374 | Rcpp::List optim_test() 375 | { 376 | Eigen::VectorXd x(2); 377 | x[0] = -1.2; 378 | x[1] = 1; 379 | double fopt; 380 | Rosenbrock f; 381 | int res = optim_lbfgs(f, x, fopt); 382 | return Rcpp::List::create( 383 | Rcpp::Named("xopt") = x, 384 | Rcpp::Named("fopt") = fopt, 385 | Rcpp::Named("status") = res 386 | ); 387 | } 388 | ``` 389 | 390 | Calling the generated R function `optim_test()` gives 391 | 392 | ```{r} 393 | optim_test() 394 | ``` 395 | 396 | ## A More Practical Example 397 | 398 | It may be more meaningful to look at a real application of the **RcppNumerical** 399 | package. Below is an example to fit logistic regression using the L-BFGS 400 | algorithm. It also demonstrates the performance of the library. 401 | 402 | ```{Rcpp} 403 | // [[Rcpp::depends(RcppEigen)]] 404 | // [[Rcpp::depends(RcppNumerical)]] 405 | 406 | #include 407 | 408 | using namespace Numer; 409 | 410 | typedef Eigen::Map MapMat; 411 | typedef Eigen::Map MapVec; 412 | 413 | class LogisticReg: public MFuncGrad 414 | { 415 | private: 416 | const MapMat X; 417 | const MapVec Y; 418 | public: 419 | LogisticReg(const MapMat x_, const MapVec y_) : X(x_), Y(y_) {} 420 | 421 | double f_grad(Constvec& beta, Refvec grad) 422 | { 423 | // Negative log likelihood 424 | // sum(log(1 + exp(X * beta))) - y' * X * beta 425 | 426 | Eigen::VectorXd xbeta = X * beta; 427 | const double yxbeta = Y.dot(xbeta); 428 | // X * beta => exp(X * beta) 429 | xbeta = xbeta.array().exp(); 430 | const double f = (xbeta.array() + 1.0).log().sum() - yxbeta; 431 | 432 | // Gradient 433 | // X' * (p - y), p = exp(X * beta) / (1 + exp(X * beta)) 434 | 435 | // exp(X * beta) => p 436 | xbeta.array() /= (xbeta.array() + 1.0); 437 | grad.noalias() = X.transpose() * (xbeta - Y); 438 | 439 | return f; 440 | } 441 | }; 442 | 443 | // [[Rcpp::export]] 444 | Rcpp::NumericVector logistic_reg(Rcpp::NumericMatrix x, Rcpp::NumericVector y) 445 | { 446 | const MapMat xx = Rcpp::as(x); 447 | const MapVec yy = Rcpp::as(y); 448 | // Negative log likelihood 449 | LogisticReg nll(xx, yy); 450 | // Initial guess 451 | Eigen::VectorXd beta(xx.cols()); 452 | beta.setZero(); 453 | 454 | double fopt; 455 | int status = optim_lbfgs(nll, beta, fopt); 456 | if(status < 0) 457 | Rcpp::stop("fail to converge"); 458 | 459 | return Rcpp::wrap(beta); 460 | } 461 | ``` 462 | 463 | Here is the R code to test the function: 464 | 465 | ```{r} 466 | set.seed(123) 467 | n = 5000 468 | p = 100 469 | x = matrix(rnorm(n * p), n) 470 | beta = runif(p) 471 | xb = c(x %*% beta) 472 | p = exp(xb) / (1 + exp(xb)) 473 | y = rbinom(n, 1, p) 474 | 475 | system.time(res1 <- glm.fit(x, y, family = binomial())$coefficients) 476 | system.time(res2 <- logistic_reg(x, y)) 477 | max(abs(res1 - res2)) 478 | ``` 479 | 480 | It is much faster than the standard `glm.fit()` function in R! (Although 481 | `glm.fit()` calculates some other quantities besides beta.) 482 | 483 | **RcppNumerical** also provides the `fastLR()` function to run fast logistic 484 | regression, which is a modified and more stable version of the code above. 485 | 486 | ```{r} 487 | system.time(res3 <- fastLR(x, y)$coefficients) 488 | max(abs(res1 - res3)) 489 | ``` 490 | --------------------------------------------------------------------------------