I am quite new to C++ and Rcpp integration. I am required to create a program using C++ with R integration to find the MLE/root of a Cauchy Distribution.
Below is my code thus far.
#include <Rcpp.h>
#include <math.h>
#include <iostream>
#include <cstdlib>
using namespace std;
using namespace Rcpp;
// [[Rcpp::export]]
double Cauchy(double x, double y); //Declare Function
double Cauchy(double x,double y) //Define Function
{
return 1/(M_PI*(1+(pow(x-y,2)))); //write the equation whose roots are to be determined x=chosen y=theta
}
using namespace std;
// [[Rcpp::export]]
int Secant (NumericVector x){
NumericVector xvector(x) ; //Input of x vector
double eplison= 0.001; //Threshold
double a= xvector[3]; //Select starting point
double b= xvector[4];//Select end point
double c= 0.0; //initial value for c
double Theta= 10.6; //median value for theta estimate
int noofIter= 0; //Iterations
double error = 0.0;
if (std::abs(Cauchy(a, Theta) <(std::abs(Cauchy(a, Theta))))) {
do {
a=b;
b=c;
error= (b-(Cauchy(b, Theta)))*((a-b)/(Cauchy(a, Theta)-Cauchy(b, Theta)));
error= Cauchy(c,Theta);
//return number of iterations
noofIter++;
for (int i = 0; i < noofIter; i += 1) {
cout << "The Value is " << c << endl;
cout << "The Value is " << a << endl;
cout << "The Value is " << b << endl;
cout << "The Value is " << Theta << endl;
}
} while (std::abs(error)>eplison);
}
cout<<"\nThe root of the equation is occurs at "<<c<<endl; //print the root
cout << "The number of iterations is " << noofIter;
return 0;
}
With a few amendments, the program either goes into a never ending loop or returns a value which is infinitely small.
My understanding of this mathematics is limited. Therefore any help or correction in that would be greatly appreciated.
The X vector that we have been given as an output is
x <- c( 11.262307 , 10.281078 , 10.287090 , 12.734039 ,
11.731881 , 8.861998 , 12.246509 , 11.244818 ,
9.696278 , 11.557572 , 11.112531 , 10.550190 ,
9.018438 , 10.704774 , 9.515617 , 10.003247 ,
10.278352 , 9.709630 , 10.963905 , 17.314814)
Using previous R code we know that the MLE/Root for this distribution occurs at 10.5935 approx
The code used to obtain this MLE was
optimize(function(theta)-sum(dcauchy(x, location=theta,
log=TRUE)), c(-100,100))
Thanks!
With the optimize()function you are directly searching for an extremum of the likelihood. An alternative is to use a root finding algorithm (e.g. the secant method) together with the derivative of the (log-)likelihood. From Wikipedia we get the formula we have to solve. In R this could look like this:
x <- c( 11.262307 , 10.281078 , 10.287090 , 12.734039 ,
11.731881 , 8.861998 , 12.246509 , 11.244818 ,
9.696278 , 11.557572 , 11.112531 , 10.550190 ,
9.018438 , 10.704774 , 9.515617 , 10.003247 ,
10.278352 , 9.709630 , 10.963905 , 17.314814)
ld <- function(sample, theta){
xp <- outer(sample, theta, FUN = "-")
colSums(xp/(1+xp^2))
}
uniroot(ld, sample = x, lower = 0, upper = 20)$root
#> [1] 10.59724
Note that the derivative of the log-likelihood is vectorized on both arguments. This allows for easy plotting:
theta <- seq(0, 20, length=500)
plot(theta, ld(x, theta), type="l",
xlab=expression(theta), ylab=expression(ld(x, theta)))
From this plot we already see that it will be tricky to find the correct starting points for the secant method to work.
Let's move this to C++ (C++11 to be precise):
#include <Rcpp.h>
// [[Rcpp::plugins(cpp11)]]
Rcpp::List secant(const std::function<double(double)>& f,
double a, double b, int maxIterations, double epsilon) {
double c(0.0);
do {
c = b * (1 - (1 - a/b) / (1 - f(a)/f(b)));
a = b;
b = c;
} while (maxIterations-- > 0 && std::abs(a - b) > epsilon);
return Rcpp::List::create(Rcpp::Named("root") = c,
Rcpp::Named("f.root") = f(c),
Rcpp::Named("converged") = (maxIterations > 0));
}
// [[Rcpp::export]]
Rcpp::List mleCauchy(const Rcpp::NumericVector& sample, double a, double b,
int maxIterations = 100, double epsilon = 0.0001) {
auto f = [&sample](double theta) {
Rcpp::NumericVector xp = sample - theta;
xp = xp / (1 + xp * xp);
return Rcpp::sum(xp);
};
return secant(f, a, b, maxIterations, epsilon);
}
/*** R
x <- c( 11.262307 , 10.281078 , 10.287090 , 12.734039 ,
11.731881 , 8.861998 , 12.246509 , 11.244818 ,
9.696278 , 11.557572 , 11.112531 , 10.550190 ,
9.018438 , 10.704774 , 9.515617 , 10.003247 ,
10.278352 , 9.709630 , 10.963905 , 17.314814)
mleCauchy(x, 11, 15)
#-> does not converge
mleCauchy(x, 11, 14)
#-> 10.59721
mleCauchy(x, mean(x), median(x))
#-> 10.59721
*/
The secant() function works for any std::function that takes a double as argument and returns a double. Such a function is than defined as lambda function that depends on the provided sample values. As expected one gets the correct root only when starting with values that are close to the correct value.
Lambda functions might be a bit confusing at first sight, but they are very close to what we are used to in R. Here the same algorithm written in R:
secant <- function(f, a, b, maxIterations, epsilon) {
for (i in seq.int(maxIterations)) {
c <- b * (1 - (1 - a/b) / (1 - f(a)/f(b)))
a <- b
b <- c
if (abs(a - b) <= epsilon)
break
}
list(root = c, f.root = f(c), converged = (i < maxIterations))
}
mleCauchy <- function(sample, a, b, maxIterations = 100L, epsilon = 0.001) {
f <- function(theta) {
xp <- sample - theta
sum(xp/(1 + xp^2))
}
secant(f, a, b, maxIterations, epsilon)
}
x <- c( 11.262307 , 10.281078 , 10.287090 , 12.734039 ,
11.731881 , 8.861998 , 12.246509 , 11.244818 ,
9.696278 , 11.557572 , 11.112531 , 10.550190 ,
9.018438 , 10.704774 , 9.515617 , 10.003247 ,
10.278352 , 9.709630 , 10.963905 , 17.314814)
mleCauchy(x, 11, 12)
#-> 10.59721
The R function f and the lambda function f take the vector sample from the environment where they are defined. In R this happens implicitly, while in C++ we have to explicitly tell that this value should be captured. The numeric theta is the argument supplied when the function is called, i.e. the successive estimates for the root starting with a and b.
Related
I am developing a package in R that I would like to convert to Rcpp for better performance. I'm new to Rcpp (and C++ in general.) My problem is that the Rcpp function I've written works fine if I run it many times with one set of arguments, but if I try to loop it over many combinations of arguments, it springs memory leaks and causes the R session to abort.
Here is the code in R, which holds up well to any test I throw at it:
raw_noise <- function(timesteps, mu, sigma, phi) {
delta <- mu * (1 - phi)
variance <- sigma^2 * (1 - phi^2)
noise <- vector(mode = "double", length = timesteps)
noise[1] <- c(rnorm(1, mu, sigma))
for (i in (1:(timesteps - 1))) {
noise[i + 1] <- delta + phi * noise[i] + rnorm(1, 0, sqrt(variance))
}
return(noise)
}
Here is the code in Rcpp, using three Rcpp sugar functions (pow, sqrt, rnorm):
NumericVector raw_noise(int timesteps, double mu, double sigma, double phi) {
double delta = mu * (1 - phi);
double variance = pow(sigma, 2.0) * (1 - pow(phi, 2.0));
NumericVector noise(timesteps);
noise[0] = R::rnorm(mu, sigma);
for(int i = 0; i < timesteps; ++i) {
noise[i+1] = delta + phi*noise[i] + R::rnorm(0, sqrt(variance));
}
return noise;
}
What really confuses me is that this code runs without problems:
library(purrr)
rerun(10000, raw_noise(timesteps = 30, mu = 0.5, sigma = 0.2, phi = 0.3))
But when I run this code:
test_loop <- function(timesteps, mu, sigma, phi, replicates) {
params <- cross_df(list(timesteps = timesteps, phi = phi, mu = mu, sigma =
sigma))
for (i in 1:nrow(params)) {
print(params[i,])
pmap(params[i,], raw_noise)
}
}
library(purrr)
test_loop(timesteps=c(5, 6, 7, 8, 9, 10), mu=c(0.2, 0.5), sigma=c(0.2, 0.5),
phi=c(0, 0.1))
More often than not, the R session aborts and RStudio crashes altogether. But sometimes I manage to catch this error message before the R session aborts:
Error in match(x, table, nomatch = 0L) : GC encountered a node
(0x10db7af50) with an unknown SEXP type: NEWSXP at memory.c:1692
As I understand it, NEWSXP is an exotic object type in R that doesn't come up very often. What's happening looks to me like a memory leak, but I'm not at all sure how to fix it. Like I said, I'm new to Rcpp and C++ generally so I'd appreciate any nudges in the right direction.
You have an out of bounds error:
for(int i = 0; i < timesteps; ++i)
causes
noise[i+1]
to exceed the defined range since C++ indices start at 0 and not 1.
For example, 0 to timesteps - 1 has a length of timesteps and, thus, is okay.
but
0 to timesteps would have a length of timesteps + 1
This can be seen if you change noise[i+1] to noise(i+1), which performs a bounds check on the requested index.
Error in raw_noise(100, 2, 3, 0.2) :
Index out of bounds: [index=100; extent=100].
To address this, make the following change:
NumericVector raw_noise(int timesteps, double mu, double sigma, double phi) {
double delta = mu * (1 - phi);
double variance = pow(sigma, 2.0) * (1 - pow(phi, 2.0));
NumericVector noise(timesteps);
noise[0] = R::rnorm(mu, sigma);
// change here
for(int i = 0; i < timesteps - 1; ++i) { // 1 less time step
noise[i+1] = delta + phi*noise[i] + R::rnorm(0, sqrt(variance));
}
return noise;
}
I am trying to implement steepest descent algorithm in programming languages (C/C++/fortran).
For example minimization of f(x1,x2) = x1^3 + x2^3 - 2*x1*x2
Estimate starting design point x0, iteration counter k0, convergence parameter tolerence = 0.1.
Say this staring point is (1,0)
Compute gradient of f(x1,x2) at the current point x(k) as grad(f). I will use numerical differentiation here.
d/dx1 (f) = lim (h->0) (f(x1+h,x2) - f(x1,x2) )/h
This is grad(f)=(3*x1^2 - 2*x2, 3*x2^2 - 2*x1)
grad(f) at (0,1) is c0 = (3,-2)
since L2 norm of c0 > tolerence, we proceed for next step
direction d0 = -c0 = (-3,2)
Calculate step size a. Minimize f(a) = f(x0 + ad0) = (1-3a,2a) = (1-3a)^3 + (2a)^3 - 2(1-3a)*(2a). I am not keeping constant step size.
update: new[x1,x2] = old[x1,x2]x + a*d0.
I do not understand how to do step 5.
I have a 1D minimization program with bisection method, and it looks like:
program main()
...
...
define upper, lower interval
call function value
...calculations
...
...
function value (input x1in) (output xout)
...function is x^4 - 2x^2 + x + 10
xout = (xin)^4 - 2*(xin)^2 + (xin) + 10
In this case, looking at step 5, I cannot pass symbolic a.
Any ideas how to implement the algorithm in programming language, especially step 5? Please suggest if there is altogether different way to program this. I have seen many programs with constant step size, but I want to compute it at every step. This algorithm can be easy to implement in MATLAB ot python sympy using symbolics, but I do not want to use symbolics.
Any suggestions appreciated. Thanks.
If C++ is an option, you can take advantage of functors and lambdas.
Let's consider a function we want to minimize, for example y = x2 - x + 2. It can be represented as a function object, which is a class with an overloaded operator():
struct MyFunc {
double operator()( double x ) const {
return x * x - x + 2.0;
}
};
Now we can declare an object of this type, use it like a function and pass it to other templated function as a templated parameter.
// given this templated function:
template < typename F >
void tabulate_function( F func, double a, double b, int steps ) {
// the functor ^^^^^^ is passed to the templated function
double step = (b - a) / (steps - 1);
std::cout << " x f(x)\n------------------------\n";
for ( int i = 0; i < steps; ++i ) {
double x = a + i * step,
fx = func(x);
// ^^^^^^^ call the operator() of the functor
std::cout << std::fixed << std::setw(8) << std::setprecision(3) << x
<< std::scientific << std::setw(16) << std::setprecision(5)
<< fx << '\n';
}
}
// we can use the previous functor like this:
MyFunc example;
tabulate_function(example, 0.0, 2.0, 21);
OP's function can be implemented (given an helper class to represent 2D points) in a similar way:
struct MyFuncVec {
double operator()( const Point &p ) const {
return p.x * p.x * p.x + p.y * p.y * p.y - 2.0 * p.x * p.y;
}
};
The gradient of that function can be represented (given a class which implement a 2D vector) by:
struct MyFuncGradient {
Vector operator()( const Point &p ) {
return Vector(3.0 * p.x * p.x - 2.0 * p.y, 3.0 * p.y * p.y - 2.0 * p.x);
}
};
Now, the fifth step of OP question requests to minimize the first function along the direction of the gradient using a monodimensional optimization algorithm which requires a monodimensional function to be passed. We can solve this issue using a lambda:
MyFuncVec funcOP;
MyFuncGradient grad_funcOP;
Point p0(0.2, 0.8);
Vector g = grad_funcOP(p0);
// use a lambda to transform the OP function to 1D
auto sliced_func = [&funcOP, &p0, &g] ( double t ) -> double {
// those variables ^^^ ^^^ ^^ are captured and used
return funcOP(p0 - t * g);
};
tabulate_function(sliced_func, 0, 0.5, 21);
Live example HERE.
I am using Rcpp to integrate a piece of C++ code in R. I am implementing a function in C++ in two ways:
// [[Rcpp::export]]
double rhobiweight(double x,double k = 2.0){
double rho = 1.0;
if(abs(x)<k){
rho = 1.0-pow((1.0-pow(x/k,2)),3);
}
return rho/Erho(k) ;
}
// [[Rcpp::export]]
double rhobiweight2(double x,double k = 2.0){
double rho = 1.0-pow((1.0-pow(x/k,2)),3);
if(abs(x)>k){
rho = 1.0;
}
return rho/Erho(k) ;
}
If the x-value is between 2 and 3, I get different results of these functions. I can't figure out why.
> set.seed(1)
> x = 3*rnorm(10^5)
> c = x
> c2 = x
> for(i in 1:length(x)){
+ c[i] = rhobiweight(x[i])
+ c2[i] = rhobiweight2(x[i])
+ }
> print(sum(c-c2))
[1] -18564.31
The problem comes from your if statement inside the function. The negative of < is >=. so you should either replace < with <= in one function or > with >= in the other, depending on the expected behaviour.
Your problem happens for value between 2.0 and 2.9 inclusive because the abs(int) will always return 2 for this range.
abs(x) takes an int an return an int. Your double x is implicitly conversion to an int in your case.
Using boost c++ odeint library, is it possible to solve a second order differential equation defined as follows ?
m*x''[i] + x'[i] = K*\sum{j=1,N} sin(x[j] - x[i]), where i = 1,2,3..N.
m = 1, K = 1
where initial value of x is an vector or array of N uniformly generated random numbers between 0 to 2*pi.
I want to integrate above equation using runge_kutta stepper of odeint ?
I can solve it by writing above eqn. in two first order differential equations, but
then in that case how the odeint stepper's would be written or modified ?
Just transform your equations to a first order ODE and use a state type of length 2 N. The first N entries now handle only the x[i] while the second N entries refer to the velocities x'[i]
void ode( state_type const& x , state_type &dxdt , double t )
{
for( size_t i=0 ; i<N ; ++i )
{
double sum = 0.0;
// calculate sum
dxdt[i] = x[i+N];
dxdt[i+N] = K * sum;
}
}
A complete example might look like
size_t N = 512;
typedef std::vector< double > state_type;
state_type x( 2 * N );
// initialize x
double t_start = 0.0 , t_end = 10.0 , dt = 0.01;
odeint::integrate( ode , x , t_start , t_end , dt );
Can someone explain to me how I would use the secant method to find the root of an equation?
The equation is: ( v / b ) ^2sin(alpha)= kr * Ts^4 +Uc *Ts -q
and I have to find Ts. I have all the other info but am confused on what I'm supposed to do with the seccant method. Any help would be greatly appreciated.
Here is my code so far:
#include <iostream>
#include <cmath>
#include <fstream>
#include <iomanip>
#include <cmath>
using namespace std;
void secant(double, double, double, double, double, double, double);
int main()
{
double kr, uc, q, b, radians;
const double PI = 4.0 * atan(1.0);
ifstream datain("shuttle.txt");
ofstream dataout("results.txt");
datain >> kr >> uc >> q >> b;
int velocity = 16000;
double angle = 10;
for (int velocity = 16000; velocity <= 17500; velocity += 500) {
for (int angle = 10; angle <= 70; angle += 15) {
radians = angle * PI / 180;
cout << velocity << endl;
cout << radians << endl;
cout << angle << endl;
secant(angle, radians, velocity, kr, uc, q, b);
}
}
getchar();
}
void secant(double angle, double radians, double velocity, double kr, double uc,
double q, double b)
{
}
The Wikipedia article on the Secant Method includes a nice layout of successive x_n values, which I'm cut-n-pasting here:
...
You need your secant method to iteratively calculate these x_n values, until either (a) you realize the method is diverging, and you cannot find a solution or (b) your successive x_n values are changing by small enough amounts that you can happily call the result a root.
So you'll need a function f that you can call to calculate your equation:
double f(double Ts, double v, double b, double alpha, double kr, double Uc, double q) {
double first = pow(v/b, 2.0) * sin(alpha);
double second = kr * pow(Ts, 4.0) + Uc * Ts - q;
return first - second;
}
Be sure to check the order of operations. :) Writing equations in HTML is always iffy.
Next you need to write a loop that checks for the exit conditions:
x_0 = /* some guess */
x_1 = x_0 + .01 /* or similar */
while ( (fabs(x_0 - x_1) > EPSILON) && (fabs(x_0 - x_1) < DIVERGENCE) ) {
x_new = x_1 - f(x_1, /* rest */) * (x_1 - x_0) / (f(x_1, /* rest */) - f(x_0, /* rest */));
x_0 = x_1;
x_1 = x_new;
}
You might consider hiding all the arguments to f() that aren't being solved for via a macro. That would help make sure you get all the arguments in the correct order.
And definitely consider solving much simpler functions like x^2 - 17 == 0 before jumping into your multivariate function. (It'd also remove the confusing double-inner-loop you've got now. That's just a recipe for multiplying any errors by a few hundred times. :)
[ There is actually an analytic method for solving the quartic (which is admittedly fairly involved), but as this is homework exercise, you presumably want the secant numerical method. For extra marks, you might want to check that the analytic results agree!]
I assume you have already checked Wikipedia. It shows that the numerical iteration is:
x[n] = x[n-1] - f(x[n-1]) * (x[n-1] - x[n-2])/(f(x[n-1] - f(x[n-2]));
Start with x[0], x[1] suitably chosen - e.g. use a guess from graphing in Excel.
To do the iteration nicely, you probably want to abstract f(x). You can use a function pointer, a functor or just an abstract class.
class Function
{
public:
virtual double evaluate(double x) const = 0;
};
double findRootUsingSecant(const Function& function, double x0, double x1);
Pass in an instance of a class which implements evaluate() by computing your formula, and implement the above iteration. Make sure to terminate the iteration on some suitable conditions.