00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028 #ifdef HAVE_CONFIG_H
00029 # include <config.h>
00030 #endif
00031
00032 #include <math.h>
00033
00034 #include <cxtypes.h>
00035 #include <cxmemory.h>
00036
00037 #include "gimath.h"
00038 #include "gilevenberg.h"
00039
00040
00049 inline static void
00050 _giraffe_swap(cxdouble *a, cxdouble *b) {
00051
00052 register cxdouble t = *a;
00053
00054 *a = *b;
00055 *b = t;
00056
00057 return;
00058
00059 }
00060
00061
00062 inline static void
00063 _giraffe_covsrt(cpl_matrix *covar, cxint ma, cxint ia[], cxint mfit)
00064 {
00065
00066 register cxint i, j, k;
00067
00068 cxint nr = cpl_matrix_get_nrow(covar);
00069
00070 cxdouble *_covar = cpl_matrix_get_data(covar);
00071
00072
00073 for (i = mfit; i < ma; i++) {
00074 for (j = 0; j <= i; j++) {
00075 _covar[i * nr + j] = _covar[j * nr + i] = 0.0;
00076 }
00077 }
00078
00079 k = mfit - 1;
00080
00081 for (j = (ma - 1); j >= 0; j--) {
00082 if (ia[j]) {
00083 for (i = 0; i < ma; i++) {
00084 _giraffe_swap(&_covar[i * nr + k], &_covar[i * nr + j]);
00085 }
00086
00087 for (i = 0;i < ma; i++) {
00088 _giraffe_swap(&_covar[k * nr + i], &_covar[j * nr + i]);
00089 }
00090
00091 k--;
00092 }
00093 }
00094
00095 }
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118
00119
00120
00121
00122
00123 inline static cxint
00124 _giraffe_mrqcof(cpl_matrix *x, cpl_matrix *y, cpl_matrix *sig,
00125 cxint ndata, cpl_matrix *a, cxdouble r[], cxint ia[],
00126 cxint ma, cpl_matrix *alpha, cpl_matrix *beta,
00127 cxdouble *chisq, GiFitFunc funcs)
00128 {
00129
00130 register cxint i, j, k, l, m;
00131 register cxint mfit = 0;
00132
00133 cxint nr_alpha = cpl_matrix_get_nrow(alpha);
00134 cxint nc_x = cpl_matrix_get_ncol(x);
00135
00136 cxdouble ymod;
00137 cxdouble wt;
00138 cxdouble sig2i;
00139 cxdouble dy;
00140 cxdouble *dyda;
00141 cxdouble *pd_x = cpl_matrix_get_data(x);
00142 cxdouble *pd_y = cpl_matrix_get_data(y);
00143 cxdouble *pd_sig = cpl_matrix_get_data(sig);
00144 cxdouble *pd_a = cpl_matrix_get_data(a);
00145 cxdouble *pd_alpha = cpl_matrix_get_data(alpha);
00146 cxdouble *pd_beta = cpl_matrix_get_data(beta);
00147
00148
00149 for (j = 0; j < ma; j++) {
00150 if (ia[j]) {
00151 mfit++;
00152 }
00153 }
00154
00155 for (j = 0; j < mfit; j++) {
00156 for (k = 0; k <= j; k++) {
00157 pd_alpha[j * nr_alpha + k] = 0.0;
00158 }
00159
00160 pd_beta[j] = 0.0;
00161 }
00162
00163 *chisq = 0.0;
00164
00165 dyda = cx_calloc(ma, sizeof(cxdouble));
00166
00167 for (i = 0; i < ndata; i++) {
00168
00169 (*funcs)(&ymod, &(pd_x[i * nc_x]), pd_a, ma, dyda, r);
00170
00171 if (pd_sig[i] == 0.0) {
00172 continue;
00173 }
00174
00175 sig2i = 1.0 / (pd_sig[i] * pd_sig[i]);
00176 dy = pd_y[i] - ymod;
00177
00178 for (j = -1, l = 0; l < ma; l++) {
00179
00180 if (ia[l]) {
00181 wt = dyda[l] * sig2i;
00182 for (j++, k = -1, m = 0; m <= l; m++) {
00183 if (ia[m]) {
00184 ++k;
00185 pd_alpha[j * nr_alpha + k] += (wt * dyda[m]);
00186 }
00187 }
00188
00189 pd_beta[j] += (dy * wt);
00190
00191 }
00192 }
00193
00194 *chisq += (dy * dy * sig2i);
00195
00196 }
00197
00198 for (j = 1; j < mfit; j++) {
00199 for (k = 0; k < j; k++) {
00200 pd_alpha[k * nr_alpha + j] = pd_alpha[j * nr_alpha + k];
00201 }
00202 }
00203
00204
00205 cx_free(dyda);
00206
00207 return 0;
00208
00209 }
00210
00211
00212
00213
00214
00215
00216
00217
00218
00219
00220
00221
00222
00223
00224
00225
00226
00227
00228
00229
00230
00231
00232
00233
00234
00235
00236
00237
00238
00239
00240
00241
00242
00243
00244
00245
00246
00247
00248
00249
00250
00251
00252
00253
00254
00255
00256
00257
00258
00259
00260
00261
00262
00263
00264
00265
00266
00267 static cxint
00268 _giraffe_mrqmin(cpl_matrix *x, cpl_matrix *y, cpl_matrix *sig, cxint ndata,
00269 cpl_matrix *a, cxdouble r[], cxint ia[], cxint ma,
00270 cpl_matrix *covar, cpl_matrix *alpha, cxdouble *chisq,
00271 GiFitFunc funcs, cxdouble *alamda)
00272 {
00273
00274 register cxint gj, j, k, l, m;
00275
00276 static cxint nr_covar, nr_alpha, nr_moneda, mfit;
00277
00278 static cxdouble *pd_a, *pd_covar, *pd_alpha;
00279 static cxdouble *atry, *beta, *da, *oneda, ochisq;
00280
00281 static cpl_matrix *matry, *mbeta, *mda, *moneda;
00282
00283
00284 pd_a = cpl_matrix_get_data(a);
00285 pd_covar = cpl_matrix_get_data(covar);
00286 pd_alpha = cpl_matrix_get_data(alpha);
00287 nr_covar = cpl_matrix_get_nrow(covar);
00288 nr_alpha = cpl_matrix_get_nrow(alpha);
00289
00290 if (*alamda < 0.0) {
00291
00292 matry = cpl_matrix_new(ma, 1);
00293 atry = cpl_matrix_get_data(matry);
00294
00295 mbeta = cpl_matrix_new(ma, 1);
00296 beta = cpl_matrix_get_data(mbeta);
00297
00298 mda = cpl_matrix_new(ma, 1);
00299 da = cpl_matrix_get_data(mda);
00300
00301 for (mfit = 0, j = 0; j < ma; j++) {
00302 if (ia[j]) {
00303 mfit++;
00304 }
00305 }
00306
00307 moneda = cpl_matrix_new(1, mfit);
00308 oneda = cpl_matrix_get_data(moneda);
00309
00310 *alamda = 0.001;
00311
00312 gj = _giraffe_mrqcof(x, y, sig, ndata, a, r, ia, ma, alpha, mbeta,
00313 chisq, funcs);
00314
00315 if (gj != 0) {
00316 cpl_matrix_delete(moneda);
00317 moneda = NULL;
00318 oneda = NULL;
00319
00320 cpl_matrix_delete(mda);
00321 mda = NULL;
00322 da = NULL;
00323
00324 cpl_matrix_delete(mbeta);
00325 mbeta = NULL;
00326 beta = NULL;
00327
00328 cpl_matrix_delete(matry);
00329 matry = NULL;
00330 atry = NULL;
00331
00332 return gj;
00333 }
00334
00335 ochisq = (*chisq);
00336
00337 for (j = 0; j < ma; j++) {
00338 atry[j] = pd_a[j];
00339 }
00340
00341 }
00342
00343 nr_moneda = cpl_matrix_get_nrow(moneda);
00344
00345 for (j = -1, l = 0; l < ma; l++) {
00346 if (ia[l]) {
00347 for (j++, k = -1, m = 0; m < ma; m++) {
00348 if (ia[m]) {
00349 k++;
00350 pd_covar[j * nr_covar + k] = pd_alpha[j * nr_alpha + k];
00351 }
00352 }
00353
00354 pd_covar[j * nr_covar + j] = pd_alpha[j * nr_alpha + j] *
00355 (1.0 + (*alamda));
00356
00357 oneda[j * nr_moneda + 0] = beta[j];
00358 }
00359 }
00360
00361 gj = giraffe_gauss_jordan(covar, mfit, moneda, 1);
00362
00363 if (gj != 0) {
00364 cpl_matrix_delete(moneda);
00365 moneda = NULL;
00366 oneda = NULL;
00367
00368 cpl_matrix_delete(mda);
00369 mda = NULL;
00370 da = NULL;
00371
00372 cpl_matrix_delete(mbeta);
00373 mbeta = NULL;
00374 beta = NULL;
00375
00376 cpl_matrix_delete(matry);
00377 matry = NULL;
00378 atry = NULL;
00379
00380 return gj;
00381 }
00382
00383 for (j = 0; j < mfit; j++) {
00384 da[j] = oneda[j * nr_moneda + 0];
00385 }
00386
00387 if (*alamda == 0.0) {
00388 _giraffe_covsrt(covar, ma, ia, mfit);
00389
00390 cpl_matrix_delete(moneda);
00391 moneda = NULL;
00392 oneda = NULL;
00393
00394 cpl_matrix_delete(mda);
00395 mda = NULL;
00396 da = NULL;
00397
00398 cpl_matrix_delete(mbeta);
00399 mbeta = NULL;
00400 beta = NULL;
00401
00402 cpl_matrix_delete(matry);
00403 matry = NULL;
00404 atry = NULL;
00405
00406 return 0;
00407 }
00408
00409 for (j = -1, l = 0; l < ma; l++) {
00410 if (ia[l]) {
00411 atry[l] = pd_a[l] + da[++j];
00412 }
00413 }
00414
00415 gj = _giraffe_mrqcof(x, y, sig, ndata, matry, r, ia, ma, covar, mda,
00416 chisq, funcs);
00417
00418 if (gj != 0) {
00419 cpl_matrix_delete(moneda);
00420 moneda = NULL;
00421 oneda = NULL;
00422
00423 cpl_matrix_delete(mda);
00424 mda = NULL;
00425 da = NULL;
00426
00427 cpl_matrix_delete(mbeta);
00428 mbeta = NULL;
00429 beta = NULL;
00430
00431 cpl_matrix_delete(matry);
00432 matry = NULL;
00433 atry = NULL;
00434
00435 return gj;
00436 }
00437
00438 if (*chisq < ochisq) {
00439
00440 *alamda *= 0.1;
00441 ochisq = *chisq;
00442
00443 for (j = -1, l = 0; l < ma; l++) {
00444 if (ia[l]) {
00445 for (j++, k = -1, m = 0; m < ma; m++) {
00446 if (ia[m]) {
00447 k++;
00448 pd_alpha[j * nr_alpha + k] =
00449 pd_covar[j * nr_covar + k];
00450 }
00451 }
00452
00453 beta[j] = da[j];
00454 pd_a[l] = atry[l];
00455 }
00456 }
00457
00458 }
00459 else {
00460
00461 *alamda *= 10.0;
00462 *chisq = ochisq;
00463
00464 }
00465
00466 return 0;
00467
00468 }
00469
00470
00495 cxint
00496 giraffe_nlfit(cpl_matrix *x, cpl_matrix *y, cpl_matrix *sigma,
00497 cxint ndata, cpl_matrix *a, cpl_matrix *delta, cxint *ia,
00498 cxint ma, cpl_matrix *alpha, cxdouble *chisq, GiFitFunc funcs,
00499 const GiFitParams *setup)
00500 {
00501
00502 cxint itst;
00503 cxint n;
00504 cxint res;
00505
00506 cxdouble alamda = -1.;
00507 cxdouble *r = NULL;
00508
00509 cpl_matrix *beta = cpl_matrix_new(ma, ma);
00510
00511
00512 if (delta) {
00513 r = cpl_matrix_get_data(delta);
00514 }
00515
00516 res = _giraffe_mrqmin(x, y, sigma, ndata, a, r, ia, ma, alpha, beta,
00517 chisq, funcs, &alamda);
00518
00519 if (res != 0) {
00520 cpl_matrix_delete(beta);
00521 beta = NULL;
00522
00523 return res;
00524 }
00525
00526 itst=0;
00527
00528 for (n = 1; n <= setup->iterations; n++) {
00529
00530 cxdouble ochisq = *chisq;
00531
00532 res = _giraffe_mrqmin(x, y, sigma, ndata, a, r, ia, ma, alpha, beta,
00533 chisq, funcs, &alamda);
00534
00535 if (res != 0) {
00536 cpl_matrix_delete(beta);
00537 beta = NULL;
00538
00539 return res;
00540 }
00541
00542 if (*chisq > ochisq) {
00543 itst = 0;
00544 }
00545 else if (fabs(ochisq - *chisq) < setup->dchisq) {
00546 itst++;
00547 }
00548
00549 if (itst > setup->tests) {
00550 break;
00551 }
00552
00553 }
00554
00555
00556
00557
00558
00559
00560 alamda=0.0;
00561
00562 res = _giraffe_mrqmin(x, y, sigma, ndata, a, r, ia, ma, alpha, beta,
00563 chisq, funcs, &alamda);
00564
00565 if (res != 0) {
00566 cpl_matrix_delete(beta);
00567 beta = NULL;
00568
00569 return res;
00570 }
00571
00572 cpl_matrix_delete(beta);
00573 beta = NULL;
00574
00575 return n;
00576
00577 }