38 #include "gilevenberg.h"
50 _giraffe_swap(cxdouble *a, cxdouble *b) {
52 register cxdouble t = *a;
63 _giraffe_covsrt(cpl_matrix *covar, cxint ma, cxint ia[], cxint mfit)
66 register cxint i, j, k;
68 cxint nr = cpl_matrix_get_nrow(covar);
70 cxdouble *_covar = cpl_matrix_get_data(covar);
73 for (i = mfit; i < ma; i++) {
74 for (j = 0; j <= i; j++) {
75 _covar[i * nr + j] = _covar[j * nr + i] = 0.0;
81 for (j = (ma - 1); j >= 0; j--) {
83 for (i = 0; i < ma; i++) {
84 _giraffe_swap(&_covar[i * nr + k], &_covar[i * nr + j]);
87 for (i = 0;i < ma; i++) {
88 _giraffe_swap(&_covar[k * nr + i], &_covar[j * nr + i]);
124 _giraffe_mrqcof(cpl_matrix *x, cpl_matrix *y, cpl_matrix *sig,
125 cxint ndata, cpl_matrix *a, cxdouble r[], cxint ia[],
126 cxint ma, cpl_matrix *alpha, cpl_matrix *beta,
127 cxdouble *chisq, GiFitFunc funcs)
130 register cxint i, j, k, l, m;
131 register cxint mfit = 0;
133 cxint nr_alpha = cpl_matrix_get_nrow(alpha);
134 cxint nc_x = cpl_matrix_get_ncol(x);
141 cxdouble *pd_x = cpl_matrix_get_data(x);
142 cxdouble *pd_y = cpl_matrix_get_data(y);
143 cxdouble *pd_sig = cpl_matrix_get_data(sig);
144 cxdouble *pd_a = cpl_matrix_get_data(a);
145 cxdouble *pd_alpha = cpl_matrix_get_data(alpha);
146 cxdouble *pd_beta = cpl_matrix_get_data(beta);
149 for (j = 0; j < ma; j++) {
155 for (j = 0; j < mfit; j++) {
156 for (k = 0; k <= j; k++) {
157 pd_alpha[j * nr_alpha + k] = 0.0;
165 dyda = cx_calloc(ma,
sizeof(cxdouble));
167 for (i = 0; i < ndata; i++) {
169 (*funcs)(&ymod, &(pd_x[i * nc_x]), pd_a, ma, dyda, r);
171 if (pd_sig[i] == 0.0) {
175 sig2i = 1.0 / (pd_sig[i] * pd_sig[i]);
178 for (j = -1, l = 0; l < ma; l++) {
181 wt = dyda[l] * sig2i;
182 for (j++, k = -1, m = 0; m <= l; m++) {
185 pd_alpha[j * nr_alpha + k] += (wt * dyda[m]);
189 pd_beta[j] += (dy * wt);
194 *chisq += (dy * dy * sig2i);
198 for (j = 1; j < mfit; j++) {
199 for (k = 0; k < j; k++) {
200 pd_alpha[k * nr_alpha + j] = pd_alpha[j * nr_alpha + k];
268 _giraffe_mrqmin(cpl_matrix *x, cpl_matrix *y, cpl_matrix *sig, cxint ndata,
269 cpl_matrix *a, cxdouble r[], cxint ia[], cxint ma,
270 cpl_matrix *covar, cpl_matrix *alpha, cxdouble *chisq,
271 GiFitFunc funcs, cxdouble *alamda)
274 register cxint gj, j, k, l, m;
276 static cxint nr_covar, nr_alpha, nr_moneda, mfit;
278 static cxdouble *pd_a, *pd_covar, *pd_alpha;
279 static cxdouble *atry, *beta, *da, *oneda, ochisq;
281 static cpl_matrix *matry, *mbeta, *mda, *moneda;
284 pd_a = cpl_matrix_get_data(a);
285 pd_covar = cpl_matrix_get_data(covar);
286 pd_alpha = cpl_matrix_get_data(alpha);
287 nr_covar = cpl_matrix_get_nrow(covar);
288 nr_alpha = cpl_matrix_get_nrow(alpha);
292 matry = cpl_matrix_new(ma, 1);
293 atry = cpl_matrix_get_data(matry);
295 mbeta = cpl_matrix_new(ma, 1);
296 beta = cpl_matrix_get_data(mbeta);
298 mda = cpl_matrix_new(ma, 1);
299 da = cpl_matrix_get_data(mda);
301 for (mfit = 0, j = 0; j < ma; j++) {
307 moneda = cpl_matrix_new(1, mfit);
308 oneda = cpl_matrix_get_data(moneda);
312 gj = _giraffe_mrqcof(x, y, sig, ndata, a, r, ia, ma, alpha, mbeta,
316 cpl_matrix_delete(moneda);
320 cpl_matrix_delete(mda);
324 cpl_matrix_delete(mbeta);
328 cpl_matrix_delete(matry);
337 for (j = 0; j < ma; j++) {
343 nr_moneda = cpl_matrix_get_nrow(moneda);
345 for (j = -1, l = 0; l < ma; l++) {
347 for (j++, k = -1, m = 0; m < ma; m++) {
350 pd_covar[j * nr_covar + k] = pd_alpha[j * nr_alpha + k];
354 pd_covar[j * nr_covar + j] = pd_alpha[j * nr_alpha + j] *
357 oneda[j * nr_moneda + 0] = beta[j];
361 gj = giraffe_gauss_jordan(covar, mfit, moneda, 1);
364 cpl_matrix_delete(moneda);
368 cpl_matrix_delete(mda);
372 cpl_matrix_delete(mbeta);
376 cpl_matrix_delete(matry);
383 for (j = 0; j < mfit; j++) {
384 da[j] = oneda[j * nr_moneda + 0];
387 if (*alamda == 0.0) {
388 _giraffe_covsrt(covar, ma, ia, mfit);
390 cpl_matrix_delete(moneda);
394 cpl_matrix_delete(mda);
398 cpl_matrix_delete(mbeta);
402 cpl_matrix_delete(matry);
409 for (j = -1, l = 0; l < ma; l++) {
411 atry[l] = pd_a[l] + da[++j];
415 gj = _giraffe_mrqcof(x, y, sig, ndata, matry, r, ia, ma, covar, mda,
419 cpl_matrix_delete(moneda);
423 cpl_matrix_delete(mda);
427 cpl_matrix_delete(mbeta);
431 cpl_matrix_delete(matry);
438 if (*chisq < ochisq) {
443 for (j = -1, l = 0; l < ma; l++) {
445 for (j++, k = -1, m = 0; m < ma; m++) {
448 pd_alpha[j * nr_alpha + k] =
449 pd_covar[j * nr_covar + k];
497 cxint ndata, cpl_matrix *a, cpl_matrix *delta, cxint *ia,
498 cxint ma, cpl_matrix *alpha, cxdouble *chisq, GiFitFunc funcs,
506 cxdouble alamda = -1.;
509 cpl_matrix *beta = cpl_matrix_new(ma, ma);
513 r = cpl_matrix_get_data(delta);
516 res = _giraffe_mrqmin(x, y, sigma, ndata, a, r, ia, ma, alpha, beta,
517 chisq, funcs, &alamda);
520 cpl_matrix_delete(beta);
530 cxdouble ochisq = *chisq;
532 res = _giraffe_mrqmin(x, y, sigma, ndata, a, r, ia, ma, alpha, beta,
533 chisq, funcs, &alamda);
536 cpl_matrix_delete(beta);
542 if (*chisq > ochisq) {
545 else if (fabs(ochisq - *chisq) < setup->
dchisq) {
549 if (itst > setup->
tests) {
562 res = _giraffe_mrqmin(x, y, sigma, ndata, a, r, ia, ma, alpha, beta,
563 chisq, funcs, &alamda);
566 cpl_matrix_delete(beta);
572 cpl_matrix_delete(beta);
Non-linear fit control parameters.
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.