00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019 #ifdef HAVE_CONFIG_H
00020 # include <config.h>
00021 #endif
00022 #include <sinfo_fit.h>
00023 #include <sinfo_msg.h>
00024 #include <stdio.h>
00025 #include <math.h>
00034 static double
00035 sinfo_spline(double x,
00036 double cons[],
00037 double ak[],
00038 double *sp,
00039 double *spp,
00040 double *sppp,
00041 int n);
00042
00043
00044
00045
00046
00047
00062 double
00063 sinfo_amsub(double d0[],
00064 double d1[],
00065 double d2[],
00066 double value[],
00067 double range[],
00068 double tol,
00069 int ivorf[],
00070 int ncon,
00071 int nref,
00072 double(*ftbm)(double[],int ncon))
00073
00074 {
00075 double alpha=1.0,loc_gamma=1.5;
00076 double sf,bsave,temp,sum,cval,ccval,beta;
00077 int idone,nvar,nvec,nrefl,i,j,k,kd1,kval,isign,jvar,imin,imax,i2max,
00078 it1,it2,itemp;
00079 idone=0;
00080 isign=1;
00081
00082 nvar=0;
00083 for(i=0;i<ncon;++i) {
00084 if(ivorf[i] == 1) {
00085 nvar=nvar+1;
00086 }
00087 }
00088 nvec=nvar+1;
00089
00090 sf=1e5*nvec;
00091 nrefl=0;
00092 value[0]=(*ftbm)(d2,ncon);
00093
00094
00095
00096
00097 cont20:
00098 kd1=-1;
00099 for(i=0;i<ncon;++i) {
00100 if(ivorf[i]==1) {
00101 kd1=kd1+1;
00102 d1[kd1]=d2[i];
00103 }
00104 }
00105
00106 kval=0;
00107 for(jvar=0;jvar<ncon;++jvar) {
00108 if(ivorf[jvar] == 1) {
00109 kval=kval+1;
00110 bsave=d2[jvar];
00111 isign=-isign;
00112 d2[jvar]=d2[jvar]+isign*range[jvar];
00113 value[kval]=(*ftbm)(d2,ncon);
00114 for(i=0;i<ncon;++i) {
00115 if(ivorf[i]==1) {
00116 kd1=kd1+1;
00117 d1[kd1]=d2[i];
00118 }
00119 }
00120 d2[jvar]=bsave;
00121 }
00122 }
00123
00124
00125
00126
00127
00128
00129
00130
00131
00132
00133 cont40:
00134 imin=1;
00135 if(value[0]>value[1]) {
00136 imax=0;
00137 i2max=1;
00138 } else {
00139 imax=1;
00140 i2max=0;
00141 }
00142 for(i=0;i<nvec;++i) {
00143 if(value[i]<value[imin]) imin=i;
00144 if(value[i]>value[imax]) {
00145 i2max=imax;
00146 imax=i;
00147 } else if( (value[i]>value[i2max]) && (i != imax) ) {
00148 i2max=i;
00149 }
00150 }
00151
00152
00153
00154
00155
00156
00157
00158 if(nrefl>=nref) {
00159 sinfo_msg(" maximum number of reflection reached");
00160 idone=1;
00161 goto cont400;
00162 }
00163 if(value[imin]!=0.0) {
00164 temp=(value[imax]-value[imin])/value[imin];
00165 if(fabs(temp)<=tol) {
00166 sinfo_msg(" reached tolerance %lg temp %lg tol",temp,tol);
00167 idone=1;
00168 goto cont400;
00169 }
00170 }
00171 if(value[imax]-value[imin]<=tol) {
00172 sinfo_msg("value[max]-value[min]<=tol");
00173 idone=1;
00174 goto cont400;
00175 }
00176
00177
00178 for(j=0;j<nvar;++j) {
00179 sum=0.0;
00180 for(i=0;i<nvec;++i) {
00181 if(i!=imax)sum=sum+d1[i*nvar+j];
00182 }
00183 d0[j]=sum/(nvec-1);
00184 }
00185
00186
00187
00188
00189
00190 nrefl=nrefl+1;
00191 k=-1;
00192 for(j=0;j<ncon;++j) {
00193 if(ivorf[j]==1) {
00194 k=k+1;
00195 it1=imax*nvar+k;
00196 d2[j]=(1+alpha)*d0[k]-alpha*d1[it1];
00197 }
00198 }
00199
00200
00201
00202
00203 cval=(*ftbm)(d2,ncon);
00204
00205
00206
00207 if(cval>=value[i2max]) goto cont200;
00208
00209
00210
00211 value[imax]=cval;
00212 k=-1;
00213 for(j=0;j<ncon;++j) {
00214 if(ivorf[j]==1) {
00215 k=k+1;
00216 it1=imax*nvar+k;
00217 d1[it1]=d2[j];
00218 }
00219 }
00220
00221
00222 if(cval<value[imin]) goto cont300;
00223 goto cont40;
00224
00225
00226 cont200:
00227
00228 beta=0.75;
00229 for(itemp=0;itemp<3;++itemp) {
00230 if(cval<=value[imax]) {
00231 value[imax]=cval;
00232 k=-1;
00233 for(j=0;j<ncon;++j) {
00234 if(ivorf[j]==1) {
00235 k=k+1;
00236 it1=imax*nvar+k;
00237 d1[it1]=d2[j];
00238 }
00239 }
00240 }
00241 k=-1;
00242 for(j=0;j<ncon;++j) {
00243 if(ivorf[j]==1) {
00244 k=k+1;
00245 it1=imax*nvar+k;
00246 d2[j]=beta*d1[it1]+(1.-beta)*d0[k];
00247 }
00248 }
00249 cval=ftbm(d2,ncon);
00250
00251
00252
00253 if(cval<value[i2max]) {
00254 value[imax]=cval;
00255 k=-1;
00256 for(j=0;j<ncon;++j) {
00257 if(ivorf[j]==1) {
00258 k=k+1;
00259 it1=imax*nvar+k;
00260 d1[it1]=d2[j];
00261 }
00262 }
00263 if(cval<value[imin]) sinfo_msg(" contraction minimum %lg",cval);
00264 goto cont40;
00265 }
00266 beta=beta-0.25;
00267 }
00268 sinfo_msg(" contraction failed ==>shrink");
00269
00270
00271
00272 goto cont400;
00273
00274
00275
00276 cont300:
00277 sinfo_msg(" reflection min %lg \n", cval);
00278 k=-1;
00279 for(j=0;j<ncon;++j) {
00280 if(ivorf[j]==1) {
00281 k=k+1;
00282 d2[j]=loc_gamma*d2[j]+(1.-loc_gamma)*d0[k];
00283 }
00284 }
00285 ccval=(*ftbm)(d2,ncon);
00286
00287 if(ccval>cval) goto cont40;
00288
00289 sinfo_msg(" expansion minimum %lg \n",ccval);
00290 value[imax]=ccval;
00291 k=-1;
00292 for(j=0;j<ncon;++j) {
00293 if(ivorf[j]==1) {
00294 k=k+1;
00295 it1=imax*nvar+k;
00296 d1[it1]=d2[j];
00297 }
00298 }
00299 goto cont40;
00300
00301 cont400:
00302
00303
00304
00305
00306 k=-1;
00307 for(j=0;j<ncon;++j) {
00308 if(ivorf[j]==1) {
00309 k=k+1;
00310 it1=imin*nvar+k;
00311 d2[j]=d1[it1];
00312 sum=0.0;
00313 for(i=0;i<nvec;++i) {
00314 it1=i*nvar+k;
00315 it2=imin*nvar+k;
00316 sum=sum+(d1[it1]-d1[it2])*(d1[it1]-d1[it2]);
00317 }
00318 range[j]=sf*sqrt(sum/(nvec-1));
00319 }
00320 }
00321 value[1]=value[imin];
00322 sf=.75*sf;
00323 if(sf<0.1)idone=1;
00324 sinfo_msg(" shrink factor %lg ",sf);
00325 if(idone!=1)goto cont20;
00326 return value[1];
00327
00328 }
00329
00330 static double
00331 sinfo_spline(double x,
00332 double cons[],
00333 double ak[],
00334 double *sp,
00335 double *spp,
00336 double *sppp,
00337 int n)
00338 {
00339 double retval=0;
00340 double xm=0;
00341 double xm2=0;
00342 double xm3=0;
00343
00344 int i=0;
00345
00346
00347 *sp=0;
00348 *spp=0;
00349 *sppp=0;
00350
00351 for(i=0;i<n;++i) {
00352 if(ak[i] >= x) {
00353 xm=ak[i]-x;
00354 xm2=xm*xm;
00355 xm3=xm*xm2;
00356 sinfo_msg("cons=%g",cons[i]);
00357 retval+=cons[i]*xm3;
00358 *sp-=3*cons[i]*xm2;
00359 *spp+=6*cons[i]*xm;
00360 *sppp-=6*cons[i];
00361 }
00362 }
00363 sinfo_msg("1x=%g retval=%g",x,retval);
00364 return retval;
00365
00366 }
00367
00368
00369
00370
00371 double
00372 sinfo_ftbm(const double x, double cons[])
00373 {
00374 double retval=0;
00375 double ak[4]={-1,-.666666666666666,-.333333333333,0};
00376 double sm1=0;
00377 double spm1=0;
00378 double sppm1=0;
00379 double spppm1=0;
00380
00381 int n=4;
00382
00383 sm1=sinfo_spline(x,cons,ak,&spm1,&sppm1,&spppm1,n)-1;
00384 sinfo_msg("x=%g val=%g",x,sm1+1);
00385
00386 retval=sm1*sm1+spm1*spm1+sppm1*sppm1+spppm1*spppm1;
00387 sinfo_msg("fitbm: x=%g retval=%g",x,retval);
00388
00389 return retval;
00390
00391 }
00392
00393
00394