22 #include <sinfo_fit.h>
23 #include <sinfo_msg.h>
34 sinfo_spline(
double x,
double cons[],
double ak[],
double *sp,
double *spp,
52 sinfo_amsub(
double d0[],
double d1[],
double d2[],
double value[],
53 double range[],
double tol,
int ivorf[],
int ncon,
int nref,
double
54 (*ftbm)(
double[],
int ncon))
57 double alpha = 1.0, loc_gamma = 1.5;
58 double sf, bsave, temp, sum, cval, ccval, beta;
59 int idone, nvar, nvec, nrefl, i, j, k, kd1, kval, isign, jvar, imin, imax,
60 i2max, it1, it2, itemp;
65 for (i = 0; i < ncon; ++i) {
74 value[0] = (*ftbm)(d2, ncon);
80 for (i = 0; i < ncon; ++i) {
88 for (jvar = 0; jvar < ncon; ++jvar) {
89 if (ivorf[jvar] == 1) {
93 d2[jvar] = d2[jvar] + isign * range[jvar];
94 value[kval] = (*ftbm)(d2, ncon);
95 for (i = 0; i < ncon; ++i) {
115 if (value[0] > value[1]) {
123 for (i = 0; i < nvec; ++i) {
124 if (value[i] < value[imin])
126 if (value[i] > value[imax]) {
130 else if ((value[i] > value[i2max]) && (i != imax)) {
142 sinfo_msg(
" maximum number of reflection reached");
146 if (value[imin] != 0.0) {
147 temp = (value[imax] - value[imin]) / value[imin];
148 if (fabs(temp) <= tol) {
149 sinfo_msg(
" reached tolerance %lg temp %lg tol", temp, tol);
154 if (value[imax] - value[imin] <= tol) {
155 sinfo_msg(
"value[max]-value[min]<=tol");
161 for (j = 0; j < nvar; ++j) {
163 for (i = 0; i < nvec; ++i) {
165 sum = sum + d1[i * nvar + j];
167 d0[j] = sum / (nvec - 1);
176 for (j = 0; j < ncon; ++j) {
179 it1 = imax * nvar + k;
180 d2[j] = (1 + alpha) * d0[k] - alpha * d1[it1];
187 cval = (*ftbm)(d2, ncon);
191 if (cval >= value[i2max])
198 for (j = 0; j < ncon; ++j) {
201 it1 = imax * nvar + k;
207 if (cval < value[imin])
215 for (itemp = 0; itemp < 3; ++itemp) {
216 if (cval <= value[imax]) {
219 for (j = 0; j < ncon; ++j) {
222 it1 = imax * nvar + k;
228 for (j = 0; j < ncon; ++j) {
231 it1 = imax * nvar + k;
232 d2[j] = beta * d1[it1] + (1. - beta) * d0[k];
235 cval = ftbm(d2, ncon);
239 if (cval < value[i2max]) {
242 for (j = 0; j < ncon; ++j) {
245 it1 = imax * nvar + k;
249 if (cval < value[imin])
250 sinfo_msg(
" contraction minimum %lg", cval);
255 sinfo_msg(
" contraction failed ==>shrink");
264 sinfo_msg(
" reflection min %lg \n", cval);
266 for (j = 0; j < ncon; ++j) {
269 d2[j] = loc_gamma * d2[j] + (1. - loc_gamma) * d0[k];
272 ccval = (*ftbm)(d2, ncon);
277 sinfo_msg(
" expansion minimum %lg \n", ccval);
280 for (j = 0; j < ncon; ++j) {
283 it1 = imax * nvar + k;
295 for (j = 0; j < ncon; ++j) {
298 it1 = imin * nvar + k;
301 for (i = 0; i < nvec; ++i) {
303 it2 = imin * nvar + k;
304 sum = sum + (d1[it1] - d1[it2]) * (d1[it1] - d1[it2]);
306 range[j] = sf * sqrt(sum / (nvec - 1));
309 value[1] = value[imin];
313 sinfo_msg(
" shrink factor %lg ", sf);
321 sinfo_spline(
double x,
double cons[],
double ak[],
double *sp,
double *spp,
335 for (i = 0; i < n; ++i) {
340 sinfo_msg(
"cons=%g", cons[i]);
341 retval += cons[i] * xm3;
342 *sp -= 3 * cons[i] * xm2;
343 *spp += 6 * cons[i] * xm;
344 *sppp -= 6 * cons[i];
347 sinfo_msg(
"1x=%g retval=%g", x, retval);
353 sinfo_ftbm(
const double x,
double cons[])
357 { -1, -.666666666666666, -.333333333333, 0 };
365 sm1 = sinfo_spline(x, cons, ak, &spm1, &sppm1, &spppm1, n) - 1;
366 sinfo_msg(
"x=%g val=%g", x, sm1 + 1);
368 retval = sm1 * sm1 + spm1 * spm1 + sppm1 * sppm1 + spppm1 * spppm1;
369 sinfo_msg(
"fitbm: x=%g retval=%g", x, retval);