int main(void) {
printf("f1 = 0 em x = %f\n\n", brent(-1, 1, 6, f1));
printf("f2 = 0 em x = %f\n\n", brent(-1, 1, 6, f2));
printf("f3 = 0 em x = %f\n\n", brent(-1, 1, 6, f3));
printf("f4 = 0 em x = %f\n\n", brent(-1, 1, 6, f4));
printf("f5 = 0 em x = %f\n\n", brent(-1, 1, 6, f5));
return 0;
}
void linmin( vectorN &p, vectorN &xi, int n, m_real &fret, m_real (*func) (vectorN const&))
{
m_real xx, xmin, fx, fb, fa, bx, ax;
ncom = n;
pcom.setSize(n);
xicom.setSize(n);
nrfunc = func;
for (int j=0; j<n; j++)
{
pcom[j] = p[j];
xicom[j] = xi[j];
}
ax = 0.0;
xx = 1.0;
mnbrak(ax, xx, bx, fa, fx, fb, f1dim);
fret = brent(ax, xx, bx, f1dim, TOL, xmin);
for (int j=0; j<n; j++)
{
xi[j] *= xmin;
p[j] += xi[j];
}
}
/* Based on Root's TGraphAsymmErrors::Efficiency function. That function
* lists the following information:
*
* Calculate the shortest central confidence interval containing the required
* probability content.
* interval(low) returns the length of the interval starting at low
* that contains conflevel probability. We use Brent's method,
* except in two special cases: when k=0, or when k=N
* Main driver routine
* Author: Marc Paterno
*/
void
efficiency_ci(pTHX_ int k, int N, double conflevel, double* mode, double* low, double* high)
{
/* If there are no entries, then we know nothing, thus return the prior... */
if (0==N) {
*mode = .5; *low = 0.0; *high = 1.0;
return;
}
/* Calculate the most probable value for the posterior cross section.
* This is easy, 'cause it is just k/N
*/
*mode = (double)k/N;
if (k == 0) {
*low = 0.0;
*high = search_upper(aTHX_ *low, k, N, conflevel);
} else if (k == N) {
*high = 1.0;
*low = search_lower(aTHX_ *high, k, N, conflevel);
} else {
brent(aTHX_ 0.0, 0.5, 1.0, 1.0e-9, low, k, N, conflevel);
*high = *low + interval(aTHX_ *low, k, N, conflevel);
}
return;
}
void ML_multi_Powell::linmin(v_ratep_type& p,
v_ratep_type& xi,
double& fret,
ptr_eval_func func
)
{
int j;
const double TOL=1.0e-8;
double xx, xmin, fx, fb, fa, bx, ax;
int n = p.size();
ncom = n;
pcom.resize(n);
xicom.resize(n);
nrfunc = func;
for(j = 0; j < n; ++j) {
pcom[j] = p[j];
xicom[j] = xi[j];
}
ax = 0.0;
xx = 1.0;
mnbrak(ax, xx, bx, fa, fx, fb, &ML_multi_Powell::f1dim);
fret = brent(ax, xx, bx, &ML_multi_Powell::f1dim, TOL, xmin);
for (j = 0; j < n; ++j) {
xi[j] *= xmin;
p[j] += xi[j];
}
}
void linmin(float p[], float xi[], int n, float *fret, float (*func)(float []))
{
float brent(float ax, float bx, float cx,
float (*f)(float), float tol, float *xmin);
float f1dim(float x);
void mnbrak(float *ax, float *bx, float *cx, float *fa, float *fb,
float *fc, float (*func)(float));
int j;
float xx,xmin,fx,fb,fa,bx,ax;
ncom=n;
pcom=vector(1,n);
xicom=vector(1,n);
nrfunc=func;
for (j=1;j<=n;j++) {
pcom[j]=p[j];
xicom[j]=xi[j];
}
ax=0.0;
xx=1.0;
mnbrak(&ax,&xx,&bx,&fa,&fx,&fb,f1dim);
*fret=brent(ax,xx,bx,f1dim,TOL,&xmin);
for (j=1;j<=n;j++) {
xi[j] *= xmin;
p[j] += xi[j];
}
free_vector(xicom,1,n);
free_vector(pcom,1,n);
}
double linmin(double xi[], double del[], double fxi1, double *x1, double *x2, double *fret1, double *fret2)
{
int j;
static double *vecu = NULL; /* Vector of location u */
double xx, fx, fb, bx, ax;
double fa = fxi1;
double xmin;
double xmin2;
xicom = xi;
delcom = del;
ax = 0.0; /*do not change without correcting fa, */
/*saves 1 fcalc... */
bx = .1;
if (vecu == NULL) {
vecu = vect_double(ndimtot);
reg_for_free(vecu, "vecu");
}
for (j = 0; j < ndimtot; j++)
vecu[j] = xicom[j] + bx * delcom[j]; /*set vecu */
fb = (*calc_forces) (vecu, fret2, 0);
bracket(&ax, &xx, &bx, &fa, &fx, &fb, fret1, fret2);
fx = brent(ax, xx, bx, fx, TOL, &xmin, &xmin2, fret1, fret2);
for (j = 0; j < ndimtot; j++) {
del[j] *= xmin;
xi[j] += del[j];
}
*x1 = xmin;
*x2 = xmin2;
return fx;
}
void linmin(double p[], double xi[], int n, double *fret, double (*func)(double []))
{
double brent(double ax, double bx, double cx,
double (*f)(double), double tol, double *xmin);
double f1dim(double x);
void mnbrak(double *ax, double *bx, double *cx, double *fa, double *fb,
double *fc, double (*func)(double));
int j;
double xx,xmin,fx,fb,fa,bx,ax;
ncom=n;
pcom=dvector(1,n);
xicom=dvector(1,n);
nrfunc=func;
for (j=1;j<=n;j++) {
pcom[j]=p[j];
xicom[j]=xi[j];
}
ax=0.0;
xx=1.0;
mnbrak(&ax,&xx,&bx,&fa,&fx,&fb,f1dim);
*fret=brent(ax,xx,bx,f1dim,TOL,&xmin);
for (j=1;j<=n;j++) {
xi[j] *= xmin;
p[j] += xi[j];
}
free_dvector(xicom,1,n);
free_dvector(pcom,1,n);
}
int main()
{
double a0=-4;
double b0=100;
double x;
bool flag=true;
double raiz;
// std::cout << "f(a0)=" << fun(a0) << ", f(b0)=" << fun(b0) << std::endl;
// std::cout << std::endl;
// raiz= brent(&fun, a0, b0, 0.0001, 100, flag);
// std::cout << "Raiz fun=" << raiz << std::endl;
// std::cout << std::endl;
//
// raiz= brent(&fun, a0, b0, 0.0000001, 10000, flag);
// std::cout << "Raiz fun=" << raiz << std::endl;
//
// std::cout << std::endl;
//
// raiz= brent(&fun, a0, b0, 0.001, 100, flag);
// std::cout << "Raiz fun=" << raiz << std::endl;
//
//
raiz= brent(&sin, -0.6, 1, 0.001, 100, flag);
std::cout << "Raiz fun=" << raiz << std::endl;
//
//
// raiz= brent(&cos, -100, 100, 0.0001, 100, flag);
// std::cout << "Raiz fun=" << raiz << std::endl;
//
}//end main
/* FIXME */
double impv_baw(double spot, double strike, double r, double d, double expiry, double price, int type) {
double low = 0.000001, high = 0.3, ce;
/* FIXME */
if (type != AMER_CALL && type != AMER_PUT)
return NAN;
ce = type == AMER_CALL ? baw_call(spot, strike, r, d, high, expiry) :
baw_put(spot, strike, r, d, high, expiry);
while (ce < price) {
high *= 2.0;
if (high > 1e10)
return NAN;
ce = type == AMER_CALL ? baw_call(spot, strike, r, d, high, expiry) :
baw_put(spot, strike, r, d, high, expiry);
}
return type == AMER_CALL ? brent(low, high, price, baw_call, spot, strike, r, d, expiry) :
brent(low, high, price, baw_put, spot, strike, r, d, expiry);
}
static float
checkEccExcursion(Ecc ecc_matrix[N1][N2], int dst, int src)
{
int i;
float ymax;
float step;
/*
* b = time
* fb = abs(f(b))
* ffb = max(sum of abs vals of all terms that could be the same sign)
*
* ffb is the largest partial sum of terms that we could get at
* time b. In general, it is larger than fb, because there may be
* cancellation by terms of different signs. Because all terms
* are exponentially decaying, we know that abs(f(t)) for t>b will
* always be less than ffb.
*/
float a, fa;
float b, fb, ffb;
float c, fc, ffc;
float localMax;
float tmin = 1e-5; /* Minimum time constant */
/* Initial maximum is just initial value */
ymax = absEccEval(ecc_matrix, src, dst, 0, NULL);
// printf("Exc'n: ymax=%f\n",ymax);
/*
* Step along curve looking for local maxima
* The strategy here is to take fairly large steps until we see
* that we have bracketed a peak. Then iterate on that region.
*/
step = 2.718; /* Seems to be good value */
a = 0; fa = ymax;
b = tmin; fb = absEccEval(ecc_matrix, src, dst, b, &ffb);
for (i=0; i<100; i++) { /* Should break out long before this limit */
c = b * step;
fc = absEccEval(ecc_matrix, src, dst, c, &ffc);
// printf("Exc'n: fc=%f ffc=%f\n",fc,ffc);
if (fa < fb && fb > fc) {
localMax = brent(ecc_matrix, a, b, c, fa, fb, fc, src, dst);
if (localMax > ymax) {
ymax = localMax;
}
}
if (ffb <= ymax) {
/* All terms are too small to exceed previous maximum */
break;
}
a = b; fa = fb;
b = c; fb = fc; ffb = ffc;
}
return ymax;
}
void linmin(float p[], float xi[], int n, float *fret, float (*func)(float []))
{
float brent(float ax, float bx, float cx,
float (*f)(float), float tol, float *xmin);
float f1dim(float x);
void mnbrak(float *ax, float *bx, float *cx, float *fa, float *fb,
float *fc, float (*func)(float));
int j;
float xx,xmin,fx,fb,fa,bx,ax;
if (DEBUGGING_NR) {
fprintf(stderr,"Inside linmin with n=%d\n",n);
}
ncom=n;
if (DEBUGGING_NR) {
fprintf(stderr,"Calling vector(1,%d)\n",n);
}
pcom=vector(1,n);
if (DEBUGGING_NR) {
fprintf(stderr,"done vector(1,%d)\n",n);
}
xicom=vector(1,n);
if (DEBUGGING_NR && 0) {
fprintf(stderr,"done vector(1,%d)\n",n);
}
nrfunc=func;
for (j=1;j<=n;j++) {
pcom[j]=p[j];
xicom[j]=xi[j];
}
ax=0.0;
xx=1.0;
if (DEBUGGING_NR && 0) {
fprintf(stderr,"calling mnbrak\n");
}
mnbrak(&ax,&xx,&bx,&fa,&fx,&fb,f1dim);
if (DEBUGGING_NR && 0) {
fprintf(stderr,"returned from mnbrak\n");
}
*fret=brent(ax,xx,bx,f1dim,TOL,&xmin);
if (DEBUGGING_NR) {
fprintf(stderr,"returned from brent\n");
}
for (j=1;j<=n;j++) {
xi[j] *= xmin;
p[j] += xi[j];
}
free_vector(xicom,1,n);
free_vector(pcom,1,n);
}
static double searchGeom (Point a, Point p, Geometry *g)
{
Vector ap;
double tol = dparam("TOLCURV"), s[3], f[3];
register int ip;
/* start the search at the closest point */
ap = setVector (a, p);
s[0] = g -> arclen[ip = closest (p, g)];
s[1] = g -> arclen[ip + 1];
bracket (s, f, g, a, ap);
if (fabs(f[1]) > tol)
brent (s, g, a, ap, tol);
return s[1];
}
void BenchDMR::test()
{
REAL ax=-1,bx=1,cx,fa,fb,fc;
mnbrack(&ax,&bx,&cx,&fa,&fb,&fc);
REAL xmin1;
golden(ax,bx,cx,1e-15,&xmin1);
if (_pol.degre() <= 4)
BENCH_ASSERT(std::abs(_dpol(xmin1)) < BIG_epsilon);
BENCH_ASSERT(std::abs(_dpol(xmin1)) < GIGANTESQUE_epsilon);
Pt2dr aP = brent(true);
if (_pol.degre() <= 4)
BENCH_ASSERT(std::abs(_dpol(aP.x)) < BIG_epsilon);
BENCH_ASSERT(std::abs(_dpol(aP.x)) < GIGANTESQUE_epsilon);
}
REAL BrentSearch( REAL x_lower, REAL x_upper, PCOSTFUNC pf, void* pParam, int maxiter )
{
int i;
double x_minimum = (x_upper + x_lower)/2.;
double f_minimum;
double f_lower;
double f_upper;
/* stato iterazione */
brent_state_t itstate;
const double golden = 0.3819660; /* golden = (3 - sqrt(5))/2 */
double v = x_lower + golden * (x_upper - x_lower);
double w = v;
double f_vw;
f_lower=(*pf)(pParam, x_lower);
f_upper=(*pf)(pParam, x_upper);
f_minimum=(*pf)(pParam, x_minimum);
itstate.v = v;
itstate.w = w;
itstate.d = 0.;
itstate.e = 0.;
/* SAFE_FUNC_CALL (f, v, &f_vw); */
f_vw = (*pf)(pParam, v);
itstate.f_v = f_vw;
itstate.f_w = f_vw;
for(i=0; i < maxiter; i++) {
brent(&itstate,pf,pParam,&x_minimum,&f_minimum,&x_lower,&f_lower,&x_upper,&f_upper);
if(fabs(f_upper - f_lower) < GSL_DBL_EPSILON * fabs(f_minimum)){
return x_minimum;
}
}
return x_minimum;
}
// Perform a one dimensional minimization starting at configuration p.
// The gradient of the function at p is calculated, and the
// minimization is along the line of that gradient. The resulting
// minimum configuration point is returned.
static struct configuration *
linearMinimize(struct configuration *p,
double tolerance,
enum linearAlgorithm algorithm)
{
struct configuration *a = NULL;
struct configuration *b = NULL;
struct configuration *c = NULL;
struct configuration *min = NULL;
Enter(p);
bracketMinimum(&a, &b, &c, p);
BAILR(NULL);
if (Interrupted) return b;
NULLPTRR(a, p);
NULLPTRR(b, p);
NULLPTRR(c, p);
if (DEBUG(D_MINIMIZE)) {
message(p->functionDefinition, "bmin: a %e[%e] b %e[%e] c %e[%e]",
evaluate(a), a->parameter,
evaluate(b), b->parameter,
evaluate(c), c->parameter);
}
if (algorithm == LinearBracket && b != p) {
SetConfiguration(&min, b);
} else {
min = brent(p, a, b, c, tolerance);
}
//printf("minimum at parameter value: %e, function value: %e\n", min->parameter, evaluate(min));
SetConfiguration(&a, NULL);
SetConfiguration(&b, NULL);
SetConfiguration(&c, NULL);
if (DEBUG(D_MINIMIZE) && min == p) {
message(p->functionDefinition, "linearMinimize returning argument");
}
Leave(linearMinimize, p, (min == p) ? 0 : 1);
return min;
}
void linmin(pT& p,pT& xi,rT& fret,func_obj<rT,pT>& func)
{
// assert(p.size()==10);
//assert(xi.size()==10);
func_adaptor<rT,pT> fadpt(p,xi,func);
int j=0;
const rT TOL=std::sqrt(std::numeric_limits<rT>::epsilon());
rT xx=0,xmin=0,fx=0,fb=0,fa=0,bx=0,ax=0;
int n=(int)get_size(p);
ax=0.;
xx=1.;
mnbrak(ax,xx,bx,fa,fx,fb,fadpt);
//cout<<xx<<endl;
fret=brent(ax,xx,bx,fadpt,TOL,xmin);
//cout<<xmin<<endl;
#ifdef _OPENMP
#pragma omp parallel for
#endif
for(j=0;j<n;++j)
{
//get_element(xi,j)*=xmin;
set_element(xi,j,
get_element(xi,j)*xmin);
//get_element(p,j)+=get_element(xi,j);
set_element(p,j,
get_element(p,j)+get_element(xi,j));
}
// delete xicom_p;
//delete pcom_p;
}
optimizeSelectonParameters::optimizeSelectonParameters(tree& et, //find Best params and best BBL
const sequenceContainer& sc,
vector<stochasticProcess>& spVec,
distribution * distr,
bool bblFlag,
bool isGamma, bool isBetaProbSet,bool isOmegaSet,
bool isKappaSet, bool isAlphaSet, bool isBetaSet,
const MDOUBLE upperBoundOnAlpha,
const MDOUBLE upperBoundOnBeta,
const MDOUBLE epsilonAlphaOptimization,
const MDOUBLE epsilonKOptimization,
const MDOUBLE epsilonLikelihoodImprovment,
const int maxBBLIterations,
const int maxTotalIterations){
//initialization
MDOUBLE lowerValueOfParamK = 0;
MDOUBLE lowerValueOfParamAlpha = 0.1;
MDOUBLE lowerValueOfParamBeta = 0.1;
MDOUBLE omegaLowerBoundary = 0.99; // this is to allow brent to reach the exact lower bound value
MDOUBLE omegaUpperBoundary = 5.0;
MDOUBLE upperValueOfParamK = 5; // changed from 50, Adi S. 2/1/07
MDOUBLE initialGuessValueOfParamTr;
initialGuessValueOfParamTr = _bestK = static_cast<wYangModel*>(spVec[0].getPijAccelerator()->getReplacementModel())->getK();
MDOUBLE initialGuessValueOfParamAlpha;
if (isGamma) initialGuessValueOfParamAlpha = _bestAlpha = static_cast<generalGammaDistribution*>(distr)->getAlpha();
else initialGuessValueOfParamAlpha = _bestAlpha = static_cast<betaOmegaDistribution*>(distr)->getAlpha();
MDOUBLE initialGuessValueOfParamBeta;
if (isGamma) initialGuessValueOfParamBeta = _bestBeta = static_cast<generalGammaDistribution*>(distr)->getBeta();
else initialGuessValueOfParamBeta = _bestBeta = static_cast<betaOmegaDistribution*>(distr)->getBeta();
MDOUBLE initialGuessValueOfParamOmega = -1;
MDOUBLE initialGuessValueOfParamBetaProb = -1;
if (!isGamma) {
initialGuessValueOfParamOmega = _bestOmega = static_cast<betaOmegaDistribution*>(distr)->getOmega();
initialGuessValueOfParamBetaProb = _bestBetaProb = static_cast<betaOmegaDistribution*>(distr)->getBetaProb();
}
_bestL = likelihoodComputation2Codon::getTreeLikelihoodAllPosAlphTheSame(et,sc,spVec,distr);;
MDOUBLE newL = _bestL;
MDOUBLE alphaFound = 0;
MDOUBLE kFound = 0;
MDOUBLE betaFound = 0;
MDOUBLE omegaFound = 0;
MDOUBLE betaProbFound = 0;
bool changed = false;
int i=0;
LOG(5,<<endl<<"Beginning optimization of parameters"<<endl<<endl);
for (i=0; i < maxTotalIterations; ++i) {
LOG(5,<<"Iteration Number= " << i <<endl);
LOG(5,<<"---------------------"<<endl);
cout<<"Iteration number = "<< i <<endl;
alphaFound = omegaFound = betaProbFound = kFound = betaFound=0;
changed = false;
//ALPHA (beta or gamma distribution parameter)
if (!isAlphaSet){
if (isGamma) initialGuessValueOfParamAlpha = static_cast<generalGammaDistribution*>(distr)->getAlpha();
else initialGuessValueOfParamAlpha = static_cast<betaOmegaDistribution*>(distr)->getAlpha();
newL = -brent(lowerValueOfParamAlpha,
initialGuessValueOfParamAlpha,
upperBoundOnAlpha,
evalParam(et,sc,spVec,-1,distr,isGamma),epsilonAlphaOptimization,&alphaFound);
LOG(5,<<"current best L= "<<_bestL<<endl<<endl);
LOG(5,<<"new L After alpha= " << newL<<endl);
LOG(5,<<"new alpha = " <<alphaFound<<endl<<endl);
if (newL > _bestL+epsilonLikelihoodImprovment ) {// update of likelihood ,v and model.
_bestL = newL;
_bestAlpha = alphaFound;
if (isGamma) static_cast<generalGammaDistribution*>(distr)->setAlpha(alphaFound);
else static_cast<betaOmegaDistribution*>(distr)->setAlpha(alphaFound);
for (int categor = 0; categor < spVec.size();categor++)
static_cast<wYangModel*>(spVec[categor].getPijAccelerator()->getReplacementModel())->setW(distr->rates(categor));
normalizeMatrices(spVec,distr);
changed = true;
}
}
//BETA (beta distribution parameter)
if (!isBetaSet) {
if (isGamma) initialGuessValueOfParamBeta = static_cast<generalGammaDistribution*>(distr)->getBeta();
else initialGuessValueOfParamBeta = static_cast<betaOmegaDistribution*>(distr)->getBeta();
newL = -brent(lowerValueOfParamBeta,
initialGuessValueOfParamBeta,
upperBoundOnBeta,
evalParam(et,sc,spVec,-2,distr,isGamma),epsilonAlphaOptimization,&betaFound);
LOG(5,<<"current best L= "<<_bestL<<endl<<endl);
LOG(5,<<"new L After beta= " << newL<<endl);
LOG(5,<<"new beta = " <<betaFound<<endl<<endl);
if (newL > _bestL+epsilonLikelihoodImprovment ) {// update of likelihood ,v and model.
_bestL = newL;
_bestBeta = betaFound;
if (isGamma) static_cast<generalGammaDistribution*>(distr)->setBeta(betaFound);
else static_cast<betaOmegaDistribution*>(distr)->setBeta(betaFound);
for (int categor = 0; categor < spVec.size();categor++)
static_cast<wYangModel*>(spVec[categor].getPijAccelerator()->getReplacementModel())->setW(distr->rates(categor));
normalizeMatrices(spVec,distr);
changed = true;
}
}
//K parameter
if (!isKappaSet){
initialGuessValueOfParamTr = static_cast<wYangModel*>(spVec[0].getPijAccelerator()->getReplacementModel())->getK();
newL = -brent(lowerValueOfParamK, //optimaize Tr
initialGuessValueOfParamTr,
upperValueOfParamK,
evalParam(et,sc,spVec,0,distr,isGamma),epsilonKOptimization,&kFound);
LOG(5,<<"current best L= "<<_bestL<<endl<<endl);
LOG(5,<<"new L After kappa= " << newL<<endl);
LOG(5,<<"new kappa = " <<kFound<<endl);
if (newL > _bestL+epsilonLikelihoodImprovment ) {// update of likelihood and model.
_bestL = newL;
_bestK = kFound;
for (int categor = 0; categor < spVec.size();categor++)
static_cast<wYangModel*>(spVec[categor].getPijAccelerator()->getReplacementModel())->setK(kFound);
normalizeMatrices(spVec,distr);
changed = true;
}
}
//beta distribution part (betaProb and additional omega)
if (isGamma==false && !isBetaProbSet){ //optimize beta probs
if (!isOmegaSet){ // optimize omega (M8 or M8b)
MDOUBLE omegaFound;
newL = -brent(omegaLowerBoundary,
initialGuessValueOfParamOmega,
omegaUpperBoundary,
evalParam(et,sc,spVec,1,distr,isGamma),0.01,&omegaFound);
LOG(5,<<"current best L= "<<_bestL<<endl<<endl);
LOG(5,<<"new L After additional omega caetgory = " << newL<<endl);
LOG(5,<<"new additional omega caetgory = " <<omegaFound<<endl<<endl);
if (newL > _bestL+epsilonLikelihoodImprovment ) {
_bestL = newL;
_bestOmega = omegaFound;
static_cast<betaOmegaDistribution*>(distr)->setOmega(omegaFound);
static_cast<wYangModel*>(spVec[spVec.size()-1].getPijAccelerator()->getReplacementModel())->setW(omegaFound);
normalizeMatrices(spVec,distr);
changed = true;
}
}
MDOUBLE betaProbFound;
newL = -brent(0.0,initialGuessValueOfParamBetaProb,1.0,
evalParam(et,sc,spVec,2,distr,isGamma),0.01,&betaProbFound);
LOG(5,<<"current best L= "<<_bestL<<endl<<endl);
LOG(5,<<"new L After prob(additional omega caetgory)= " << newL<<endl);
LOG(5,<<"new prob(additional omega caetgory)= " <<1 - betaProbFound<<endl<<endl);
if (newL > _bestL+epsilonLikelihoodImprovment ) {// update of likelihood ,v and model.
_bestL = newL;
_bestBetaProb = betaProbFound;
static_cast<betaOmegaDistribution*>(distr)->setBetaProb(betaProbFound);
normalizeMatrices(spVec,distr);
changed = true;
}
}
void
LEPlic :: findCellLineConstant(double &p, FloatArray &fvgrad, int ie, bool coord_upd, bool temp_vof_flag)
{
/* The line constatnt p is solved from the general non-linear function
* F(p) = V(p)-V = 0,
* where V(p) is the truncated volume resulting from the intersection between
* assumed line segment and the reference cell
* V is the given Volume of Fluid ratio
* To find zero of this function, Brent's method is been used.
*/
Element *elem = domain->giveElement(ie);
LEPlicElementInterface *interface = ( LEPlicElementInterface * ) elem->giveInterface(LEPlicElementInterfaceType);
int ivert, nelemnodes = elem->giveNumberOfNodes();
double ivof, fvi;
double ivx, ivy, pp, target_vof;
if ( temp_vof_flag ) {
target_vof = interface->giveTempVolumeFraction();
} else {
target_vof = interface->giveVolumeFraction();
}
computeLEPLICVolumeFractionWrapper wrapper(interface, this, fvgrad, target_vof, coord_upd);
/*
* Initial part: find lower and uper bounds for Brent algorithm
* Here lines with given interface normal are passed through each vertex
* and corresponding volume fractions are computed. The two lines forming
* truncation volumes that bound the actual material in the cell provide
* upper and lower bounds for line constant
*/
double upper_vof = 10.0, lower_vof = -10.0;
double upper_p = 0.0, lower_p = 0.0;
if ( temp_vof_flag ) {
fvi = interface->giveTempVolumeFraction();
} else {
fvi = interface->giveVolumeFraction();
}
if ( ( fvi > LEPLIC_ZERO_VOF ) && ( fvi < 1.0 ) ) {
// boundary cell
for ( ivert = 1; ivert <= nelemnodes; ivert++ ) {
if ( coord_upd ) {
ivx = giveUpdatedXCoordinate( elem->giveNode(ivert)->giveNumber() );
ivy = giveUpdatedYCoordinate( elem->giveNode(ivert)->giveNumber() );
} else {
ivx = elem->giveNode(ivert)->giveCoordinate(1);
ivy = elem->giveNode(ivert)->giveCoordinate(2);
}
// determine line constant for vertex ivert
pp = -( fvgrad.at(1) * ivx + fvgrad.at(2) * ivy );
ivof = interface->computeLEPLICVolumeFraction(fvgrad, pp, this, coord_upd);
if ( ( ( ivof - target_vof ) >= 0. ) && ( ivof < upper_vof ) ) {
upper_vof = ivof;
upper_p = pp;
} else if ( ( ( target_vof - ivof ) >= 0. ) && ( ivof > lower_vof ) ) {
lower_vof = ivof;
lower_p = pp;
}
}
if ( ( lower_vof >= 0. ) && ( upper_vof <= 1.00000000001 ) ) {
// now use brent's method to find minima of V(p)-V function
brent(lower_p, 0.5 * ( lower_p + upper_p ), upper_p,
mem_fun< computeLEPLICVolumeFractionWrapper >(& wrapper, & computeLEPLICVolumeFractionWrapper :: eval),
LEPLIC_BRENT_EPS, p);
//interface->setTempLineConstant (p);
#ifdef __OOFEG
/*
* Polygon grp, cell;
* // check here
* //Polygon testvolpoly;
* //interface->formMaterialVolumePoly(testvolpoly, this, fvgrad, p, true);
* //double debug_vof = interface->truncateMatVolume(testvolpoly);
*
* //printf ("Cell %d-> target_vof is %e, debug val is %e\n", ie, target_vof, debug_vof);
* interface->formMyVolumePoly (cell, this, true);
* GraphicObj *goc = cell.draw(::gc[0], false);
* EASValsSetLayer(OOFEG_DEBUG_LAYER);
* EASValsSetColor(::gc[0].getBcIcColor());
* EGWithMaskChangeAttributes(COLOR_MASK | LAYER_MASK, goc);
* EMDrawGraphics (ESIModel(), goc);
*
* interface->formVolumeInterfacePoly (grp, this, fvgrad, p, true);
* GraphicObj *go = grp.draw(::gc[0], true);
* EASValsSetColor(::gc[0].getActiveCrackColor());
* EGWithMaskChangeAttributes(COLOR_MASK | LAYER_MASK, go);
* EMDrawGraphics (ESIModel(), go);
* //ESIEventLoop (YES, "findCellLineConstant -> Press Ctrl-p to continue");
*/
#endif
} else {
OOFEM_ERROR("LEPlic::findCellLineConstant: finding lower and uper bounds of line constant value failed");
}
}
}
main ( int argc, char *argv[] ){
int i, j, k, l, iter, internal_index;
double fret;
double *p, *del, *p_old, abs_dev, Z_old, Z_diff;
char *in_data, *in_model, *out_model;
FILE *fp_in_data, *fp_in_model, *fp_out_model, *fp_evolution;
char evolution_file_name[100] ;
double *mu_vec, *grad_mu;
double mu_x, mu_y;
double FTOL;
double mu_scalar;
double ax, bx, xx, fa, fx, fb, xmin ;
/* output version number and compilation parameters */
printf("VERA_OC version: %s\n", __DATE__);
#ifdef USERHOD
printf("rho_delta may be non-zero, ");
#else
printf("rho_delta forced to zero, ");
#endif
#ifdef MUNONNEG
printf("non-negative mus only.\n ");
#else
printf("mus may be negative.\n ");
#endif
/* initialize command line variables */
verbose = FALSE;
disp_iter = FALSE;
start_mod = FALSE;
evolution = FALSE;
stop_crit = FALSE;
in_data = NULL;
in_model = NULL;
out_model = NULL;
start_time(); /* start timer */
/* parse command line */
for (i=1; i<argc; i++) {
if (strcmp(argv[i], "-verbose") == 0) verbose = TRUE ;
else if (strcmp(argv[i], "-iter") == 0) disp_iter = TRUE;
else if (strcmp(argv[i], "-init") == 0) start_mod = TRUE;
else if (strcmp(argv[i], "-evol") == 0) evolution = TRUE;
else if (in_model == NULL && start_mod == TRUE ) in_model = argv[i];
else if (strcmp(argv[i], "-crit") == 0) stop_crit = TRUE;
else if (stop_crit == TRUE ){ EPS_BETA = atof(argv[i]); stop_crit = FALSE; }
else if (in_data == NULL) in_data = argv[i];
else if (out_model == NULL) out_model = argv[i];
else die (1) ;
}
if (in_data == NULL || (in_model == NULL && start_mod == TRUE) || out_model == NULL ) die(1);
fp_in_data = fopen(in_data, "r");
if (fp_in_data == NULL) die (2);
if ( start_mod == TRUE ){
fp_in_model = fopen(in_model, "r");
if (fp_in_model == NULL) die (2);
}
fp_out_model = fopen(out_model, "w");
if (fp_out_model == NULL) die (2);
if ( evolution == TRUE ){
strcpy ( evolution_file_name, in_data );
strcat ( evolution_file_name, ".evolution" );
fp_evolution = fopen( evolution_file_name, "w" );
fprintf(fp_evolution, "iter sigma_eps_x sigma_del_x objective function\n");
fflush( fp_evolution );
}
/* read in the data */
printf ("Reading expression data (merge) file %s\n", in_data );
read_data_OC( fp_in_data );
/* allocate memory for mu variables and set them to zero */
muX = (float *) calloc(N, sizeof(float));
for (i=0 ; i<N ; i++ ){
muX[i] = 0.;
}
/* read in the model */
cov = (double *) calloc(NDIM+1, sizeof(double));
if ( start_mod == TRUE ) {
printf ("Reading input model (initial guess) file %s\n", in_model );
read_mod( fp_in_model );
} else { /* if model is not read in use starting guess */
cov[1] = 0.3 ;
cov[2] = 20 ;
/* cov[2] = 10 ; */
}
/* If mu values were not read in by read_mod, assign mu to means */
if( muX[0] == 0. && muX[N-1] == 0. ){ /* this criterion could be improved e.g. use sum over all entries */
for(i=0 ; i<N ; i++ ){
for (j=0; j<m[i] ; j++ ){
muX[i] += X[i][j] ;
}
muX[i] /= (float)(m[i]);
}
}
/****************************************************************************/
/********* Memory allocation, Initialization ******/
/****************************************************************************/
/* beta vector and gradient indexed 1,..,6 for NumRec routines*/
p = (double *) calloc(NDIM+1, sizeof(double));
del = (double *) calloc(NDIM+1 ,sizeof(double));
p_old = (double *) calloc(NDIM+1, sizeof(double));
/* parameters of covariance matrix and vectors for single gene objective function */
grad_mu = (double *) calloc(NDIM_MU+1, sizeof(double));
for( i=1 ; i<= NDIM ; i++ ){
p[i] = cov[i];
}
if ( evolution == TRUE ){
/* print initial parameter evolution file */
fprintf ( fp_evolution, "%4d ", 0);
for ( j=1 ; j<= NDIM; j++ ){
fprintf ( fp_evolution," %9.4f ", p[j]);
fflush( fp_evolution );
}
}
/*****************************************************************************/
/** Master loop begins here ******/
/*****************************************************************************/
if ( disp_iter == FALSE ) printf("Iterations in progress: ");
fflush(stdout);
for (k=0 ; k<MAX_MASTER ; k++){ /* master loop */
/* display . for iteration */
if ( disp_iter == FALSE ){
if ( (k+1) % 5 ){
printf(".");
fflush(stdout);
} else {
printf("%d" , k+1 );
fflush(stdout);
}
}
if ( disp_iter == TRUE )
printf("\n\n ********** Starting master loop iteration %d ************** \n", k);
/****************************************************************************/
/********* Optimize beta ******/
/****************************************************************************/
for( i=0 ; i<N ; i++ ){
for (j=0; j<m[i] ; j++ ){
X[i][j] -= muX[i] ;
}
}
/* save current values of beta to later assess progress of iteration */
for( i=1 ; i<= NDIM ; i++ ){
p_old[i] = p[i];
}
Z_old = Z_OC(p);
if ( disp_iter == TRUE )
printf("Objective function at beginning of master it. no. %d is %14f\n", k, Z_old);
/* log10(tolerance) drops with each master iteration */
LINMIN_TOL = pow(10., log10(LINMIN_TOL_HIGH) + k* (log10(LINMIN_TOL_LOW)-log10(LINMIN_TOL_HIGH)) / (double) MAX_MASTER ) ;
FTOL = pow(10., log10(FTOL_HIGH) + k* (log10(FTOL_LOW)-log10(FTOL_HIGH)) / (double) MAX_MASTER );
if ( disp_iter == TRUE )
printf("\nlog10(LINMIN_TOL): %f, log10(FTOL): %f\n\n", log10(LINMIN_TOL), log10(FTOL));
/* shift intensities by mus for this evaluation below */
/*
for( i=0 ; i<N ; i++ ){
for (j=0; j<m[i] ; j++ ){
X[i][j] -= muX[i] ;
}
}
*/
if ( disp_iter == TRUE )
printf("Objective function at beginning of master it. no. %d is %14f\n", k, Z_OC(p));
if ( evolution == TRUE )
fprintf( fp_evolution, "%18.3f\n", Z_OC(p) );
if ( disp_iter == TRUE )
printf("\n+++Starting epsilon+delta optimization++++++\n");
LINMIN_TOL = LINMIN_TOL_LOW;
frprmn(p, NDIM, FTOL_LOW, &iter, &fret, Z_OC, gradZ_OC);
if (verbose == TRUE){
printf("Iterations: %3d\n",iter);
printf("frprmn solution vector: (");
for (j=1 ;j<=NDIM ; j++) printf("%6.4f,", p[j]);
printf(")\n");
printf("Func. value at solution %14f\n",fret);
}
/* print result of beta optimization */
if ( disp_iter == TRUE ){
printf( " Beta: ");
for (j=1 ;j<=NDIM ; j++) printf("%6.4f,", p[j]);
printf("\n");
printf( " Value of objective function: %14f\n", fret);
}
/* copy covariance into global location */
for (i=1 ; i<=NDIM ; i++ ) cov[i] = p[i];
/****************************************************************************/
/********* Optimize mus ******/
/****************************************************************************/
if ( disp_iter == TRUE )
printf("\n+++Starting mu optimization++++++\n");
/* Need unshifted intensities below */
for( i=0 ; i<N ; i++ ){
for (j=0; j<m[i] ; j++ ){
X[i][j] += muX[i] ;
}
}
for(i=0 ; i<N; i++ ){ /* loop over genes */
if ( disp_iter == TRUE )
printf("mu optimization for gene %d begins \n", internal2full[i]);
mu_x = (double) muX[i] ;
gene_index = i;
/* seed unconstrained with result from above */
mu_scalar = mu_x;
/********* Will have to change to single variable minimization ****/
if ( disp_iter == TRUE )
printf("mu_scalar before minimization %f\n", mu_scalar );
/*frprmn(mu_scalar, NDIM_MU, FTOL, &iter, &fret, Z_gene_OC, derivativeZ_gene_OC); */
ax = mu_x;
xx = mu_x+ 5.; /* who knows? */
mnbrak(&ax,&xx,&bx,&fa,&fx,&fb,Z_gene_OC);
brent(ax,xx,bx,Z_gene_OC,LINMIN_TOL,&xmin);
mu_scalar=xmin;
if ( disp_iter == TRUE ){
printf("mu_scalar after minimization %f\n", mu_scalar );
printf("mu derivative: %f\n", derivativeZ_gene_OC(mu_scalar) );
}
#ifdef MUNONNEG
mu_scalar = fabs( mu_scalar );
#endif
/* replace revised muX */
muX[i] = mu_scalar;
} /* mu optimization ends here. X is not mu subtracted at this point*/
/* correct for instances of finding negative sigma */
if ( p[1] < 0 ){
p[1] = -p[1];
}
if ( p[2] < 0 ){
p[2] = -p[2];
}
/* summarize result of beta optimization */
if ( disp_iter == TRUE ){
printf( " Beta after master loop iteration %d : ",k);
for (j=1 ;j<=NDIM ; j++) printf(" %6.4f ", p[j]);
printf( "\n");
}
if ( evolution == TRUE ){
/* print results of master loop iteration in parameter evolution file */
fprintf ( fp_evolution, "%4d ", k+1);
for ( j=1 ; j<= NDIM; j++ ){
fprintf ( fp_evolution," %9.4f ", p[j]);
fflush( fp_evolution );
}
}
/* exit master loop if maximum absolute increment is below threshold */
abs_dev = 0.;
for ( j=1 ; j<=NDIM ; j++ ){
if ( fabs(p[j]-p_old[j]) > abs_dev ) abs_dev = fabs(p[j]-p_old[j]);
}
/* shift for evaluation */
for( i=0 ; i<N ; i++ ){
for (j=0; j<m[i] ; j++ ){
X[i][j] -= muX[i] ;
}
}
Z_diff = fabs(Z_OC(p)-Z_old);
if ( disp_iter == TRUE )
printf("Objective function at end of master it. no. %d is %14f\n", k, Z_OC(p));
/* unshift */
for( i=0 ; i<N ; i++ ){
for (j=0; j<m[i] ; j++ ){
X[i][j] += muX[i] ;
}
}
if ( Z_diff > abs_dev ) abs_dev = Z_diff ;
if ( abs_dev < EPS_BETA && k > MIN_MASTER )
break;
} /* close master loop */
/* shift intensities by mus for this evaluation below */
for( i=0 ; i<N ; i++ ){
for (j=0; j<m[i] ; j++ ){
X[i][j] -= muX[i] ;
}
}
printf("\nOptimization completed in %d iterations.\n", k+1);
if( k == MAX_MASTER ) printf("Warning: This is the maximum of number of allowed iterations\n");
printf( "Final objective value %f\n\n", Z_OC(cov));
if ( evolution == TRUE )
fprintf( fp_evolution, "%18.3f\n", Z_OC(cov));
/****************************************************************************/
/********* Print out final model ******/
/****************************************************************************/
fprintf(fp_out_model,"sig_eps_x sig_del_x\n");
fprintf(fp_out_model," %8.5f %8.5f",
p[1],p[2]);
fprintf(fp_out_model,"\n");
fclose(fp_in_data);
if ( start_mod == TRUE ){
fclose(fp_in_model);
}
if ( evolution == TRUE )
fclose( fp_evolution );
stdout_prn_time(); /* display elapsed time */
return (0);
}
/* Function: esl_min_ConjugateGradientDescent()
* Incept: SRE, Wed Jun 22 08:49:42 2005 [St. Louis]
*
* Purpose: n-dimensional minimization by conjugate gradient descent.
*
* An initial point is provided by <x>, a vector of <n>
* components. The caller also provides a function <*func()> that
* compute the objective function f(x) when called as
* <(*func)(x, n, prm)>, and a function <*dfunc()> that can
* compute the gradient <dx> at <x> when called as
* <(*dfunc)(x, n, prm, dx)>, given an allocated vector <dx>
* to put the derivative in. Any additional data or fixed
* parameters that these functions require are passed by
* the void pointer <prm>.
*
* The first step of each iteration is to try to bracket
* the minimum along the current direction. The initial step
* size is controlled by <u[]>; the first step will not exceed
* <u[i]> for any dimension <i>. (You can think of <u> as
* being the natural "units" to use along a graph axis, if
* you were plotting the objective function.)
*
* The caller also provides an allocated workspace sufficient to
* hold four allocated n-vectors. (4 * sizeof(double) * n).
*
* Iterations continue until the objective function has changed
* by less than a fraction <tol>. This should not be set to less than
* sqrt(<DBL_EPSILON>).
*
* Upon return, <x> is the minimum, and <ret_fx> is f(x),
* the function value at <x>.
*
* Args: x - an initial guess n-vector; RETURN: x at the minimum
* u - "units": maximum initial step size along gradient when bracketing.
* n - dimensionality of all vectors
* *func() - function for computing objective function f(x)
* *dfunc() - function for computing a gradient at x
* prm - void ptr to any data/params func,dfunc need
* tol - convergence criterion applied to f(x)
* wrk - allocated 4xn-vector for workspace
* ret_fx - optRETURN: f(x) at the minimum
*
* Returns: <eslOK> on success.
*
* Throws: <eslENOHALT> if it fails to converge in MAXITERATIONS.
* <eslERANGE> if the minimum is not finite, which may
* indicate a problem in the implementation or choice of <*func()>.
*
* Xref: STL9/101.
*/
int
esl_min_ConjugateGradientDescent(double *x, double *u, int n,
double (*func)(double *, int, void *),
void (*dfunc)(double *, int, void *, double *),
void *prm, double tol, double *wrk, double *ret_fx)
{
double oldfx;
double coeff;
int i, i1;
double *dx, *cg, *w1, *w2;
double cvg;
double fa,fb,fc;
double ax,bx,cx;
double fx;
dx = wrk;
cg = wrk + n;
w1 = wrk + 2*n;
w2 = wrk + 3*n;
oldfx = (*func)(x, n, prm); /* init the objective function */
/* Bail out if the function is +/-inf: this can happen if the caller
* has screwed something up, or has chosen a bad start point.
*/
if (oldfx == eslINFINITY || oldfx == -eslINFINITY)
ESL_EXCEPTION(eslERANGE, "minimum not finite");
if (dfunc != NULL)
{
(*dfunc)(x, n, prm, dx); /* find the current negative gradient, - df(x)/dxi */
esl_vec_DScale(dx, n, -1.0);
}
else numeric_derivative(x, u, n, func, prm, 1e-4, dx); /* resort to brute force */
esl_vec_DCopy(dx, n, cg); /* and make that the first conjugate direction, cg */
/* (failsafe) convergence test: a zero direction can happen,
* and it either means we're stuck or we're finished (most likely stuck)
*/
for (i1 = 0; i1 < n; i1++)
if (cg[i1] != 0.) break;
if (i1 == n) {
if (ret_fx != NULL) *ret_fx = oldfx;
return eslOK;
}
for (i = 0; i < MAXITERATIONS; i++)
{
/* Figure out the initial step size.
*/
bx = fabs(u[0] / cg[0]);
for (i1 = 1; i1 < n; i1++)
{
cx = fabs(u[i1] / cg[i1]);
if (cx < bx) bx = cx;
}
/* Bracket the minimum.
*/
bracket(x, cg, n, bx, func, prm, w1,
&ax, &bx, &cx,
&fa, &fb, &fc);
/* Minimize along the line given by the conjugate gradient <cg> */
brent(x, cg, n, func, prm, ax, cx, 1e-3, 1e-8, w2, NULL, &fx);
esl_vec_DCopy(w2, n, x);
/* Bail out if the function is now +/-inf: this can happen if the caller
* has screwed something up.
*/
if (fx == eslINFINITY || fx == -eslINFINITY)
ESL_EXCEPTION(eslERANGE, "minimum not finite");
/* Find the negative gradient at that point (temporarily in w1) */
if (dfunc != NULL)
{
(*dfunc)(x, n, prm, w1);
esl_vec_DScale(w1, n, -1.0);
}
else numeric_derivative(x, u, n, func, prm, 1e-4, w1); /* resort to brute force */
/* Calculate the Polak-Ribiere coefficient */
for (coeff = 0., i1 = 0; i1 < n; i1++)
coeff += (w1[i1] - dx[i1]) * w1[i1];
coeff /= esl_vec_DDot(dx, dx, n);
/* Calculate the next conjugate gradient direction in w2 */
esl_vec_DCopy(w1, n, w2);
esl_vec_DAddScaled(w2, cg, coeff, n);
/* Finishing set up for next iteration: */
esl_vec_DCopy(w1, n, dx);
esl_vec_DCopy(w2, n, cg);
/* Now: x is the current point;
* fx is the function value at that point;
* dx is the current gradient at x;
* cg is the current conjugate gradient direction.
*/
/* Main convergence test. 1e-9 factor is fudging the case where our
* minimum is at exactly f()=0.
*/
cvg = 2.0 * fabs((oldfx-fx)) / (1e-10 + fabs(oldfx) + fabs(fx));
// fprintf(stderr, "(%d): Old f() = %.9f New f() = %.9f Convergence = %.9f\n", i, oldfx, fx, cvg);
// fprintf(stdout, "(%d): Old f() = %.9f New f() = %.9f Convergence = %.9f\n", i, oldfx, fx, cvg);
#if eslDEBUGLEVEL >= 2
printf("\nesl_min_ConjugateGradientDescent():\n");
printf("new point: ");
for (i1 = 0; i1 < n; i1++)
printf("%g ", x[i1]);
printf("\nnew gradient: ");
for (i1 = 0; i1 < n; i1++)
printf("%g ", dx[i1]);
numeric_derivative(x, u, n, func, prm, 1e-4, w1);
printf("\n(numeric grad): ");
for (i1 = 0; i1 < n; i1++)
printf("%g ", w1[i1]);
printf("\nnew direction: ");
for (i1 = 0; i1 < n; i1++)
printf("%g ", cg[i1]);
printf("\nOld f() = %g New f() = %g Convergence = %g\n\n", oldfx, fx, cvg);
#endif
if (cvg <= tol) break;
/* Second (failsafe) convergence test: a zero direction can happen,
* and it either means we're stuck or we're finished (most likely stuck)
*/
for (i1 = 0; i1 < n; i1++)
if (cg[i1] != 0.) break;
if (i1 == n) break;
oldfx = fx;
}
if (ret_fx != NULL) *ret_fx = fx;
if (i == MAXITERATIONS)
ESL_FAIL(eslENOHALT, NULL, " ");
// ESL_EXCEPTION(eslENOHALT, "Failed to converge in ConjugateGradientDescent()");
return eslOK;
}
void fitexy(float x[], float y[], int ndat, float sigx[], float sigy[],
float *a, float *b, float *siga, float *sigb, float *chi2, float *q)
{
void avevar(float data[], unsigned long n, float *ave, float *var);
float brent(float ax, float bx, float cx,
float (*f)(float), float tol, float *xmin);
float chixy(float bang);
void fit(float x[], float y[], int ndata, float sig[], int mwt,
float *a, float *b, float *siga, float *sigb, float *chi2, float *q);
float gammq(float a, float x);
void mnbrak(float *ax, float *bx, float *cx, float *fa, float *fb,
float *fc, float (*func)(float));
float zbrent(float (*func)(float), float x1, float x2, float tol);
int j;
float swap,amx,amn,varx,vary,ang[7],ch[7],scale,bmn,bmx,d1,d2,r2,
dum1,dum2,dum3,dum4,dum5;
xx=vector(1,ndat);
yy=vector(1,ndat);
sx=vector(1,ndat);
sy=vector(1,ndat);
ww=vector(1,ndat);
avevar(x,ndat,&dum1,&varx);
avevar(y,ndat,&dum1,&vary);
scale=sqrt(varx/vary);
nn=ndat;
for (j=1;j<=ndat;j++) {
xx[j]=x[j];
yy[j]=y[j]*scale;
sx[j]=sigx[j];
sy[j]=sigy[j]*scale;
ww[j]=sqrt(SQR(sx[j])+SQR(sy[j]));
}
fit(xx,yy,nn,ww,1,&dum1,b,&dum2,&dum3,&dum4,&dum5);
offs=ang[1]=0.0;
ang[2]=atan(*b);
ang[4]=0.0;
ang[5]=ang[2];
ang[6]=POTN;
for (j=4;j<=6;j++) ch[j]=chixy(ang[j]);
mnbrak(&ang[1],&ang[2],&ang[3],&ch[1],&ch[2],&ch[3],chixy);
*chi2=brent(ang[1],ang[2],ang[3],chixy,ACC,b);
*chi2=chixy(*b);
*a=aa;
*q=gammq(0.5*(nn-2),*chi2*0.5);
for (r2=0.0,j=1;j<=nn;j++) r2 += ww[j];
r2=1.0/r2;
bmx=BIG;
bmn=BIG;
offs=(*chi2)+1.0;
for (j=1;j<=6;j++) {
if (ch[j] > offs) {
d1=fabs(ang[j]-(*b));
while (d1 >= PI) d1 -= PI;
d2=PI-d1;
if (ang[j] < *b) {
swap=d1;
d1=d2;
d2=swap;
}
if (d1 < bmx) bmx=d1;
if (d2 < bmn) bmn=d2;
}
}
if (bmx < BIG) {
bmx=zbrent(chixy,*b,*b+bmx,ACC)-(*b);
amx=aa-(*a);
bmn=zbrent(chixy,*b,*b-bmn,ACC)-(*b);
amn=aa-(*a);
*sigb=sqrt(0.5*(bmx*bmx+bmn*bmn))/(scale*SQR(cos(*b)));
*siga=sqrt(0.5*(amx*amx+amn*amn)+r2)/scale;
} else (*sigb)=(*siga)=BIG;
*a /= scale;
*b=tan(*b)/scale;
free_vector(ww,1,ndat);
free_vector(sy,1,ndat);
free_vector(sx,1,ndat);
free_vector(yy,1,ndat);
free_vector(xx,1,ndat);
}