30 #include "gilevenberg.h"
42 _giraffe_swap(cxdouble *a, cxdouble *b) {
44 register cxdouble t = *a;
55 _giraffe_covsrt(cpl_matrix *covar, cxint ma, cxint ia[], cxint mfit)
58 register cxint i, j, k;
60 cxint nr = cpl_matrix_get_nrow(covar);
62 cxdouble *_covar = cpl_matrix_get_data(covar);
65 for (i = mfit; i < ma; i++) {
66 for (j = 0; j <= i; j++) {
67 _covar[i * nr + j] = _covar[j * nr + i] = 0.0;
73 for (j = (ma - 1); j >= 0; j--) {
75 for (i = 0; i < ma; i++) {
76 _giraffe_swap(&_covar[i * nr + k], &_covar[i * nr + j]);
79 for (i = 0;i < ma; i++) {
80 _giraffe_swap(&_covar[k * nr + i], &_covar[j * nr + i]);
116 _giraffe_mrqcof(cpl_matrix *x, cpl_matrix *y, cpl_matrix *sig,
117 cxint ndata, cpl_matrix *a, cxdouble r[], cxint ia[],
118 cxint ma, cpl_matrix *alpha, cpl_matrix *beta,
119 cxdouble *chisq, GiFitFunc funcs)
122 register cxint i, j, k, l, m;
123 register cxint mfit = 0;
125 cxint nr_alpha = cpl_matrix_get_nrow(alpha);
126 cxint nc_x = cpl_matrix_get_ncol(x);
133 cxdouble *pd_x = cpl_matrix_get_data(x);
134 cxdouble *pd_y = cpl_matrix_get_data(y);
135 cxdouble *pd_sig = cpl_matrix_get_data(sig);
136 cxdouble *pd_a = cpl_matrix_get_data(a);
137 cxdouble *pd_alpha = cpl_matrix_get_data(alpha);
138 cxdouble *pd_beta = cpl_matrix_get_data(beta);
141 for (j = 0; j < ma; j++) {
147 for (j = 0; j < mfit; j++) {
148 for (k = 0; k <= j; k++) {
149 pd_alpha[j * nr_alpha + k] = 0.0;
157 dyda = cx_calloc(ma,
sizeof(cxdouble));
159 for (i = 0; i < ndata; i++) {
161 (*funcs)(&ymod, &(pd_x[i * nc_x]), pd_a, ma, dyda, r);
163 if (pd_sig[i] == 0.0) {
167 sig2i = 1.0 / (pd_sig[i] * pd_sig[i]);
170 for (j = -1, l = 0; l < ma; l++) {
173 wt = dyda[l] * sig2i;
174 for (j++, k = -1, m = 0; m <= l; m++) {
177 pd_alpha[j * nr_alpha + k] += (wt * dyda[m]);
181 pd_beta[j] += (dy * wt);
186 *chisq += (dy * dy * sig2i);
190 for (j = 1; j < mfit; j++) {
191 for (k = 0; k < j; k++) {
192 pd_alpha[k * nr_alpha + j] = pd_alpha[j * nr_alpha + k];
260 _giraffe_mrqmin(cpl_matrix *x, cpl_matrix *y, cpl_matrix *sig, cxint ndata,
261 cpl_matrix *a, cxdouble r[], cxint ia[], cxint ma,
262 cpl_matrix *covar, cpl_matrix *alpha, cxdouble *chisq,
263 GiFitFunc funcs, cxdouble *alamda)
266 register cxint gj, j, k, l, m;
268 static cxint nr_covar, nr_alpha, nr_moneda, mfit;
270 static cxdouble *pd_a, *pd_covar, *pd_alpha;
271 static cxdouble *atry, *beta, *da, *oneda, ochisq;
273 static cpl_matrix *matry, *mbeta, *mda, *moneda;
276 pd_a = cpl_matrix_get_data(a);
277 pd_covar = cpl_matrix_get_data(covar);
278 pd_alpha = cpl_matrix_get_data(alpha);
279 nr_covar = cpl_matrix_get_nrow(covar);
280 nr_alpha = cpl_matrix_get_nrow(alpha);
284 matry = cpl_matrix_new(ma, 1);
285 atry = cpl_matrix_get_data(matry);
287 mbeta = cpl_matrix_new(ma, 1);
288 beta = cpl_matrix_get_data(mbeta);
290 mda = cpl_matrix_new(ma, 1);
291 da = cpl_matrix_get_data(mda);
293 for (mfit = 0, j = 0; j < ma; j++) {
299 moneda = cpl_matrix_new(1, mfit);
300 oneda = cpl_matrix_get_data(moneda);
304 gj = _giraffe_mrqcof(x, y, sig, ndata, a, r, ia, ma, alpha, mbeta,
308 cpl_matrix_delete(moneda);
312 cpl_matrix_delete(mda);
316 cpl_matrix_delete(mbeta);
320 cpl_matrix_delete(matry);
329 for (j = 0; j < ma; j++) {
335 nr_moneda = cpl_matrix_get_nrow(moneda);
337 for (j = -1, l = 0; l < ma; l++) {
339 for (j++, k = -1, m = 0; m < ma; m++) {
342 pd_covar[j * nr_covar + k] = pd_alpha[j * nr_alpha + k];
346 pd_covar[j * nr_covar + j] = pd_alpha[j * nr_alpha + j] *
349 oneda[j * nr_moneda + 0] = beta[j];
353 gj = giraffe_gauss_jordan(covar, mfit, moneda, 1);
356 cpl_matrix_delete(moneda);
360 cpl_matrix_delete(mda);
364 cpl_matrix_delete(mbeta);
368 cpl_matrix_delete(matry);
375 for (j = 0; j < mfit; j++) {
376 da[j] = oneda[j * nr_moneda + 0];
379 if (*alamda == 0.0) {
380 _giraffe_covsrt(covar, ma, ia, mfit);
382 cpl_matrix_delete(moneda);
386 cpl_matrix_delete(mda);
390 cpl_matrix_delete(mbeta);
394 cpl_matrix_delete(matry);
401 for (j = -1, l = 0; l < ma; l++) {
403 atry[l] = pd_a[l] + da[++j];
407 gj = _giraffe_mrqcof(x, y, sig, ndata, matry, r, ia, ma, covar, mda,
411 cpl_matrix_delete(moneda);
415 cpl_matrix_delete(mda);
419 cpl_matrix_delete(mbeta);
423 cpl_matrix_delete(matry);
430 if (*chisq < ochisq) {
435 for (j = -1, l = 0; l < ma; l++) {
437 for (j++, k = -1, m = 0; m < ma; m++) {
440 pd_alpha[j * nr_alpha + k] =
441 pd_covar[j * nr_covar + k];
489 cxint ndata, cpl_matrix *a, cpl_matrix *delta, cxint *ia,
490 cxint ma, cpl_matrix *alpha, cxdouble *chisq, GiFitFunc funcs,
498 cxdouble alamda = -1.;
501 cpl_matrix *beta = cpl_matrix_new(ma, ma);
505 r = cpl_matrix_get_data(delta);
508 res = _giraffe_mrqmin(x, y, sigma, ndata, a, r, ia, ma, alpha, beta,
509 chisq, funcs, &alamda);
512 cpl_matrix_delete(beta);
522 cxdouble ochisq = *chisq;
524 res = _giraffe_mrqmin(x, y, sigma, ndata, a, r, ia, ma, alpha, beta,
525 chisq, funcs, &alamda);
528 cpl_matrix_delete(beta);
534 if (*chisq > ochisq) {
537 else if (fabs(ochisq - *chisq) < setup->
dchisq) {
541 if (itst > setup->
tests) {
554 res = _giraffe_mrqmin(x, y, sigma, ndata, a, r, ia, ma, alpha, beta,
555 chisq, funcs, &alamda);
558 cpl_matrix_delete(beta);
564 cpl_matrix_delete(beta);
cxint giraffe_nlfit(cpl_matrix *x, cpl_matrix *y, cpl_matrix *sigma, cxint ndata, cpl_matrix *a, cpl_matrix *delta, cxint *ia, cxint ma, cpl_matrix *alpha, cxdouble *chisq, GiFitFunc funcs, const GiFitParams *setup)
Levenberg-Marquardt non-linear fit driver.
Non-linear fit control parameters.