public static void lm_minimize( int m_dat, int n_par, double[] par,
evaluate_delegate evaluate, printout_delegate printout,
object data, lm_control_type control )
{
/*** allocate work space. ***/
double[] fvec, diag, fjac, qtf, wa1, wa2, wa3, wa4;
int []ipvt;
int n = n_par;
int m = m_dat;
fvec = new double[m];
diag = new double[n];
qtf = new double[n];
fjac = new double[n*m];
wa1 = new double[n];
wa2 = new double[n];
wa3 = new double[n];
wa4 = new double[m];
ipvt = new int[m];
/*** perform fit. ***/
control.info = 0;
control.nfev = 0;
/* this goes through the modified legacy interface: */
lm_lmdif( m, n, par, fvec, control.ftol, control.xtol, control.gtol,
control.maxcall * (n + 1), control.epsilon, diag, 1,
control.stepbound, ref control.info,
ref control.nfev, fjac, ipvt, qtf, wa1, wa2, wa3, wa4,
evaluate, printout, data );
if ( printout != null )
printout(n, par, m, fvec, data, -1, 0, control.nfev);
control.fnorm = lm_enorm(m, fvec);
if ( control.info < 0 )
control.info = 10;
/*** clean up. ***/
} /*** lm_minimize. ***/
/***** the low-level legacy interface for full control. *****/
public static void lm_lmdif(int m, int n, double[] x, double[] fvec, double ftol,
double xtol, double gtol, int maxfev, double epsfcn,
double[] diag, int mode, double factor, ref int info, ref int nfev,
double[] fjac, int[] ipvt, double[] qtf, double[] wa1,
double[] wa2, double[] wa3, double[] wa4,
evaluate_delegate evaluate,
printout_delegate printout,
object data)
{
/*
* The purpose of lmdif is to minimize the sum of the squares of
* m nonlinear functions in n variables by a modification of
* the levenberg-marquardt algorithm. The user must provide a
* subroutine evaluate which calculates the functions. The jacobian
* is then calculated by a forward-difference approximation.
*
* The multi-parameter interface lm_lmdif is for users who want
* full control and flexibility. Most users will be better off using
* the simpler interface lm_minimize provided above.
*
* The parameters are the same as in the legacy FORTRAN implementation,
* with the following exceptions:
* the old parameter ldfjac which gave leading dimension of fjac has
* been deleted because this C translation makes no use of two-
* dimensional arrays;
* the old parameter nprint has been deleted; printout is now controlled
* by the user-supplied routine *printout;
* the parameter field *data and the function parameters *evaluate and
* *printout have been added; they help avoiding global variables.
*
* Parameters:
*
* m is a positive integer input variable set to the number
* of functions.
*
* n is a positive integer input variable set to the number
* of variables; n must not exceed m.
*
* x is an array of length n. On input x must contain
* an initial estimate of the solution vector. on output x
* contains the final estimate of the solution vector.
*
* fvec is an output array of length m which contains
* the functions evaluated at the output x.
*
* ftol is a nonnegative input variable. termination
* occurs when both the actual and predicted relative
* reductions in the sum of squares are at most ftol.
* Therefore, ftol measures the relative error desired
* in the sum of squares.
*
* xtol is a nonnegative input variable. Termination
* occurs when the relative error between two consecutive
* iterates is at most xtol. Therefore, xtol measures the
* relative error desired in the approximate solution.
*
* gtol is a nonnegative input variable. Termination
* occurs when the cosine of the angle between fvec and
* any column of the jacobian is at most gtol in absolute
* value. Therefore, gtol measures the orthogonality
* desired between the function vector and the columns
* of the jacobian.
*
* maxfev is a positive integer input variable. Termination
* occurs when the number of calls to lm_fcn is at least
* maxfev by the end of an iteration.
*
* epsfcn is an input variable used in determining a suitable
* step length for the forward-difference approximation. This
* approximation assumes that the relative errors in the
* functions are of the order of epsfcn. If epsfcn is less
* than the machine precision, it is assumed that the relative
* errors in the functions are of the order of the machine
* precision.
*
* diag is an array of length n. If mode = 1 (see below), diag is
* internally set. If mode = 2, diag must contain positive entries
* that serve as multiplicative scale factors for the variables.
*
* mode is an integer input variable. If mode = 1, the
* variables will be scaled internally. If mode = 2,
* the scaling is specified by the input diag. other
* values of mode are equivalent to mode = 1.0
*
* factor is a positive input variable used in determining the
* initial step bound. This bound is set to the product of
* factor and the euclidean norm of diag*x if nonzero, or else
* to factor itself. In most cases factor should lie in the
* interval (0.01,100.0). Generally, the value 100.0 is recommended.
*
* info is an integer output variable that indicates the termination
* status of lm_lmdif as follows:
*
* info < 0 termination requested by user-supplied routine *evaluate;
*
* info = 0 improper input parameters;
*
* info = 1 both actual and predicted relative reductions
* in the sum of squares are at most ftol;
*
* info = 2 relative error between two consecutive iterates
* is at most xtol;
*
* info = 3 conditions for info = 1 and info = 2 both hold;
*
* info = 4 the cosine of the angle between fvec and any
* column of the jacobian is at most gtol in
* absolute value;
*
* info = 5 number of calls to lm_fcn has reached or
* exceeded maxfev;
*
* info = 6 ftol is too small: no further reduction in
* the sum of squares is possible;
*
* info = 7 xtol is too small: no further improvement in
* the approximate solution x is possible;
*
* info = 8 gtol is too small: fvec is orthogonal to the
* columns of the jacobian to machine precision;
*
* nfev is an output variable set to the number of calls to the
* user-supplied routine *evaluate.
*
* fjac is an output m by n array. The upper n by n submatrix
* of fjac contains an upper triangular matrix r with
* diagonal elements of nonincreasing magnitude such that
*
* t t t
* p *(jac *jac)*p = r *r,
*
* where p is a permutation matrix and jac is the final
* calculated jacobian. Column j of p is column ipvt(j)
* (see below) of the identity matrix. The lower trapezoidal
* part of fjac contains information generated during
* the computation of r.
*
* ipvt is an integer output array of length n. It defines a
* permutation matrix p such that jac*p = q*r, where jac is
* the final calculated jacobian, q is orthogonal (not stored),
* and r is upper triangular with diagonal elements of
* nonincreasing magnitude. Column j of p is column ipvt(j)
* of the identity matrix.
*
* qtf is an output array of length n which contains
* the first n elements of the vector (q transpose)*fvec.
*
* wa1, wa2, and wa3 are work arrays of length n.
*
* wa4 is a work array of length m.
*
* The following parameters are newly introduced in this C translation:
*
* evaluate is the name of the subroutine which calculates the
* m nonlinear functions. A default implementation lm_evaluate_default
* is provided in lm_eval.c. Alternative implementations should
* be written as follows:
*
* void evaluate ( double* par, int m_dat, double* fvec,
* object data, int info )
* {
* // for ( i=0; i<m_dat; ++i )
* // calculate fvec[i] for given parameters par;
* // to stop the minimization,
* // set info to a negative integer.
* }
*
* printout is the name of the subroutine which nforms about fit progress.
* Call with printout=NULL if no printout is desired.
* Call with printout=lm_print_default to use the default
* implementation provided in lm_eval.c.
* Alternative implementations should be written as follows:
*
* void printout ( int n_par, double* par, int m_dat, double* fvec,
* object data, int iflag, int iter, int nfev )
* {
* // iflag : 0 (init) 1 (outer loop) 2(inner loop) -1(terminated)
* // iter : outer loop counter
* // nfev : number of calls to *evaluate
* }
*
* data is an input pointer to an arbitrary structure that is passed to
* evaluate. Typically, it contains experimental data to be fitted.
*
*/
int i, iter, j;
double actred, delta, dirder, eps, fnorm, fnorm1, gnorm, par, pnorm,
prered, ratio, step, sum, temp, temp1, temp2, temp3, xnorm;
double p1 = 0.01;
double p0001 = 1.00e-4;
nfev = 0; /* function evaluation counter */
iter = 1; /* outer loop counter */
par = 0; /* levenberg-marquardt parameter */
delta = 0; /* to prevent a warning (initialization within if-clause) */
xnorm = 0; /* ditto */
temp = MAX(epsfcn, LM_MACHEP);
eps = sqrt(temp); /* for calculating the Jacobian by forward differences */
/*** lmdif: check input parameters for errors. ***/
if ((n <= 0) || (m < n) || (ftol < 0.0)
|| (xtol < 0.0) || (gtol < 0.0) || (maxfev <= 0) || (factor <= 0.0)) {
info = 0; // invalid parameter
return;
}
if (mode == 2) { /* scaling by diag[] */
for (j = 0; j < n; j++) { /* check for nonpositive elements */
if (diag[j] <= 0.00) {
info = 0; // invalid parameter
return;
}
}
}
#if BUG
Console.Write("lmdif\n");
#endif
/*** lmdif: evaluate function at starting point and calculate norm. ***/
info = 0;
evaluate(x, m, fvec, data, ref info); ++(nfev);
if( printout != null )
printout(n, x, m, fvec, data, 0, 0, nfev);
if (info < 0)
return;
fnorm = lm_enorm(m, fvec);
/*** lmdif: the outer loop. ***/
do {
#if BUG
Console.Write("lmdif/ outer loop iter={0} nfev={0} fnorm=%.10e\n",
iter, nfev, fnorm);
#endif
/*** outer: calculate the jacobian matrix. ***/
for (j = 0; j < n; j++) {
temp = x[j];
step = eps * fabs(temp);
if (step == 0.0)
step = eps;
x[j] = temp + step;
info = 0;
evaluate(x, m, wa4, data, ref info);
if( printout != null )
printout(n, x, m, wa4, data, 1, iter, ++(nfev));
if (info < 0)
return; /* user requested break */
for (i = 0; i < m; i++) /* changed in 2.3, Mark Bydder */
fjac[j * m + i] = (wa4[i] - fvec[i]) / (x[j] - temp);
x[j] = temp;
}
#if BUG2
/* DEBUG: print the entire matrix */
for (i = 0; i < m; i++) {
for (j = 0; j < n; j++)
Console.Write("%.5e ", fjac[j * m + i]);
Console.Write("\n");
}
#endif
/*** outer: compute the qr factorization of the jacobian. ***/
lm_qrfac(m, n, fjac, 1, ipvt, wa1, wa2, wa3);
if (iter == 1) { /* first iteration */
if (mode != 2) {
/* diag := norms of the columns of the initial jacobian */
for (j = 0; j < n; j++) {
diag[j] = wa2[j];
if (wa2[j] == 0.0)
diag[j] = 1.0;
}
}
/* use diag to scale x, then calculate the norm */
for (j = 0; j < n; j++)
wa3[j] = diag[j] * x[j];
xnorm = lm_enorm(n, wa3);
/* initialize the step bound delta. */
delta = factor * xnorm;
if (delta == 0.0)
delta = factor;
}
/*** outer: form (q transpose)*fvec and store first n components in qtf. ***/
for (i = 0; i < m; i++)
wa4[i] = fvec[i];
for (j = 0; j < n; j++) {
temp3 = fjac[j * m + j];
if (temp3 != 0.0) {
sum = 0;
for (i = j; i < m; i++)
sum += fjac[j * m + i] * wa4[i];
temp = -sum / temp3;
for (i = j; i < m; i++)
wa4[i] += fjac[j * m + i] * temp;
}
fjac[j * m + j] = wa1[j];
qtf[j] = wa4[j];
}
/** outer: compute norm of scaled gradient and test for convergence. ***/
gnorm = 0;
if (fnorm != 0) {
for (j = 0; j < n; j++) {
if (wa2[ipvt[j]] == 0)
continue;
sum = 0.0;
for (i = 0; i <= j; i++)
sum += fjac[j * m + i] * qtf[i] / fnorm;
gnorm = MAX(gnorm, fabs(sum / wa2[ipvt[j]]));
}
}
if (gnorm <= gtol) {
info = 4;
return;
}
/*** outer: rescale if necessary. ***/
if (mode != 2) {
for (j = 0; j < n; j++)
diag[j] = MAX(diag[j], wa2[j]);
}
/*** the inner loop. ***/
do {
#if BUG
Console.Write("lmdif/ inner loop iter={0} nfev={0}\n", iter, nfev);
#endif
/*** inner: determine the levenberg-marquardt parameter. ***/
lm_lmpar(n, fjac, m, ipvt, diag, qtf, delta, ref par,
wa1, wa2, wa3, wa4);
/*** inner: store the direction p and x + p; calculate the norm of p. ***/
for (j = 0; j < n; j++) {
wa1[j] = -wa1[j];
wa2[j] = x[j] + wa1[j];
wa3[j] = diag[j] * wa1[j];
}
pnorm = lm_enorm(n, wa3);
/*** inner: on the first iteration, adjust the initial step bound. ***/
if (nfev <= 1 + n)
delta = MIN(delta, pnorm);
/* evaluate the function at x + p and calculate its norm. */
info = 0;
evaluate(wa2, m, wa4, data, ref info); ++(nfev);
if( printout != null )
printout(n, x, m, wa4, data, 2, iter, nfev);
if (info < 0)
return; /* user requested break. */
fnorm1 = lm_enorm(m, wa4);
#if BUG
Console.Write("lmdif/ pnorm %.10e fnorm1 %.10e fnorm %.10e"
" delta=%.10e par=%.10e\n",
pnorm, fnorm1, fnorm, delta, par);
#endif
/*** inner: compute the scaled actual reduction. ***/
if (p1 * fnorm1 < fnorm)
actred = 1 - SQR(fnorm1 / fnorm);
else
actred = -1;
/*** inner: compute the scaled predicted reduction and
the scaled directional derivative. ***/
for (j = 0; j < n; j++) {
wa3[j] = 0;
for (i = 0; i <= j; i++)
wa3[i] += fjac[j * m + i] * wa1[ipvt[j]];
}
temp1 = lm_enorm(n, wa3) / fnorm;
temp2 = sqrt(par) * pnorm / fnorm;
prered = SQR(temp1) + 2 * SQR(temp2);
dirder = -(SQR(temp1) + SQR(temp2));
/*** inner: compute the ratio of the actual to the predicted reduction. ***/
ratio = prered != 0 ? actred / prered : 0;
#if BUG
Console.Write("lmdif/ actred=%.10e prered=%.10e ratio=%.10e"
" sq(1)=%.10e sq(2)=%.10e dd=%.10e\n",
actred, prered, prered != 0 ? ratio : 0.0,
SQR(temp1), SQR(temp2), dirder);
#endif
/*** inner: update the step bound. ***/
if (ratio <= 0.025) {
if (actred >= 0.0)
temp = 0.05;
else
temp = 0.05 * dirder / (dirder + 0.055 * actred);
if (p1 * fnorm1 >= fnorm || temp < p1)
temp = p1;
delta = temp * MIN(delta, pnorm / p1);
par /= temp;
} else if (par == 0.0 || ratio >= 0.075) {
delta = pnorm / 0.05;
par *= 0.05;
}
/*** inner: test for successful iteration. ***/
if (ratio >= p0001) {
/* yes, success: update x, fvec, and their norms. */
for (j = 0; j < n; j++) {
x[j] = wa2[j];
wa2[j] = diag[j] * x[j];
}
for (i = 0; i < m; i++)
fvec[i] = wa4[i];
xnorm = lm_enorm(n, wa2);
fnorm = fnorm1;
iter++;
}
#if BUG
else {
Console.Write("ATTN: iteration considered unsuccessful\n");
}
#endif
/*** inner: tests for convergence ( otherwise info = 1, 2, or 3 ). ***/
info = 0; /* do not terminate (unless overwritten by nonzero) */
if (fabs(actred) <= ftol && prered <= ftol && 0.05 * ratio <= 1)
info = 1;
if (delta <= xtol * xnorm)
info += 2;
if (info != 0)
return;
/*** inner: tests for termination and stringent tolerances. ***/
if (nfev >= maxfev)
info = 5;
if (fabs(actred) <= LM_MACHEP &&
prered <= LM_MACHEP && 0.05 * ratio <= 1)
info = 6;
if (delta <= LM_MACHEP * xnorm)
info = 7;
if (gnorm <= LM_MACHEP)
info = 8;
if (info != 0)
return;
/*** inner: end of the loop. repeat if iteration unsuccessful. ***/
} while (ratio < p0001);
/*** outer: end of the loop. ***/
} while (true);
} /*** lm_lmdif. ***/
