int main(void)
{
long idum=(-911);
int i,j,mfit=MA,*ia;
float chisq,*beta,*x,*y,*sig,**covar,**alpha;
static float a[MA+1]=
{0.0,5.0,2.0,3.0,2.0,5.0,3.0};
static float gues[MA+1]=
{0.0,4.9,2.1,2.9,2.1,4.9,3.1};
ia=ivector(1,MA);
beta=vector(1,MA);
x=vector(1,NPT);
y=vector(1,NPT);
sig=vector(1,NPT);
covar=matrix(1,MA,1,MA);
alpha=matrix(1,MA,1,MA);
/* First try sum of two gaussians */
for (i=1;i<=NPT;i++) {
x[i]=0.1*i;
y[i]=0.0;
y[i] += a[1]*exp(-SQR((x[i]-a[2])/a[3]));
y[i] += a[4]*exp(-SQR((x[i]-a[5])/a[6]));
y[i] *= (1.0+SPREAD*gasdev(&idum));
sig[i]=SPREAD*y[i];
}
for (i=1;i<=mfit;i++) ia[i]=1;
for (i=1;i<=mfit;i++) a[i]=gues[i];
mrqcof(x,y,sig,NPT,a,ia,MA,alpha,beta,&chisq,fgauss);
printf("\nmatrix alpha\n");
for (i=1;i<=MA;i++) {
for (j=1;j<=MA;j++) printf("%12.4f",alpha[i][j]);
printf("\n");
}
printf("vector beta\n");
for (i=1;i<=MA;i++) printf("%12.4f",beta[i]);
printf("\nchi-squared: %12.4f\n\n",chisq);
/* Next fix one line and improve the other */
mfit=3;
for (i=1;i<=mfit;i++) ia[i]=0;
for (i=1;i<=MA;i++) a[i]=gues[i];
mrqcof(x,y,sig,NPT,a,ia,MA,alpha,beta,&chisq,fgauss);
printf("matrix alpha\n");
for (i=1;i<=mfit;i++) {
for (j=1;j<=mfit;j++) printf("%12.4f",alpha[i][j]);
printf("\n");
}
printf("vector beta\n");
for (i=1;i<=mfit;i++) printf("%12.4f",beta[i]);
printf("\nchi-squared: %12.4f\n\n",chisq);
free_matrix(alpha,1,MA,1,MA);
free_matrix(covar,1,MA,1,MA);
free_vector(sig,1,NPT);
free_vector(y,1,NPT);
free_vector(x,1,NPT);
free_vector(beta,1,MA);
free_ivector(ia,1,MA);
return 0;
}
void mrqminbd(double x[], // x values of dataset
double y[], // y values of dataset
double sig[], // individual std. deviations
int npts, // number of data points
double p[], // function parameters p
double lb[], // lower bounds on function parameters
double ub[], // upper bounds on function parameters
int npar, // number of function parameters
int ip[], // indices of parameters to fit
int nfit, // number of parameters to fit
double **covar, // returned covariance matrix
double **alpha, // returned curvature matrix
double beta[], // returned chi^2 partials matrix
double *chisq, // returned chi^2 value
double (*funcs)(double, // function x value, returns f(p, x)
double [], // function parameters p
double [], // returned df/dp values
int), // number of parameters
double *lambda) { // returned curvature diagonal scaling factor
// declare variables
// some are static because of repeated calls
static double ochisq; // old chi^2
static double *ptry; // function parameters to test
static double *dp; // parameter increments
int inverr; // matrix inversion error
int j, k; // loop counters
// first call has scaling < 0 for initialization
if (*lambda < 0.0) {
ptry = (double *) mxCalloc(npar, sizeof(double));
dp = (double *) mxCalloc(npar, sizeof(double));
// assign initial parameters
for (j = 0; j < npar; j++) {
ptry[j] = p[j];
}
// return initial chi^2, curvature & chi^2 partial derivatives
*lambda = FIRST_ALAMBDA;
mrqcof(x, y, sig, npts, ptry, npar, ip, nfit, alpha, beta, chisq, funcs);
ochisq = (*chisq);
return;
}
// augment diagonal curvature values with lambda
for (j = 0; j < nfit; j++) {
for (k = 0; k < nfit; k++) {
covar[j][k] = alpha[j][k];
}
covar[j][j] *= 1.0 + (*lambda);
dp[j] = beta[j];
}
// solve for covariance & parameter increments
// trial is unsuccessful if matrix inversion error
inverr = gaussj(covar, dp, nfit);
if (inverr < 0) {
*lambda *= INC_ALAMBDA;
return;
}
// last call has lambda = 0
// rearrange matrices & free allocated space
if (*lambda == 0.0) {
if (nfit < npar) {
ArrangeFixed(alpha, beta, npar, ip, nfit, SORT_BKWD);
ArrangeFixed(covar, dp, npar, ip, nfit, SORT_BKWD);
}
mxFree((void *) dp);
mxFree((void *) ptry);
return;
}
// increment parameters to see if trial succeeded
// trial is unsuccessful if bounds are exceeded
for (j = 0; j < nfit; j++) {
ptry[ip[j]] = p[ip[j]] + dp[j];
if (mxIsFinite(lb[ip[j]]) && (ptry[ip[j]] <= lb[ip[j]])) {
*lambda *= INC_ALAMBDA;
return;
}
else if (mxIsFinite(ub[ip[j]]) && (ptry[ip[j]] >= ub[ip[j]])) {
*lambda *= INC_ALAMBDA;
return;
}
}
// obtain updated chi^2, curvature & chi^2 partial derivatives
// note that covar & dp are used to preserve alpha & beta if step fails
mrqcof(x, y, sig, npts, ptry, npar, ip, nfit, covar, dp, chisq, funcs);
// if successful, accept new parameters
// decrease lambda
if (*chisq < ochisq) {
*lambda *= DEC_ALAMBDA;
ochisq = (*chisq);
for (j = 0; j < nfit; j++) {
for (k = 0; k < nfit; k++) {
alpha[j][k] = covar[j][k];
}
beta[j] = dp[j];
p[ip[j]] = ptry[ip[j]];
}
}
// otherwise reject new parameters
// increase lambda
else {
*lambda *= INC_ALAMBDA;
*chisq = ochisq;
}
}
void mrqmin( double x[], double y[], double sig[], int ndata, CVector a,
int ia[], int ma, CMatrix covar, CMatrix alpha, double *chisq,
void (*funcs)(double, double [], double *, double [], int),
double *alamda)
{
int j,k,l,m;
static int mfit;
static double ochisq;
CMatrix oneda;
CVector atry,beta,da;
if (*alamda < 0.0) {
atry=CVector(1,ma);
beta=CVector(1,ma);
da=CVector(1,ma);
for (mfit=0,j=1;j<=ma;j++)
if (ia[j]) mfit++;
oneda=CMatrix(1,mfit);
*alamda=0.001;
mrqcof(x,y,sig,ndata,a,ia,ma,alpha,beta,chisq,funcs);
ochisq=(*chisq);
for (j=1;j<=ma;j++) atry[j]=a[j];
}
for (j=0,l=1;l<=ma;l++) {
if (ia[l]) {
for (j++,k=0,m=1;m<=ma;m++) {
if (ia[m]) {
k++;
covar[j][k]=alpha[j][k];
}
}
covar[j][j]=alpha[j][j]*(1.0+(*alamda));
oneda[j][1]=beta[j];
}
}
covar.ColMax();
for (j=1;j<=mfit;j++) da[j]=oneda[j][1];
if (*alamda == 0.0) {
covsrt(covar,ma,ia,mfit);
return;
}
for (j=0,l=1;l<=ma;l++)
if (ia[l]) atry[l]=a[l]+da[++j];
mrqcof(x,y,sig,ndata,atry,ia,ma,covar,da,chisq,funcs);
if (*chisq < ochisq) {
*alamda *= 0.1;
ochisq=(*chisq);
for (j=0,l=1;l<=ma;l++) {
if (ia[l]) {
for (j++,k=0,m=1;m<=ma;m++) {
if (ia[m]) {
k++;
alpha[j][k]=covar[j][k];
}
}
beta[j]=da[j];
a[l]=atry[l];
}
}
} else {
*alamda *= 10.0;
*chisq=ochisq;
}
}
void mrqmin( m_elem x[], m_elem y[], m_elem sig[], int ndata, m_elem a[],
int ia[], int ma, m_elem **covar, m_elem **alpha, m_elem *chisq,
void (*funcs)(m_elem, m_elem [], m_elem *, m_elem [], int),
m_elem *alamda)
{
int j,k,l,m;
static int mfit;
static m_elem ochisq,*atry,*beta,*da,**oneda;
if (*alamda < 0.0) {
atry=vector(1,ma);
beta=vector(1,ma);
da=vector(1,ma);
for (mfit=0,j=1;j<=ma;j++)
if (ia[j]) mfit++;
oneda=matrix(1,mfit,1,1);
*alamda=0.001;
mrqcof(x,y,sig,ndata,a,ia,ma,alpha,beta,chisq,funcs);
ochisq=(*chisq);
for (j=1;j<=ma;j++) atry[j]=a[j];
}
for (j=0,l=1;l<=ma;l++) {
if (ia[l]) {
for (j++,k=0,m=1;m<=ma;m++) {
if (ia[m]) {
k++;
covar[j][k]=alpha[j][k];
}
}
covar[j][j]=alpha[j][j]*(1.0+(*alamda));
oneda[j][1]=beta[j];
}
}
gaussj(covar,mfit,oneda,1);
for (j=1;j<=mfit;j++) da[j]=oneda[j][1];
if (*alamda == 0.0) {
covsrt(covar,ma,ia,mfit);
free_matrix(oneda,1,mfit,1,1);
free_vector(da,1,ma);
free_vector(beta,1,ma);
free_vector(atry,1,ma);
return;
}
for (j=0,l=1;l<=ma;l++)
if (ia[l]) atry[l]=a[l]+da[++j];
mrqcof(x,y,sig,ndata,atry,ia,ma,covar,da,chisq,funcs);
if (*chisq < ochisq) {
*alamda *= 0.1;
ochisq=(*chisq);
for (j=0,l=1;l<=ma;l++) {
if (ia[l]) {
for (j++,k=0,m=1;m<=ma;m++) {
if (ia[m]) {
k++;
alpha[j][k]=covar[j][k];
}
}
beta[j]=da[j];
a[l]=atry[l];
}
}
} else {
*alamda *= 10.0;
*chisq=ochisq;
}
}
gmx_bool mrqmin(real x[], real y[], real sig[], int ndata, real a[],
int ma, int lista[], int mfit,
real **covar, real **alpha, real *chisq,
void (*funcs)(real,real *,real *,real *),
real *alamda)
{
int k,kk,j,ihit;
static real *da,*atry,**oneda,*beta,ochisq;
if (*alamda < 0.0) {
oneda=matrix1(1,mfit,1,1);
atry=rvector(1,ma);
da=rvector(1,ma);
beta=rvector(1,ma);
kk=mfit+1;
for (j=1;j<=ma;j++) {
ihit=0;
for (k=1;k<=mfit;k++)
if (lista[k] == j) ihit++;
if (ihit == 0)
lista[kk++]=j;
else if (ihit > 1) {
nrerror("Bad LISTA permutation in MRQMIN-1", FALSE);
return FALSE;
}
}
if (kk != ma+1) {
nrerror("Bad LISTA permutation in MRQMIN-2", FALSE);
return FALSE;
}
*alamda=0.001;
mrqcof(x,y,sig,ndata,a,ma,lista,mfit,alpha,beta,chisq,funcs);
ochisq=(*chisq);
}
for (j=1;j<=mfit;j++) {
for (k=1;k<=mfit;k++) covar[j][k]=alpha[j][k];
covar[j][j]=alpha[j][j]*(1.0+(*alamda));
oneda[j][1]=beta[j];
}
if (!gaussj(covar,mfit,oneda,1))
return FALSE;
for (j=1;j<=mfit;j++)
da[j]=oneda[j][1];
if (*alamda == 0.0) {
covsrt(covar,ma,lista,mfit);
free_vector(beta,1);
free_vector(da,1);
free_vector(atry,1);
free_matrix(oneda,1,mfit,1);
return TRUE;
}
for (j=1;j<=ma;j++) atry[j]=a[j];
for (j=1;j<=mfit;j++)
atry[lista[j]] = a[lista[j]]+da[j];
mrqcof(x,y,sig,ndata,atry,ma,lista,mfit,covar,da,chisq,funcs);
if (*chisq < ochisq) {
*alamda *= 0.1;
ochisq=(*chisq);
for (j=1;j<=mfit;j++) {
for (k=1;k<=mfit;k++) alpha[j][k]=covar[j][k];
beta[j]=da[j];
a[lista[j]]=atry[lista[j]];
}
} else {
*alamda *= 10.0;
*chisq=ochisq;
}
return TRUE;
}
void mrqmin(double *x, double *y, double *sig, int ndata, double *a, int *ia, int ma, double **covar, double **alpha, double *chisq, double *alamda, void (*funcs)(double *, double *, double *, double **, int, int, int, double *, double **, double *, double *, int *, void *), int Nlin_coeff, double **Design_Matrix, double *lin_coeffs, int *varylin_coeffs,
#ifdef PARALLEL
int mfit, double *ochisq, double *atry, double *beta, double *da, double **oneda,
#endif
void *userparams)
{
/*This function is taken from Press et al., 1992 -
Levenberg-Marquardt method, attempting to reduce the value of chi^2 of a fit between a set of data points x[0....ndata-1], y[0.....ndata-1] with individual standard deviations sig[0.....ndata-1], and a nonlinear function dependent on ma coefficients a[0...ma-1]. The input array ia[0....ma-1] indicates by nonzero entries those components of a that should be fitted for, and by zero entries, those components that should be held fixed at their input values. The program returns current best-fit values for the parameters a[0...ma-1], and chi^2. The arrays covar[0...ma-1][0...ma-1], alpha[0....ma-1][0....ma-1] are used as working space during most iterations. Supply a routine funcs(x,a,yfit,dyda,ma) that evaluates the fitting fuction yfit, and its derivatives dyda[0....ma-1] with respect to the fitting parameters a at x. On the first call provide an initial guess for the parameters a, and set alamda<0 for initialization (which then sets alamda=0.001). If a step succeeds chisq becomes smaller and alamda decreases by a factor of 10. If a step fails alamda grows by a factor of 10. You must call this routine repeatedly until convergence is achieved. Then make one final call with alamda=0, so that covar[0....ma-1][0....ma-1] returns the covariance matrix, and alpha the curvature matrix. (Parameters help fixed will return zero covariances). */
void covsrt(double **covar, int ma, int *ia, int mfit);
int gaussj(double **a, int n, double **b, int m);
void mrqcof(double *x, double *y, double *sig, int ndata, double *a, int *ia, int ma, double **alpha, double *beta, double *chisq, void (*funcs)(double *, double *, double *, double **, int, int, int, double *, double **, double *, double *, int *, void *), int, double **, double *, int *, void *);
int j, k, l;
#ifndef PARALLEL
static int mfit;
static double ochisq[1], *atry, *beta, *da, **oneda;
#endif
if(*alamda < 0.0) {
#ifndef PARALLEL
if((atry = (double *) malloc(ma * sizeof(double))) == NULL ||
(beta = (double *) malloc(ma * sizeof(double))) == NULL ||
(da = (double *) malloc(ma * sizeof(double))) == NULL)
error(ERR_MEMALLOC);
for(mfit=0,j=0;j<ma;j++)
if(ia[j]) mfit++;
if((oneda = (double **) malloc(mfit * sizeof(double *))) == NULL)
error(ERR_MEMALLOC);
for(j=0;j<mfit;j++)
if((oneda[j] = (double *) malloc(sizeof(double))) == NULL)
error(ERR_MEMALLOC);
#endif
*alamda = 0.001;
mrqcof(x,y,sig,ndata,a,ia,ma,alpha,beta,chisq,funcs, Nlin_coeff, Design_Matrix, lin_coeffs, varylin_coeffs, userparams);
ochisq[0]=(*chisq);
for(j=0;j<ma;j++)
atry[j] = a[j];
}
for(j=0;j<mfit;j++) {
for(k=0;k<mfit;k++) covar[j][k] = alpha[j][k];
covar[j][j]=alpha[j][j]*(1.0+(*alamda));
oneda[j][0] = beta[j];
}
if(gaussj(covar,mfit,oneda,1))
{
*alamda = 0;
}
for(j=0;j<mfit;j++) da[j] = oneda[j][0];
if (*alamda == 0.0) {
covsrt(covar,ma,ia,mfit);
covsrt(alpha,ma,ia,mfit);
#ifndef PARALLEL
for(j=0;j<mfit;j++)
free(oneda[j]);
free(oneda);
free(da);
free(beta);
free(atry);
#endif
return;
}
for(j=0,l=0;l<ma;l++)
if(ia[l]) atry[l]=a[l]+da[j++];
mrqcof(x,y,sig,ndata,atry,ia,ma,covar,da,chisq,funcs,Nlin_coeff,Design_Matrix,lin_coeffs,varylin_coeffs, userparams);
if (*chisq < ochisq[0]) {
*alamda *= 0.1;
ochisq[0] = (*chisq);
for (j=0;j<mfit;j++) {
for(k=0;k<mfit;k++) alpha[j][k] = covar[j][k];
beta[j] = da[j];
}
for(l=0;l<ma;l++) a[l]=atry[l];
} else {
*alamda *= 10.0;
*chisq=ochisq[0];
}
}
//-----------------------------------------------------------------------
void TLMFit::mrqmin()
{
static vector < double> atry, beta, da;
int j, k, l;
static int mfit;
static double ochisq;
static vector< vector < double> > oneda;
if (alamda < 0.0)
{
atry.resize(nparam);
beta.resize(nparam);
da.resize(nparam);
for (mfit = 0, j = 0; j < nparam; j++)
if (ia[j])
mfit++;
oneda.resize(mfit);
for (unsigned int i = 0; i < oneda.size(); i++)
oneda[i].resize(1);
alamda = 0.001;
mrqcof(a, alpha, beta);
ochisq = (chisq);
for (j = 0; j < nparam; j++)
atry[j] =(a[j]);
}
for (j = 0; j < mfit; j++)
{
for (k = 0; k < mfit; k++)
covar[j][k] = alpha[j][k];
covar[j][j] = alpha[j][j]*(1.0 + (alamda));
oneda[j][0] = beta[j];
}
try {gaussj(covar, mfit, oneda, 1);}
catch (ESingularMatrix &E)
{
throw;
}
for (j = 0; j < mfit; j++)
{
da[j] = oneda[j][0];
}
if (alamda == 0.0)
{
covsrt(mfit);
return;
}
for (j = 0, l = 0; l < nparam; l++)
if (ia[l])
atry[l] = a[l] + da[j++];
mrqcof(atry, covar, da);
if (chisq < ochisq)
{
alamda *= 0.1;
ochisq = (chisq);
for (j = 0; j < mfit; j++)
{
for (k = 0; k < mfit; k++)
alpha[j][k] = covar[j][k];
beta[j] = da[j];
}
for (j = 0; j < nparam; j++) // Achtung!! in aelteren Versionen war hier ein Fehler
a[j] = atry[j];
} else
{
alamda *= 10.0;
chisq = ochisq;
}
}
int mrqmin(float **y, float **sig, struct image *psf, int ma, double **covar,
double **alpha, double *chisq, void (*funcs)(int, int, float *, float [],
int [], int, struct fitpars *), float *alamda, struct fitpars *fpar,
struct cons *constr, struct convpars *cpar, double *sigma)
{
void errcalc (double *sigma, double **alpha, int ma, int *ia, int mfit);
int j,k,l;
static int mfit;
static double *da,**oneda,*beta,ochisq;
static float *atry, *aorig;
float *a;
int *ia;
/* Kludge -- copy from fpar->a to a */
a = vector (1, ma);
ia = ivector (1, ma);
copy_pars (a, ia, fpar, FROM);
if (*alamda < 0.0) {
aorig=vector(1,ma);
copy_pars (aorig, ia, fpar, FROM);
atry=vector(1,ma);
beta=dvector(1,ma);
da=dvector(1,ma);
for (mfit=0,j=1;j<=ma;j++)
if (ia[j]==1)
mfit++;
oneda=dmatrix(1,mfit,1,1);
*alamda=0.01;
mrqcof(y,sig,psf,a,ia,ma,alpha,beta,chisq,funcs,fpar,cpar);
ochisq=(*chisq);
for (j=1;j<=ma;j++) atry[j]=a[j];
}
for (j=1;j<=mfit;j++) {
for (k=1;k<=mfit;k++) covar[j][k]=alpha[j][k];
covar[j][j]=alpha[j][j]*(1.0+(*alamda));
oneda[j][1]=beta[j];
}
gaussj(covar,mfit,oneda,1);
for (j=1;j<=mfit;j++) da[j]=oneda[j][1];
if (*alamda == 0.0) { /* Convergence! */
errcalc (sigma, alpha, ma, ia, mfit); /* calculate uncert. */
covsrt(covar,ma,ia,mfit);
covsrt(alpha,ma,ia,mfit);
free_dmatrix(oneda,1,mfit,1,1);
free_dvector(da,1,ma);
free_dvector(beta,1,ma);
free_vector(atry,1,ma);
free_vector (a, 1, ma);
free_ivector (ia, 1, ma);
return;
}
par_monitor (ma, a, ia, atry, da, fpar);
constraints (ma, mfit, atry, a, ia, constr, da, aorig);
copy_pars (atry, ia, fpar, TO);
mrqcof(y,sig,psf,atry,ia,ma,covar,da,chisq,funcs,fpar,cpar);
if (*chisq < ochisq) {
*alamda *= 0.1;
ochisq=(*chisq);
for (j=1;j<=mfit;j++) {
for (k=1;k<=mfit;k++) alpha[j][k]=covar[j][k];
beta[j]=da[j];
}
for (l=1;l<=ma;l++)
a[l]=atry[l];
} else {
*alamda *= 10.0;
*chisq=ochisq;
}
copy_pars (a, ia, fpar, TO);
free_vector (a, 1, ma);
free_ivector (ia, 1, ma);
return (0);
}
