/** Create the Householder symmetric matrix v*v^T
*
* This matrix is used to process the rows and columns of the input matrix.
*/
static void create_house_matrix_packed(size_t order, double shift, double *source, size_t incs, double *hhp) {
double h[order];
int i;
/* zero out the destination hhp (it's packed aka triangular, so the size is
* non-square) */
for (i = 0; i < order * (order + 1) / 2; i++) {
hhp[i] = 0;
}
/* create and normalize householder vector h */
cblas_dcopy(order, source, incs, h, 1);
h[0] += MYSIGN(h[0]) * cblas_dnrm2(order, h, 1);
h[0] -= shift;
cblas_dscal(order, 1.0 / cblas_dnrm2(order, h, 1), h, 1);
/* hhp = h h^T */
cblas_dspr(CblasRowMajor, CblasUpper, order, 1.0, h, 1, hhp);
}
double
brent(pTHX_ double ax, double bx, double cx, double tol, double *xmin, int k, int N, double conflevel)
{
int iter;
double a,b,d=0.,etemp,fu,fv,fw,fx,p,q,r,tol1,tol2,u,v,w,x,xm;
double e=0.0;
const int kITMAX = 100;
const double kCGOLD = 0.3819660;
const double kZEPS = 1.0e-10;
/* Implementation file for the numerical equation solver library.
* This includes root finding and minimum finding algorithms.
* Adapted from Numerical Recipes in C, 2nd edition.
* Translated to C++ by Marc Paterno
* Translated back to C by Steffen Mueller (shame on him for
* not going back to the original NR sources...)
*/
a=(ax < cx ? ax : cx);
b=(ax > cx ? ax : cx);
x=w=v=bx;
fw=fv=fx=interval(aTHX_ x, k, N, conflevel);
for (iter=1;iter<=kITMAX;iter++) {
xm=0.5*(a+b);
tol2=2.0*(tol1=tol*fabs(x)+kZEPS);
if (fabs(x-xm) <= (tol2-0.5*(b-a))) {
*xmin=x;
return fx;
}
if (fabs(e) > tol1) {
r=(x-w)*(fx-fv);
q=(x-v)*(fx-fw);
p=(x-v)*q-(x-w)*r;
q=2.0*(q-r);
if (q > 0.0) p = -p;
q=fabs(q);
etemp=e;
e=d;
if (fabs(p) >= fabs(0.5*q*etemp) || p <= q*(a-x) || p >= q*(b-x)) d=kCGOLD*(e=(x >= xm ? a-x : b-x));
else {
d=p/q;
u=x+d;
if (u-a < tol2 || b-u < tol2) d=MYSIGN(tol1,xm-x);
}
} else {
d=kCGOLD*(e=(x >= xm ? a-x : b-x));
}
u=(fabs(d) >= tol1 ? x+d : x+MYSIGN(tol1,d));
fu=interval(aTHX_ u, k, N, conflevel);
if (fu <= fx) {
if (u >= x) a=x; else b=x;
v = w;
w = x;
x = u;
fv = fw;
fw = fx;
fx = fu;
} else {
if (u < x) a=u; else b=u;
if (fu <= fw || w == x) {
v=w;
w=u;
fv=fw;
fw=fu;
} else if (fu <= fv || v == x || v == w) {
v=u;
fv=fu;
}
}
}
{
const char *err = "brent: Too many interations\n";
if (use_exceptions(aTHX))
croak("%s", err);
else
warn("%s", err);
}
*xmin=x;
return fx;
}
