5 /************************
\r
7 *************************/
\r
9 char BASEs[]="TCAGUYRMKSWHBVD-N?";
\r
10 char *EquateBASE[]={"T","C","A","G", "T", "TC","AG","CA","TG","CG","TA",
\r
11 "TCA","TCG","CAG","TAG", "TCAG","TCAG","TCAG"};
\r
12 char BASEs5[]="TCAGEUYRMKSWHBVD-N?";
\r
13 char *EquateBASE5[]={"T","C","A","G", "E", "T", "TC","AG","CA","TG","CG","TA",
\r
14 "TCA","TCG","CAG","TAG", "TCAG","TCAG","TCAG"};
\r
15 char CODONs[256][4], AAs[] = "ARNDCQEGHILKMFPSTWYV-*?X";
\r
16 char nChara[256], CharaMap[256][64];
\r
17 char AA3Str[]= {"AlaArgAsnAspCysGlnGluGlyHisIleLeuLysMetPheProSerThrTrpTyrVal***"};
\r
19 int GeneticCode[][64] =
\r
20 {{13,13,10,10,15,15,15,15,18,18,-1,-1, 4, 4,-1,17,
\r
21 10,10,10,10,14,14,14,14, 8, 8, 5, 5, 1, 1, 1, 1,
\r
22 9, 9, 9,12,16,16,16,16, 2, 2,11,11,15,15, 1, 1,
\r
23 19,19,19,19, 0, 0, 0, 0, 3, 3, 6, 6, 7, 7, 7, 7}, /* 0:universal */
\r
25 {13,13,10,10,15,15,15,15,18,18,-1,-1, 4, 4,17,17,
\r
26 10,10,10,10,14,14,14,14, 8, 8, 5, 5, 1, 1, 1, 1,
\r
27 9, 9,12,12,16,16,16,16, 2, 2,11,11,15,15,-1,-1,
\r
28 19,19,19,19, 0, 0, 0, 0, 3, 3, 6, 6, 7, 7, 7, 7}, /* 1:vertebrate mt.*/
\r
30 {13,13,10,10,15,15,15,15,18,18,-1,-1, 4, 4,17,17,
\r
31 16,16,16,16,14,14,14,14, 8, 8, 5, 5, 1, 1, 1, 1,
\r
32 9, 9,12,12,16,16,16,16, 2, 2,11,11,15,15, 1, 1,
\r
33 19,19,19,19, 0, 0, 0, 0, 3, 3, 6, 6, 7, 7, 7, 7}, /* 2:yeast mt. */
\r
35 {13,13,10,10,15,15,15,15,18,18,-1,-1, 4, 4,17,17,
\r
36 10,10,10,10,14,14,14,14, 8, 8, 5, 5, 1, 1, 1, 1,
\r
37 9, 9, 9,12,16,16,16,16, 2, 2,11,11,15,15, 1, 1,
\r
38 19,19,19,19, 0, 0, 0, 0, 3, 3, 6, 6, 7, 7, 7, 7}, /* 3:mold mt. */
\r
40 {13,13,10,10,15,15,15,15,18,18,-1,-1, 4, 4,17,17,
\r
41 10,10,10,10,14,14,14,14, 8, 8, 5, 5, 1, 1, 1, 1,
\r
42 9, 9,12,12,16,16,16,16, 2, 2,11,11,15,15,15,15,
\r
43 19,19,19,19, 0, 0, 0, 0, 3, 3, 6, 6, 7, 7, 7, 7}, /* 4:invertebrate mt. */
\r
45 {13,13,10,10,15,15,15,15,18,18, 5, 5, 4, 4,-1,17,
\r
46 10,10,10,10,14,14,14,14, 8, 8, 5, 5, 1, 1, 1, 1,
\r
47 9, 9, 9,12,16,16,16,16, 2, 2,11,11,15,15, 1, 1,
\r
48 19,19,19,19, 0, 0, 0, 0, 3, 3, 6, 6, 7, 7, 7, 7}, /* 5:ciliate nuclear*/
\r
50 {13,13,10,10,15,15,15,15,18,18,-1,-1, 4, 4,17,17,
\r
51 10,10,10,10,14,14,14,14, 8, 8, 5, 5, 1, 1, 1, 1,
\r
52 9, 9, 9,12,16,16,16,16, 2, 2, 2,11,15,15,15,15,
\r
53 19,19,19,19, 0, 0, 0, 0, 3, 3, 6, 6, 7, 7, 7, 7}, /* 6:echinoderm mt.*/
\r
55 {13,13,10,10,15,15,15,15,18,18,-1,-1, 4, 4, 4,17,
\r
56 10,10,10,10,14,14,14,14, 8, 8, 5, 5, 1, 1, 1, 1,
\r
57 9, 9, 9,12,16,16,16,16, 2, 2,11,11,15,15, 1, 1,
\r
58 19,19,19,19, 0, 0, 0, 0, 3, 3, 6, 6, 7, 7, 7, 7}, /* 7:euplotid mt. */
\r
60 {13,13,10,10,15,15,15,15,18,18,-1,-1, 4, 4,-1,17,
\r
61 10,10,10,15,14,14,14,14, 8, 8, 5, 5, 1, 1, 1, 1,
\r
62 9, 9, 9,12,16,16,16,16, 2, 2,11,11,15,15, 1, 1,
\r
63 19,19,19,19, 0, 0, 0, 0, 3, 3, 6, 6, 7, 7, 7, 7},
\r
64 /* 8:alternative yeast nu.*/
\r
66 {13,13,10,10,15,15,15,15,18,18,-1,-1, 4, 4,17,17,
\r
67 10,10,10,10,14,14,14,14, 8, 8, 5, 5, 1, 1, 1, 1,
\r
68 9, 9,12,12,16,16,16,16, 2, 2,11,11,15,15, 7, 7,
\r
69 19,19,19,19, 0, 0, 0, 0, 3, 3, 6, 6, 7, 7, 7, 7}, /* 9:ascidian mt. */
\r
71 {13,13,10,10,15,15,15,15,18,18,-1, 5, 4, 4,-1,17,
\r
72 10,10,10,10,14,14,14,14, 8, 8, 5, 5, 1, 1, 1, 1,
\r
73 9, 9, 9,12,16,16,16,16, 2, 2,11,11,15,15, 1, 1,
\r
74 19,19,19,19, 0, 0, 0, 0, 3, 3, 6, 6, 7, 7, 7, 7}, /* 10:blepharisma nu.*/
\r
76 { 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4,
\r
77 5, 5, 5, 5, 6, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8,
\r
78 9, 9, 9, 9,10,10,10,10,11,11,11,11,12,12,12,12,
\r
79 13,13,13,13,14,14,14,14,15,15,15,15,16,16,16,16} /* 11:Ziheng's regular code */
\r
80 }; /* GeneticCode[icode][#codon] */
\r
84 int noisy=0, Iround=0, NFunCall=0, NEigenQ, NPMatUVRoot;
\r
87 int blankline (char *str)
\r
90 while (*p) if (isalnum(*p++)) return(0);
\r
94 int PopEmptyLines (FILE* fseq, int lline, char line[])
\r
96 /* pop out empty lines in the sequence data file.
\r
99 char *eqdel=".-?", *p;
\r
103 p = fgets (line, lline, fseq);
\r
104 if (p==NULL) return(-1);
\r
106 if (*p==eqdel[0] || *p==eqdel[1] || *p==eqdel[2] || isalpha(*p))
\r
108 if (*p==eqdel[0] || *p==eqdel[1] || *p==eqdel[2] || isalnum(*p))
\r
116 int picksite (char *z, int l, int begin, int gap, char *result)
\r
118 /* pick every gap-th site, e.g., the third codon position for example.
\r
122 for (il=0, z+=begin; il<l; il+=gap,z+=gap) *result++ = *z;
\r
126 int CodeChara (char b, int seqtype)
\r
128 /* This codes nucleotides or amino acids into 0, 1, 2, ...
\r
130 int i, n=(seqtype<=1?4:(seqtype==2?20:2));
\r
131 char *pch=(seqtype<=1 ? BASEs : (seqtype==2 ? AAs: (seqtype==5 ? BASEs5 : BINs)));
\r
135 case 'T': case 'U': return(0);
\r
136 case 'C': return(1);
\r
137 case 'A': return(2);
\r
138 case 'G': return(3);
\r
142 if (b==pch[i]) return (i);
\r
143 if(noisy>=9) printf ("\nwarning: strange character '%c' ", b);
\r
147 int dnamaker (char z[], int ls, double pi[])
\r
149 /* sequences z[] are coded 0,1,2,3
\r
152 double p[4], r, small=1e-5;
\r
155 for (i=1; i<4; i++) p[i] += p[i-1];
\r
156 if(fabs(p[3]-1)>small)
\r
157 error2("sum pi != 1..");
\r
158 for(i=0; i<ls; i++) {
\r
159 for(j=0,r=rndu(); j<4; j++)
\r
166 int transform (char *z, int ls, int direction, int seqtype)
\r
168 /* direction==1 from TCAG to 0123, ==0 from 0123 to TCGA.
\r
172 char *pch=(seqtype<=1 ? BASEs : (seqtype==2 ? AAs: (seqtype==5 ? BASEs5 : BINs)));
\r
175 for (il=0,p=z; il<ls; il++,p++) {
\r
176 if ((*p=(char)CodeChara(*p, seqtype)) == (char)(-1)) status=-1;
\r
179 for (il=0,p=z; il<ls; il++,p++) *p = pch[(int) (*p)];
\r
184 int f_mono_di (FILE *fout, char *z, int ls, int iring,
\r
185 double fb1[], double fb2[], double CondP[])
\r
187 /* get mono- di- nucleitide frequencies.
\r
193 t1 = 1./(double) ls;
\r
194 t2=1./(double) (ls-1+iring);
\r
195 for (i=0; i<4; fb1[i++]=0.0) for (j=0; j<4; fb2[i*4+j++]=0.0) ;
\r
196 for (il=0, s=z; il<ls-1; il++, s++) {
\r
198 fb2[(*s-1)* 4 + *(s+1)-1 ] += t2;
\r
201 if (iring) fb2[(*s-1)*4 + z[0]-1] += t2;
\r
202 for (i=0; i<4; i++) for (j=0; j<4; j++) CondP[i*4+j] = fb2[i*4+j]/fb1[i];
\r
203 fprintf(fout, "\nmono-\n") ;
\r
204 FOR (i,4) fprintf(fout, "%12.4f", fb1[i]) ;
\r
205 fprintf(fout, "\n\ndi- & conditional P\n") ;
\r
207 FOR (j,4) fprintf(fout, "%9.4f%7.4f ", fb2[i*4+j], CondP[i*4+j]) ;
\r
214 int PickExtreme (FILE *fout, char *z, int ls, int iring, int lfrag, int *ffrag)
\r
216 /* picking up (lfrag)-tuples with extreme frequencies.
\r
219 int i, j, isf, n=(1<<2*lfrag), lvirt=ls-(lfrag-1)*(1-iring);
\r
220 double fb1[4], fb2[4*4], p_2[4*4];
\r
221 double prob1, prob2, ne1, ne2, u1, u2, ualpha=2.0;
\r
224 f_mono_di(fout, z, ls, iring, fb1, fb2, p_2 );
\r
226 error2("change PickExtreme()");
\r
227 FOR (i, lfrag-1) z[ls+i]=z[i]; /* dangerous */
\r
230 printf ("\ncounting %d tuple frequencies", lfrag);
\r
231 FOR (i, n) ffrag[i]=0;
\r
232 for (i=0; i<lvirt; i++, pz++) {
\r
233 for (j=0,isf=0; j<lfrag; j++) isf=isf*4+(int)pz[j]-1;
\r
237 for (i=0; i<n; i++) {
\r
238 for (j=0,isf=i; j<lfrag; ib[lfrag-1-j]=isf%4,isf=isf/4,j++) ;
\r
239 for (j=0,prob1=1.0; j<lfrag; prob1 *= fb1[ ib[j++] ] ) ;
\r
240 for (j=0,prob2=fb1[ib[0]]; j<lfrag-1; j++)
\r
241 prob2 *= p_2[ib[j]*4+ib[j+1]];
\r
242 ne1 = (double) lvirt * prob1;
\r
243 ne2 = (double) lvirt * prob2;
\r
244 if (ne1<=0.0) ne1=0.5;
\r
245 if (ne2<=0.0) ne2=0.5;
\r
246 u1=((double) ffrag[i]-ne1) / sqrt (ne1);
\r
247 u2=((double) ffrag[i]-ne2) / sqrt (ne2);
\r
248 if ( fabs(u1)>ualpha /* && fabs(u2)>ualpha */ ) {
\r
249 fprintf (fout,"\n");
\r
250 FOR (j, lfrag) fprintf (fout,"%1c", BASEs[ib[j]]);
\r
251 fprintf (fout,"%6d %8.1f%7.2f %8.1f%7.2f ",ffrag[i],ne1,u1,ne2,u2);
\r
252 if (u1<-ualpha && u2<-ualpha) fprintf (fout, " %c", '-');
\r
253 else if (u1>ualpha && u2>ualpha) fprintf (fout, " %c", '+');
\r
254 else if (u1*u2<0 && fabs(u1) > ualpha && fabs(u2) > ualpha)
\r
255 fprintf (fout, " %c", '?');
\r
257 fprintf (fout, " %c", ' ');
\r
263 int zztox ( int n31, int l, char *z1, char *z2, double *x )
\r
266 double t = 1./(double) (l / n31);
\r
271 for (i=0; i<n31; i++) {
\r
272 for (il=0; il<l; il += n31) {
\r
273 ib[0] = z1[il+i] - 1;
\r
274 ib[1] = z2[il+i] - 1;
\r
275 x [ i*16+ib[0]*4+ib[1] ] += t;
\r
278 fprintf (f1, "\nThe difference matrix X %6d\tin %6d\n", i+1,n31);
\r
279 for (j=0; j<4; j++) {
\r
280 for (k=0; k<4; k++) fprintf(f1, "%10.2f", x[i][j][k]);
\r
288 int testXMat (double x[])
\r
290 /* test whether X matrix is acceptable (0) or not (-1) */
\r
293 for (i=0,t=0; i<4; i++) FOR (j,4) {
\r
294 if (x[i*4+j]<0 || x[i*4+j]>1) it=-1;
\r
297 if (fabs(t-1) > 1e-4) it =-1;
\r
302 int difcodonNG (char codon1[], char codon2[], double *SynSite,double *AsynSite,
\r
303 double *SynDif, double *AsynDif, int transfed, int icode)
\r
305 /* # of synonymous and non-synonymous sites and differences.
\r
306 Nei, M. and T. Gojobori (1986)
\r
307 returns the number of differences between two codons.
\r
308 The two codons (codon1 & codon2) do not contain ambiguity characters.
\r
309 dmark[i] (=0,1,2) is the i_th different codon position, with i=0,1,ndiff
\r
310 step[j] (=0,1,2) is the codon position to be changed at step j (j=0,1,ndiff)
\r
311 b[i][j] (=0,1,2,3) is the nucleotide at position j (0,1,2) in codon i (0,1)
\r
313 I made some arbitrary decisions when the two codons have ambiguity characters
\r
316 int i,j,k, i1,i2, iy[2]={0}, iaa[2],ic[2];
\r
317 int ndiff,npath,nstop,sdpath,ndpath,dmark[3],step[3],b[2][3],bt1[3],bt2[3];
\r
318 int by[3] = {16, 4, 1};
\r
321 for (i=0,*SynSite=0,nstop=0; i<2; i++) {
\r
322 for (j=0; j<3; j++) {
\r
323 if (transfed) b[i][j] = (i?codon1[j]:codon2[j]);
\r
324 else b[i][j] = (int)CodeChara((char)(i?codon1[j]:codon2[j]),0);
\r
325 iy[i] += by[j]*b[i][j];
\r
326 if(b[i][j]<0||b[i][j]>3) {
\r
328 printf("\nwarning ambiguity in difcodonNG: %s %s", codon1,codon2);
\r
329 *SynSite = 0.5; *AsynSite = 2.5;
\r
330 *SynDif = (codon1[2]!=codon2[2])/2;
\r
331 *AsynDif = *SynDif + (codon1[0]!=codon2[0])+(codon1[1]!=codon2[1]);
\r
332 return((int)(*SynDif + *AsynDif));
\r
335 iaa[i] = GeneticCode[icode][iy[i]];
\r
337 printf("\nNG86: stop codon %s.\n",getcodon(str,iy[i]));
\r
340 for(j=0; j<3; j++)
\r
341 for(k=0; k<4; k++) {
\r
342 if (k==b[i][j]) continue;
\r
343 i1 = GeneticCode[icode][ iy[i] + (k-b[i][j])*by[j] ];
\r
346 else if (i1==iaa[i])
\r
350 *SynSite *= 3/18.; /* 2 codons, 2*9 possibilities. */
\r
351 *AsynSite = 3*(1-nstop/18.) - *SynSite;
\r
353 #if 0 /* MEGA 1.1 */
\r
354 *AsynSite = 3 - *SynSite;
\r
357 ndiff=0; *SynDif=*AsynDif=0;
\r
358 for(k=0; k<3; k++) dmark[k]=-1;
\r
359 for(k=0; k<3; k++)
\r
360 if (b[0][k]-b[1][k]) dmark[ndiff++]=k;
\r
361 if (ndiff==0) return(0);
\r
365 npath = (ndiff==2 ? 2 : 6);
\r
367 if (iaa[0]==iaa[1]) (*SynDif)++;
\r
370 else { /* ndiff=2 or 3 */
\r
371 for(k=0; k<npath; k++) {
\r
372 for(i1=0; i1<3; i1++)
\r
376 step[1]=dmark[1-k];
\r
379 step[0]=k/2; step[1]=k%2;
\r
380 if (step[0]<=step[1]) step[1]++;
\r
381 step[2]=3-step[0]-step[1];
\r
384 for(i1=0; i1<3; i1++)
\r
385 bt1[i1] = bt2[i1] = b[0][i1];
\r
386 sdpath=ndpath=0; /* mutations for each path */
\r
387 for(i1=0; i1<ndiff; i1++) { /* mutation steps for each path */
\r
388 bt2[step[i1]] = b[1][step[i1]];
\r
389 for (i2=0,ic[0]=ic[1]=0; i2<3; i2++) {
\r
390 ic[0]+=bt1[i2]*by[i2];
\r
391 ic[1]+=bt2[i2]*by[i2];
\r
393 for(i2=0; i2<2; i2++) iaa[i2]=GeneticCode[icode][ic[i2]];
\r
395 nstop++; sdpath=ndpath=0; break;
\r
397 if (iaa[0]==iaa[1]) sdpath++;
\r
399 for(i2=0; i2<3; i2++)
\r
402 *SynDif += (double)sdpath;
\r
403 *AsynDif += (double)ndpath;
\r
406 if (npath==nstop) {
\r
407 puts ("NG86: All paths are through stop codons..");
\r
408 if (ndiff==2) { *SynDif=0; *AsynDif=2; }
\r
409 else { *SynDif=1; *AsynDif=2; }
\r
412 *SynDif /= (double)(npath-nstop); *AsynDif /= (double)(npath-nstop);
\r
419 int difcodonLWL85 (char codon1[], char codon2[], double sites[3], double sdiff[3],
\r
420 double vdiff[3], int transfed, int icode)
\r
422 /* This partitions codon sites according to degeneracy, that is sites[3] has
\r
423 L0, L2, L4, averaged between the two codons. It also compares the two codons
\r
424 and add the differences to the transition and transversion differences for use
\r
425 in LWL85 and similar methods.
\r
426 The two codons (codon1 & codon2) should not contain ambiguity characters.
\r
427 c[0] & c[1] are the two codons, coded 0, 1, ..., 63.
\r
428 b[][] has the nucleotides, coded 0123 for TCAG.
\r
430 int b[2][3], by[3] = {16, 4, 1}, i,j, ifold[2], c[2], ct, aa[2], ibase,nsame;
\r
433 for(i=0; i<3; i++) sites[i]=sdiff[i]=vdiff[i]=0;
\r
434 /* check the two codons and code them */
\r
435 for (i=0; i<2; i++) {
\r
436 for (j=0,c[i]=0; j<3; j++) {
\r
437 if (transfed) b[i][j] = (i?codon1[j]:codon2[j]);
\r
438 else b[i][j] = (int)CodeChara((char)(i?codon1[j]:codon2[j]),0);
\r
439 c[i] += b[i][j]*by[j];
\r
440 if(b[i][j]<0 || b[i][j]>3) {
\r
442 printf("\nwarning ambiguity in difcodonLWL85: %s %s", codon1,codon2);
\r
446 aa[i] = GeneticCode[icode][c[i]];
\r
448 printf("\nLWL85: stop codon %s.\n", getcodon(str,c[i]));
\r
453 for (j=0; j<3; j++) { /* three codon positions */
\r
454 for (i=0; i<2; i++) { /* two codons */
\r
455 for(ibase=0,nsame=0; ibase<4; ibase++) { /* change codon i pos j into ibase */
\r
456 ct = c[i] + (ibase-b[i][j])*by[j];
\r
457 if(ibase!=b[i][j] && aa[i]==GeneticCode[icode][ct]) nsame++;
\r
459 if(nsame==0) ifold[i]=0; /* codon i pos j is 0-fold */
\r
460 else if (nsame==1 || nsame==2) ifold[i]=1; /* codon i pos j is 2-fold */
\r
461 else ifold[i]=2; /* codon i pos j is 4-fold */
\r
462 sites[ifold[i]] += .5;
\r
465 if(b[0][j]==b[1][j]) continue;
\r
466 if(b[0][j]+b[1][j]==1 || b[0][j]+b[1][j]==5) { /* pos j has a transition */
\r
467 sdiff[ifold[0]]+=.5; sdiff[ifold[1]]+=.5;
\r
469 else { /* pos j has a transversion */
\r
470 vdiff[ifold[0]]+=.5; vdiff[ifold[1]]+=.5;
\r
478 int testTransP (double P[], int n)
\r
481 double sum, small=1e-10;
\r
483 for (i=0; i<n; i++) {
\r
484 for (j=0,sum=0; j<n; sum+=P[i*n+j++])
\r
485 if (P[i*n+j]<-small) status=-1;
\r
486 if (fabs(sum-1)>small && status==0) {
\r
487 printf ("\nrow sum (#%2d) = 1 = %10.6f", i+1, sum);
\r
494 double testDetailedBalance (double P[], double pi[], int n)
\r
496 /* this calculates maxdiff for the detailed balance check. maxdiff should be close
\r
497 to 0 if the detailed balance condition holds.
\r
500 double small=1e-10, maxdiff=0, d;
\r
502 for (i=0; i<n; i++) {
\r
503 for (j=0; j<n; j++) {
\r
504 d = fabs(pi[i]*P[i*n+j] - pi[j]*P[j*n+i]);
\r
505 if(d>maxdiff) maxdiff = d;
\r
512 int PMatUVRoot (double P[], double t, int n, double U[], double V[], double Root[])
\r
514 /* P(t) = U * exp{Root*t} * V
\r
517 double expt, uexpt, *pP;
\r
521 if (t<-0.1) printf ("\nt = %.5f in PMatUVRoot", t);
\r
526 for (k=0,zero(P,n*n); k<n; k++)
\r
527 for (i=0,pP=P,expt=exp(t*Root[k]); i<n; i++)
\r
528 for (j=0,uexpt=U[i*n+k]*expt; j<n; j++)
\r
529 *pP++ += uexpt*V[k*n+j];
\r
531 for(i=0; i<n*n; i++)
\r
532 if(P[i]<smallp) P[i] = 0;
\r
535 if (testTransP(P,n)) {
\r
536 printf("\nP(%.6f) err in PMatUVRoot.\n", t);
\r
545 int PMatQRev(double Q[], double pi[], double t, int n, double space[])
\r
547 /* This calculates P(t) = exp(Q*t), where Q is the rate matrix for a
\r
548 time-reversible Markov process.
\r
550 Q[] or P[] has the rate matrix as input, and P(t) in return.
\r
553 double *U=space, *V=U+n*n, *Root=V+n*n, *spacesqrtpi=Root+n;
\r
555 eigenQREV(Q, pi, n, Root, U, V, spacesqrtpi);
\r
556 PMatUVRoot(Q, t, n, U, V, Root);
\r
561 void pijJC69 (double pij[2], double t)
\r
564 printf ("\nt = %.5f in pijJC69", t);
\r
566 { pij[0]=1; pij[1]=0; }
\r
568 { pij[0] = (1.+3*exp(-4*t/3.))/4; pij[1] = (1-pij[0])/3; }
\r
573 int PMatK80 (double P[], double t, double kappa)
\r
575 /* PMat for JC69 and K80
\r
581 printf ("\nt = %.5f in PMatK80", t);
\r
582 if (t<1e-100) { identity (P, 4); return(0); }
\r
583 e1=exp(-4*t/(kappa+2));
\r
584 if (fabs(kappa-1)<1e-5) {
\r
585 FOR (i,4) FOR (j,4)
\r
586 if (i==j) P[i*4+j]=(1+3*e1)/4;
\r
587 else P[i*4+j]=(1-e1)/4;
\r
590 e2=exp(-2*t*(kappa+1)/(kappa+2));
\r
591 FOR (i,4) P[i*4+i]=(1+e1+2*e2)/4;
\r
592 P[0*4+1]=P[1*4+0]=P[2*4+3]=P[3*4+2]=(1+e1-2*e2)/4;
\r
593 P[0*4+2]=P[0*4+3]=P[2*4+0]=P[3*4+0]=
\r
594 P[1*4+2]=P[1*4+3]=P[2*4+1]=P[3*4+1]=(1-e1)/4;
\r
600 int PMatT92 (double P[], double t, double kappa, double pGC)
\r
602 /* PMat for Tamura'92
\r
603 t is branch lnegth, number of changes per site.
\r
606 t/=(pGC*(1-pGC)*kappa + .5);
\r
608 if (t<-0.1) printf ("\nt = %.5f in PMatT92", t);
\r
609 if (t<1e-100) { identity (P, 4); return(0); }
\r
610 e1=exp(-t); e2=exp(-(kappa+1)*t/2);
\r
612 P[0*4+0]=P[2*4+2] = (1-pGC)/2*(1+e1)+pGC*e2;
\r
613 P[1*4+1]=P[3*4+3] = pGC/2*(1+e1)+(1-pGC)*e2;
\r
614 P[1*4+0]=P[3*4+2] = (1-pGC)/2*(1+e1)-(1-pGC)*e2;
\r
615 P[0*4+1]=P[2*4+3] = pGC/2*(1+e1)-pGC*e2;
\r
617 P[0*4+2]=P[2*4+0]=P[3*4+0]=P[1*4+2] = (1-pGC)/2*(1-e1);
\r
618 P[1*4+3]=P[3*4+1]=P[0*4+3]=P[2*4+1] = pGC/2*(1-e1);
\r
623 int PMatTN93 (double P[], double a1t, double a2t, double bt, double pi[])
\r
625 double T=pi[0],C=pi[1],A=pi[2],G=pi[3], Y=T+C, R=A+G;
\r
626 double e1, e2, e3, small=-1e-3;
\r
628 if(noisy && (a1t<small || a2t<small || bt<small))
\r
629 printf ("\nat=%12.6f %12.6f bt=%12.6f", a1t,a2t,bt);
\r
631 if(a1t+a2t+bt < 1e-300)
\r
632 { identity(P,4); return(0); }
\r
635 e2 = exp(-(R*a2t + Y*bt));
\r
636 e3 = exp(-(Y*a1t + R*bt));
\r
638 P[0*4+0] = T + R*T/Y*e1 + C/Y*e3;
\r
639 P[0*4+1] = C + R*C/Y*e1 - C/Y*e3;
\r
640 P[0*4+2] = A*(1-e1);
\r
641 P[0*4+3] = G*(1-e1);
\r
643 P[1*4+0] = T + R*T/Y*e1 - T/Y*e3;
\r
644 P[1*4+1] = C + R*C/Y*e1 + T/Y*e3;
\r
645 P[1*4+2] = A*(1-e1);
\r
646 P[1*4+3] = G*(1-e1);
\r
648 P[2*4+0] = T*(1-e1);
\r
649 P[2*4+1] = C*(1-e1);
\r
650 P[2*4+2] = A + Y*A/R*e1 + G/R*e2;
\r
651 P[2*4+3] = G + Y*G/R*e1 - G/R*e2;
\r
653 P[3*4+0] = T*(1-e1);
\r
654 P[3*4+1] = C*(1-e1);
\r
655 P[3*4+2] = A + Y*A/R*e1 - A/R*e2;
\r
656 P[3*4+3] = G + Y*G/R*e1 + A/R*e2;
\r
663 int EvolveHKY85 (char source[], char target[], int ls, double t,
\r
664 double rates[], double pi[4], double kappa, int isHKY85)
\r
666 /* isHKY85=1 if HKY85, =0 if F84
\r
667 Use NULL for rates if rates are identical among sites.
\r
670 double TransP[16],a1t,a2t,bt,r, Y = pi[0]+pi[1], R = pi[2]+pi[3];
\r
672 if (isHKY85) a1t=a2t=kappa;
\r
673 else { a1t=1+kappa/Y; a2t=1+kappa/R; }
\r
674 bt=t/(2*(pi[0]*pi[1]*a1t+pi[2]*pi[3]*a2t)+2*Y*R);
\r
677 if (h==0 || (rates && rates[h]!=rates[h-1])) {
\r
678 r=(rates?rates[h]:1);
\r
679 PMatTN93 (TransP, a1t*r, a2t*r, bt*r, pi);
\r
680 for (i=0;i<n;i++) {
\r
681 for (j=1;j<n;j++) TransP[i*n+j]+=TransP[i*n+j-1];
\r
682 if (fabs(TransP[i*n+n-1]-1)>1e-5) error2("TransP err");
\r
685 for (j=0,i=source[h],r=rndu();j<n-1;j++) if (r<TransP[i*n+j]) break;
\r
686 target[h] = (char)j;
\r
691 int Rates4Sites (double rates[],double alpha,int ncatG,int ls, int cdf,
\r
694 /* Rates for sites from the gamma (ncatG=0) or discrete-gamma (ncatG>1).
\r
695 Rates are converted into the c.d.f. if cdf=1, which is useful for
\r
696 simulation under JC69-like models.
\r
699 int h, ir, j, K=ncatG, *Lalias=(int*)(space+3*K), *counts=(int*)(space+4*K);
\r
700 double *rK=space, *freqK=space+K, *Falias=space+2*K;
\r
703 { if(rates) FOR(h,ls) rates[h]=1; }
\r
706 DiscreteGamma(freqK, rK, alpha, alpha, K, DGammaUseMedian);
\r
708 MultiNomialAliasSetTable(K, freqK, Falias, Lalias, space+5*K);
\r
709 MultiNomialAlias(ls, K, Falias, Lalias, counts);
\r
711 for (ir=0,h=0; ir<K; ir++)
\r
712 for (j=0; j<counts[ir]; j++) rates[h++]=rK[ir];
\r
715 for (h=0; h<ls; h++) rates[h] = rndgamma(alpha)/alpha;
\r
717 for (h=1; h<ls; h++) rates[h] += rates[h-1];
\r
718 abyx (1/rates[ls-1], rates, ls);
\r
725 char *getcodon (char codon[], int icodon)
\r
728 if (icodon<0 || icodon>63) {
\r
729 printf("\ncodon %d\n", icodon);
\r
730 error2("getcodon.");
\r
732 codon[0] = BASEs[icodon/16];
\r
733 codon[1] = BASEs[(icodon%16)/4];
\r
734 codon[2] = BASEs[icodon%4];
\r
740 char *getAAstr(char *AAstr, int iaa)
\r
742 /* iaa (0,20) with 20 meaning termination */
\r
743 if (iaa<0 || iaa>20) error2("getAAstr: iaa err. \n");
\r
744 strncpy (AAstr, AA3Str+iaa*3, 3);
\r
748 int NucListall(char b, int *nb, int ib[4])
\r
750 /* Resolve an ambiguity nucleotide b into all possibilities.
\r
751 nb is number of bases and ib (0,1,2,3) list all of them.
\r
752 Data are complete if (nb==1).
\r
756 k = strchr(BASEs,(int)b) - BASEs;
\r
758 { printf("NucListall: strange character %c\n",b); return(-1);}
\r
760 *nb = 1; ib[0] = k;
\r
763 *nb = strlen(EquateBASE[k]);
\r
764 for(j=0; j< *nb; j++)
\r
765 ib[j] = strchr(BASEs,EquateBASE[k][j]) - BASEs;
\r
770 int Codon2AA(char codon[3], char aa[3], int icode, int *iaa)
\r
772 /* translate a triplet codon[] into amino acid (aa[] and iaa), using
\r
773 genetic code icode. This deals with ambiguity nucleotides.
\r
774 *iaa=(0,...,19), 20 for stop or missing data.
\r
775 Distinquish between stop codon and missing data?
\r
776 naa=0: only stop codons; 1: one AA; 2: more than 1 AA.
\r
778 Returns 0: if one amino acid
\r
779 1: if multiple amino acids (ambiguity data)
\r
782 int nb[3],ib[3][4], ic, i, i0,i1,i2, iaa0=-1,naa=0;
\r
784 for(i=0; i<3; i++)
\r
785 NucListall(codon[i], &nb[i], ib[i]);
\r
786 for(i0=0; i0<nb[0]; i0++)
\r
787 for(i1=0; i1<nb[1]; i1++)
\r
788 for(i2=0; i2<nb[2]; i2++) {
\r
789 ic = ib[0][i0]*16 + ib[1][i1]*4 + ib[2][i2];
\r
790 *iaa = GeneticCode[icode][ic];
\r
791 if(*iaa==-1) continue;
\r
792 if(naa==0) { iaa0=*iaa; naa++; }
\r
793 else if (*iaa!=iaa0) naa=2;
\r
797 printf("stop codon %c%c%c\n", codon[0], codon[1], codon[2]);
\r
800 else if(naa==2) *iaa = 20;
\r
802 strncpy(aa, AA3Str+*iaa*3, 3);
\r
804 return(naa==1 ? 0 : (naa==0 ? -1 : 1));
\r
807 int DNA2protein(char dna[], char protein[], int lc, int icode)
\r
809 /* translate a DNA into a protein, using genetic code icode, with lc codons.
\r
810 dna[] and protein[] can be the same string.
\r
815 for(h=0; h<lc; h++) {
\r
816 k = Codon2AA(dna+h*3,aa3,icode,&iaa);
\r
817 if(k == -1) printf(" stop codon at %d out of %d\n",h+1,lc);
\r
818 protein[h] = AAs[iaa];
\r
824 int printcu (FILE *fout, double fcodon[], int icode)
\r
826 /* output codon usage table and other related statistics
\r
828 Outputs the genetic code table if fcodon==NULL
\r
830 int wc=8, wd=0; /* wc: for codon, wd: decimal */
\r
831 int it, i,j,k, iaa;
\r
832 double faa[21], fb3x4[3*5]; /* chi34, Ic, lc, */
\r
833 char *word="|-", aa3[4]=" ",codon[4]=" ", ss3[4][4], *noodle;
\r
834 static double aawt[]={89.1, 174.2, 132.1, 133.1, 121.2, 146.2,
\r
835 147.1, 75.1, 155.2, 131.2, 131.2, 146.2, 149.2, 165.2, 115.1,
\r
836 105.1, 119.1, 204.2, 181.2, 117.1};
\r
838 if (fcodon) { zero(faa,21); zero(fb3x4,12); }
\r
840 for(i=0; i<4; i++) strcpy(ss3[i],"\0\0\0");
\r
841 noodle = strc(4*(10+2+wc)-2,word[1]);
\r
842 fprintf(fout, "\n%s\n", noodle);
\r
843 for(i=0; i<4; i++,FPN(fout)) {
\r
844 for(j=0; j<4; j++) {
\r
845 for(k=0; k<4; k++) {
\r
847 iaa = GeneticCode[icode][it];
\r
848 if(iaa==-1) iaa = 20;
\r
849 getcodon(codon, it); getAAstr(aa3,iaa);
\r
850 if (!strcmp(ss3[k],aa3) && j>0)
\r
851 fprintf(fout, " ");
\r
853 fprintf(fout, "%s %c", aa3,(iaa<20?AAs[iaa]:'*'));
\r
854 strcpy(ss3[k], aa3);
\r
856 fprintf(fout, " %s", codon);
\r
857 if (fcodon) fprintf(fout, "%*.*f", wc,wd, fcodon[it] );
\r
858 if (k<3) fprintf(fout, " %c ", word[0]);
\r
862 fputs (noodle, fout);
\r
867 int printcums (FILE *fout, int ns, double fcodons[], int icode)
\r
869 int neach0=6, neach=neach0, wc=4,wd=0; /* wc: for codon, wd: decimal */
\r
870 int iaa,it, i,j,k, i1, ngroup, igroup;
\r
871 char *word="|-", aa3[4]=" ",codon[4]=" ", ss3[4][4], *noodle;
\r
873 ngroup=(ns-1)/neach+1;
\r
874 for(igroup=0; igroup<ngroup; igroup++,FPN(fout)) {
\r
875 if (igroup==ngroup-1)
\r
876 neach = ns - neach0*igroup;
\r
877 noodle = strc(4*(10+wc*neach)-2, word[1]);
\r
878 strcat(noodle, "\n");
\r
879 fputs(noodle, fout);
\r
880 for(i=0; i<4; i++) strcpy (ss3[i]," ");
\r
881 for(i=0; i<4; i++) {
\r
882 for(j=0; j<4; j++) {
\r
883 for(k=0; k<4; k++) {
\r
885 iaa = GeneticCode[icode][it];
\r
886 if(iaa==-1) iaa = 20;
\r
887 getcodon(codon, it);
\r
889 if ( !strcmp(ss3[k], aa3) && j>0) fprintf(fout, " ");
\r
890 else { fprintf(fout, "%s", aa3); strcpy(ss3[k], aa3); }
\r
892 fprintf(fout, " %s", codon);
\r
893 for(i1=0; i1<neach; i1++)
\r
894 fprintf(fout, " %*.*f", wc-1, wd, fcodons[(igroup*neach0+i1)*64+it] );
\r
895 if (k<3) fprintf(fout, " %c ", word[0]);
\r
899 fputs (noodle, fout);
\r
905 int QtoPi (double Q[], double pi[], int n, double space[])
\r
907 /* from rate matrix Q[] to pi, the stationary frequencies:
\r
908 Q' * pi = 0 pi * 1 = 1
\r
909 space[] is of size n*(n+1).
\r
912 double *T = space; /* T[n*(n+1)] */
\r
914 for(i=0;i<n+1;i++) T[i]=1;
\r
917 T[i*(n+1)+j] = Q[j*n+i]; /* transpose */
\r
920 matinv(T, n, n+1, pi);
\r
922 pi[i] = T[i*(n+1)+n];
\r
926 int PtoPi (double P[], double pi[], int n, double space[])
\r
928 /* from transition probability P[ij] to pi, the stationary frequencies
\r
929 (P'-I) * pi = 0 pi * 1 = 1
\r
930 space[] is of size n*(n+1).
\r
933 double *T = space; /* T[n*(n+1)] */
\r
935 for(i=0; i<n+1; i++) T[i]=1;
\r
936 for(i=1; i<n; i++) {
\r
938 T[i*(n+1)+j] = P[j*n+i] - (double)(i==j); /* transpose */
\r
941 matinv(T, n, n+1, pi);
\r
942 for(i=0; i<n; i++) pi[i] = T[i*(n+1)+n];
\r
946 int PtoX (double P1[], double P2[], double pi[], double X[])
\r
948 /* from P1 & P2 to X. X = P1' diag{pi} P2
\r
954 for (k=0,X[i*4+j]=0.0; k<4; k++) {
\r
955 X[i*4+j] += pi[k] * P1[k*4+i] * P2[k*4+j];
\r
961 int ScanFastaFile (FILE *fin, int *ns, int *ls, int *aligned)
\r
963 /* This scans a fasta alignment file to get com.ns & com.ls.
\r
964 Returns -1 if the sequences are not aligned and have different lengths.
\r
966 int len=0, ch, starter='>', stop='/'; /* both EOF and / mark the end of the file. */
\r
967 char name[200], *p;
\r
969 if(noisy) printf("\nprocessing fasta file");
\r
970 for (*aligned=1,*ns=-1,*ls=0; ; ) {
\r
972 if(ch==starter || ch==EOF || ch==stop) {
\r
973 if(*ns >= 0) { /* process end of the sequence */
\r
974 if(noisy) printf(" %7d sites", len);
\r
976 if(*ns>1 && len!= *ls) {
\r
978 printf("previous sequence %s has len %d, current seq has %d\n", name, *ls, len);
\r
980 if(len > *ls) *ls = len;
\r
982 (*ns)++; /* next sequence */
\r
983 if(ch==EOF || ch==stop) break;
\r
984 /* fscanf(fin, "%s", name); */
\r
986 while((ch=getc(fin)) != '\n' && ch != EOF) *p++ = ch;
\r
988 if(noisy) printf("\nreading seq#%2d %-50s", *ns+1, name);
\r
991 else if(isgraph(ch)) {
\r
993 error2("seq file error: use '>' in fasta format.");
\r
1002 int printaSeq (FILE *fout, char z[], int ls, int lline, int gap)
\r
1006 fprintf (fout, "%c", z[i]);
\r
1007 if (gap && (i+1)%gap==0) fprintf (fout, " ");
\r
1008 if ((i+1)%lline==0) { fprintf (fout, "%7d", i+1); FPN (fout); }
\r
1011 if (i) fprintf (fout, "%*d\n", 7+lline+lline/gap-i-i/gap, ls);
\r
1016 int printsma (FILE*fout, char*spname[], unsigned char*z[], int ns, int l, int lline, int gap, int seqtype,
\r
1017 int transformed, int simple, int pose[])
\r
1019 /* print multiple aligned sequences.
\r
1020 use spname==NULL if no seq names available.
\r
1021 pose[h] marks the position of the h_th site in z[], useful for
\r
1022 printing out the original sequences after site patterns are collapsed.
\r
1023 Sequences z[] are coded if(transformed) and not if otherwise.
\r
1025 int igroup, ngroup, lt, h,hp, i, b,b0=-1,igap, lspname=30, lseqlen=7;
\r
1026 char indel='-', ambi='?', equal='.';
\r
1027 char *pch=(seqtype<=1 ? BASEs : (seqtype==2 ? AAs: (seqtype==5 ? BASEs5 : BINs)));
\r
1028 char codon[4]=" ";
\r
1030 if(l==0) return(1);
\r
1031 codon[0]=-1; /* to avoid warning */
\r
1032 if (gap==0) gap=lline+1;
\r
1033 ngroup=(l-1)/lline+1;
\r
1034 for (igroup=0,FPN(fout); igroup<ngroup; igroup++,FPN(fout)) {
\r
1035 lt = min2(l, (igroup+1)*lline); /* seqlen mark at the end of block */
\r
1036 igap = lline + (lline/gap) + lspname + 1 - lseqlen - 1; /* spaces */
\r
1037 if(igroup+1 == ngroup)
\r
1038 igap = (l-igroup*lline) + (l-igroup*lline)/gap + lspname + 1 - lseqlen - 1;
\r
1039 /* fprintf (fout,"%*s[%*d]\n", igap, "", lseqlen,lt); */
\r
1040 for(i=0; i<ns; i++) {
\r
1041 if(spname) fprintf(fout,"%-*s ", lspname,spname[i]);
\r
1042 for (h=igroup*lline,lt=0,igap=0; lt<lline && h<l; h++,lt++) {
\r
1043 hp = (pose ? pose[h] : h);
\r
1044 if(seqtype==CODONseq && transformed) {
\r
1045 fprintf(fout," %s", CODONs[(int)z[i][hp]]);
\r
1048 b0 = (int)z[0][hp];
\r
1049 b = (int)z[i][hp];
\r
1054 if(i&&simple && b==b0 && b!=indel && b!=ambi)
\r
1057 if (++igap==gap) {
\r
1058 fputc(' ', fout); igap=0;
\r
1070 /* ***************************
\r
1072 ******************************/
\r
1074 static time_t time_start;
\r
1076 void starttimer (void)
\r
1078 time_start=time(NULL);
\r
1081 char* printtime (char timestr[])
\r
1083 /* print time elapsed since last call to starttimer()
\r
1088 t = time(NULL)-time_start;
\r
1090 m = (int)(t%3600)/60;
\r
1091 s = (int)(t-(t/60)*60);
\r
1092 if(h) sprintf(timestr,"%d:%02d:%02d", h,m,s);
\r
1093 else sprintf(timestr,"%2d:%02d", m,s);
\r
1097 void sleep2(int wait)
\r
1099 /* Pauses for a specified number of seconds. */
\r
1100 time_t t_cur=time(NULL);
\r
1102 while(time(NULL) < t_cur+wait) ;
\r
1107 char *strc (int n, int c)
\r
1109 static char s[256];
\r
1112 if (n>255) error2("line >255 in strc");
\r
1113 FOR (i,n) s[i]=(char)c; s[n]=0;
\r
1117 int putdouble(FILE*fout, double a)
\r
1119 double aa=fabs(a);
\r
1120 return fprintf(fout, (aa<1e-5||aa>1e6 ? " %11.4e" : " %11.6f"), a);
\r
1123 void strcase (char *str, int direction)
\r
1125 /* direction = 0: to lower; 1: to upper */
\r
1127 if(direction) while(*p) { *p=(char)toupper(*p); p++; }
\r
1128 else while(*p) { *p=(char)tolower(*p); p++; }
\r
1132 FILE *gfopen(char *filename, char *mode)
\r
1136 if(filename==NULL || filename[0]==0)
\r
1137 error2("file name empty.");
\r
1139 fp=(FILE*)fopen(filename, mode);
\r
1141 printf("\nerror when opening file %s\n", filename);
\r
1142 if(!strchr(mode,'r')) exit(-1);
\r
1143 printf("tell me the full path-name of the file? ");
\r
1144 scanf("%s", filename);
\r
1145 if((fp=(FILE*)fopen(filename, mode))!=NULL) return(fp);
\r
1146 puts("Can't find the file. I give up.");
\r
1153 int appendfile(FILE*fout, char*filename)
\r
1155 FILE *fin=fopen(filename,"r");
\r
1159 while((ch=fgetc(fin))!=EOF)
\r
1168 void error2 (char * message)
\r
1169 { fprintf(stderr, "\nError: %s.\n", message); exit(-1); }
\r
1171 int zero (double x[], int n)
\r
1172 { int i; for(i=0; i<n; i++) x[i]=0; return (0);}
\r
1174 double sum (double x[], int n)
\r
1175 { int i; double t=0; for(i=0; i<n; i++) t += x[i]; return(t); }
\r
1177 int fillxc (double x[], double c, int n)
\r
1178 { int i; for(i=0; i<n; i++) x[i]=c; return (0); }
\r
1180 int xtoy (double x[], double y[], int n)
\r
1181 { int i; for (i=0; i<n; y[i]=x[i],i++) ; return(0); }
\r
1183 int abyx (double a, double x[], int n)
\r
1184 { int i; for (i=0; i<n; x[i]*=a,i++) ; return(0); }
\r
1186 int axtoy(double a, double x[], double y[], int n)
\r
1187 { int i; for (i=0; i<n; y[i] = a*x[i],i++) ; return(0);}
\r
1189 int axbytoz(double a, double x[], double b, double y[], double z[], int n)
\r
1190 { int i; for(i=0; i<n; i++) z[i] = a*x[i]+b*y[i]; return (0); }
\r
1192 int identity (double x[], int n)
\r
1193 { int i,j; for(i=0; i<n; i++) { for(j=0; j<n; j++) x[i*n+j]=0; x[i*n+i]=1; } return (0); }
\r
1195 double distance (double x[], double y[], int n)
\r
1196 { int i; double t=0;
\r
1197 for (i=0; i<n; i++) t += square(x[i]-y[i]);
\r
1201 double innerp (double x[], double y[], int n)
\r
1202 { int i; double t=0; for(i=0; i<n; i++) t += x[i]*y[i]; return(t); }
\r
1204 double norm (double x[], int n)
\r
1205 { int i; double t=0; for(i=0; i<n; i++) t += x[i]*x[i]; return sqrt(t); }
\r
1208 int Add2Ptree (int counts[3], double Ptree[3])
\r
1210 /* Suppose counts[3] have the numbers of sites supporting the three trees. This
\r
1211 routine adds a total of probability 1 to Ptree[3], by breaking ties.
\r
1213 int i, ibest[3]={0,0,0}, nbest=1, *x=counts;
\r
1215 for(i=1; i<3; i++) {
\r
1216 if(x[i] > x[ibest[0]])
\r
1217 { nbest=1; ibest[0]=i; }
\r
1218 else if(x[i] == x[ibest[0]])
\r
1221 for(i=0; i<nbest; i++)
\r
1222 Ptree[ibest[i]] += 1./nbest;
\r
1227 int binarysearch (const void *key, const void *base, size_t n, size_t size, int(*compare)(const void *, const void *), int *found)
\r
1229 /* This searches for key in an array of n elements (base). The n elements are already sorted.
\r
1230 Each element has size size. If a match is found, the function returns the index for the
\r
1231 element found. Otherwise it returns the loc where key should be inserted. This does not deal with ties.
\r
1233 int l=0, u=n-1, m=u, z;
\r
1238 z = (*compare)(key, (char*)base + m*size);
\r
1239 if(z<0) u = m - 1;
\r
1240 else if(z>0) l = m + 1;
\r
1241 else { *found = 1; break; }
\r
1243 if(m<l) m++; /* last comparison had z > 0 */
\r
1248 int indexing (double x[], int n, int index[], int descending, int space[])
\r
1250 /* bubble sort to calculate the indecies for the vector x[].
\r
1251 x[index[2]] will be the third largest or smallest number in x[].
\r
1252 This does not change x[].
\r
1254 int i,j, it=0, *mark=space;
\r
1257 for(i=0; i<n; i++) mark[i]=1;
\r
1258 for(i=0; i<n; i++) {
\r
1259 for(j=0; j<n; j++)
\r
1260 if(mark[j]) { t=x[j]; it=j++; break; } /* first unused number */
\r
1263 if (mark[j] && x[j]>t) { t=x[j]; it=j; }
\r
1267 if (mark[j] && x[j]<t) { t=x[j]; it=j; }
\r
1269 mark[it]=0; index[i]=it;
\r
1274 int f_and_x(double x[], double f[], int n, int fromf, int LastItem)
\r
1276 /* This transforms between x and f. x and f can be identical.
\r
1279 The iterative variable x[] and frequency f[0,1,n-2] are related as:
\r
1280 freq[k] = exp(x[k])/(1+SUM(exp(x[k]))), k=0,1,...,n-2,
\r
1281 x[] and freq[] may be the same vector.
\r
1282 The last element (f[n-1] or x[n-1]=1) is updated only if(LastItem).
\r
1287 if (fromf) { /* f => x */
\r
1288 if((tot=1-sum(f,n-1))<1e-80) error2("f[n-1]==1, not dealt with.");
\r
1290 for(i=0; i<n-1; i++) x[i] = log(f[i]*tot);
\r
1291 if(LastItem) x[n-1] = 0;
\r
1293 else { /* x => f */
\r
1294 for(i=0,tot=1; i<n-1; i++) tot += (f[i]=exp(x[i]));
\r
1295 for(i=0; i<n-1; i++) f[i] /= tot;
\r
1296 if(LastItem) f[n-1] = 1/tot;
\r
1301 void bigexp(double lnx, double *a, double *b)
\r
1303 /* this prints out x = e^lnx as a x 10^b
\r
1306 z = lnx*log10(2.71828);
\r
1308 *a = pow(10, z-(*b));
\r
1311 static unsigned int z_rndu=1237;
\r
1312 static int w_rndu=1237;
\r
1314 void SetSeed (int seed, int PrintSeed)
\r
1317 FILE *frand, *fseed;
\r
1319 if(sizeof(unsigned int) != 4)
\r
1320 error2("oh-oh, we are in trouble. int not 32-bit?");
\r
1323 frand = fopen("/dev/urandom", "r");
\r
1325 for (i=0,seed=0; i<sizeof(unsigned int); i++)
\r
1326 seed += (seed << 8) + getc(frand);
\r
1327 seed = 2*seed + 1;
\r
1331 seed = 1234567891*(int)time(NULL) + 1;
\r
1337 fseed = fopen("SeedUsed", "w");
\r
1338 if(fseed == NULL) error2("can't open file SeedUsed.");
\r
1339 fprintf(fseed, "%d\n", seed);
\r
1344 z_rndu = (unsigned int)seed;
\r
1349 #ifdef FAST_RANDOM_NUMBER
\r
1351 double rndu (void)
\r
1353 /* 32-bit integer assumed.
\r
1354 From Ripley (1987) p. 46 or table 2.4 line 2.
\r
1355 This may return 0 or 1, which can be a problem.
\r
1357 z_rndu = z_rndu*69069 + 1;
\r
1358 if(z_rndu==0 || z_rndu==4294967295) z_rndu = 13;
\r
1359 return z_rndu/4294967295.0;
\r
1362 double rndu2 (void)
\r
1364 /* 32-bit integer assumed.
\r
1365 From Ripley (1987) table 2.4 line 4.
\r
1367 w_rndu = abs(w_rndu*16807) % 2147483647;
\r
1368 if(w_rndu==0) w_rndu = 13;
\r
1369 return w_rndu/2147483647.0;
\r
1374 double rndu (void)
\r
1376 /* U(0,1): AS 183: Appl. Stat. 31:188-190
\r
1377 Wichmann BA & Hill ID. 1982. An efficient and portable
\r
1378 pseudo-random number generator. Appl. Stat. 31:188-190
\r
1380 x, y, z are any numbers in the range 1-30000. Integer operation up
\r
1381 to 30323 required.
\r
1383 static unsigned int x_rndu=11, y_rndu=23;
\r
1386 x_rndu = 171*(x_rndu%177) - 2*(x_rndu/177);
\r
1387 y_rndu = 172*(y_rndu%176) - 35*(y_rndu/176);
\r
1388 z_rndu = 170*(z_rndu%178) - 63*(z_rndu/178);
\r
1390 if (x_rndu<0) x_rndu += 30269;
\r
1391 if (y_rndu<0) y_rndu += 30307;
\r
1392 if (z_rndu<0) z_rndu += 30323;
\r
1394 r = x_rndu/30269.0 + y_rndu/30307.0 + z_rndu/30323.0;
\r
1395 return (r-(int)r);
\r
1401 double rnduM0V1 (void)
\r
1403 /* uniform with mean 0 and variance 1 */
\r
1404 return 1.732050807568877*(-1 + rndu()*2);
\r
1408 double reflect (double x, double a, double b)
\r
1410 /* This returns a variable in the range (a,b) by reflecting x back into the range
\r
1412 int side=0; /* n is number of jumps over interval. side=0 (left) or 1 (right). */
\r
1413 double n, e=0, small=1e-100; /* e is excess */
\r
1416 printf("\nimproper range x0=%.6g (%.6g, %.6g)\n", x, a, b);
\r
1419 if(x<a) { e = a-x; side = 0; }
\r
1420 else if(x>b) { e = x-b; side = 1; }
\r
1422 n = floor(e/(b-a));
\r
1423 if(fmod(n, 2.0) > 0.1) /* fmod should be 0 if n is even and 1 if n is odd. */
\r
1424 side = 1-side; /* change side if n is odd */
\r
1426 x = (side ? b-e : a+e);
\r
1432 double PjumpOptimum = 0.30; /* this is the optimum for the Bactrian move. */
\r
1434 int ResetFinetuneSteps(FILE *fout, double Pjump[], double finetune[], int nsteps)
\r
1436 int j, verybadstep=0;
\r
1437 double maxstep=99; /* max step length */
\r
1440 printf("\n\nCurrent Pjump: ");
\r
1441 for(j=0; j<nsteps; j++)
\r
1442 printf(" %8.5f", Pjump[j]);
\r
1443 printf("\nCurrent finetune: ");
\r
1444 for(j=0; j<nsteps; j++)
\r
1445 printf(" %8.5f", finetune[j]);
\r
1448 fprintf(fout, "\nCurrent Pjump: ");
\r
1449 for(j=0; j<nsteps; j++)
\r
1450 fprintf(fout, " %8.5f", Pjump[j]);
\r
1451 fprintf(fout, "\nCurrent finetune: ");
\r
1452 for(j=0; j<nsteps; j++)
\r
1453 fprintf(fout, " %8.5f", finetune[j]);
\r
1456 for(j=0; j<nsteps; j++) {
\r
1457 if(Pjump[j] < 0.001) {
\r
1458 finetune[j] /= 100;
\r
1461 else if(Pjump[j] > 0.999) {
\r
1462 finetune[j] = min2(maxstep, finetune[j]*100);
\r
1466 finetune[j] *= tan(Pi/2*Pjump[j]) / tan(Pi/2*PjumpOptimum);
\r
1467 finetune[j] = min2(maxstep, finetune[j]);
\r
1472 printf("\nNew finetune: ");
\r
1473 for(j=0; j<nsteps; j++)
\r
1474 printf(" %8.5f", finetune[j]);
\r
1478 fprintf(fout, "\nNew finetune: ");
\r
1479 for(j=0; j<nsteps; j++)
\r
1480 fprintf(fout, " %8.5f", finetune[j]);
\r
1481 fprintf(fout, "\n");
\r
1484 return(verybadstep);
\r
1489 void randorder(int order[], int n, int space[])
\r
1491 /* This orders 0,1,2,...,n-1 at random
\r
1494 int i,k, *item=space;
\r
1496 for(i=0; i<n; i++) item[i]=i;
\r
1497 for(i=0; i<n; i++) {
\r
1498 k=(int)((n-i)*rndu());
\r
1499 order[i]=item[i+k]; item[i+k]=item[i];
\r
1504 double rndNormal (void)
\r
1506 /* Standard normal variate, using the Box-Muller method (1958), improved by
\r
1507 Marsaglia and Bray (1964). The method generates a pair of N(0,1) variates,
\r
1508 but only one is used.
\r
1509 Johnson et al. (1994), Continuous univariate distributions, vol 1. p.153.
\r
1517 if (s>0 && s<1) break;
\r
1519 s = sqrt(-2*log(s)/s);
\r
1520 return (u*s); /* (v*s) is the other N(0,1) variate, wasted. */
\r
1524 double rndBactrian (void)
\r
1526 /* This returns a variate from the 1:1 mixture of two normals N(-m, 1-m^2) and N(m, 1-m^2),
\r
1527 which has mean 0 and variance 1.
\r
1529 The value m = 0.95 is useful for generating MCMC proposals
\r
1531 double z = mBactrian + rndNormal()*sBactrian;
\r
1532 if(rndu()<0.5) z = -z;
\r
1537 double rndBactrianTriangle (void)
\r
1539 /* This returns a variate from the 1:1 mixture of two Triangle Tri(-m, 1-m^2) and Tri(m, 1-m^2),
\r
1540 which has mean 0 and variance 1.
\r
1542 double z = mBactrian + rndTriangle()*sBactrian;
\r
1543 if(rndu() < 0.5) z = -z;
\r
1547 double rndBactrianLaplace (void)
\r
1549 /* This returns a variate from the 1:1 mixture of two Laplace Lap(-m, 1-m^2) and Lap(m, 1-m^2),
\r
1550 which has mean 0 and variance 1.
\r
1552 double z = mBactrian + rndLaplace()*sBactrian;
\r
1553 if(rndu() < 0.5) z = -z;
\r
1557 double rndBox(void)
\r
1559 double z = rndu() * (bBox - aBox) + aBox;
\r
1560 if(rndu() < 0.5) z = -z;
\r
1564 double getRoot(double (*f)(double), double (*df)(double), double initVal) {
\r
1565 double x, newx = initVal;
\r
1569 newx = x - (*f)(x) / (*df)(x);
\r
1571 } while((fabs(x-newx) > 1e-10) && nIter < 100);
\r
1573 if(fabs(x-newx) > 1e-10) {
\r
1574 error2("root finder didn't converge");
\r
1579 double BAirplane(double b) {
\r
1580 return 4*b*b*b - 12*b + 6*aAirplane - aAirplane * aAirplane * aAirplane;
\r
1583 double dBAirplane(double b) {
\r
1584 return 12*b*b - 12;
\r
1587 double rndAirplane() {
\r
1588 double z, bAirplane = getRoot(&BAirplane, &dBAirplane, 2.5);
\r
1590 if(rndu() < aAirplane/(2*bAirplane -aAirplane)) {
\r
1591 /* sample from linear part */
\r
1592 z = sqrt(aAirplane*aAirplane*rndu());
\r
1595 /* sample from box part */
\r
1596 z = rndu() * (bAirplane - aAirplane) + aAirplane;
\r
1598 return (rndu() < 0.5 ? -z : z);
\r
1601 double BParabola(double b) {
\r
1602 return 5*b*b*b - 15*b + 10*aParab - 2*aParab*aParab*aParab;
\r
1605 double dBParabola(double b) {
\r
1606 return 15*b*b - 15;
\r
1609 double rndParabola() {
\r
1610 double z, bParab = getRoot(&BParabola, &dBParabola, 2.0);
\r
1612 if(rndu() < aParab/((3*bParab-2*aParab))) {
\r
1613 /* sample from parabola part */
\r
1614 z = aParab * pow(rndu(), 1.0/3.0);
\r
1617 /* sample from the box part */
\r
1618 z = rndu() * (bParab - aParab) + aParab;
\r
1620 return (rndu() < 0.5 ? -z : z);
\r
1625 double rndloglogistic (double loc, double s)
\r
1627 double t = rndlogistic(), logt=1E300;
\r
1628 if(t<800) logt = exp(loc + s*t);
\r
1632 double rndlogistic (void)
\r
1634 /* log-logistic variate */
\r
1638 return log(u/(1-u));
\r
1641 double rndlogt2 (double loc, double s)
\r
1643 double t2 = rndt2(), logt2=1E300;
\r
1644 if(t2<800) logt2 = exp(loc + s*t2);
\r
1648 double rndCauchy (void)
\r
1650 /* Standard Cauchy variate, generated using inverse CDF
\r
1652 return tan(Pi*(rndu()-0.5));
\r
1656 double rndTriangle(void)
\r
1659 /* Standard Triangle variate, generated using inverse CDF */
\r
1662 z = sqrt(6.0) - 2.0*sqrt(3.0*(1.0 - u));
\r
1664 z = -sqrt(6.0) + 2.0*sqrt(3.0*u);
\r
1669 double rndLaplace (void)
\r
1671 /* Standard Laplace variate, generated using inverse CDF */
\r
1674 r = log(1 - 2*fabs(u)) * 0.70710678118654752440;
\r
1675 return (u>=0 ? -r : r);
\r
1679 double rndLaplace (void){
\r
1681 /* Standard Laplace variate, generated using inverse CDF */
\r
1682 u = -0.5 + rndu();
\r
1683 return (u>=0 ? log(1 - 2*fabs(u)) : -log(1 - 2*fabs(u)));
\r
1687 double rndt2 (void)
\r
1689 /* Standard Student's t_2 variate, with d.f. = 2. t2 has mean 0 and variance infinity. */
\r
1692 u = 2 * rndu() - 1;
\r
1694 t2 = sqrt(2*u/(1-u));
\r
1695 if(rndu()<0.5) t2 = -t2;
\r
1699 double rndt4 (void)
\r
1701 /* Student's t_4 variate, with d.f. = 4.
\r
1702 This has variance 1, and is the standard t4 variate divided by sqrt(2).
\r
1703 The standard t4 variate has variance 2.
\r
1705 double u, v, w, c2, r2, t4, sqrt2=0.707106781;
\r
1708 u = 2 * rndu() - 1;
\r
1709 v = 2 * rndu() - 1;
\r
1714 r2 = 4/sqrt(w) - 4;
\r
1716 if(rndu()<0.5) t4 = -t4;
\r
1718 return t4 * sqrt2;
\r
1722 int rndpoisson (double m)
\r
1724 /* m is the rate parameter of the poisson
\r
1725 Numerical Recipes in C, 2nd ed. pp. 293-295
\r
1727 static double sq, alm, g, oldm=-1;
\r
1730 /* search from the origin
\r
1732 if (m!=oldm) { oldm=m; g=exp(-m); }
\r
1733 y=rndu(); sq=alm=g;
\r
1736 sq+= (alm*=m/ ++em);
\r
1741 if (m!=oldm) { oldm=m; g=exp(-m); }
\r
1750 oldm=m; sq=sqrt(2*m); alm=log(m);
\r
1751 g=m*alm-LnGamma(m+1);
\r
1755 y=tan(3.141592654*rndu());
\r
1759 t=0.9*(1+y*y)*exp(em*alm-LnGamma(em+1)-g);
\r
1760 } while (rndu()>t);
\r
1762 return ((int) em);
\r
1766 double rndgamma (double a)
\r
1768 /* This returns a random variable from gamma(a, 1).
\r
1769 Marsaglia and Tsang (2000) A Simple Method for generating gamma variables",
\r
1770 ACM Transactions on Mathematical Software, 26 (3): 363-372.
\r
1771 This is not entirely safe and is noted to produce zero when a is small (0.001).
\r
1773 double a0=a, c, d, u, v, x;
\r
1778 c = (1.0/3.0) / sqrt(d);
\r
1790 if (u < 1 - 0.0331 * x * x * x * x)
\r
1792 if (log(u) < 0.5 * x * x + d * (1 - v + log(v)))
\r
1798 v *= pow(rndu(), 1/a0);
\r
1800 printf("\a\nrndgamma returning 0.\n");
\r
1805 double rndbeta (double p, double q)
\r
1807 /* this generates a random beta(p,q) variate
\r
1809 double gamma1, gamma2;
\r
1810 gamma1 = rndgamma(p);
\r
1811 gamma2 = rndgamma(q);
\r
1812 return gamma1/(gamma1+gamma2);
\r
1816 int rndNegBinomial (double shape, double mean)
\r
1818 /* mean=mean, var=mean^2/shape+m
\r
1820 return (rndpoisson(rndgamma(shape)/shape*mean));
\r
1824 int MultiNomialAliasSetTable (int ncat, double prob[], double F[], int L[], double space[])
\r
1826 /* This sets up the tables F and L for the alias algorithm for generating samples from the
\r
1827 multinomial distribution MN(ncat, p) (Walker 1974; Kronmal & Peterson 1979).
\r
1829 F[i] has cutoff probabilities, L[i] has aliases.
\r
1830 I[i] is an indicator: -1 for F[i]<1; +1 for F[i]>=1; 0 if the cell is now empty.
\r
1832 Should perhaps check whether prob[] sums to 1.
\r
1834 signed char *I = (signed char *)space;
\r
1835 int i,j,k, nsmall;
\r
1837 for(i=0; i<ncat; i++) L[i] = -9;
\r
1838 for(i=0; i<ncat; i++) F[i] = ncat*prob[i];
\r
1839 for(i=0,nsmall=0; i<ncat; i++) {
\r
1840 if(F[i]>=1) I[i]=1;
\r
1841 else { I[i]=-1; nsmall++; }
\r
1843 for(i=0; nsmall>0; i++) {
\r
1844 for(j=0; j<ncat; j++) if(I[j]==-1) break;
\r
1845 for(k=0; k<ncat; k++) if(I[k]==1) break;
\r
1846 if(k==ncat) break;
\r
1850 if(F[k]<1) { I[k]=-1; nsmall++; }
\r
1857 int MultiNomialAlias (int n, int ncat, double F[], int L[], int nobs[])
\r
1859 /* This generates multinomial samples using the F and L tables set up before,
\r
1860 using the alias algorithm (Walker 1974; Kronmal & Peterson 1979).
\r
1862 F[i] has cutoff probabilities, L[i] has aliases.
\r
1863 I[i] is an indicator: -1 for F[i]<1; +1 for F[i]>=1; 0 if the cell is now empty.
\r
1868 for(i=0; i<ncat; i++) nobs[i]=0;
\r
1869 for(i=0; i<n; i++) {
\r
1873 if(r<=F[k]) nobs[k]++;
\r
1874 else nobs[L[k]]++;
\r
1880 int MultiNomial2 (int n, int ncat, double prob[], int nobs[], double space[])
\r
1882 /* sample n times from a mutinomial distribution M(ncat, prob[])
\r
1883 prob[] is considered cumulative prob if (space==NULL)
\r
1884 ncrude is the number or crude categories, and lcrude marks the
\r
1885 starting category for each crude category. These are used
\r
1886 to speed up the process when ncat is large.
\r
1888 int i, j, crude=(ncat>20), ncrude, lcrude[200];
\r
1889 double r, *pcdf=(space==NULL?prob:space), small=1e-5;
\r
1891 ncrude=max2(5,ncat/20); ncrude=min2(200,ncrude);
\r
1892 for(i=0; i<ncat; i++) nobs[i]=0;
\r
1894 xtoy(prob, pcdf, ncat);
\r
1895 for(i=1; i<ncat; i++) pcdf[i]+=pcdf[i-1];
\r
1897 if (fabs(pcdf[ncat-1]-1) > small)
\r
1898 error2("sum P!=1 in MultiNomial2");
\r
1900 for(j=1,lcrude[0]=i=0; j<ncrude; j++) {
\r
1901 while (pcdf[i]<(double)j/ncrude) i++;
\r
1905 for(i=0; i<n; i++) {
\r
1909 for (; j<ncrude; j++) if (r<(j+1.)/ncrude) break;
\r
1912 for (; j<ncat-1; j++) if (r<pcdf[j]) break;
\r
1919 /* functions concerning the CDF and percentage points of the gamma and
\r
1922 double QuantileNormal (double prob)
\r
1924 /* returns z so that Prob{x<z}=prob where x ~ N(0,1) and (1e-12)<prob<1-(1e-12)
\r
1925 returns (-9999) if in error
\r
1926 Odeh RE & Evans JO (1974) The percentage points of the normal distribution.
\r
1927 Applied Statistics 22: 96-97 (AS70)
\r
1930 Wichura MJ (1988) Algorithm AS 241: the percentage points of the
\r
1931 normal distribution. 37: 477-484.
\r
1932 Beasley JD & Springer SG (1977). Algorithm AS 111: the percentage
\r
1933 points of the normal distribution. 26: 118-121.
\r
1935 double a0=-.322232431088, a1=-1, a2=-.342242088547, a3=-.0204231210245;
\r
1936 double a4=-.453642210148e-4, b0=.0993484626060, b1=.588581570495;
\r
1937 double b2=.531103462366, b3=.103537752850, b4=.0038560700634;
\r
1938 double y, z=0, p=prob, p1;
\r
1940 p1 = (p<0.5 ? p : 1-p);
\r
1941 if (p1<1e-20) z=999;
\r
1943 y = sqrt (log(1/(p1*p1)));
\r
1944 z = y + ((((y*a4+a3)*y+a2)*y+a1)*y+a0) / ((((y*b4+b3)*y+b2)*y+b1)*y+b0);
\r
1946 return (p<0.5 ? -z : z);
\r
1949 double PDFNormal (double x, double mu, double sigma2)
\r
1951 return 1/sqrt(2*Pi*sigma2)*exp(-.5/sigma2*(x-mu)*(x-mu));
\r
1954 double logPDFNormal (double x, double mu, double sigma2)
\r
1956 return -0.5*log(2*Pi*sigma2) - 0.5/sigma2*(x-mu)*(x-mu);
\r
1959 double CDFNormal (double x)
\r
1961 /* Hill ID (1973) The normal integral. Applied Statistics, 22:424-427.
\r
1962 Algorithm AS 66. (error < ?)
\r
1963 adapted by Z. Yang, March 1994. Hill's routine does not look good, and I
\r
1964 haven't consulted the following reference.
\r
1965 Adams AG (1969) Algorithm 39. Areas under the normal curve.
\r
1966 Computer J. 12: 197-198.
\r
1969 double p, t=1.28, y=x*x/2;
\r
1971 if (x<0) { invers=1; x=-x; }
\r
1973 p = .5 - x * ( .398942280444 - .399903438504 * y
\r
1974 /(y + 5.75885480458 - 29.8213557808
\r
1975 /(y + 2.62433121679 + 48.6959930692
\r
1976 /(y + 5.92885724438))));
\r
1978 p = 0.398942280385 * exp(-y) /
\r
1979 (x - 3.8052e-8 + 1.00000615302 /
\r
1980 (x + 3.98064794e-4 + 1.98615381364 /
\r
1981 (x - 0.151679116635 + 5.29330324926 /
\r
1982 (x + 4.8385912808 - 15.1508972451 /
\r
1983 (x + 0.742380924027 + 30.789933034 /
\r
1984 (x + 3.99019417011))))));
\r
1986 return (invers ? p : 1-p);
\r
1990 double logCDFNormal (double x)
\r
1992 /* logarithm of CDF of N(0,1).
\r
1994 The accuracy is good for the full range (-inf, 38) on my 32-bit machine.
\r
1995 When x=38, log(F(x)) = -2.88542835e-316. When x > 38, log(F(x)) can't be
\r
1996 distinguished from 0. F(5) = 1 - 1.89E-8, and when x>5, F(x) is hard to
\r
1997 distinguish from 1. Instead the smaller tail area F(-5) is used for the
\r
1998 calculation, using the expansion log(1-z) = -z(1 + z/2 + z*z/3), where
\r
1999 z = F(-5) is small.
\r
2000 For 3 < x < 7, both approaches are close, but when x = 8, Mathematica and
\r
2001 log(CDFNormal) give the incorrect answer -6.66133815E-16, while the correct
\r
2002 value is log(F(8)) = log(1 - F(-8)) ~= -F(-8) = -6.22096057E-16.
\r
2004 F(x) when x<-10 is reliably calculatd using the series expansion, even though
\r
2005 log(CDFNormal) works until F(-38) = 2.88542835E-316.
\r
2008 Regarding calculation of the logarithm of Pr(a < X < b), note that
\r
2009 F(-9) - F(-10) = F(10) - F(9), but the left side is better computationally.
\r
2011 double lnF, z=fabs(x), C, low=-10, high=5;
\r
2013 /* calculate the log of the smaller area */
\r
2014 if(x >= low && x <= high)
\r
2015 return log(CDFNormal(x));
\r
2016 if(x > high && x < -low)
\r
2017 lnF = log(CDFNormal(-z));
\r
2019 C = 1 - 1/(z*z) + 3/(z*z*z*z) - 15/(z*z*z*z*z*z) + 105/(z*z*z*z*z*z*z*z);
\r
2020 lnF = -z*z/2 - log(sqrt(2*Pi)*z) + log(C);
\r
2024 lnF = -z*(1 + z/2 + z*z/3 + z*z*z/4 + z*z*z*z/5);
\r
2030 double PDFCauchy (double x, double m, double sigma)
\r
2032 double z = (x-m)/sigma;
\r
2033 return 1/(Pi*sigma*(1 + z*z));
\r
2036 double PDFloglogistic (double x, double loc, double s)
\r
2038 double y = (log(x)-loc)/s, e=exp(-y);
\r
2039 return 1/(s*x)*e/((1+e)*(1+e));
\r
2042 double PDFlogt2 (double x, double loc, double s)
\r
2044 double y=(log(x)-loc)/s, pdf;
\r
2045 y = 2+y*y; y *= y*y; /* [2 + y*y]^3 */
\r
2048 pdf = 1/(sqrt(y)*x*s);
\r
2052 double PDFt2 (double x, double m, double s)
\r
2054 double y = (x-m)/s;
\r
2055 y = 2 + y*y; y *= y*y; /* [2 + y*y]^3 */
\r
2058 return 1/(sqrt(y)*s);
\r
2061 double PDFt4 (double x, double m, double s)
\r
2063 /* This t4 PDF has mean m and variance s*s. Note that the standard t4 has variance 2*s*s.
\r
2065 double z = (x-m)/s, pdf;
\r
2067 pdf = 3/(4*1.414213562*s)*pow(1 + z*z/2, -2.5);
\r
2073 double PDFt (double x, double loc, double scale, double df, double lnConst)
\r
2075 /* CDF of t distribution with lococation, scale, and degree of freedom
\r
2077 double z = (x-loc)/scale, lnpdf=lnConst;
\r
2080 lnpdf = LnGamma((df+1)/2) - LnGamma(df/2) - 0.5*log(Pi*df);
\r
2082 lnpdf -= (df+1)/2 * log(1+z*z/df);
\r
2083 return exp(lnpdf)/scale;
\r
2086 double CDFt (double x, double loc, double scale, double df, double lnbeta)
\r
2088 /* CDF of t distribution with location, scale, and degree of freedom
\r
2090 double z = (x-loc)/scale, cdf;
\r
2091 double lnghalf = 0.57236494292470008707; /* log{G(1/2)} = log{sqrt(Pi)} */
\r
2094 lnbeta = LnGamma(df/2) + lnghalf - LnGamma((df+1)/2);
\r
2096 cdf = CDFBeta(df/(df+z*z), df/2, 0.5, lnbeta);
\r
2098 if(z>=0) cdf = 1 - cdf/2;
\r
2103 double PDFSkewT (double x, double loc, double scale, double shape, double df)
\r
2105 double z = (x-loc)/scale, pdf;
\r
2106 double lnghalf=0.57236494292470008707; /* log{G(1/2)} = log{sqrt(Pi)} */
\r
2107 double lngv, lngv1, lnConst_pdft, lnbeta_cdft;
\r
2109 lngv = LnGamma(df/2);
\r
2110 lngv1 = LnGamma((df+1)/2);
\r
2111 lnConst_pdft = lngv1 - lngv - 0.5*log(Pi*df);
\r
2112 lnbeta_cdft = lngv1 + lnghalf - lngv - log(df/2); /* log{ B((df+1)/2, 1/2) } */
\r
2114 pdf = 2/scale * PDFt(z, 0, 1, df, lnConst_pdft)
\r
2115 * CDFt(shape*z*sqrt((df+1)/(df+z*z)), 0, 1, df+1, lnbeta_cdft);
\r
2120 double PDFSkewN (double x, double loc, double scale, double shape)
\r
2122 double z = (x-loc)/scale, pdf = 2/scale;
\r
2124 pdf *= PDFNormal(z,0,1) * CDFNormal(shape*z);
\r
2128 double logPDFSkewN (double x, double loc, double scale, double shape)
\r
2130 double z = (x-loc)/scale, lnpdf = 2/scale;
\r
2132 lnpdf = 0.5*log(2/(Pi*scale*scale)) - z*z/2 + logCDFNormal(shape*z);
\r
2137 int StirlingS2(int n, int k)
\r
2139 /* Stirling number of the second type, calculated using the recursion (loop)
\r
2140 S(n, k) = S(n - 1, k - 1) + k*S(n - 1, k).
\r
2141 This works for small numbers of n<=15.
\r
2143 int S[16]={0}, i, j;
\r
2145 if((n==0 && k==0) || k==1 || k==n)
\r
2150 return (int) ldexp(1,n-1) - 1;
\r
2154 error2("n>15 too large in StirlingS2()");
\r
2156 S[1] = S[2] = 1; /* start with n = 2 */
\r
2157 for(i=3; i<=n; i++) {
\r
2158 for(j=min2(k,i); j>=2; j--)
\r
2159 S[j] = S[j-1] + j*S[j];
\r
2164 double lnStirlingS2(int n, int k)
\r
2166 /* This calculates the logarithm of the Stirling number of the second type.
\r
2167 Temme NM. 1993. Asymptotic estimates of Stirling numbers. Stud Appl Math 89:233-243.
\r
2170 double lnS=0, t0, x0, x, A, nk, y;
\r
2172 if(k>n) error2("k<n in lnStirlingS2");
\r
2181 return (n<50 ? log(ldexp(1,n-1) - 1) : (n-1)*0.693147);
\r
2183 return log(n*(n-1)/2.0);
\r
2185 return log((double)StirlingS2(n, k));
\r
2188 for(i=0,x0=x=1; i<10000; i++) {
\r
2189 x = (x0 + nk - nk*exp(-x0))/2;
\r
2190 if(fabs(x-x0)/(1+x) < 1e-10) break;
\r
2193 t0 = n/(double)k - 1;
\r
2195 A = -n * log(x) + k*log(exp(x) - 1);
\r
2197 A = -n * log(x) + k*x;
\r
2199 A += -k*t0 + (n-k)*log(t0);
\r
2200 lnS = A + (n-k)*log((double)k) + 0.5*log(t0/((1 + t0)*(x - t0)));
\r
2201 lnS += log(Binomial(n, k, &y));
\r
2208 double LnGamma (double x)
\r
2210 /* returns ln(gamma(x)) for x>0, accurate to 10 decimal places.
\r
2211 Stirling's formula is used for the central polynomial part of the procedure.
\r
2213 Pike MC & Hill ID (1966) Algorithm 291: Logarithm of the gamma function.
\r
2214 Communications of the Association for Computing Machinery, 9:684
\r
2216 double f=0, fneg=0, z, lng;
\r
2219 if((double)nx==x && nx>=0 && nx<=11)
\r
2220 lng = log((double)factorial(nx-1));
\r
2223 printf("LnGamma(%.6f) not implemented", x);
\r
2224 if((int)x-x==0) { puts("lnGamma undefined"); return(-1); }
\r
2225 for (fneg=1; x<0; x++) fneg /= x;
\r
2227 error2("strange!! check lngamma");
\r
2239 lng = fneg + f + (x-0.5)*log(x) - x + .918938533204673
\r
2240 + (((-.000595238095238*z + .000793650793651)*z - .002777777777778)*z + .083333333333333)/x;
\r
2245 double PDFGamma (double x, double alpha, double beta)
\r
2247 /* gamma density: mean=alpha/beta; var=alpha/beta^2
\r
2249 if (x<=0 || alpha<=0 || beta<=0) {
\r
2250 printf("x=%.6f a=%.6f b=%.6f", x, alpha, beta);
\r
2251 error2("x a b outside range in PDFGamma()");
\r
2254 error2("large alpha in PDFGamma()");
\r
2255 return pow(beta*x,alpha)/x * exp(-beta*x - LnGamma(alpha));
\r
2258 double PDF_InverseGamma (double x, double alpha, double beta)
\r
2260 /* inverse-gamma density:
\r
2261 mean=beta/(alpha-1); var=beta^2/[(alpha-1)^2*(alpha-2)]
\r
2263 if (x<=0 || alpha<=0 || beta<=0) {
\r
2264 printf("x=%.6f a=%.6f b=%.6f", x, alpha, beta);
\r
2265 error2("x a b outside range in PDF_IGamma()");
\r
2268 error2("large alpha in PDF_IGamma()");
\r
2269 return pow(beta/x,alpha)/x * exp(-beta/x - LnGamma(alpha));
\r
2273 double IncompleteGamma (double x, double alpha, double ln_gamma_alpha)
\r
2275 /* returns the incomplete gamma ratio I(x,alpha) where x is the upper
\r
2276 limit of the integration and alpha is the shape parameter.
\r
2277 returns (-1) if in error
\r
2278 ln_gamma_alpha = ln(Gamma(alpha)), is almost redundant.
\r
2279 (1) series expansion, if (alpha>x || x<=1)
\r
2280 (2) continued fraction, otherwise
\r
2281 RATNEST FORTRAN by
\r
2282 Bhattacharjee GP (1970) The incomplete gamma integral. Applied Statistics,
\r
2283 19: 285-287 (AS32)
\r
2286 double p=alpha, g=ln_gamma_alpha;
\r
2287 double accurate=1e-10, overflow=1e60;
\r
2288 double factor, gin=0, rn=0, a=0,b=0,an=0,dif=0, term=0, pn[6];
\r
2290 if (x==0) return (0);
\r
2291 if (x<0 || p<=0) return (-1);
\r
2293 factor=exp(p*log(x)-x-g);
\r
2294 if (x>1 && x>=p) goto l30;
\r
2295 /* (1) series expansion */
\r
2296 gin=1; term=1; rn=p;
\r
2299 term *= x/rn; gin += term;
\r
2300 if (term > accurate) goto l20;
\r
2304 /* (2) continued fraction */
\r
2305 a = 1-p; b = a+x+1; term = 0;
\r
2306 pn[0] = 1; pn[1] = x; pn[2] = x+1; pn[3] = x*b;
\r
2307 gin = pn[2]/pn[3];
\r
2313 for (i=0; i<2; i++)
\r
2314 pn[i+4] = b*pn[i+2] - an*pn[i];
\r
2315 if (pn[5] == 0) goto l35;
\r
2317 dif = fabs(gin-rn);
\r
2318 if (dif > accurate) goto l34;
\r
2319 if (dif <= accurate*rn) goto l42;
\r
2323 for (i=0; i<4; i++) pn[i] = pn[i+2];
\r
2324 if (fabs(pn[4]) < overflow) goto l32;
\r
2325 for (i=0; i<4; i++) pn[i] /= overflow;
\r
2328 gin = 1-factor*gin;
\r
2335 double QuantileChi2 (double prob, double v)
\r
2337 /* returns z so that Prob{x<z}=prob where x is Chi2 distributed with df=v
\r
2338 returns -1 if in error. 0.000002<prob<0.999998
\r
2339 RATNEST FORTRAN by
\r
2340 Best DJ & Roberts DE (1975) The percentage points of the
\r
2341 Chi2 distribution. Applied Statistics 24: 385-388. (AS91)
\r
2342 Converted into C by Ziheng Yang, Oct. 1993.
\r
2344 double e=.5e-6, aa=.6931471805, p=prob, g, small=1e-6;
\r
2345 double xx, c, ch, a=0,q=0,p1=0,p2=0,t=0,x=0,b=0,s1,s2,s3,s4,s5,s6;
\r
2347 if (p<small) return(0);
\r
2348 if (p>1-small) return(9999);
\r
2349 if (v<=0) return (-1);
\r
2351 g = LnGamma (v/2);
\r
2353 if (v >= -1.24*log(p)) goto l1;
\r
2355 ch=pow((p*xx*exp(g+xx*aa)), 1/xx);
\r
2356 if (ch-e<0) return (ch);
\r
2359 if (v>.32) goto l3;
\r
2360 ch=0.4; a=log(1-p);
\r
2362 q=ch; p1=1+ch*(4.67+ch); p2=ch*(6.73+ch*(6.66+ch));
\r
2363 t=-0.5+(4.67+2*ch)/p1 - (6.73+ch*(13.32+3*ch))/p2;
\r
2364 ch-=(1-exp(a+g+.5*ch+c*aa)*p2/p1)/t;
\r
2365 if (fabs(q/ch-1)-.01 <= 0) goto l4;
\r
2369 x = QuantileNormal(p);
\r
2371 ch = v*pow((x*sqrt(p1)+1-p1), 3.0);
\r
2373 ch = -2*(log(1-p)-c*log(.5*ch)+g);
\r
2376 if ((t=IncompleteGamma (p1, xx, g))<0)
\r
2377 error2("\nIncompleteGamma");
\r
2379 t=p2*exp(xx*aa+g+p1-c*log(ch));
\r
2380 b=t/ch; a=0.5*t-b*c;
\r
2382 s1=(210+a*(140+a*(105+a*(84+a*(70+60*a))))) / 420;
\r
2383 s2=(420+a*(735+a*(966+a*(1141+1278*a))))/2520;
\r
2384 s3=(210+a*(462+a*(707+932*a)))/2520;
\r
2385 s4=(252+a*(672+1182*a)+c*(294+a*(889+1740*a)))/5040;
\r
2386 s5=(84+264*a+c*(175+606*a))/2520;
\r
2387 s6=(120+c*(346+127*c))/5040;
\r
2388 ch+=t*(1+0.5*t*s1-b*c*(s1-b*(s2-b*(s3-b*(s4-b*(s5-b*s6))))));
\r
2389 if (fabs(q/ch-1) > e) goto l4;
\r
2395 int DiscreteBeta (double freq[], double x[], double p, double q, int K, int UseMedian)
\r
2397 /* discretization of beta(p, q), with equal proportions in each category.
\r
2400 double mean=p/(p+q), lnbeta, lnbeta1, t;
\r
2402 lnbeta = LnBeta(p, q);
\r
2403 if(UseMedian) { /* median */
\r
2404 for(i=0,t=0; i<K; i++)
\r
2405 t += x[i] = QuantileBeta((i+0.5)/K, p, q, lnbeta);
\r
2406 for(i=0; i<K; i++)
\r
2409 /* printf("\nmedian "); for(i=0; i<K; i++) printf("%9.5f", x[i]); */
\r
2412 for(i=0; i<K-1; i++) /* cutting points */
\r
2413 freq[i] = QuantileBeta((i+1.0)/K, p, q, lnbeta);
\r
2416 /* printf("\npoints "); for(i=0; i<K; i++) printf("%9.5f", freq[i]); */
\r
2417 lnbeta1 = lnbeta - log(1 + q/p);
\r
2418 for(i=0; i<K-1; i++) /* CDF */
\r
2419 freq[i] = CDFBeta(freq[i], p+1, q, lnbeta1);
\r
2421 x[0] = freq[0]*mean*K;
\r
2422 for (i=1; i<K-1; i++) x[i] = (freq[i] - freq[i-1])*mean*K;
\r
2423 x[K-1] = (1 - freq[K-2])*mean*K;
\r
2425 /* printf("\nmean "); for(i=0; i<K; i++) printf("%9.5f", x[i]); */
\r
2426 for(i=0,t=0; i<K; i++) t += x[i]/K;
\r
2429 for (i=0; i<K; i++) freq[i] = 1.0/K;
\r
2433 int DiscreteGamma (double freqK[], double rK[], double alpha, double beta, int K, int UseMedian)
\r
2435 /* discretization of G(alpha, beta) with equal proportions in each category.
\r
2438 double t, mean=alpha/beta, lnga1;
\r
2440 if(UseMedian) { /* median */
\r
2441 for(i=0; i<K; i++) rK[i] = QuantileGamma((i*2.+1)/(2.*K), alpha, beta);
\r
2442 for(i=0,t=0; i<K; i++) t += rK[i];
\r
2443 for(i=0; i<K; i++) rK[i] *= mean*K/t; /* rescale so that the mean is alpha/beta. */
\r
2446 lnga1 = LnGamma(alpha+1);
\r
2447 for (i=0; i<K-1; i++) /* cutting points, Eq. 9 */
\r
2448 freqK[i] = QuantileGamma((i+1.0)/K, alpha, beta);
\r
2449 for (i=0; i<K-1; i++) /* Eq. 10 */
\r
2450 freqK[i] = IncompleteGamma(freqK[i]*beta, alpha+1, lnga1);
\r
2451 rK[0] = freqK[0]*mean*K;
\r
2452 for (i=1; i<K-1; i++) rK[i] = (freqK[i] - freqK[i-1])*mean*K;
\r
2453 rK[K-1] = (1-freqK[K-2])*mean*K;
\r
2456 for (i=0; i<K; i++) freqK[i] = 1.0/K;
\r
2462 int AutodGamma (double M[], double freqK[], double rK[], double *rho1, double alpha, double rho, int K)
\r
2464 /* Auto-discrete-gamma distribution of rates over sites, K equal-probable
\r
2465 categories, with the mean for each category used.
\r
2466 This routine calculates M[], freqK[] and rK[], using alpha, rho and K.
\r
2469 double *point=freqK;
\r
2470 double x, y, large=20, v1;
\r
2472 if (fabs(rho)>1-1e-4) error2("rho out of range");
\r
2474 for(i=0; i<K-1; i++)
\r
2475 point[i]=QuantileNormal((i+1.0)/K);
\r
2476 for (i=0; i<K; i++) {
\r
2477 for (j=0; j<K; j++) {
\r
2478 x = (i<K-1?point[i]:large);
\r
2479 y = (j<K-1?point[j]:large);
\r
2480 M[i*K+j] = CDFBinormal(x,y,rho);
\r
2483 for (i1=0; i1<2*K-1; i1++) {
\r
2484 for (i2=0; i2<K*K; i2++) {
\r
2486 if (i+j != 2*(K-1)-i1) continue;
\r
2488 if (i>0) y-= M[(i-1)*K+j];
\r
2489 if (j>0) y-= M[i*K+(j-1)];
\r
2490 if (i>0 && j>0) y += M[(i-1)*K+(j-1)];
\r
2491 M[i*K+j] = (M[i*K+j]+y)*K;
\r
2493 if (M[i*K+j]<0) printf("M(%d,%d) =%12.8f<0\n", i+1, j+1, M[i*K+j]);
\r
2497 DiscreteGamma(freqK, rK, alpha, alpha, K, DGammaUseMedian);
\r
2499 for (i=0,v1=*rho1=0; i<K; i++) {
\r
2500 v1+=rK[i]*rK[i]*freqK[i];
\r
2501 for (j=0; j<K; j++)
\r
2502 *rho1 += freqK[i]*M[i*K+j]*rK[i]*rK[j];
\r
2505 *rho1=(*rho1-1)/v1;
\r
2510 double LBinormal (double h, double k, double r)
\r
2512 /* L(h,k,r) = prob(X>h, Y>k), where X and Y are standard binormal variables,
\r
2513 with r = corr(X, Y).
\r
2515 (1) Drezner Z., and G.O. Wesolowsky (1990) On the computation of the
\r
2516 bivariate normal integral. J. Statist. Comput. Simul. 35:101-107.
\r
2518 (2) Genz, A.C., Numerical computation of rectangular bivariate and
\r
2519 trivariate normal and t probabilities. Statist. Comput., 2004. 14: p. 1573-1375.
\r
2521 This uses the algorithm of Genz (2004).
\r
2522 Here h<k is assumed. If h>k, a swapping between h and k is performed.
\r
2524 Gauss-Legendre quadrature points used.
\r
2528 <0.75 (eq. 3) 12 20
\r
2529 <0.925 (eq. 3) 20 20
\r
2532 int nGL = (fabs(r)<0.3 ? 16 : 32), i,j;
\r
2533 double *x=NULL, *w=NULL; /* Gauss-Legendre quadrature points */
\r
2534 double shk, h0=h,k0=k, sk, L=0, t[2], hk2, y, a=0,b,c,d, bs, as, rs, smallr=1e-10;
\r
2536 h=min2(h0,k0); k=max2(h0,k0);
\r
2537 sk = (r>=0 ? k : -k);
\r
2538 shk = (r>=0 ? h*k : -h*k);
\r
2539 if(fabs(r)>1) error2("|r| > 1 in LBinormal");
\r
2540 GaussLegendreRule(&x, &w, nGL);
\r
2542 if(fabs(r) < 0.925) { /* equation 3 */
\r
2543 if(fabs(r)>smallr) {
\r
2544 hk2 = (h*h + k*k)/2;
\r
2546 for(i=0,L=0; i<nGL/2; i++) {
\r
2547 t[0] = a*(1 - x[i]); t[0] = sin(t[0]);
\r
2548 t[1] = a*(1 + x[i]); t[1] = sin(t[1]);
\r
2549 for(j=0; j<2; j++)
\r
2550 L += w[i]*exp((t[j]*h*k - hk2)/(1 - t[j]*t[j]));
\r
2553 L = L*a/(2*Pi) + CDFNormal(-h)*CDFNormal(-k);
\r
2555 else { /* equation 6, using equation 7 instead of equation 5. */
\r
2557 /* first term in equation (6), analytical */
\r
2562 c = (4 - shk)/8 ;
\r
2563 d = (12 - shk)/16;
\r
2564 y = -(bs/as + shk)/2;
\r
2566 L = a*exp(y)*(1 - c*(bs-as)*(1-d*bs/5)/3 + c*d*as*as/5);
\r
2568 L -= exp(-shk/2)*sqrt(2*Pi) * CDFNormal(-b/a) * b * (1 - c*bs*(1 - d*bs/5)/3);
\r
2570 /* second term in equation (6), numerical */
\r
2572 for(i=0; i<nGL/2; i++) {
\r
2573 t[0] = a*(1 - x[i]); t[0] = t[0]*t[0];
\r
2574 t[1] = a*(1 + x[i]); t[1] = t[1]*t[1];
\r
2575 for(j=0; j<2; j++) {
\r
2576 rs = sqrt(1 - t[j]);
\r
2577 y = -(bs/t[j] + shk)/2;
\r
2579 L += a*w[i]*exp(y)*(exp(-shk*(1-rs)/(2*(1+rs)))/rs - (1+c*t[j]*(1+d*t[j])));
\r
2585 L += CDFNormal(-max2(h, k));
\r
2589 L += CDFNormal(-h) - CDFNormal(k);
\r
2593 if(L<-1e-12) printf("L = %.9g very negative. Let me know please.\n", L);
\r
2599 double logLBinormal (double h, double k, double r)
\r
2601 /* This calculates the logarithm of the tail probability
\r
2602 log{Pr(X>h, Y>k)} where X and Y have a standard bivariate normal distribution
\r
2603 with correlation r. This is modified from LBinormal().
\r
2605 L(-10, 9, -1) = F(-9) - F(-10) is better than L(-10, 9, -1) = F(10) - F(9).
\r
2606 So we use L(-10, 9, -0.3) = F(-9) - L(10, 9, 0.3).
\r
2607 not L(-10, 9, -0.3) = F(10) - L(-10, -9, 0.3).
\r
2609 Results for the left tail, the very negative log(L), are reliable.
\r
2610 Results for the right tail are not reliable, that is,
\r
2611 if log(L) is close to 0 and L ~= 1. Perhaps try to use the following to reflect:
\r
2612 L(-5,-9,r) = 1 - [ F(-5) + F(-9) - L(5,9,r) ]
\r
2613 See logCDFNormal() for more details of the idea.
\r
2615 int nGL = (fabs(r)<0.3 ? 16 : 32), i,j;
\r
2616 double *x=NULL, *w=NULL; /* Gauss-Legendre quadrature points */
\r
2617 double shk, h0=h,k0=k, sk, L, t[2], hk2, a,b,c,d, bs, as, rs, signr=(r>=0?1:-1);
\r
2618 double S1=0,S2=-1e300,S3=-1e300, y,L1=0,L2=0,L3=0, largeneg=-1e300, smallr=1e-10;
\r
2620 h=min2(h0,k0); k=max2(h0,k0);
\r
2623 if(fabs(r)>1+smallr) error2("|r| > 1 in LBinormal");
\r
2624 GaussLegendreRule(&x, &w, nGL);
\r
2626 if(fabs(r) < 0.925) { /* equation 3 */
\r
2627 S1 = L = logCDFNormal(-h) + logCDFNormal(-k);
\r
2628 if(fabs(r) > smallr) { /* this saves computation for the case of r = 0 */
\r
2629 hk2 = (h*h + k*k)/2;
\r
2631 for(i=0,L2=0,S2=-hk2; i<nGL/2; i++) {
\r
2632 t[0] = a*(1 - x[i]); t[0] = sin(t[0]);
\r
2633 t[1] = a*(1 + x[i]); t[1] = sin(t[1]);
\r
2634 for(j=0; j<2; j++) {
\r
2635 y = -(hk2 - t[j]*h*k)/(1 - t[j]*t[j]);
\r
2640 L2 += a*w[i]*exp(y-S2);
\r
2645 a = exp(S1-y) + L2*exp(S2-y);
\r
2646 L = (a>0 ? y + log(a) : largeneg);
\r
2649 else { /* equation 6, using equation 7 instead of equation 5. */
\r
2650 /* L = L1*exp(S1) + L2*exp(S2) + L3*exp(S3) */
\r
2652 /* first term in equation (6), analytical: L2 & S2 */
\r
2658 d = (12 - shk)/16;
\r
2659 S2 = -(bs/as + shk)/2; /* is this too large? */
\r
2660 L2 = a*(1 - c*(bs-as)*(1-d*bs/5)/3 + c*d*as*as/5);
\r
2661 y = -shk/2 + logCDFNormal(-b/a);
\r
2666 L2 -= sqrt(2*Pi) * exp(y-S2) * b * (1 - c*bs*(1 - d*bs/5)/3);
\r
2668 /* second term in equation (6), numerical: L3 & S3 */
\r
2670 for(i=0,L3=0,S3=-1e300; i<nGL/2; i++) {
\r
2671 t[0] = a*(1 - x[i]); t[0] = t[0]*t[0];
\r
2672 t[1] = a*(1 + x[i]); t[1] = t[1]*t[1];
\r
2673 for(j=0; j<2; j++) {
\r
2674 rs = sqrt(1 - t[j]);
\r
2675 y = -(bs/t[j] + shk)/2;
\r
2680 L3 += a*w[i]*exp(y-S3) * (exp(-shk*(1-rs)/(2*(1+rs)))/rs - (1+c*t[j]*(1+d*t[j])));
\r
2686 /* L(h,k,s) term in equation (6), L1 & S1 */
\r
2688 S1 = logCDFNormal(-max2(h, k));
\r
2691 else if (r<0 && h+k<0) {
\r
2692 a = logCDFNormal(-k);
\r
2693 y = logCDFNormal(h);
\r
2695 L1 = exp(a-S1) - exp(y-S1);
\r
2700 a = L1*exp(S1-y) - signr/(2*Pi) * (L2*exp(S2-y) + L3*exp(S3-y));
\r
2702 L = (a>0 ? y + log(a) : largeneg);
\r
2706 printf("ln L(%2g, %.2g, %.2g) = %.6g is very large.\n", h0, k0, r, L);
\r
2713 void testLBinormal (void)
\r
2715 double x,y,r, L, lnL;
\r
2717 for(r=-1; r<1.01; r+=0.05) {
\r
2718 if(fabs(r-1)<1e-5) r=1;
\r
2719 printf("\nr = %.2f\n", r);
\r
2720 for(x=-10; x<=10.01; x+=0.5) {
\r
2721 for(y=-10; y<=10.01; y+=0.5) {
\r
2723 printf("x y r? "); scanf("%lf%lf%lf", &x, &y, &r);
\r
2725 L = LBinormal(x,y,r);
\r
2726 lnL = logLBinormal(x,y,r);
\r
2728 if(fabs(L-exp(lnL))>1e-10)
\r
2729 printf("L - exp(lnL) = %.10g very different.\n", L - exp(lnL));
\r
2732 printf("%6.2f %6.2f %6.2f L %15.8g = %15.8g %9.5g\n", x,y,r, L, exp(lnL), lnL);
\r
2734 if(lnL>0) exit(-1);
\r
2744 int probBinomialDistribution (int n, double p, double prob[])
\r
2746 /* calculates {n\choose k} * p^k * (1-p)^(n-k), for k=0,1,...,n and store in prob[].
\r
2751 prob[0] = y = pow(1-p, (double)n);
\r
2752 for(k=1; k<=n; k++)
\r
2753 prob[k] = y *= ((n-k+1)*p) / (k*(1-p));
\r
2758 double probBinomial (int n, int k, double p)
\r
2760 /* calculates {n\choose k} * p^k * (1-p)^(n-k)
\r
2762 double C, up, down;
\r
2764 if (n<40 || (n<1000&&k<10)) {
\r
2765 for (down=min2(k,n-k),up=n,C=1; down>0; down--,up--) C *= up/down;
\r
2766 if (fabs(p-.5)<1e-6) C *= pow(p,(double)n);
\r
2767 else C *= pow(p,(double)k)*pow((1-p),(double)(n-k));
\r
2770 C = exp((LnGamma(n+1.)-LnGamma(k+1.)-LnGamma(n-k+1.))/n);
\r
2771 C = pow(p*C,(double)k) * pow((1-p)*C,(double)(n-k));
\r
2777 double probBetaBinomial (int n, int k, double p, double q)
\r
2779 /* This calculates beta-binomial probability of k succeses out of n trials,
\r
2780 The binomial probability parameter has distribution beta(p, q)
\r
2782 prob(x) = C1(-a,k) * C2(-b,n-k)/C3(-a-b,n)
\r
2784 double a=p,b=q, C1,C2,C3,scale1,scale2,scale3;
\r
2786 if(a<=0 || b<=0) return(0);
\r
2787 C1 = Binomial(-a, k, &scale1);
\r
2788 C2 = Binomial(-b, n-k, &scale2);
\r
2789 C3 = Binomial(-a-b, n, &scale3);
\r
2792 error2("error in probBetaBinomial");
\r
2793 return C1*exp(scale1+scale2-scale3);
\r
2797 double PDFBeta (double x, double p, double q)
\r
2799 /* Returns pdf of beta(p,q)
\r
2801 double y, small=1e-20;
\r
2803 if(x<small || x>1-small)
\r
2804 error2("bad x in PDFbeta");
\r
2806 y = (p-1)*log(x) + (q-1)*log(1-x);
\r
2807 y-= LnGamma(p) + LnGamma(q) - LnGamma(p+q);
\r
2812 double CDFBeta (double x, double pin, double qin, double lnbeta)
\r
2814 /* Returns distribution function of the standard form of the beta distribution,
\r
2815 that is, the incomplete beta ratio I_x(p,q).
\r
2817 This is also known as the incomplete beta function ratio I_x(p, q)
\r
2819 lnbeta is log of the complete beta function; provide it if known,
\r
2820 and otherwise use 0.
\r
2822 This is called from QuantileBeta() in a root-finding loop.
\r
2824 This routine is a translation into C of a Fortran subroutine
\r
2825 by W. Fullerton of Los Alamos Scientific Laboratory.
\r
2826 Bosten and Battiste (1974).
\r
2827 Remark on Algorithm 179, CACM 17, p153, (1974).
\r
2829 double ans, c, finsum, p, ps, p1, q, term, xb, xi, y, small=1e-15;
\r
2831 static double eps = 0, alneps = 0, sml = 0, alnsml = 0;
\r
2833 if(x<small) return 0;
\r
2834 else if(x>1-small) return 1;
\r
2835 if(pin<=0 || qin<=0) {
\r
2836 printf("p=%.4f q=%.4f: parameter outside range in CDFBeta",pin,qin);
\r
2840 if (eps == 0) {/* initialize machine constants ONCE */
\r
2841 eps = pow((double)FLT_RADIX, -(double)DBL_MANT_DIG);
\r
2842 alneps = log(eps);
\r
2844 alnsml = log(sml);
\r
2846 y = x; p = pin; q = qin;
\r
2848 /* swap tails if x is greater than the mean */
\r
2849 if (p / (p + q) < x) {
\r
2855 if(lnbeta==0) lnbeta = LnBeta(p, q);
\r
2857 if ((p + q) * y / (p + 1) < eps) { /* tail approximation */
\r
2859 xb = p * log(max2(y, sml)) - log(p) - lnbeta;
\r
2860 if (xb > alnsml && y != 0)
\r
2862 if (y != x || p != pin)
\r
2866 /* evaluate the infinite sum first. term will equal */
\r
2867 /* y^p / beta(ps, p) * (1 - ps)-sub-i * y^i / fac(i) */
\r
2868 ps = q - floor(q);
\r
2872 xb=LnGamma(ps)+LnGamma(p)-LnGamma(ps+p);
\r
2873 xb = p * log(y) - xb - log(p);
\r
2876 if (xb >= alnsml) {
\r
2880 n = (int)max2(alneps/log(y), 4.0);
\r
2881 for(i=1 ; i<= n ; i++) {
\r
2883 term = term * (xi - ps) * y / xi;
\r
2884 ans = ans + term / (p + xi);
\r
2889 /* evaluate the finite sum. */
\r
2891 xb = p * log(y) + q * log(1 - y) - lnbeta - log(q);
\r
2892 ib = (int) (xb/alnsml); if(ib<0) ib=0;
\r
2893 term = exp(xb - ib * alnsml);
\r
2895 p1 = q * c / (p + q - 1);
\r
2899 if (q == (double)n)
\r
2901 for(i=1 ; i<=n ; i++) {
\r
2902 if (p1 <= 1 && term / eps <= finsum)
\r
2905 term = (q - xi + 1) * c * term / (p + q - xi);
\r
2908 term = term * sml;
\r
2911 finsum = finsum + term;
\r
2913 ans = ans + finsum;
\r
2915 if (y != x || p != pin)
\r
2923 double QuantileBeta(double prob, double p, double q, double lnbeta)
\r
2925 /* This calculates the Quantile of the beta distribution
\r
2927 Cran, G. W., K. J. Martin and G. E. Thomas (1977).
\r
2928 Remark AS R19 and Algorithm AS 109, Applied Statistics, 26(1), 111-114.
\r
2929 Remark AS R83 (v.39, 309-310) and correction (v.40(1) p.236).
\r
2931 My own implementation of the algorithm did not bracket the variable well.
\r
2932 This version is Adpated from the pbeta and qbeta routines from
\r
2933 "R : A Computer Language for Statistical Data Analysis". It fails for
\r
2934 extreme values of p and q as well, although it seems better than my
\r
2936 Ziheng Yang, May 2001
\r
2938 double fpu=3e-308, acu_min=1e-300, lower=fpu, upper=1-2.22e-16;
\r
2939 /* acu_min>= fpu: Minimal value for accuracy 'acu' which will depend on (a,p); */
\r
2940 int swap_tail, i_pb, i_inn, niterations=2000;
\r
2941 double a, adj, g, h, pp, prev=0, qq, r, s, t, tx=0, w, y, yprev;
\r
2942 double acu, xinbta;
\r
2944 if(prob<0 || prob>1 || p<0 || q<0) error2("out of range in QuantileBeta");
\r
2946 /* define accuracy and initialize */
\r
2949 /* test for admissibility of parameters */
\r
2950 if(p<0 || q<0 || prob<0 || prob>1) error2("beta par err");
\r
2951 if (prob == 0 || prob == 1)
\r
2954 if(lnbeta==0) lnbeta = LnBeta(p, q);
\r
2956 /* change tail if necessary; afterwards 0 < a <= 1/2 */
\r
2957 if (prob <= 0.5) {
\r
2958 a = prob; pp = p; qq = q; swap_tail = 0;
\r
2961 a = 1. - prob; pp = q; qq = p; swap_tail = 1;
\r
2964 /* calculate the initial approximation */
\r
2965 r = sqrt(-log(a * a));
\r
2966 y = r - (2.30753+0.27061*r)/(1.+ (0.99229+0.04481*r) * r);
\r
2968 if (pp > 1. && qq > 1.) {
\r
2969 r = (y * y - 3.) / 6.;
\r
2970 s = 1. / (pp*2. - 1.);
\r
2971 t = 1. / (qq*2. - 1.);
\r
2973 w = y * sqrt(h + r) / h - (t - s) * (r + 5./6. - 2./(3.*h));
\r
2974 xinbta = pp / (pp + qq * exp(w + w));
\r
2978 t = 1. / (9. * qq);
\r
2979 t = r * pow(1. - t + y * sqrt(t), 3.);
\r
2981 xinbta = 1. - exp((log((1. - a) * qq) + lnbeta) / qq);
\r
2983 t = (4.*pp + r - 2.) / t;
\r
2985 xinbta = exp((log(a * pp) + lnbeta) / pp);
\r
2987 xinbta = 1. - 2./(t+1.);
\r
2991 /* solve for x by a modified newton-raphson method, using CDFBeta */
\r
2998 /* Changes made by Ziheng to fix a bug in qbeta()
\r
2999 qbeta(0.25, 0.143891, 0.05) = 3e-308 wrong (correct value is 0.457227)
\r
3001 if(xinbta<=lower || xinbta>=upper) xinbta=(a+.5)/2;
\r
3003 /* Desired accuracy should depend on (a,p)
\r
3004 * This is from Remark .. on AS 109, adapted.
\r
3005 * However, it's not clear if this is "optimal" for IEEE double prec.
\r
3006 * acu = fmax2(acu_min, pow(10., -25. - 5./(pp * pp) - 1./(a * a)));
\r
3007 * NEW: 'acu' accuracy NOT for squared adjustment, but simple;
\r
3008 * ---- i.e., "new acu" = sqrt(old acu)
\r
3010 acu = pow(10., -13. - 2.5/(pp * pp) - 0.5/(a * a));
\r
3011 acu = max2(acu, acu_min);
\r
3013 for (i_pb=0; i_pb<niterations; i_pb++) {
\r
3014 y = CDFBeta(xinbta, pp, qq, lnbeta);
\r
3016 exp(lnbeta + r * log(xinbta) + t * log(1. - xinbta));
\r
3017 if (y * yprev <= 0)
\r
3018 prev = max2(fabs(adj),fpu);
\r
3019 for (i_inn=0,g=1; i_inn<niterations; i_inn++) {
\r
3021 if (fabs(adj) < prev) {
\r
3022 tx = xinbta - adj; /* trial new x */
\r
3023 if (tx >= 0. && tx <= 1.) {
\r
3024 if (prev <= acu || fabs(y) <= acu) goto L_converged;
\r
3025 if (tx != 0. && tx != 1.) break;
\r
3030 if (fabs(tx-xinbta)<fpu)
\r
3035 if(!PAML_RELEASE)
\r
3036 printf("\nQuantileBeta(%.2f, %.5f, %.5f) = %.6e\t%d rounds\n",
\r
3037 prob,p,q, (swap_tail ? 1. - xinbta : xinbta), niterations);
\r
3040 return (swap_tail ? 1. - xinbta : xinbta);
\r
3044 static double prob_Quantile, *par_Quantile;
\r
3045 static double (*cdf_Quantile)(double x,double par[]);
\r
3046 double diff_Quantile(double x);
\r
3048 double diff_Quantile(double x)
\r
3050 /* This is the difference between the given p and the CDF(x), the
\r
3051 objective function to be minimized.
\r
3053 double px=(*cdf_Quantile)(x,par_Quantile);
\r
3054 return(square(prob_Quantile-px));
\r
3057 double Quantile(double(*cdf)(double x, double par[]),
\r
3058 double p, double x, double par[], double xb[2])
\r
3060 /* Use x for initial value if in range
\r
3063 double sdiff,step=min2(0.05,(xb[1]-xb[0])/100), e=1e-15;
\r
3066 prob_Quantile=p; par_Quantile=par; cdf_Quantile=cdf;
\r
3067 if(x<=xb[0]||x>=xb[1]) x=.5;
\r
3068 LineSearch(diff_Quantile, &sdiff, &x, xb, step, e);
\r
3077 int GaussLegendreRule(double **x, double **w, int npoints)
\r
3079 /* This returns the Gauss-Legendre nodes and weights in x[] and w[].
\r
3080 npoints = 10, 20, 32, 64, 128, 256, 512, 1024
\r
3083 static double x4[] = {0.3399810435848562648026658, 0.8611363115940525752239465};
\r
3084 static double w4[] = {0.6521451548625461426269361, 0.3478548451374538573730639};
\r
3086 static double x8[] = {0.1834346424956498049394761, 0.5255324099163289858177390,
\r
3087 0.7966664774136267395915539, 0.9602898564975362316835609};
\r
3088 static double w8[] = {0.3626837833783619829651504, 0.3137066458778872873379622,
\r
3089 0.2223810344533744705443560, 0.1012285362903762591525314};
\r
3091 static double x16[] = {0.0950125098376374401853193, 0.2816035507792589132304605,
\r
3092 0.4580167776572273863424194, 0.6178762444026437484466718,
\r
3093 0.7554044083550030338951012, 0.8656312023878317438804679,
\r
3094 0.9445750230732325760779884, 0.9894009349916499325961542};
\r
3095 static double w16[] = {0.1894506104550684962853967, 0.1826034150449235888667637,
\r
3096 0.1691565193950025381893121, 0.1495959888165767320815017,
\r
3097 0.1246289712555338720524763, 0.0951585116824927848099251,
\r
3098 0.0622535239386478928628438, 0.0271524594117540948517806};
\r
3100 static double x32[] = {0.048307665687738316234812570441, 0.144471961582796493485186373599,
\r
3101 0.239287362252137074544603209166, 0.331868602282127649779916805730,
\r
3102 0.421351276130635345364119436172, 0.506899908932229390023747474378,
\r
3103 0.587715757240762329040745476402, 0.663044266930215200975115168663,
\r
3104 0.732182118740289680387426665091, 0.794483795967942406963097298970,
\r
3105 0.849367613732569970133693004968, 0.896321155766052123965307243719,
\r
3106 0.934906075937739689170919134835, 0.964762255587506430773811928118,
\r
3107 0.985611511545268335400175044631, 0.997263861849481563544981128665};
\r
3108 static double w32[] = {0.0965400885147278005667648300636, 0.0956387200792748594190820022041,
\r
3109 0.0938443990808045656391802376681, 0.0911738786957638847128685771116,
\r
3110 0.0876520930044038111427714627518, 0.0833119242269467552221990746043,
\r
3111 0.0781938957870703064717409188283, 0.0723457941088485062253993564785,
\r
3112 0.0658222227763618468376500637069, 0.0586840934785355471452836373002,
\r
3113 0.0509980592623761761961632446895, 0.0428358980222266806568786466061,
\r
3114 0.0342738629130214331026877322524, 0.0253920653092620594557525897892,
\r
3115 0.0162743947309056706051705622064, 0.0070186100094700966004070637389};
\r
3117 static double x64[] = {0.024350292663424432508955842854, 0.072993121787799039449542941940,
\r
3118 0.121462819296120554470376463492, 0.169644420423992818037313629748,
\r
3119 0.217423643740007084149648748989, 0.264687162208767416373964172510,
\r
3120 0.311322871990210956157512698560, 0.357220158337668115950442615046,
\r
3121 0.402270157963991603695766771260, 0.446366017253464087984947714759,
\r
3122 0.489403145707052957478526307022, 0.531279464019894545658013903544,
\r
3123 0.571895646202634034283878116659, 0.611155355172393250248852971019,
\r
3124 0.648965471254657339857761231993, 0.685236313054233242563558371031,
\r
3125 0.719881850171610826848940217832, 0.752819907260531896611863774886,
\r
3126 0.783972358943341407610220525214, 0.813265315122797559741923338086,
\r
3127 0.840629296252580362751691544696, 0.865999398154092819760783385070,
\r
3128 0.889315445995114105853404038273, 0.910522137078502805756380668008,
\r
3129 0.929569172131939575821490154559, 0.946411374858402816062481491347,
\r
3130 0.961008799652053718918614121897, 0.973326827789910963741853507352,
\r
3131 0.983336253884625956931299302157, 0.991013371476744320739382383443,
\r
3132 0.996340116771955279346924500676, 0.999305041735772139456905624346};
\r
3133 static double w64[] = {0.0486909570091397203833653907347, 0.0485754674415034269347990667840,
\r
3134 0.0483447622348029571697695271580, 0.0479993885964583077281261798713,
\r
3135 0.0475401657148303086622822069442, 0.0469681828162100173253262857546,
\r
3136 0.0462847965813144172959532492323, 0.0454916279274181444797709969713,
\r
3137 0.0445905581637565630601347100309, 0.0435837245293234533768278609737,
\r
3138 0.0424735151236535890073397679088, 0.0412625632426235286101562974736,
\r
3139 0.0399537411327203413866569261283, 0.0385501531786156291289624969468,
\r
3140 0.0370551285402400460404151018096, 0.0354722132568823838106931467152,
\r
3141 0.0338051618371416093915654821107, 0.0320579283548515535854675043479,
\r
3142 0.0302346570724024788679740598195, 0.0283396726142594832275113052002,
\r
3143 0.0263774697150546586716917926252, 0.0243527025687108733381775504091,
\r
3144 0.0222701738083832541592983303842, 0.0201348231535302093723403167285,
\r
3145 0.0179517157756973430850453020011, 0.0157260304760247193219659952975,
\r
3146 0.0134630478967186425980607666860, 0.0111681394601311288185904930192,
\r
3147 0.0088467598263639477230309146597, 0.0065044579689783628561173604000,
\r
3148 0.0041470332605624676352875357286, 0.0017832807216964329472960791450};
\r
3150 static double x128[] = {0.0122236989606157641980521, 0.0366637909687334933302153,
\r
3151 0.0610819696041395681037870, 0.0854636405045154986364980,
\r
3152 0.1097942311276437466729747, 0.1340591994611877851175753,
\r
3153 0.1582440427142249339974755, 0.1823343059853371824103826,
\r
3154 0.2063155909020792171540580, 0.2301735642266599864109866,
\r
3155 0.2538939664226943208556180, 0.2774626201779044028062316,
\r
3156 0.3008654388776772026671541, 0.3240884350244133751832523,
\r
3157 0.3471177285976355084261628, 0.3699395553498590266165917,
\r
3158 0.3925402750332674427356482, 0.4149063795522750154922739,
\r
3159 0.4370245010371041629370429, 0.4588814198335521954490891,
\r
3160 0.4804640724041720258582757, 0.5017595591361444642896063,
\r
3161 0.5227551520511754784539479, 0.5434383024128103634441936,
\r
3162 0.5637966482266180839144308, 0.5838180216287630895500389,
\r
3163 0.6034904561585486242035732, 0.6228021939105849107615396,
\r
3164 0.6417416925623075571535249, 0.6602976322726460521059468,
\r
3165 0.6784589224477192593677557, 0.6962147083695143323850866,
\r
3166 0.7135543776835874133438599, 0.7304675667419088064717369,
\r
3167 0.7469441667970619811698824, 0.7629743300440947227797691,
\r
3168 0.7785484755064119668504941, 0.7936572947621932902433329,
\r
3169 0.8082917575079136601196422, 0.8224431169556438424645942,
\r
3170 0.8361029150609068471168753, 0.8492629875779689691636001,
\r
3171 0.8619154689395484605906323, 0.8740527969580317986954180,
\r
3172 0.8856677173453972174082924, 0.8967532880491581843864474,
\r
3173 0.9073028834017568139214859, 0.9173101980809605370364836,
\r
3174 0.9267692508789478433346245, 0.9356743882779163757831268,
\r
3175 0.9440202878302201821211114, 0.9518019613412643862177963,
\r
3176 0.9590147578536999280989185, 0.9656543664319652686458290,
\r
3177 0.9717168187471365809043384, 0.9771984914639073871653744,
\r
3178 0.9820961084357185360247656, 0.9864067427245862088712355,
\r
3179 0.9901278184917343833379303, 0.9932571129002129353034372,
\r
3180 0.9957927585349811868641612, 0.9977332486255140198821574,
\r
3181 0.9990774599773758950119878, 0.9998248879471319144736081};
\r
3182 static double w128[] = {0.0244461801962625182113259, 0.0244315690978500450548486,
\r
3183 0.0244023556338495820932980, 0.0243585572646906258532685,
\r
3184 0.0243002001679718653234426, 0.0242273192228152481200933,
\r
3185 0.0241399579890192849977167, 0.0240381686810240526375873,
\r
3186 0.0239220121367034556724504, 0.0237915577810034006387807,
\r
3187 0.0236468835844476151436514, 0.0234880760165359131530253,
\r
3188 0.0233152299940627601224157, 0.0231284488243870278792979,
\r
3189 0.0229278441436868469204110, 0.0227135358502364613097126,
\r
3190 0.0224856520327449668718246, 0.0222443288937997651046291,
\r
3191 0.0219897106684604914341221, 0.0217219495380520753752610,
\r
3192 0.0214412055392084601371119, 0.0211476464682213485370195,
\r
3193 0.0208414477807511491135839, 0.0205227924869600694322850,
\r
3194 0.0201918710421300411806732, 0.0198488812328308622199444,
\r
3195 0.0194940280587066028230219, 0.0191275236099509454865185,
\r
3196 0.0187495869405447086509195, 0.0183604439373313432212893,
\r
3197 0.0179603271850086859401969, 0.0175494758271177046487069,
\r
3198 0.0171281354231113768306810, 0.0166965578015892045890915,
\r
3199 0.0162550009097851870516575, 0.0158037286593993468589656,
\r
3200 0.0153430107688651440859909, 0.0148731226021473142523855,
\r
3201 0.0143943450041668461768239, 0.0139069641329519852442880,
\r
3202 0.0134112712886163323144890, 0.0129075627392673472204428,
\r
3203 0.0123961395439509229688217, 0.0118773073727402795758911,
\r
3204 0.0113513763240804166932817, 0.0108186607395030762476596,
\r
3205 0.0102794790158321571332153, 0.0097341534150068058635483,
\r
3206 0.0091830098716608743344787, 0.0086263777986167497049788,
\r
3207 0.0080645898904860579729286, 0.0074979819256347286876720,
\r
3208 0.0069268925668988135634267, 0.0063516631617071887872143,
\r
3209 0.0057726375428656985893346, 0.0051901618326763302050708,
\r
3210 0.0046045842567029551182905, 0.0040162549837386423131943,
\r
3211 0.0034255260409102157743378, 0.0028327514714579910952857,
\r
3212 0.0022382884309626187436221, 0.0016425030186690295387909,
\r
3213 0.0010458126793403487793129, 0.0004493809602920903763943};
\r
3215 static double x256[] = {0.0061239123751895295011702, 0.0183708184788136651179263,
\r
3216 0.0306149687799790293662786, 0.0428545265363790983812423,
\r
3217 0.0550876556946339841045614, 0.0673125211657164002422903,
\r
3218 0.0795272891002329659032271, 0.0917301271635195520311456,
\r
3219 0.1039192048105094036391969, 0.1160926935603328049407349,
\r
3220 0.1282487672706070947420496, 0.1403856024113758859130249,
\r
3221 0.1525013783386563953746068, 0.1645942775675538498292845,
\r
3222 0.1766624860449019974037218, 0.1887041934213888264615036,
\r
3223 0.2007175933231266700680007, 0.2127008836226259579370402,
\r
3224 0.2246522667091319671478783, 0.2365699497582840184775084,
\r
3225 0.2484521450010566668332427, 0.2602970699919425419785609,
\r
3226 0.2721029478763366095052447, 0.2838680076570817417997658,
\r
3227 0.2955904844601356145637868, 0.3072686197993190762586103,
\r
3228 0.3189006618401062756316834, 0.3304848656624169762291870,
\r
3229 0.3420194935223716364807297, 0.3535028151129699895377902,
\r
3230 0.3649331078236540185334649, 0.3763086569987163902830557,
\r
3231 0.3876277561945155836379846, 0.3988887074354591277134632,
\r
3232 0.4100898214687165500064336, 0.4212294180176238249768124,
\r
3233 0.4323058260337413099534411, 0.4433173839475273572169258,
\r
3234 0.4542624399175899987744552, 0.4651393520784793136455705,
\r
3235 0.4759464887869833063907375, 0.4866822288668903501036214,
\r
3236 0.4973449618521814771195124, 0.5079330882286160362319249,
\r
3237 0.5184450196736744762216617, 0.5288791792948222619514764,
\r
3238 0.5392340018660591811279362, 0.5495079340627185570424269,
\r
3239 0.5596994346944811451369074, 0.5698069749365687590576675,
\r
3240 0.5798290385590829449218317, 0.5897641221544543007857861,
\r
3241 0.5996107353629683217303882, 0.6093674010963339395223108,
\r
3242 0.6190326557592612194309676, 0.6286050494690149754322099,
\r
3243 0.6380831462729113686686886, 0.6474655243637248626170162,
\r
3244 0.6567507762929732218875002, 0.6659375091820485599064084,
\r
3245 0.6750243449311627638559187, 0.6840099204260759531248771,
\r
3246 0.6928928877425769601053416, 0.7016719143486851594060835,
\r
3247 0.7103456833045433133945663, 0.7189128934599714483726399,
\r
3248 0.7273722596496521265868944, 0.7357225128859178346203729,
\r
3249 0.7439624005491115684556831, 0.7520906865754920595875297,
\r
3250 0.7601061516426554549419068, 0.7680075933524456359758906,
\r
3251 0.7757938264113257391320526, 0.7834636828081838207506702,
\r
3252 0.7910160119895459945467075, 0.7984496810321707587825429,
\r
3253 0.8057635748129986232573891, 0.8129565961764315431364104,
\r
3254 0.8200276660989170674034781, 0.8269757238508125142890929,
\r
3255 0.8337997271555048943484439, 0.8404986523457627138950680,
\r
3256 0.8470714945172962071870724, 0.8535172676795029650730355,
\r
3257 0.8598350049033763506961731, 0.8660237584665545192975154,
\r
3258 0.8720825999954882891300459, 0.8780106206047065439864349,
\r
3259 0.8838069310331582848598262, 0.8894706617776108888286766,
\r
3260 0.8950009632230845774412228, 0.9003970057703035447716200,
\r
3261 0.9056579799601446470826819, 0.9107830965950650118909072,
\r
3262 0.9157715868574903845266696, 0.9206227024251464955050471,
\r
3263 0.9253357155833162028727303, 0.9299099193340056411802456,
\r
3264 0.9343446275020030942924765, 0.9386391748378148049819261,
\r
3265 0.9427929171174624431830761, 0.9468052312391274813720517,
\r
3266 0.9506755153166282763638521, 0.9544031887697162417644479,
\r
3267 0.9579876924111781293657904, 0.9614284885307321440064075,
\r
3268 0.9647250609757064309326123, 0.9678769152284894549090038,
\r
3269 0.9708835784807430293209233, 0.9737445997043704052660786,
\r
3270 0.9764595497192341556210107, 0.9790280212576220388242380,
\r
3271 0.9814496290254644057693031, 0.9837240097603154961666861,
\r
3272 0.9858508222861259564792451, 0.9878297475648606089164877,
\r
3273 0.9896604887450652183192437, 0.9913427712075830869221885,
\r
3274 0.9928763426088221171435338, 0.9942609729224096649628775,
\r
3275 0.9954964544810963565926471, 0.9965826020233815404305044,
\r
3276 0.9975192527567208275634088, 0.9983062664730064440555005,
\r
3277 0.9989435258434088565550263, 0.9994309374662614082408542,
\r
3278 0.9997684374092631861048786, 0.9999560500189922307348012};
\r
3279 static double w256[] = {0.0122476716402897559040703, 0.0122458343697479201424639,
\r
3280 0.0122421601042728007697281, 0.0122366493950401581092426,
\r
3281 0.0122293030687102789041463, 0.0122201222273039691917087,
\r
3282 0.0122091082480372404075141, 0.0121962627831147135181810,
\r
3283 0.0121815877594817721740476, 0.0121650853785355020613073,
\r
3284 0.0121467581157944598155598, 0.0121266087205273210347185,
\r
3285 0.0121046402153404630977578, 0.0120808558957245446559752,
\r
3286 0.0120552593295601498143471, 0.0120278543565825711612675,
\r
3287 0.0119986450878058119345367, 0.0119676359049058937290073,
\r
3288 0.0119348314595635622558732, 0.0119002366727664897542872,
\r
3289 0.0118638567340710787319046, 0.0118256971008239777711607,
\r
3290 0.0117857634973434261816901, 0.0117440619140605503053767,
\r
3291 0.0117005986066207402881898, 0.0116553800949452421212989,
\r
3292 0.0116084131622531057220847, 0.0115597048540436357726687,
\r
3293 0.0115092624770394979585864, 0.0114570935980906391523344,
\r
3294 0.0114032060430391859648471, 0.0113476078955454919416257,
\r
3295 0.0112903074958755095083676, 0.0112313134396496685726568,
\r
3296 0.0111706345765534494627109, 0.0111082800090098436304608,
\r
3297 0.0110442590908139012635176, 0.0109785814257295706379882,
\r
3298 0.0109112568660490397007968, 0.0108422955111147959952935,
\r
3299 0.0107717077058046266366536, 0.0106995040389797856030482,
\r
3300 0.0106256953418965611339617, 0.0105502926865814815175336,
\r
3301 0.0104733073841704030035696, 0.0103947509832117289971017,
\r
3302 0.0103146352679340150682607, 0.0102329722564782196569549,
\r
3303 0.0101497741990948656546341, 0.0100650535763063833094610,
\r
3304 0.0099788230970349101247339, 0.0098910956966958286026307,
\r
3305 0.0098018845352573278254988, 0.0097112029952662799642497,
\r
3306 0.0096190646798407278571622, 0.0095254834106292848118297,
\r
3307 0.0094304732257377527473528, 0.0093340483776232697124660,
\r
3308 0.0092362233309563026873787, 0.0091370127604508064020005,
\r
3309 0.0090364315486628736802278, 0.0089344947837582075484084,
\r
3310 0.0088312177572487500253183, 0.0087266159616988071403366,
\r
3311 0.0086207050884010143053688, 0.0085135010250224906938384,
\r
3312 0.0084050198532215357561803, 0.0082952778462352254251714,
\r
3313 0.0081842914664382699356198, 0.0080720773628734995009470,
\r
3314 0.0079586523687543483536132, 0.0078440334989397118668103,
\r
3315 0.0077282379473815556311102, 0.0076112830845456594616187,
\r
3316 0.0074931864548058833585998, 0.0073739657738123464375724,
\r
3317 0.0072536389258339137838291, 0.0071322239610753900716724,
\r
3318 0.0070097390929698226212344, 0.0068862026954463203467133,
\r
3319 0.0067616333001737987809279, 0.0066360495937810650445900,
\r
3320 0.0065094704150536602678099, 0.0063819147521078805703752,
\r
3321 0.0062534017395424012720636, 0.0061239506555679325423891,
\r
3322 0.0059935809191153382211277, 0.0058623120869226530606616,
\r
3323 0.0057301638506014371773844, 0.0055971560336829100775514,
\r
3324 0.0054633085886443102775705, 0.0053286415939159303170811,
\r
3325 0.0051931752508692809303288, 0.0050569298807868423875578,
\r
3326 0.0049199259218138656695588, 0.0047821839258926913729317,
\r
3327 0.0046437245556800603139791, 0.0045045685814478970686418,
\r
3328 0.0043647368779680566815684, 0.0042242504213815362723565,
\r
3329 0.0040831302860526684085998, 0.0039413976414088336277290,
\r
3330 0.0037990737487662579981170, 0.0036561799581425021693892,
\r
3331 0.0035127377050563073309711, 0.0033687685073155510120191,
\r
3332 0.0032242939617941981570107, 0.0030793357411993375832054,
\r
3333 0.0029339155908297166460123, 0.0027880553253277068805748,
\r
3334 0.0026417768254274905641208, 0.0024951020347037068508395,
\r
3335 0.0023480529563273120170065, 0.0022006516498399104996849,
\r
3336 0.0020529202279661431745488, 0.0019048808534997184044191,
\r
3337 0.0017565557363307299936069, 0.0016079671307493272424499,
\r
3338 0.0014591373333107332010884, 0.0013100886819025044578317,
\r
3339 0.0011608435575677247239706, 0.0010114243932084404526058,
\r
3340 0.0008618537014200890378141, 0.0007121541634733206669090,
\r
3341 0.0005623489540314098028152, 0.0004124632544261763284322,
\r
3342 0.0002625349442964459062875, 0.0001127890178222721755125};
\r
3344 static double x512[] = {0.0030649621851593961529232, 0.0091947713864329108047442,
\r
3345 0.0153242350848981855249677, 0.0214531229597748745137841,
\r
3346 0.0275812047119197840615246, 0.0337082500724805951232271,
\r
3347 0.0398340288115484476830396, 0.0459583107468090617788760,
\r
3348 0.0520808657521920701127271, 0.0582014637665182372392330,
\r
3349 0.0643198748021442404045319, 0.0704358689536046871990309,
\r
3350 0.0765492164062510452915674, 0.0826596874448871596284651,
\r
3351 0.0887670524624010326092165, 0.0948710819683925428909483,
\r
3352 0.1009715465977967786264323, 0.1070682171195026611052004,
\r
3353 0.1131608644449665349442888, 0.1192492596368204011642726,
\r
3354 0.1253331739174744696875513, 0.1314123786777137080093018,
\r
3355 0.1374866454852880630171099, 0.1435557460934960331730353,
\r
3356 0.1496194524497612685217272, 0.1556775367042018762501969,
\r
3357 0.1617297712181921097989489, 0.1677759285729161198103670,
\r
3358 0.1738157815779134454985394, 0.1798491032796159253350647,
\r
3359 0.1858756669698757062678115, 0.1918952461944840310240859,
\r
3360 0.1979076147616804833961808, 0.2039125467506523717658375,
\r
3361 0.2099098165200239314947094, 0.2158991987163350271904893,
\r
3362 0.2218804682825090362529109, 0.2278534004663095955103621,
\r
3363 0.2338177708287858931763260, 0.2397733552527061887852891,
\r
3364 0.2457199299509792442100997, 0.2516572714750633493170137,
\r
3365 0.2575851567233626262808095, 0.2635033629496102970603704,
\r
3366 0.2694116677712385990250046, 0.2753098491777350342234845,
\r
3367 0.2811976855389846383013106, 0.2870749556135979555970354,
\r
3368 0.2929414385572244074855835, 0.2987969139308507415853707,
\r
3369 0.3046411617090842500066247, 0.3104739622884204453906292,
\r
3370 0.3162950964954948840736281, 0.3221043455953188263048133,
\r
3371 0.3279014912994984240551598, 0.3336863157744371275728377,
\r
3372 0.3394586016495210024715049, 0.3452181320252866497799379,
\r
3373 0.3509646904815714220351686, 0.3566980610856456291665404,
\r
3374 0.3624180284003264285948478, 0.3681243774920730946589582,
\r
3375 0.3738168939390633631820054, 0.3794953638392505477003659,
\r
3376 0.3851595738184011246011504, 0.3908093110381124851478484,
\r
3377 0.3964443632038105531190080, 0.4020645185727269675414064,
\r
3378 0.4076695659618555307670286, 0.4132592947558876229222955,
\r
3379 0.4188334949151262845483445, 0.4243919569833786700527309,
\r
3380 0.4299344720958265754056529, 0.4354608319868747443376920,
\r
3381 0.4409708289979766581310498, 0.4464642560854375149423431,
\r
3382 0.4519409068281941054521446, 0.4574005754355712925046003,
\r
3383 0.4628430567550148032795831, 0.4682681462798000434299255,
\r
3384 0.4736756401567166435172692, 0.4790653351937284489919577,
\r
3385 0.4844370288676086658851277, 0.4897905193315498753147078,
\r
3386 0.4951256054227486308513615, 0.5004420866699643537454866,
\r
3387 0.5057397633010522419821678, 0.5110184362504699101074361,
\r
3388 0.5162779071667574777562819, 0.5215179784199908258105606,
\r
3389 0.5267384531092077401231844, 0.5319391350698066637637706,
\r
3390 0.5371198288809177797701793, 0.5422803398727461474300859,
\r
3391 0.5474204741338866161668468, 0.5525400385186102421644070,
\r
3392 0.5576388406541219339368088, 0.5627166889477890541289656,
\r
3393 0.5677733925943407059267120, 0.5728087615830374335557009,
\r
3394 0.5778226067048110674604360, 0.5828147395593744458765762,
\r
3395 0.5877849725623007456415722, 0.5927331189520721562306608,
\r
3396 0.5976589927970976321572046, 0.6025624090026994600382737,
\r
3397 0.6074431833180683777981926, 0.6123011323431869846644595,
\r
3398 0.6171360735357211818019505, 0.6219478252178793846326095,
\r
3399 0.6267362065832392490988318, 0.6315010377035416553494506,
\r
3400 0.6362421395354516935575740, 0.6409593339272863978194482,
\r
3401 0.6456524436257089753330001, 0.6503212922823892793136899,
\r
3402 0.6549657044606302753737317, 0.6595855056419602523685720,
\r
3403 0.6641805222326905300017078, 0.6687505815704384167754210,
\r
3404 0.6732955119306151731807642, 0.6778151425328787363350998,
\r
3405 0.6823093035475509635996236, 0.6867778261019991540425409,
\r
3406 0.6912205422869816079558685, 0.6956372851629569859851427,
\r
3407 0.7000278887663572307915895, 0.7043921881158238155354902,
\r
3408 0.7087300192184070848475163, 0.7130412190757284553416507,
\r
3409 0.7173256256901052441189100, 0.7215830780706378951153816,
\r
3410 0.7258134162392593745610389, 0.7300164812367465082373380,
\r
3411 0.7341921151286930346516885, 0.7383401610114441496854630,
\r
3412 0.7424604630179923197192207, 0.7465528663238341416942072,
\r
3413 0.7506172171527880300329109, 0.7546533627827725118134392,
\r
3414 0.7586611515515449130726824, 0.7626404328624002206015913,
\r
3415 0.7665910571898299050923647, 0.7705128760851404930018538,
\r
3416 0.7744057421820316760079998, 0.7782695092021337484565606,
\r
3417 0.7821040319605041647237048, 0.7859091663710830099561901,
\r
3418 0.7896847694521071791947507, 0.7934306993314830614379285,
\r
3419 0.7971468152521175267628422, 0.8008329775772070161862372,
\r
3420 0.8044890477954845355235412, 0.8081148885264243560855026,
\r
3421 0.8117103635254042266412553, 0.8152753376888249026732770,
\r
3422 0.8188096770591868005536242, 0.8223132488301235858819787,
\r
3423 0.8257859213513925068443721, 0.8292275641338212850768968,
\r
3424 0.8326380478542113781512150, 0.8360172443601974294381733,
\r
3425 0.8393650266750627227522641, 0.8426812690025104608329811,
\r
3426 0.8459658467313906883792422, 0.8492186364403826820199251,
\r
3427 0.8524395159026326312771384, 0.8556283640903464362590494,
\r
3428 0.8587850611793374495058711, 0.8619094885535289911058997,
\r
3429 0.8650015288094114678982387, 0.8680610657604539292849800,
\r
3430 0.8710879844414698938880857, 0.8740821711129372830049576,
\r
3431 0.8770435132652722985416439, 0.8799718996230570848337538,
\r
3432 0.8828672201492210155023745, 0.8857293660491754482355527,
\r
3433 0.8885582297749017921351663, 0.8913537050289927340242104,
\r
3434 0.8941156867686464718706125, 0.8968440712096138052506156,
\r
3435 0.8995387558300979345474886, 0.9021996393746068223597927,
\r
3436 0.9048266218577579723776075, 0.9074196045680354827749729,
\r
3437 0.9099784900714992329623006, 0.9125031822154460643436214,
\r
3438 0.9149935861320228175302595, 0.9174496082417910902748409,
\r
3439 0.9198711562572435822074657, 0.9222581391862718942794141,
\r
3440 0.9246104673355856526489486, 0.9269280523140828285786768,
\r
3441 0.9292108070361711277546193, 0.9314586457250403242837002,
\r
3442 0.9336714839158854164789745, 0.9358492384590804834007204,
\r
3443 0.9379918275233031229867813, 0.9400991705986093544775539,
\r
3444 0.9421711884994588697201555, 0.9442078033676905198230562,
\r
3445 0.9462089386754479255274304, 0.9481745192280551015654245,
\r
3446 0.9501044711668419871894147, 0.9519987219719197769813274,
\r
3447 0.9538572004649059479887372, 0.9556798368115988811866200,
\r
3448 0.9574665625246019772327448, 0.9592173104658971684737507,
\r
3449 0.9609320148493677311718534, 0.9626106112432703039637754,
\r
3450 0.9642530365726560206402068, 0.9658592291217406674540047,
\r
3451 0.9674291285362237773389233, 0.9689626758255565756615864,
\r
3452 0.9704598133651586944555050, 0.9719204848985835745206522,
\r
3453 0.9733446355396324773464471, 0.9747322117744170315712560,
\r
3454 0.9760831614633702416830300, 0.9773974338432058899681861,
\r
3455 0.9786749795288262664309572, 0.9799157505151781656726285,
\r
3456 0.9811197001790570947322311, 0.9822867832808596419166429,
\r
3457 0.9834169559662839640681455, 0.9845101757679783590716126,
\r
3458 0.9855664016071379024692622, 0.9865855937950491429603684,
\r
3459 0.9875677140345828729848910, 0.9885127254216350200148487,
\r
3460 0.9894205924465157453777048, 0.9902912809952868962106899,
\r
3461 0.9911247583510480415528399, 0.9919209931951714500244370,
\r
3462 0.9926799556084865573546763, 0.9934016170724147657859271,
\r
3463 0.9940859504700558793702825, 0.9947329300872282225027936,
\r
3464 0.9953425316134657151476031, 0.9959147321429772566997088,
\r
3465 0.9964495101755774022837600, 0.9969468456176038804367370,
\r
3466 0.9974067197828498321611183, 0.9978291153935628466036470,
\r
3467 0.9982140165816127953876923, 0.9985614088900397275573677,
\r
3468 0.9988712792754494246541769, 0.9991436161123782382453400,
\r
3469 0.9993784092025992514480161, 0.9995756497983108555936109,
\r
3470 0.9997353306710426625827368, 0.9998574463699794385446275,
\r
3471 0.9999419946068456536361287, 0.9999889909843818679872841};
\r
3472 static double w512[] = {0.0061299051754057857591564, 0.0061296748380364986664278,
\r
3473 0.0061292141719530834395471, 0.0061285231944655327693402,
\r
3474 0.0061276019315380226384508, 0.0061264504177879366912426,
\r
3475 0.0061250686964845654506976, 0.0061234568195474804311878,
\r
3476 0.0061216148475445832082156, 0.0061195428496898295184288,
\r
3477 0.0061172409038406284754329, 0.0061147090964949169991245,
\r
3478 0.0061119475227879095684795, 0.0061089562864885234199252,
\r
3479 0.0061057354999954793256260, 0.0061022852843330780981965,
\r
3480 0.0060986057691466529805468, 0.0060946970926976980917399,
\r
3481 0.0060905594018586731119147, 0.0060861928521074844014940,
\r
3482 0.0060815976075216427620556, 0.0060767738407720980583934,
\r
3483 0.0060717217331167509334394, 0.0060664414743936418598512,
\r
3484 0.0060609332630138177841916, 0.0060551973059538766317450,
\r
3485 0.0060492338187481899521175, 0.0060430430254808039978627,
\r
3486 0.0060366251587770195404584, 0.0060299804597946507400317,
\r
3487 0.0060231091782149633972884, 0.0060160115722332929281516,
\r
3488 0.0060086879085493424136484, 0.0060011384623571610896056,
\r
3489 0.0059933635173348036527221, 0.0059853633656336707715812,
\r
3490 0.0059771383078675312031423, 0.0059686886531012259272183,
\r
3491 0.0059600147188390547233923, 0.0059511168310128456267588,
\r
3492 0.0059419953239697077107922, 0.0059326505404594676575446,
\r
3493 0.0059230828316217905872556, 0.0059132925569729856313229,
\r
3494 0.0059032800843924967444267, 0.0058930457901090792634301,
\r
3495 0.0058825900586866627324847, 0.0058719132830099005255609,
\r
3496 0.0058610158642694068093892, 0.0058498982119466814015496,
\r
3497 0.0058385607437987230901727, 0.0058270038858423319934219,
\r
3498 0.0058152280723381015486124, 0.0058032337457741007324836,
\r
3499 0.0057910213568492471257818, 0.0057785913644563714469284,
\r
3500 0.0057659442356649741911390, 0.0057530804457036750229319,
\r
3501 0.0057400004779423555815070, 0.0057267048238739963699973,
\r
3502 0.0057131939830962084110906, 0.0056994684632924603629882,
\r
3503 0.0056855287802130018011102, 0.0056713754576554833823756,
\r
3504 0.0056570090274452746202723, 0.0056424300294154800102991,
\r
3505 0.0056276390113866542566918, 0.0056126365291462173626557,
\r
3506 0.0055974231464275703576030, 0.0055819994348889124461425,
\r
3507 0.0055663659740917603747899, 0.0055505233514791708235538,
\r
3508 0.0055344721623536666407146, 0.0055182130098548677502395,
\r
3509 0.0055017465049368275723757, 0.0054850732663450758090285,
\r
3510 0.0054681939205933684565648, 0.0054511091019401459196852,
\r
3511 0.0054338194523647001109732, 0.0054163256215430514316688,
\r
3512 0.0053986282668235365401123, 0.0053807280532021078251738,
\r
3513 0.0053626256532973455128155, 0.0053443217473251833447318,
\r
3514 0.0053258170230733487787774, 0.0053071121758755186716175,
\r
3515 0.0052882079085851914147269, 0.0052691049315492765055207,
\r
3516 0.0052498039625814025460136, 0.0052303057269349446719890,
\r
3517 0.0052106109572757724261988, 0.0051907203936547190996206,
\r
3518 0.0051706347834797735752665, 0.0051503548814879957194620,
\r
3519 0.0051298814497171563759039, 0.0051092152574771030281542,
\r
3520 0.0050883570813208522065339, 0.0050673077050154097256505,
\r
3521 0.0050460679195123198490183, 0.0050246385229179444874178,
\r
3522 0.0050030203204634735477834, 0.0049812141244746675595135,
\r
3523 0.0049592207543413337151533, 0.0049370410364865364724225,
\r
3524 0.0049146758043355438745290, 0.0048921258982845107556462,
\r
3525 0.0048693921656689000083132, 0.0048464754607316430993636,
\r
3526 0.0048233766445910410307843, 0.0048000965852084069516609,
\r
3527 0.0047766361573554516370718, 0.0047529962425814130594576,
\r
3528 0.0047291777291799312876071, 0.0047051815121556699579709,
\r
3529 0.0046810084931906855725376, 0.0046566595806105458869828,
\r
3530 0.0046321356893501986622283, 0.0046074377409195920619320,
\r
3531 0.0045825666633690479877601, 0.0045575233912543896535753,
\r
3532 0.0045323088656018247089130, 0.0045069240338725852313010,
\r
3533 0.0044813698499273259161146, 0.0044556472739902818017469,
\r
3534 0.0044297572726131868769073, 0.0044037008186389549258496,
\r
3535 0.0043774788911651239762643, 0.0043510924755070657234522,
\r
3536 0.0043245425631609613132305, 0.0042978301517665448748000,
\r
3537 0.0042709562450696162035304, 0.0042439218528843240022977,
\r
3538 0.0042167279910552210986262, 0.0041893756814190930634598,
\r
3539 0.0041618659517665616659011, 0.0041341998358034646067195,
\r
3540 0.0041063783731120129818357, 0.0040784026091117279353449,
\r
3541 0.0040502735950201579699371, 0.0040219923878133783908191,
\r
3542 0.0039935600501862743674273, 0.0039649776505126091053562,
\r
3543 0.0039362462628048786290012, 0.0039073669666739546834366,
\r
3544 0.0038783408472885172720108, 0.0038491689953342783540510,
\r
3545 0.0038198525069729982349166, 0.0037903924838012961884344,
\r
3546 0.0037607900328092568594835, 0.0037310462663388340021755,
\r
3547 0.0037011623020420531166926, 0.0036711392628390145554094,
\r
3548 0.0036409782768756986764252, 0.0036106804774815746300758,
\r
3549 0.0035802470031270143713799, 0.0035496789973805134987000,
\r
3550 0.0035189776088657205261605, 0.0034881439912182762045767,
\r
3551 0.0034571793030424645127888, 0.0034260847078676769483860,
\r
3552 0.0033948613741046917538288, 0.0033635104750017697209450,
\r
3553 0.0033320331886005682236783, 0.0033004306976918751358177,
\r
3554 0.0032687041897711642972145, 0.0032368548569939741987234,
\r
3555 0.0032048838961311115627642, 0.0031727925085236815030060,
\r
3556 0.0031405819000379459532169, 0.0031082532810200120618074,
\r
3557 0.0030758078662503522550163, 0.0030432468748981576780527,
\r
3558 0.0030105715304755267298129, 0.0029777830607914904130339,
\r
3559 0.0029448826979058762279357, 0.0029118716780830123435331,
\r
3560 0.0028787512417452737868732, 0.0028455226334264723964728,
\r
3561 0.0028121871017250922921949, 0.0027787458992573726197173,
\r
3562 0.0027452002826102393336092, 0.0027115515122940877888456,
\r
3563 0.0026778008526954179163600, 0.0026439495720293237639656,
\r
3564 0.0026099989422918391896635, 0.0025759502392121415000167,
\r
3565 0.0025418047422046148318992, 0.0025075637343207750815413,
\r
3566 0.0024732285022010581903898, 0.0024388003360264736029032,
\r
3567 0.0024042805294701247170072, 0.0023696703796485981535706,
\r
3568 0.0023349711870732236769383, 0.0023001842556012066042973,
\r
3569 0.0022653108923866345474810, 0.0022303524078313603367724,
\r
3570 0.0021953101155357629823745, 0.0021601853322493885355395,
\r
3571 0.0021249793778214727179358, 0.0020896935751513471947536,
\r
3572 0.0020543292501387313744068, 0.0020188877316339116255770,
\r
3573 0.0019833703513878098109153, 0.0019477784440019430461334,
\r
3574 0.0019121133468782766036998, 0.0018763764001689718921795,
\r
3575 0.0018405689467260314557679, 0.0018046923320508429542037,
\r
3576 0.0017687479042436241015783, 0.0017327370139527705642995,
\r
3577 0.0016966610143241088445575, 0.0016605212609500562072903,
\r
3578 0.0016243191118186897474239, 0.0015880559272627267421479,
\r
3579 0.0015517330699084184928942, 0.0015153519046243599371387,
\r
3580 0.0014789137984702174059640, 0.0014424201206453770259886,
\r
3581 0.0014058722424375164225552, 0.0013692715371711025869345,
\r
3582 0.0013326193801558190401403, 0.0012959171486349257824991,
\r
3583 0.0012591662217335559930561, 0.0012223679804069540808915,
\r
3584 0.0011855238073886605549070, 0.0011486350871386503607080,
\r
3585 0.0011117032057914329649653, 0.0010747295511041247428251,
\r
3586 0.0010377155124045074300544, 0.0010006624805390909706032,
\r
3587 0.0009635718478212056798501, 0.0009264450079791582697455,
\r
3588 0.0008892833561045005372012, 0.0008520882886004809402792,
\r
3589 0.0008148612031307819965602, 0.0007776034985686972438014,
\r
3590 0.0007403165749469818962867, 0.0007030018334087411433900,
\r
3591 0.0006656606761599343409382, 0.0006282945064244358390880,
\r
3592 0.0005909047284032230162400, 0.0005534927472403894647847,
\r
3593 0.0005160599690007674370993, 0.0004786078006679509066920,
\r
3594 0.0004411376501795405636493, 0.0004036509265333198797447,
\r
3595 0.0003661490400356268530141, 0.0003286334028523334162522,
\r
3596 0.0002911054302514885125319, 0.0002535665435705865135866,
\r
3597 0.0002160181779769908583388, 0.0001784618055459532946077,
\r
3598 0.0001408990173881984930124, 0.0001033319034969132362968,
\r
3599 0.0000657657316592401958310, 0.0000282526373739346920387};
\r
3601 static double x1024[] = {0.0015332313560626384065387, 0.0045996796509132604743248,
\r
3602 0.0076660846940754867627839, 0.0107324176515422803327458,
\r
3603 0.0137986496899844401539048, 0.0168647519770217265449962,
\r
3604 0.0199306956814939776907024, 0.0229964519737322146859283,
\r
3605 0.0260619920258297325581921, 0.0291272870119131747190088,
\r
3606 0.0321923081084135882953009, 0.0352570264943374577920498,
\r
3607 0.0383214133515377145376052, 0.0413854398649847193632977,
\r
3608 0.0444490772230372159692514, 0.0475122966177132524285687,
\r
3609 0.0505750692449610682823599, 0.0536373663049299446784129,
\r
3610 0.0566991590022410150066456, 0.0597604185462580334848567,
\r
3611 0.0628211161513580991486838, 0.0658812230372023327000985,
\r
3612 0.0689407104290065036692117, 0.0719995495578116053446277,
\r
3613 0.0750577116607543749280791, 0.0781151679813377563695878,
\r
3614 0.0811718897697013033399379, 0.0842278482828915197978074,
\r
3615 0.0872830147851321356094940, 0.0903373605480943146797811,
\r
3616 0.0933908568511667930531222, 0.0964434749817259444449839,
\r
3617 0.0994951862354057706638682, 0.1025459619163678143852404,
\r
3618 0.1055957733375709917393206, 0.1086445918210413421754502,
\r
3619 0.1116923886981416930665228, 0.1147391353098412365177689,
\r
3620 0.1177848030069850158450139, 0.1208293631505633191883714,
\r
3621 0.1238727871119809777282145, 0.1269150462733265659711591,
\r
3622 0.1299561120276415015747167, 0.1329959557791890421802183,
\r
3623 0.1360345489437231767245806, 0.1390718629487574087024745,
\r
3624 0.1421078692338334288514767, 0.1451425392507896747338214,
\r
3625 0.1481758444640297746894331, 0.1512077563507908736360111,
\r
3626 0.1542382464014118381930443, 0.1572672861196013386077717,
\r
3627 0.1602948470227058049622614, 0.1633209006419772551419632,
\r
3628 0.1663454185228409920472972, 0.1693683722251631675310675,
\r
3629 0.1723897333235182105457458, 0.1754094734074561169859457,
\r
3630 0.1784275640817695987127083, 0.1814439769667610892475458,
\r
3631 0.1844586836985096036255346, 0.1874716559291374498981239,
\r
3632 0.1904828653270767897777182, 0.1934922835773360459175133,
\r
3633 0.1964998823817661533215037, 0.1995056334593266523810493,
\r
3634 0.2025095085463516210358758, 0.2055114793968154435588961,
\r
3635 0.2085115177825984134657778, 0.2115095954937521680517391,
\r
3636 0.2145056843387649520596422, 0.2174997561448267079850562,
\r
3637 0.2204917827580939905255947, 0.2234817360439547026834844,
\r
3638 0.2264695878872926510320010, 0.2294553101927519176581055,
\r
3639 0.2324388748850010462953415, 0.2354202539089970401627982,
\r
3640 0.2383994192302491690277166, 0.2413763428350825830111093,
\r
3641 0.2443509967309017306575811, 0.2473233529464535787923793,
\r
3642 0.2502933835320906316905658, 0.2532610605600337470850902,
\r
3643 0.2562263561246347465424530, 0.2591892423426388177365829,
\r
3644 0.2621496913534467061535080, 0.2651076753193766937613805,
\r
3645 0.2680631664259263621824189, 0.2710161368820341379053566,
\r
3646 0.2739665589203406170790369, 0.2769144047974496674298651,
\r
3647 0.2798596467941893048479266, 0.2828022572158723421886958,
\r
3648 0.2857422083925568078394062, 0.2886794726793061316013119,
\r
3649 0.2916140224564490954412652, 0.2945458301298395466682397,
\r
3650 0.2974748681311158710926665, 0.3004011089179602237287060,
\r
3651 0.3033245249743575146018584, 0.3062450888108541472266190,
\r
3652 0.3091627729648165073212094, 0.3120775500006891993287636,
\r
3653 0.3149893925102530283167230, 0.3178982731128827248285835,
\r
3654 0.3208041644558044102645582, 0.3237070392143528003701590,
\r
3655 0.3266068700922281444141618, 0.3295036298217528976399056,
\r
3656 0.3323972911641281245763845, 0.3352878269096896307981228,
\r
3657 0.3381752098781638207253743, 0.3410594129189232790587667,
\r
3658 0.3439404089112420734451077, 0.3468181707645507759736923,
\r
3659 0.3496926714186912011050938, 0.3525638838441708576370887,
\r
3660 0.3554317810424171123150528, 0.3582963360460310626968790,
\r
3661 0.3611575219190411168852009, 0.3640153117571562777424605,
\r
3662 0.3668696786880191292071420, 0.3697205958714585223322883,
\r
3663 0.3725680364997419586702471, 0.3754119737978276686304337,
\r
3664 0.3782523810236163824397703, 0.3810892314682027913383487,
\r
3665 0.3839224984561266966457784, 0.3867521553456238443366159,
\r
3666 0.3895781755288764427662286, 0.3924005324322633611914264,
\r
3667 0.3952191995166100067331951, 0.3980341502774378774318886,
\r
3668 0.4008453582452137890482864, 0.4036527969855987732669841,
\r
3669 0.4064564400996966449616823, 0.4092562612243022361850445,
\r
3670 0.4120522340321492945489319, 0.4148443322321580436639788,
\r
3671 0.4176325295696824033106488, 0.4204167998267568670171117,
\r
3672 0.4231971168223430347225035, 0.4259734544125757982073747,
\r
3673 0.4287457864910091769763965, 0.4315140869888618022816824,
\r
3674 0.4342783298752620469783905, 0.4370384891574927989076034,
\r
3675 0.4397945388812358755048319, 0.4425464531308160773358662,
\r
3676 0.4452942060294448782650898, 0.4480377717394637499647905,
\r
3677 0.4507771244625871184774399, 0.4535122384401449505463744,
\r
3678 0.4562430879533249674337895, 0.4589696473234144839484647,
\r
3679 0.4616918909120418704091584, 0.4644097931214176352731591,
\r
3680 0.4671233283945751261630457, 0.4698324712156108470282980,
\r
3681 0.4725371961099243891820077, 0.4752374776444579739565725,
\r
3682 0.4779332904279356047259052, 0.4806246091111018260453658,
\r
3683 0.4833114083869600876643171, 0.4859936629910107111699206,
\r
3684 0.4886713477014884570245255, 0.4913444373395996897627612,
\r
3685 0.4940129067697591391182235, 0.4966767308998262548534419,
\r
3686 0.4993358846813411530706387, 0.5019903431097601517846292,
\r
3687 0.5046400812246908935430768, 0.5072850741101270528831987,
\r
3688 0.5099252968946826264179220, 0.5125607247518258033484145,
\r
3689 0.5151913329001124142038603, 0.5178170966034189556133159,
\r
3690 0.5204379911711751889184691, 0.5230539919585963104401304,
\r
3691 0.5256650743669146912153147, 0.5282712138436111840258187,
\r
3692 0.5308723858826459955432696, 0.5334685660246891214197081,
\r
3693 0.5360597298573503421568799, 0.5386458530154087775915395,
\r
3694 0.5412269111810419978382210, 0.5438028800840546885350993,
\r
3695 0.5463737355021068682427603, 0.5489394532609416558499039,
\r
3696 0.5515000092346125858442412, 0.5540553793457104693110943,
\r
3697 0.5566055395655897985264809, 0.5591504659145946930157566,
\r
3698 0.5616901344622843849532002, 0.5642245213276582417822586,
\r
3699 0.5667536026793803239405196, 0.5692773547360034755778519,
\r
3700 0.5717957537661929461605442, 0.5743087760889495408586850,
\r
3701 0.5768163980738322976184566, 0.5793185961411806888254667,
\r
3702 0.5818153467623363454697137, 0.5843066264598643017272666,
\r
3703 0.5867924118077737578782574, 0.5892726794317383594853053,
\r
3704 0.5917474060093159907610475, 0.5942165682701680800580147,
\r
3705 0.5966801429962784154186793, 0.5991381070221714681281111,
\r
3706 0.6015904372351302222163013, 0.6040371105754135078618616,
\r
3707 0.6064781040364728366534687, 0.6089133946651687366701116,
\r
3708 0.6113429595619865853458987, 0.6137667758812519380899084,
\r
3709 0.6161848208313453506363029, 0.6185970716749166931046915,
\r
3710 0.6210035057290989537555048, 0.6234041003657215304299416,
\r
3711 0.6257988330115230076688675, 0.6281876811483634175098794,
\r
3712 0.6305706223134359819666081, 0.6329476340994783351992008,
\r
3713 0.6353186941549832233898213, 0.6376837801844086803419153,
\r
3714 0.6400428699483876768269192, 0.6423959412639372417070377,
\r
3715 0.6447429720046670528676835, 0.6470839401009874959981582,
\r
3716 0.6494188235403171892641570, 0.6517476003672899719207013,
\r
3717 0.6540702486839613549191454, 0.6563867466500144315669620,
\r
3718 0.6586970724829652463040876, 0.6610012044583676196647058,
\r
3719 0.6632991209100174274984589, 0.6655908002301563325302097,
\r
3720 0.6678762208696749663426270, 0.6701553613383155598710345,
\r
3721 0.6724282002048740205051479, 0.6746947160974014538975312,
\r
3722 0.6769548877034051285838219, 0.6792086937700488815250166,
\r
3723 0.6814561131043529626873631, 0.6836971245733933167806834,
\r
3724 0.6859317071045003002812397, 0.6881598396854568318705713,
\r
3725 0.6903815013646959744270519, 0.6925966712514979467122689,
\r
3726 0.6948053285161865628996815, 0.6970074523903250980984011,
\r
3727 0.6992030221669115780303307, 0.7013920172005734910243170,
\r
3728 0.7035744169077619204963997, 0.7057502007669450960906928,
\r
3729 0.7079193483188013616608982, 0.7100818391664115582779368,
\r
3730 0.7122376529754508204546805, 0.7143867694743797837842896,
\r
3731 0.7165291684546352021941915, 0.7186648297708199730232898,
\r
3732 0.7207937333408925681355609, 0.7229158591463558692887801,
\r
3733 0.7250311872324454059827217, 0.7271396977083169940167956,
\r
3734 0.7292413707472337729927181, 0.7313361865867526410034676,
\r
3735 0.7334241255289100847554419, 0.7355051679404074033764222,
\r
3736 0.7375792942527953241676460, 0.7396464849626580085640129,
\r
3737 0.7417067206317964465721772, 0.7437599818874112379620360,
\r
3738 0.7458062494222847584928838, 0.7478455039949627094612890,
\r
3739 0.7498777264299350488635483, 0.7519028976178163024713854,
\r
3740 0.7539209985155252531253957, 0.7559320101464640065565832,
\r
3741 0.7579359136006964320521972, 0.7599326900351259762879594,
\r
3742 0.7619223206736728486546595, 0.7639047868074505764130149,
\r
3743 0.7658800697949419280166093, 0.7678481510621742029486694,
\r
3744 0.7698090121028938864243967, 0.7717626344787406673165402,
\r
3745 0.7737089998194208176678866, 0.7756480898228799321603470,
\r
3746 0.7775798862554750259163361, 0.7795043709521459890141759,
\r
3747 0.7814215258165863961053031, 0.7833313328214136695271245,
\r
3748 0.7852337740083385943114429, 0.7871288314883341834944720,
\r
3749 0.7890164874418038921405657, 0.7908967241187491784979139,
\r
3750 0.7927695238389364107105941, 0.7946348689920631175175217,
\r
3751 0.7964927420379235813750136, 0.7983431255065737724458586,
\r
3752 0.8001860019984956219039900, 0.8020213541847606330100649,
\r
3753 0.8038491648071928284194859, 0.8056694166785310321906380,
\r
3754 0.8074820926825904849673728, 0.8092871757744237908160400,
\r
3755 0.8110846489804811942036542, 0.8128744953987701856100790,
\r
3756 0.8146566981990144342734272, 0.8164312406228120465742028,
\r
3757 0.8181981059837931485700490, 0.8199572776677767911993239,
\r
3758 0.8217087391329271766780945, 0.8234524739099092046215225,
\r
3759 0.8251884656020433364270094, 0.8269166978854597764628854,
\r
3760 0.8286371545092519686128428, 0.8303498192956294067327593,
\r
3761 0.8320546761400697575830038, 0.8337517090114702948057846,
\r
3762 0.8354409019522986425235764, 0.8371222390787428271411563,
\r
3763 0.8387957045808606359402829, 0.8404612827227282810625704,
\r
3764 0.8421189578425883674826439, 0.8437687143529971635802028,
\r
3765 0.8454105367409711729261812, 0.8470444095681330059047621,
\r
3766 0.8486703174708565497995875, 0.8502882451604114359791023,
\r
3767 0.8518981774231068028225812, 0.8535000991204343530350070,
\r
3768 0.8550939951892107040056078, 0.8566798506417190298715048,
\r
3769 0.8582576505658499939545848, 0.8598273801252419702463831,
\r
3770 0.8613890245594205526224495, 0.8629425691839373504743648,
\r
3771 0.8644879993905080694542896, 0.8660253006471498760336444,
\r
3772 0.8675544584983180445842596, 0.8690754585650418856970762,
\r
3773 0.8705882865450599544602407, 0.8720929282129545374252050,
\r
3774 0.8735893694202854169962281, 0.8750775960957229119854680,
\r
3775 0.8765575942451801930826613, 0.8780293499519448719952049,
\r
3776 0.8794928493768098630212838, 0.8809480787582035158255322,
\r
3777 0.8823950244123190181935674, 0.8838336727332430675485994,
\r
3778 0.8852640101930838100201983, 0.8866860233420980458621863,
\r
3779 0.8880996988088177000235219, 0.8895050233001755566829532,
\r
3780 0.8909019836016302565651375, 0.8922905665772905558628607,
\r
3781 0.8936707591700388455969280, 0.8950425484016539302522575,
\r
3782 0.8964059213729330645356690, 0.8977608652638132471078410,
\r
3783 0.8991073673334917701488930, 0.9004454149205460236240486,
\r
3784 0.9017749954430525531228459, 0.9030960963987053701523781,
\r
3785 0.9044087053649335137720782, 0.9057128099990178624646022,
\r
3786 0.9070083980382071951444166, 0.9082954572998335002127549,
\r
3787 0.9095739756814265315746820, 0.9108439411608276105410847,
\r
3788 0.9121053417963026725455006, 0.9133581657266545576127977,
\r
3789 0.9146024011713345435238301, 0.9158380364305531206273175,
\r
3790 0.9170650598853900072573273, 0.9182834599979034047218800,
\r
3791 0.9194932253112384908353520, 0.9206943444497351509745089,
\r
3792 0.9218868061190349456451742, 0.9230705991061873135537215,
\r
3793 0.9242457122797550091847637, 0.9254121345899187738936182,
\r
3794 0.9265698550685812395293315, 0.9277188628294700636112689,
\r
3795 0.9288591470682402950895005, 0.9299906970625759697264543,
\r
3796 0.9311135021722909341445515, 0.9322275518394288975917975,
\r
3797 0.9333328355883627104845635, 0.9344293430258928687940732,
\r
3798 0.9355170638413452433503852, 0.9365959878066680331449597,
\r
3799 0.9376661047765279417201973, 0.9387274046884055757416456,
\r
3800 0.9397798775626900648558921, 0.9408235135027729019444869,
\r
3801 0.9418583026951410028915762, 0.9428842354094689849902736,
\r
3802 0.9439013019987106631201510, 0.9449094928991897628355911,
\r
3803 0.9459087986306898495121205, 0.9468992097965434727052183,
\r
3804 0.9478807170837205248834878, 0.9488533112629158137054760,
\r
3805 0.9498169831886358470168335, 0.9507717237992848297519245,
\r
3806 0.9517175241172498719314184, 0.9526543752489854069548347,
\r
3807 0.9535822683850968193944507, 0.9545011948004232815044368,
\r
3808 0.9554111458541197976665483, 0.9563121129897384560011695,
\r
3809 0.9572040877353088863799924, 0.9580870617034179240840996,
\r
3810 0.9589610265912884783587268, 0.9598259741808576051234879,
\r
3811 0.9606818963388537831043733, 0.9615287850168733926613630,
\r
3812 0.9623666322514563965930439, 0.9631954301641612222071790,
\r
3813 0.9640151709616388439537466, 0.9648258469357060659245549,
\r
3814 0.9656274504634180035311332, 0.9664199740071397636802195,
\r
3815 0.9672034101146173227737943, 0.9679777514190476018682591,
\r
3816 0.9687429906391477383350273, 0.9694991205792235533724866,
\r
3817 0.9702461341292372147270016, 0.9709840242648740939883669,
\r
3818 0.9717127840476088178328839, 0.9724324066247705125950353,
\r
3819 0.9731428852296072415565604, 0.9738442131813496343496072,
\r
3820 0.9745363838852737078785517, 0.9752193908327628781730396,
\r
3821 0.9758932276013691625928266, 0.9765578878548735718130775,
\r
3822 0.9772133653433456910269459, 0.9778596539032024498104955,
\r
3823 0.9784967474572660801033674, 0.9791246400148212617670490,
\r
3824 0.9797433256716714551911835, 0.9803527986101944204270933,
\r
3825 0.9809530530993969223366037, 0.9815440834949686212533729,
\r
3826 0.9821258842393351486632952, 0.9826984498617103674201996,
\r
3827 0.9832617749781478160230522, 0.9838158542915913364912672,
\r
3828 0.9843606825919248853856025, 0.9848962547560215275335618,
\r
3829 0.9854225657477916120303537, 0.9859396106182301300994116,
\r
3830 0.9864473845054632544104222, 0.9869458826347940594679517,
\r
3831 0.9874351003187474227003598, 0.9879150329571141058970610,
\r
3832 0.9883856760369940166627304, 0.9888470251328386495802522,
\r
3833 0.9892990759064927068006818, 0.9897418241072348978090276,
\r
3834 0.9901752655718179181502248, 0.9905993962245076069415402,
\r
3835 0.9910142120771212830473891, 0.9914197092290652598522332,
\r
3836 0.9918158838673715386394944, 0.9922027322667336806727008,
\r
3837 0.9925802507895418581838653, 0.9929484358859170846092543,
\r
3838 0.9933072840937446245820355, 0.9936567920387065844051246,
\r
3839 0.9939969564343136839997662, 0.9943277740819362116746914,
\r
3840 0.9946492418708341635125525, 0.9949613567781865697596566,
\r
3841 0.9952641158691200113800912, 0.9955575162967363309635588,
\r
3842 0.9958415553021395435525955, 0.9961162302144619548145649,
\r
3843 0.9963815384508894965215124, 0.9966374775166862927999356,
\r
3844 0.9968840450052184754903082, 0.9971212385979772738362093,
\r
3845 0.9973490560646014135491635, 0.9975674952628988745188845,
\r
3846 0.9977765541388680773265018, 0.9979762307267185998745420,
\r
3847 0.9981665231488915727109186, 0.9983474296160799746514418,
\r
3848 0.9985189484272491654281575, 0.9986810779696581776171579,
\r
3849 0.9988338167188825964389443, 0.9989771632388403756649803,
\r
3850 0.9991111161818228462260355, 0.9992356742885348165163858,
\r
3851 0.9993508363881507486653971, 0.9994566013984000492749057,
\r
3852 0.9995529683257070064969677, 0.9996399362654382464576482,
\r
3853 0.9997175044023747284307007, 0.9997856720116889628341744,
\r
3854 0.9998444384611711916084367, 0.9998938032169419878731474,
\r
3855 0.9999337658606177711221103, 0.9999643261538894550943330,
\r
3856 0.9999854843850284447675914, 0.9999972450545584403516182};
\r
3857 static double w1024[] = {0.0030664603092439082115513, 0.0030664314747171934849726,
\r
3858 0.0030663738059349007324470, 0.0030662873034393008056861,
\r
3859 0.0030661719680437936084028, 0.0030660278008329004477528,
\r
3860 0.0030658548031622538363679, 0.0030656529766585847450783,
\r
3861 0.0030654223232197073064431, 0.0030651628450145009692318,
\r
3862 0.0030648745444828901040266, 0.0030645574243358210601357,
\r
3863 0.0030642114875552366740338, 0.0030638367373940482295700,
\r
3864 0.0030634331773761048702058, 0.0030630008112961604635720,
\r
3865 0.0030625396432198379186545, 0.0030620496774835909559465,
\r
3866 0.0030615309186946633309249, 0.0030609833717310455112352,
\r
3867 0.0030604070417414288079918, 0.0030598019341451569616257,
\r
3868 0.0030591680546321751827342, 0.0030585054091629766484119,
\r
3869 0.0030578140039685464545661, 0.0030570938455503030247440,
\r
3870 0.0030563449406800369760227, 0.0030555672963998474425352,
\r
3871 0.0030547609200220758572342, 0.0030539258191292371925135,
\r
3872 0.0030530620015739486603347, 0.0030521694754788558725307,
\r
3873 0.0030512482492365564619779, 0.0030502983315095211653578,
\r
3874 0.0030493197312300123682482, 0.0030483124576000001133114,
\r
3875 0.0030472765200910755723677, 0.0030462119284443619831693,
\r
3876 0.0030451186926704230517109, 0.0030439968230491688209395,
\r
3877 0.0030428463301297590067471, 0.0030416672247305038021562,
\r
3878 0.0030404595179387621506312, 0.0030392232211108374894710,
\r
3879 0.0030379583458718709642643, 0.0030366649041157321154111,
\r
3880 0.0030353429080049070377385, 0.0030339923699703840142628,
\r
3881 0.0030326133027115366251721, 0.0030312057191960043331307,
\r
3882 0.0030297696326595705460252, 0.0030283050566060381583022,
\r
3883 0.0030268120048071025720655, 0.0030252904913022221991274,
\r
3884 0.0030237405303984864452325, 0.0030221621366704811776946,
\r
3885 0.0030205553249601516777118, 0.0030189201103766630786495,
\r
3886 0.0030172565082962582916016, 0.0030155645343621134195681,
\r
3887 0.0030138442044841906616068, 0.0030120955348390887083441,
\r
3888 0.0030103185418698906302495, 0.0030085132422860092601062,
\r
3889 0.0030066796530630300711306, 0.0030048177914425515522176,
\r
3890 0.0030029276749320230818149, 0.0030010093213045803019478,
\r
3891 0.0029990627485988779939449, 0.0029970879751189204574353,
\r
3892 0.0029950850194338893942123, 0.0029930539003779692985814,
\r
3893 0.0029909946370501703558363, 0.0029889072488141488505262,
\r
3894 0.0029867917552980250862041, 0.0029846481763941988183689,
\r
3895 0.0029824765322591622023349, 0.0029802768433133102577897,
\r
3896 0.0029780491302407488518214, 0.0029757934139891002022209,
\r
3897 0.0029735097157693059028890, 0.0029711980570554274731990,
\r
3898 0.0029688584595844444331918, 0.0029664909453560499065010,
\r
3899 0.0029640955366324437529314, 0.0029616722559381232326340,
\r
3900 0.0029592211260596712038487, 0.0029567421700455418562030,
\r
3901 0.0029542354112058439815854, 0.0029517008731121217846274,
\r
3902 0.0029491385795971332348581, 0.0029465485547546259626151,
\r
3903 0.0029439308229391107008170, 0.0029412854087656322747309,
\r
3904 0.0029386123371095381418860, 0.0029359116331062444843108,
\r
3905 0.0029331833221509998552933, 0.0029304274298986463828860,
\r
3906 0.0029276439822633785324025, 0.0029248330054184994301727,
\r
3907 0.0029219945257961747508486, 0.0029191285700871841705750,
\r
3908 0.0029162351652406703883623, 0.0029133143384638857180205,
\r
3909 0.0029103661172219362530391, 0.0029073905292375236068160,
\r
3910 0.0029043876024906842306667, 0.0029013573652185263120627,
\r
3911 0.0028982998459149642555740, 0.0028952150733304507490135,
\r
3912 0.0028921030764717064173001, 0.0028889638846014470665859,
\r
3913 0.0028857975272381085212091, 0.0028826040341555690560623,
\r
3914 0.0028793834353828694269858, 0.0028761357612039305018167,
\r
3915 0.0028728610421572684947521, 0.0028695593090357078067012,
\r
3916 0.0028662305928860914743281, 0.0028628749250089892305081,
\r
3917 0.0028594923369584031789413, 0.0028560828605414710856927,
\r
3918 0.0028526465278181672904478, 0.0028491833711010012402964,
\r
3919 0.0028456934229547136488796, 0.0028421767161959702837564,
\r
3920 0.0028386332838930533848701, 0.0028350631593655507170153,
\r
3921 0.0028314663761840422592303, 0.0028278429681697845340603,
\r
3922 0.0028241929693943925796601, 0.0028205164141795195677262,
\r
3923 0.0028168133370965340702726, 0.0028130837729661949782821,
\r
3924 0.0028093277568583240752928, 0.0028055453240914762689974,
\r
3925 0.0028017365102326074839556, 0.0027979013510967402185435,
\r
3926 0.0027940398827466267692845, 0.0027901521414924101257281,
\r
3927 0.0027862381638912825390663, 0.0027822979867471417676962,
\r
3928 0.0027783316471102450029635, 0.0027743391822768604783394,
\r
3929 0.0027703206297889167653083, 0.0027662760274336497592617,
\r
3930 0.0027622054132432473587211, 0.0027581088254944918412282,
\r
3931 0.0027539863027083999392661, 0.0027498378836498606195970,
\r
3932 0.0027456636073272705694208, 0.0027414635129921673927833,
\r
3933 0.0027372376401388605206822, 0.0027329860285040598383428,
\r
3934 0.0027287087180665020331547, 0.0027244057490465746667821,
\r
3935 0.0027200771619059379749851, 0.0027157229973471443987056,
\r
3936 0.0027113432963132558499974, 0.0027069380999874587163979,
\r
3937 0.0027025074497926766073634, 0.0026980513873911808464073,
\r
3938 0.0026935699546841987126055, 0.0026890631938115194351518,
\r
3939 0.0026845311471510979446691, 0.0026799738573186563850015,
\r
3940 0.0026753913671672833892344, 0.0026707837197870311237119,
\r
3941 0.0026661509585045101038391, 0.0026614931268824817854798,
\r
3942 0.0026568102687194489357814, 0.0026521024280492437872770,
\r
3943 0.0026473696491406139791397, 0.0026426119764968062894804,
\r
3944 0.0026378294548551481626046, 0.0026330221291866270351630,
\r
3945 0.0026281900446954674651512, 0.0026233332468187060677353,
\r
3946 0.0026184517812257642618999, 0.0026135456938180188319369,
\r
3947 0.0026086150307283703078113, 0.0026036598383208091684657,
\r
3948 0.0025986801631899798721388, 0.0025936760521607427178014,
\r
3949 0.0025886475522877335418257, 0.0025835947108549212540321,
\r
3950 0.0025785175753751632172710, 0.0025734161935897584747222,
\r
3951 0.0025682906134679988291122, 0.0025631408832067177780710,
\r
3952 0.0025579670512298373098703, 0.0025527691661879125638030,
\r
3953 0.0025475472769576743594882, 0.0025423014326415695994010,
\r
3954 0.0025370316825672995489502, 0.0025317380762873559984451,
\r
3955 0.0025264206635785553113127, 0.0025210794944415703629476,
\r
3956 0.0025157146191004603745948, 0.0025103260880021986466869,
\r
3957 0.0025049139518161981960773, 0.0024994782614338353016280,
\r
3958 0.0024940190679679709626349, 0.0024885364227524702745874,
\r
3959 0.0024830303773417197267843, 0.0024775009835101424263432,
\r
3960 0.0024719482932517112531633, 0.0024663723587794599504176,
\r
3961 0.0024607732325249921551741, 0.0024551509671379883737605,
\r
3962 0.0024495056154857109065099, 0.0024438372306525067265426,
\r
3963 0.0024381458659393083172574, 0.0024324315748631324732279,
\r
3964 0.0024266944111565770692147, 0.0024209344287673158020275,
\r
3965 0.0024151516818575909099866, 0.0024093462248037038747545,
\r
3966 0.0024035181121955041103265, 0.0023976673988358756439882,
\r
3967 0.0023917941397402217940673, 0.0023858983901359478493246,
\r
3968 0.0023799802054619417548485, 0.0023740396413680528093376,
\r
3969 0.0023680767537145683786720, 0.0023620915985716886306938,
\r
3970 0.0023560842322189992961374, 0.0023500547111449424606655,
\r
3971 0.0023440030920462853929883, 0.0023379294318275874140606,
\r
3972 0.0023318337876006648123684, 0.0023257162166840538103394,
\r
3973 0.0023195767766024715869239, 0.0023134155250862753614165,
\r
3974 0.0023072325200709195436049, 0.0023010278196964109553481,
\r
3975 0.0022948014823067621287099, 0.0022885535664494426857857,
\r
3976 0.0022822841308748288053830, 0.0022759932345356507817318,
\r
3977 0.0022696809365864386804193, 0.0022633472963829660967620,
\r
3978 0.0022569923734816920218464, 0.0022506162276392008214839,
\r
3979 0.0022442189188116403333494, 0.0022378005071541580875846,
\r
3980 0.0022313610530203356561684, 0.0022249006169616211363732,
\r
3981 0.0022184192597267597736437, 0.0022119170422612227292520,
\r
3982 0.0022053940257066339981005, 0.0021988502714001954820607,
\r
3983 0.0021922858408741102242558, 0.0021857007958550038097087,
\r
3984 0.0021790951982633439377969, 0.0021724691102128581719720,
\r
3985 0.0021658225940099498722195, 0.0021591557121531123157498,
\r
3986 0.0021524685273323410114303, 0.0021457611024285442134846,
\r
3987 0.0021390335005129516400021, 0.0021322857848465214018174,
\r
3988 0.0021255180188793451473363, 0.0021187302662500514289029,
\r
3989 0.0021119225907852072963166, 0.0021050950564987181231273,
\r
3990 0.0020982477275912256713511, 0.0020913806684495044002679,
\r
3991 0.0020844939436458560249764, 0.0020775876179375023304007,
\r
3992 0.0020706617562659762464561, 0.0020637164237565111901030,
\r
3993 0.0020567516857174286800274, 0.0020497676076395242297101,
\r
3994 0.0020427642551954515246552, 0.0020357416942391048895728,
\r
3995 0.0020286999908050000513193, 0.0020216392111076532034194,
\r
3996 0.0020145594215409583780096, 0.0020074606886775631310555,
\r
3997 0.0020003430792682425467160, 0.0019932066602412715667394,
\r
3998 0.0019860514987017956507927, 0.0019788776619311997736447,
\r
3999 0.0019716852173864757651327, 0.0019644742326995879988655,
\r
4000 0.0019572447756768374356240, 0.0019499969142982240274419,
\r
4001 0.0019427307167168074883601, 0.0019354462512580664378677,
\r
4002 0.0019281435864192559230531, 0.0019208227908687633255086,
\r
4003 0.0019134839334454626590447, 0.0019061270831580672642844,
\r
4004 0.0018987523091844809062265, 0.0018913596808711472808775,
\r
4005 0.0018839492677323979370705, 0.0018765211394497986196010,
\r
4006 0.0018690753658714940398285, 0.0018616120170115510799024,
\r
4007 0.0018541311630493004367905, 0.0018466328743286767122991,
\r
4008 0.0018391172213575569552912, 0.0018315842748070976623218,
\r
4009 0.0018240341055110702429247, 0.0018164667844651949558009,
\r
4010 0.0018088823828264733221690, 0.0018012809719125190225581,
\r
4011 0.0017936626232008872833327, 0.0017860274083284027592567,
\r
4012 0.0017783753990904859184165, 0.0017707066674404779358362,
\r
4013 0.0017630212854889641021349, 0.0017553193255030957535871,
\r
4014 0.0017476008599059107299616, 0.0017398659612756523665312,
\r
4015 0.0017321147023450870266539, 0.0017243471560008201813452,
\r
4016 0.0017165633952826110422716, 0.0017087634933826857546100,
\r
4017 0.0017009475236450491562317, 0.0016931155595647951096823,
\r
4018 0.0016852676747874154134422, 0.0016774039431081072989678,
\r
4019 0.0016695244384710795200224, 0.0016616292349688570408253,
\r
4020 0.0016537184068415843295541, 0.0016457920284763272637533,
\r
4021 0.0016378501744063736542136, 0.0016298929193105323938983,
\r
4022 0.0016219203380124312385075, 0.0016139325054798132252838,
\r
4023 0.0016059294968238317366751, 0.0015979113872983442154825,
\r
4024 0.0015898782522992045381361, 0.0015818301673635540527516,
\r
4025 0.0015737672081691112886347, 0.0015656894505334603439125,
\r
4026 0.0015575969704133379579831, 0.0015494898439039192754876,
\r
4027 0.0015413681472381023085203, 0.0015332319567857911038062,
\r
4028 0.0015250813490531776215856, 0.0015169164006820223329593,
\r
4029 0.0015087371884489335424584, 0.0015005437892646454426166,
\r
4030 0.0014923362801732949073323, 0.0014841147383516970308228,
\r
4031 0.0014758792411086194189814, 0.0014676298658840552399621,
\r
4032 0.0014593666902484950408286, 0.0014510897919021973371136,
\r
4033 0.0014427992486744579821480, 0.0014344951385228783230315,
\r
4034 0.0014261775395326321501237, 0.0014178465299157314469528,
\r
4035 0.0014095021880102909474427, 0.0014011445922797915073771,
\r
4036 0.0013927738213123422970256, 0.0013843899538199418218713,
\r
4037 0.0013759930686377377783877, 0.0013675832447232857518263,
\r
4038 0.0013591605611558067629844, 0.0013507250971354436709363,
\r
4039 0.0013422769319825164387192, 0.0013338161451367762689788,
\r
4040 0.0013253428161566586165863, 0.0013168570247185350852537,
\r
4041 0.0013083588506159642151809, 0.0012998483737589411687807,
\r
4042 0.0012913256741731463215379, 0.0012827908319991927650686,
\r
4043 0.0012742439274918727294554, 0.0012656850410194029319476,
\r
4044 0.0012571142530626688591208, 0.0012485316442144679896043,
\r
4045 0.0012399372951787519644928, 0.0012313312867698677125706,
\r
4046 0.0012227136999117975374834, 0.0012140846156373981740056,
\r
4047 0.0012054441150876388205601, 0.0011967922795108381551550,
\r
4048 0.0011881291902619003419159, 0.0011794549288015500353964,
\r
4049 0.0011707695766955663898644, 0.0011620732156140160807669,
\r
4050 0.0011533659273304853455891, 0.0011446477937213110513287,
\r
4051 0.0011359188967648107958214, 0.0011271793185405120501566,
\r
4052 0.0011184291412283803494364, 0.0011096684471080465391373,
\r
4053 0.0011008973185580330843445, 0.0010921158380549794491381,
\r
4054 0.0010833240881728665534171, 0.0010745221515822403144596,
\r
4055 0.0010657101110494342805238, 0.0010568880494357913638046,
\r
4056 0.0010480560496968846800697, 0.0010392141948817375023057,
\r
4057 0.0010303625681320423357186, 0.0010215012526813791214350,
\r
4058 0.0010126303318544325762649, 0.0010037498890662086758941,
\r
4059 0.0009948600078212502888805, 0.0009859607717128519688418,
\r
4060 0.0009770522644222739122264, 0.0009681345697179550890732,
\r
4061 0.0009592077714547255541688, 0.0009502719535730179460261,
\r
4062 0.0009413272000980781811114, 0.0009323735951391753507612,
\r
4063 0.0009234112228888108282347, 0.0009144401676219265933610,
\r
4064 0.0009054605136951127822476, 0.0008964723455458144695262,
\r
4065 0.0008874757476915376906225, 0.0008784708047290547115472,
\r
4066 0.0008694576013336085537138, 0.0008604362222581167813022,
\r
4067 0.0008514067523323745586954, 0.0008423692764622569855308,
\r
4068 0.0008333238796289207169173, 0.0008242706468880048763834,
\r
4069 0.0008152096633688312691343, 0.0008061410142736039032099,
\r
4070 0.0007970647848766078261514, 0.0007879810605234072847989,
\r
4071 0.0007788899266300432158601, 0.0007697914686822300749096,
\r
4072 0.0007606857722345520114971, 0.0007515729229096583980656,
\r
4073 0.0007424530063974587204051, 0.0007333261084543168373926,
\r
4074 0.0007241923149022446178008, 0.0007150517116280949619884,
\r
4075 0.0007059043845827542163241, 0.0006967504197803339882351,
\r
4076 0.0006875899032973623698204, 0.0006784229212719745780188,
\r
4077 0.0006692495599031030193850, 0.0006600699054496667875923,
\r
4078 0.0006508840442297606018626, 0.0006416920626198431946113,
\r
4079 0.0006324940470539251567018, 0.0006232900840227562488244,
\r
4080 0.0006140802600730121876541, 0.0006048646618064809156059,
\r
4081 0.0005956433758792483631993, 0.0005864164890008837132649,
\r
4082 0.0005771840879336241764943, 0.0005679462594915592881427,
\r
4083 0.0005587030905398147360662, 0.0005494546679937357307118,
\r
4084 0.0005402010788180699282026, 0.0005309424100261499182844,
\r
4085 0.0005216787486790752896494, 0.0005124101818848942860548,
\r
4086 0.0005031367967977850677401, 0.0004938586806172365939677,
\r
4087 0.0004845759205872291441124, 0.0004752886039954144966810,
\r
4088 0.0004659968181722957880391, 0.0004567006504904070755681,
\r
4089 0.0004474001883634926336095, 0.0004380955192456860150653,
\r
4090 0.0004287867306306889171352, 0.0004194739100509498966958,
\r
4091 0.0004101571450768429896514, 0.0004008365233158462997325,
\r
4092 0.0003915121324117206363681, 0.0003821840600436882993131,
\r
4093 0.0003728523939256121308821, 0.0003635172218051749865499,
\r
4094 0.0003541786314630598135175, 0.0003448367107121305776064,
\r
4095 0.0003354915473966143456333, 0.0003261432293912849189248,
\r
4096 0.0003167918446006485317858, 0.0003074374809581322877037,
\r
4097 0.0002980802264252762217455, 0.0002887201689909301727620,
\r
4098 0.0002793573966704570567274, 0.0002699919975049447012834,
\r
4099 0.0002606240595604292032823, 0.0002512536709271339139118,
\r
4100 0.0002418809197187298044384, 0.0002325058940716253739001,
\r
4101 0.0002231286821442978268308, 0.0002137493721166826096154,
\r
4102 0.0002043680521896465790359, 0.0001949848105845827899210,
\r
4103 0.0001855997355431850062940, 0.0001762129153274925249194,
\r
4104 0.0001668244382203495280013, 0.0001574343925265138930609,
\r
4105 0.0001480428665748079976500, 0.0001386499487219861751244,
\r
4106 0.0001292557273595155266326, 0.0001198602909254695827354,
\r
4107 0.0001104637279257437565603, 0.0001010661269730276014588,
\r
4108 0.0000916675768613669107254, 0.0000822681667164572752810,
\r
4109 0.0000728679863190274661367, 0.0000634671268598044229933,
\r
4110 0.0000540656828939400071988, 0.0000446637581285753393838,
\r
4111 0.0000352614859871986975067, 0.0000258591246764618586716,
\r
4112 0.0000164577275798968681068, 0.0000070700764101825898713};
\r
4116 *x = x4; *w = w4; break;
\r
4118 *x = x8; *w = w8; break;
\r
4120 *x = x16; *w = w16; break;
\r
4122 *x = x32; *w = w32; break;
\r
4124 *x = x64; *w = w64; break;
\r
4126 *x = x128; *w = w128; break;
\r
4128 *x = x256; *w = w256; break;
\r
4130 *x = x512; *w = w512; break;
\r
4132 *x = x1024; *w = w1024; break;
\r
4134 error2("use 4, 8, 16, 32, 64, 128, 512, 1024 for npoints for legendre.");
\r
4141 double NIntegrateGaussLegendre (double(*fun)(double x), double a, double b, int npoints)
\r
4143 /* this approximates the integral Nintegrate[fun[x], {x,a,b}].
\r
4144 npoints is 10, 20, 32 or 64 nodes for legendre.");
\r
4147 double *x=NULL, *w=NULL, sign, s=0, t;
\r
4149 if(npoints%2 != 0)
\r
4150 error2("this assumes even number of points.");
\r
4151 GaussLegendreRule(&x, &w, npoints);
\r
4153 /* x changes monotonically from a to b. */
\r
4154 for(j=0; j<npoints; j++) {
\r
4155 if(j<npoints/2) { ixw = npoints/2-1-j; sign=-1; }
\r
4156 else { ixw = j-npoints/2; sign=1; }
\r
4157 t = (a+b)/2 + sign*(b-a)/2*x[ixw];
\r
4158 s += w[ixw]*fun(t);
\r
4160 return s *= (b - a)/2;
\r
4164 int GaussLaguerreRule(double **x, double **w, int npoints)
\r
4166 /* this returns the Gauss-Laguerre nodes and weights in x[] and w[].
\r
4167 npoints = 5, 10, 20.
\r
4170 static double x5[]={0.263560319718140910203061943361E+00,
\r
4171 0.141340305910651679221840798019E+01,
\r
4172 0.359642577104072208122318658878E+01,
\r
4173 0.708581000585883755692212418111E+01,
\r
4174 0.126408008442757826594332193066E+02};
\r
4175 static double w5[]={0.521755610582808652475860928792E+00,
\r
4176 0.398666811083175927454133348144E+00,
\r
4177 0.759424496817075953876533114055E-01,
\r
4178 0.361175867992204845446126257304E-02,
\r
4179 0.233699723857762278911490845516E-04};
\r
4181 static double x10[]={0.137793470540492430830772505653E+00,
\r
4182 0.729454549503170498160373121676E+00,
\r
4183 0.180834290174031604823292007575E+01,
\r
4184 0.340143369785489951448253222141E+01,
\r
4185 0.555249614006380363241755848687E+01,
\r
4186 0.833015274676449670023876719727E+01,
\r
4187 0.118437858379000655649185389191E+02,
\r
4188 0.162792578313781020995326539358E+02,
\r
4189 0.219965858119807619512770901956E+02,
\r
4190 0.299206970122738915599087933408E+02};
\r
4191 static double w10[]={0.308441115765020141547470834678E+00,
\r
4192 0.401119929155273551515780309913E+00,
\r
4193 0.218068287611809421588648523475E+00,
\r
4194 0.620874560986777473929021293135E-01,
\r
4195 0.950151697518110055383907219417E-02,
\r
4196 0.753008388587538775455964353676E-03,
\r
4197 0.282592334959956556742256382685E-04,
\r
4198 0.424931398496268637258657665975E-06,
\r
4199 0.183956482397963078092153522436E-08,
\r
4200 0.991182721960900855837754728324E-12};
\r
4202 static double x20[]={0.705398896919887533666890045842E-01,
\r
4203 0.372126818001611443794241388761E+00,
\r
4204 0.916582102483273564667716277074E+00,
\r
4205 0.170730653102834388068768966741E+01,
\r
4206 0.274919925530943212964503046049E+01,
\r
4207 0.404892531385088692237495336913E+01,
\r
4208 0.561517497086161651410453988565E+01,
\r
4209 0.745901745367106330976886021837E+01,
\r
4210 0.959439286958109677247367273428E+01,
\r
4211 0.120388025469643163096234092989E+02,
\r
4212 0.148142934426307399785126797100E+02,
\r
4213 0.179488955205193760173657909926E+02,
\r
4214 0.214787882402850109757351703696E+02,
\r
4215 0.254517027931869055035186774846E+02,
\r
4216 0.299325546317006120067136561352E+02,
\r
4217 0.350134342404790000062849359067E+02,
\r
4218 0.408330570567285710620295677078E+02,
\r
4219 0.476199940473465021399416271529E+02,
\r
4220 0.558107957500638988907507734445E+02,
\r
4221 0.665244165256157538186403187915E+02};
\r
4222 static double w20[]={0.168746801851113862149223899689E+00,
\r
4223 0.291254362006068281716795323812E+00,
\r
4224 0.266686102867001288549520868998E+00,
\r
4225 0.166002453269506840031469127816E+00,
\r
4226 0.748260646687923705400624639615E-01,
\r
4227 0.249644173092832210728227383234E-01,
\r
4228 0.620255084457223684744754785395E-02,
\r
4229 0.114496238647690824203955356969E-02,
\r
4230 0.155741773027811974779809513214E-03,
\r
4231 0.154014408652249156893806714048E-04,
\r
4232 0.108648636651798235147970004439E-05,
\r
4233 0.533012090955671475092780244305E-07,
\r
4234 0.175798117905058200357787637840E-08,
\r
4235 0.372550240251232087262924585338E-10,
\r
4236 0.476752925157819052449488071613E-12,
\r
4237 0.337284424336243841236506064991E-14,
\r
4238 0.115501433950039883096396247181E-16,
\r
4239 0.153952214058234355346383319667E-19,
\r
4240 0.528644272556915782880273587683E-23,
\r
4241 0.165645661249902329590781908529E-27};
\r
4244 else if(npoints==10)
\r
4245 { *x=x10; *w=w10; }
\r
4246 else if(npoints==20)
\r
4247 { *x=x20; *w=w20; }
\r
4249 puts("use 5, 10, 20 nodes for GaussLaguerreRule.");
\r
4255 int ScatterPlot (int n, int nseries, int yLorR[], double x[], double y[],
\r
4256 int nrow, int ncol, int ForE)
\r
4258 /* This plots a scatter diagram. There are nseries of data (y)
\r
4259 for the same x. nrow and ncol specifies the #s of rows and cols
\r
4260 in the text output.
\r
4261 Use ForE=1 for floating format
\r
4262 yLorR[nseries] specifies which y axis (L or R) to use, if nseries>1.
\r
4264 char *chart,ch, *fmt[2]={"%*.*e ", "%*.*f "}, symbol[]="*~^@",overlap='&';
\r
4265 int i,j,is,iy,ny=1, ncolr=ncol+3, irow=0, icol=0, w=10, wd=2;
\r
4266 double large=1e32, xmin, xmax, xgap, ymin[2], ymax[2], ygap[2];
\r
4268 for (i=1,xmin=xmax=x[0]; i<n; i++)
\r
4269 { if(xmin>x[i]) xmin=x[i]; if(xmax<x[i]) xmax=x[i]; }
\r
4270 for (i=0; i<2; i++) { ymin[i]=large; ymax[i]=-large; }
\r
4271 for (j=0; j<(nseries>1)*nseries; j++)
\r
4272 if (yLorR[j]==1) ny=2;
\r
4273 else if (yLorR[j]!=0) printf ("err: y axis %d", yLorR[j]);
\r
4274 for (j=0; j<nseries; j++) {
\r
4275 for (i=0,iy=(nseries==1?0:yLorR[j]); i<n; i++) {
\r
4276 if (ymin[iy]>y[j*n+i]) ymin[iy]=y[j*n+i];
\r
4277 if (ymax[iy]<y[j*n+i]) ymax[iy]=y[j*n+i];
\r
4280 if (xmin==xmax) { puts("no variation in x?"); }
\r
4281 xgap=(xmax-xmin)/ncol;
\r
4282 for (iy=0; iy<ny; iy++) ygap[iy]=(ymax[iy]-ymin[iy])/nrow;
\r
4284 printf ("\n%10s", "legend: ");
\r
4285 for (is=0; is<nseries; is++) printf ("%2c", symbol[is]);
\r
4286 printf ("\n%10s", "y axies: ");
\r
4287 if (ny==2) for(is=0; is<nseries; is++) printf ("%2d", yLorR[is]);
\r
4289 printf ("\nx : (%10.2e, %10.2e)", xmin, xmax);
\r
4290 printf ("\ny[1]: (%10.2e, %10.2e)\n", ymin[0], ymax[0]);
\r
4291 if (ny==2) printf ("y[2]: (%10.2e, %10.2e) \n", ymin[1], ymax[1]);
\r
4293 chart=(char*)malloc((nrow+1)*ncolr*sizeof(char));
\r
4294 for (i=0; i<nrow+1; i++) {
\r
4295 for (j=1; j<ncol; j++) chart[i*ncolr+j]=' ';
\r
4296 if (i%5==0) chart[i*ncolr+0]=chart[i*ncolr+j++]='+';
\r
4297 else chart[i*ncolr+0]=chart[i*ncolr+j++]='|';
\r
4298 chart[i*ncolr+j]='\0';
\r
4299 if (i==0||i==nrow)
\r
4300 FOR(j,ncol+1) chart[i*ncolr+j]=(char)(j%10==0?'+':'-');
\r
4303 for (is=0; is<nseries; is++) {
\r
4304 for (i=0,iy=(nseries==1?0:yLorR[is]); i<n; i++) {
\r
4305 for(j=0; j<ncol+1; j++) if(x[i]<=xmin+(j+0.5)*xgap) { icol=j; break; }
\r
4306 for(j=0; j<nrow+1; j++)
\r
4307 if(y[is*n+i]<=ymin[iy]+(j+0.5)*ygap[iy]) { irow=nrow-j; break;}
\r
4310 chart[irow*ncolr+icol]=symbol[is];
\r
4312 if ((ch=chart[irow*ncolr+icol])==' ' || ch=='-' || ch=='+')
\r
4313 chart[irow*ncolr+icol]=symbol[is];
\r
4315 chart[irow*ncolr+icol]=overlap;
\r
4320 for (i=0; i<nrow+1; i++) {
\r
4321 if (i%5==0) printf (fmt[ForE], w-1, wd, ymin[0]+(nrow-i)*ygap[0]);
\r
4322 else printf ("%*s", w, "");
\r
4323 printf ("%s", chart+i*ncolr);
\r
4324 if (ny==2 && i%5==0) printf(fmt[ForE], w-1, wd, ymin[1]+(nrow-i)*ygap[1]);
\r
4327 printf ("%*s", w-6, "");
\r
4328 for (j=0; j<ncol+1; j++) if(j%10==0) printf(fmt[ForE], 10-1,wd,xmin+j*xgap);
\r
4329 printf ("\n%*s\n", ncol/2+1+w, "x");
\r
4334 void rainbowRGB (double temperature, int *R, int *G, int *B)
\r
4336 /* This returns the RGB values, each between 0 and 255, for given temperature
\r
4337 value in the range (0, 1) in the rainbow.
\r
4338 Curve fitting from the following data:
\r
4354 double T=temperature, maxT=1;
\r
4356 if(T>maxT) error2("temperature rescaling needed.");
\r
4357 *R = (int)fabs( -5157.3*T*T*T*T + 9681.4*T*T*T - 5491.9*T*T + 1137.7*T + 6.2168 );
\r
4358 *G = (int)fabs( -1181.4*T*T*T + 964.8*T*T + 203.66*T + 1.2028 );
\r
4359 *B = (int)fabs( 92.463*T*T*T - 595.92*T*T + 481.11*T + 21.769 );
\r
4361 if(*R>255) *R=255;
\r
4362 if(*G>255) *G=255;
\r
4363 if(*B>255) *B=255;
\r
4367 void GetIndexTernary(int *ix, int *iy, double *x, double *y, int itriangle, int K)
\r
4369 /* This gives the indices (ix, iy) and the coordinates (x, y, 1-x-y) for
\r
4370 the itriangle-th triangle, with itriangle from 0, 1, ..., KK-1.
\r
4371 The ternary graph (0-1 on each axis) is partitioned into K*K equal-sized
\r
4373 In the first row (ix=0), there is one triangle (iy=0);
\r
4374 In the second row (ix=1), there are 3 triangles (iy=0,1,2);
\r
4375 In the i-th row (ix=i), there are 2*i+1 triangles (iy=0,1,...,2*i).
\r
4377 x rises when ix goes up, but y decreases when iy increases. (x,y) is the
\r
4378 centroid in the ij-th small triangle.
\r
4380 x and y each takes on 2*K-1 possible values.
\r
4382 *ix = (int)sqrt((double)itriangle);
\r
4383 *iy = itriangle - square(*ix);
\r
4385 *x = (1 + (*iy/2)*3 + (*iy%2))/(3.*K);
\r
4386 *y = (1 + (K-1- *ix)*3 + (*iy%2))/(3.*K);
\r
4391 long factorial (int n)
\r
4394 if (n>11) error2("n>10 in factorial");
\r
4395 for (i=2; i<=(long)n; i++) f *= i;
\r
4400 double Binomial (double n, int k, double *scale)
\r
4402 /* calculates (n choose k), where n is any real number, and k is integer.
\r
4403 If(*scale!=0) the result should be c+exp(*scale).
\r
4405 double c=1,i,large=1e99;
\r
4409 error2("k is not a whole number in Binomial.");
\r
4410 if(n<0 && k%2==1)
\r
4412 if(k==0) return(1);
\r
4413 if(n>0 && (k<0 || k>n)) return (0);
\r
4415 if(n>0 && (int)n==n) k=min2(k,(int)n-k);
\r
4416 for (i=1; i<=k; i++) {
\r
4419 *scale += log(c); c=1;
\r
4425 /****************************
\r
4426 Vectors and matrices
\r
4427 *****************************/
\r
4429 double Det3x3 (double x[3*3])
\r
4432 x[0*3+0]*x[1*3+1]*x[2*3+2]
\r
4433 + x[0*3+1]*x[1*3+2]*x[2*3+0]
\r
4434 + x[0*3+2]*x[1*3+0]*x[2*3+1]
\r
4435 - x[0*3+0]*x[1*3+2]*x[2*3+1]
\r
4436 - x[0*3+1]*x[1*3+0]*x[2*3+2]
\r
4437 - x[0*3+2]*x[1*3+1]*x[2*3+0] ;
\r
4440 int matby (double a[], double b[], double c[], int n, int m, int k)
\r
4441 /* a[n*m], b[m*k], c[n*k] ...... c = a*b
\r
4447 for(i1=0; i1<n; i1++)
\r
4448 for(i2=0; i2<k; i2++) {
\r
4449 for (i3=0,t=0; i3<m; i3++) t += a[i1*m+i3]*b[i3*k+i2];
\r
4455 int matbytransposed (double a[], double b_transposed[], double c[], int n, int m, int k)
\r
4456 /* a[n*m], b[m*k], c[n*k] ...... c = a*b, but with b_transposed[k*m]
\r
4462 for(i1=0; i1<n; i1++)
\r
4463 for(i2=0; i2<k; i2++) {
\r
4464 for (i3=0,t=0; i3<m; i3++) t += a[i1*m+i3]*b_transposed[i2*m+i3];
\r
4472 int matIout (FILE *fout, int x[], int n, int m)
\r
4475 for (i=0,FPN(fout); i<n; i++,FPN(fout))
\r
4476 FOR(j,m) fprintf(fout," %4d", x[i*m+j]);
\r
4480 int matout (FILE *fout, double x[], int n, int m)
\r
4483 for (i=0,FPN(fout); i<n; i++,FPN(fout))
\r
4484 FOR(j,m) fprintf(fout," %11.6f", x[i*m+j]);
\r
4489 int matout2 (FILE * fout, double x[], int n, int m, int wid, int deci)
\r
4492 for (i=0,FPN(fout); i<n; i++,FPN(fout))
\r
4493 for(j=0; j<m; j++)
\r
4494 fprintf(fout," %*.*f", wid-1, deci, x[i*m+j]);
\r
4498 int mattransp1 (double x[], int n)
\r
4499 /* transpose a matrix x[n*n], stored by rows.
\r
4504 FOR (i,n) for (j=0; j<i; j++)
\r
4505 if (i!=j) { t=x[i*n+j]; x[i*n+j]=x[j*n+i]; x[j*n+i]=t; }
\r
4509 int mattransp2 (double x[], double y[], int n, int m)
\r
4511 /* transpose a matrix x[n][m] --> y[m][n]
\r
4515 FOR (i,n) FOR (j,m) y[j*n+i]=x[i*m+j];
\r
4519 int matinv (double x[], int n, int m, double space[])
\r
4521 /* x[n*m] ... m>=n
\r
4522 space[n]. This puts the fabs(|x|) into space[0]. Check and calculate |x|.
\r
4523 Det may have the wrong sign. Check and fix.
\r
4526 int *irow=(int*) space;
\r
4527 double ee=1e-100, t,t1,xmax, det=1;
\r
4529 for(i=0; i<n; i++) irow[i]=i;
\r
4531 for(i=0; i<n; i++) {
\r
4532 xmax = fabs(x[i*m+i]);
\r
4533 for (j=i+1; j<n; j++)
\r
4534 if (xmax<fabs(x[j*m+i]))
\r
4535 { xmax = fabs(x[j*m+i]); irow[i]=j; }
\r
4536 det *= x[irow[i]*m+i];
\r
4538 printf("\nxmax = %.4e close to zero at %3d!\t\n", xmax,i+1);
\r
4541 if (irow[i] != i) {
\r
4542 for(j=0; j<m; j++) {
\r
4544 x[i*m+j] = x[irow[i]*m+j];
\r
4545 x[irow[i]*m+j] = t;
\r
4549 for(j=0; j<n; j++) {
\r
4550 if (j == i) continue;
\r
4552 FOR(k,m) x[j*m+k] -= t1*x[i*m+k];
\r
4555 for(j=0; j<m; j++) x[i*m+j] *= t;
\r
4558 for (i=n-1; i>=0; i--) {
\r
4559 if (irow[i] == i) continue;
\r
4560 for(j=0; j<n; j++) {
\r
4562 x[j*m+i] = x[j*m + irow[i]];
\r
4563 x[j*m + irow[i]] = t;
\r
4571 int matexp (double A[], int n, int nTaylorTerms, int nSquares, double space[])
\r
4573 /* This calculates the matrix exponential e^A and returns the result in A[].
\r
4574 space[n*n*3]: required working space.
\r
4576 e^A = (I + A/m + (A/m)^2/2! + ...)^m, with m = 2^TimeSquare.
\r
4578 See equation (2.22) in Yang (2006) and the discussion below it.
\r
4579 This is method 3 in Moler & Van Loan (2003. Nineteen dubious ways to compute
\r
4580 the exponential of a matrix, twenty-five years later. SIAM Review 45:3-49).
\r
4582 In the Taylor step, T[1] and T[2] are used to avoid matrix copying.
\r
4583 In the squaring step, T[0] and T[1] are used to avoid matrix copying.
\r
4584 Use an even nSquares to avoid one round of matrix copying.
\r
4587 double *T[3], *B, m1, factor=1; /* B = A/2^nSquares */
\r
4589 if(nSquares>31) error2("nSquares too large");
\r
4592 T[2] = T[1] + n*n;
\r
4595 m1 = 1.0/(1 << nSquares);
\r
4596 for(i=0; i<n*n; i++) B[i] = T[1][i] = A[i] *= m1;
\r
4598 /* Taylor for e^B, with result in A = T[0]. Calculate I + B first. */
\r
4599 for(i=0; i<n; i++) A[i*n+i] ++;
\r
4600 for(j=2,it=2; j<=nTaylorTerms; j++,it=3-it) { /* it flips between 1 and 2. */
\r
4601 matby(T[3-it], B, T[it], n, n, n);
\r
4603 for(i=0; i<n*n; i++)
\r
4604 A[i] += T[it][i]*factor;
\r
4607 for(i=0,it=0; i<nSquares; i++,it = 1-it) {
\r
4608 matby(T[it], T[it], T[1-it], n, n, n);
\r
4611 for(i=0; i<n*n; i++) A[i] = T[1][i];
\r
4616 void HouseholderRealSym(double a[], int n, double d[], double e[]);
\r
4617 int EigenTridagQLImplicit(double d[], double e[], int n, double z[]);
\r
4619 int matsqrt (double A[], int n, double work[])
\r
4621 /* This finds the symmetrical square root of a real symmetrical matrix A[n*n].
\r
4622 R * R = A. The root is returned in A[].
\r
4623 The work space if work[n*n*2+n].
\r
4624 Used the same procedure as eigenRealSym(), but does not sort eigen values.
\r
4627 double *U=work, *Root=U+n*n, *V=Root+n;
\r
4630 HouseholderRealSym(U, n, Root, V);
\r
4631 status = EigenTridagQLImplicit(Root, V, n, U);
\r
4632 mattransp2 (U, V, n, n);
\r
4634 if(Root[i]<0) error2("negative root in matsqrt?");
\r
4635 else Root[i]=sqrt(Root[i]);
\r
4636 for(i=0;i<n;i++) for(j=0;j<n;j++)
\r
4637 U[i*n+j] *= Root[j];
\r
4638 matby(U, V, A, n, n, n);
\r
4645 int CholeskyDecomp (double A[], int n, double L[])
\r
4647 /* A=LL', where A is symmetrical and positive-definite, and L is
\r
4649 only A[i*n+j] (j>=i) are used.
\r
4654 for (i=0; i<n; i++)
\r
4655 for (j=i+1; j<n; j++)
\r
4657 for (i=0; i<n; i++) {
\r
4658 for (k=0,t=A[i*n+i]; k<i; k++)
\r
4659 t -= square(L[i*n+k]);
\r
4661 L[i*n+i] = sqrt(t);
\r
4664 for (j=i+1; j<n; j++) {
\r
4665 for (k=0,t=A[i*n+j]; k<i; k++)
\r
4666 t -= L[i*n+k]*L[j*n+k];
\r
4667 L[j*n+i] = t/L[i*n+i];
\r
4674 int Choleskyback (double L[], double b[], double x[], int n);
\r
4675 int CholeskyInverse (double L[], int n);
\r
4677 int Choleskyback (double L[], double b[], double x[], int n)
\r
4679 /* solve Ax=b, where A=LL' is lower-diagonal.
\r
4680 x=b O.K. Only A[i*n+j] (i>=j) are used
\r
4686 for (i=0; i<n; i++) { /* solve Ly=b, and store results in x */
\r
4687 for (j=0,t=b[i]; j<i; j++) t-=L[i*n+j]*x[j];
\r
4690 for (i=n-1; i>=0; i--) { /* solve L'x=y, and store results in x */
\r
4691 for (j=i+1,t=x[i]; j<n; j++) t-=L[j*n+i]*x[j];
\r
4697 int CholeskyInverse (double L[], int n)
\r
4704 for (i=0; i<n; i++) {
\r
4705 L[i*n+i]=1/L[i*n+i];
\r
4706 for (j=i+1; j<n; j++) {
\r
4707 for (k=i,t=0; k<j; k++) t -= L[j*n+k]*L[k*n+i];
\r
4708 L[j*n+i] = t/L[j*n+j];
\r
4715 int eigenQREV (double Q[], double pi[], int n, double Root[], double U[], double V[], double spacesqrtpi[])
\r
4718 This finds the eigen solution of the rate matrix Q for a time-reversible
\r
4719 Markov process, using the algorithm for a real symmetric matrix.
\r
4720 Rate matrix Q = S * diag{pi} = U * diag{Root} * V,
\r
4721 where S is symmetrical, all elements of pi are positive, and UV = I.
\r
4722 space[n] is for storing sqrt(pi).
\r
4724 [U 0] [Q_0 0] [U^-1 0] [Root 0]
\r
4725 [0 I] [0 0] [0 I] = [0 0]
\r
4727 Ziheng Yang, 25 December 2001 (ref is CME/eigenQ.pdf)
\r
4729 int i,j, inew, jnew, nnew, status;
\r
4730 double *pi_sqrt=spacesqrtpi, small=1e-100;
\r
4732 for(j=0,nnew=0; j<n; j++)
\r
4734 pi_sqrt[nnew++] = sqrt(pi[j]);
\r
4736 /* store in U the symmetrical matrix S = sqrt(D) * Q * sqrt(-D) */
\r
4739 for(i=0; i<n; i++)
\r
4740 for(j=0,U[i*n+i] = Q[i*n+i]; j<i; j++)
\r
4741 U[i*n+j] = U[j*n+i] = (Q[i*n+j] * pi_sqrt[i]/pi_sqrt[j]);
\r
4743 status = eigenRealSym(U, n, Root, V);
\r
4744 for(i=0; i<n; i++) for(j=0; j<n; j++) V[i*n+j] = U[j*n+i] * pi_sqrt[j];
\r
4745 for(i=0; i<n; i++) for(j=0; j<n; j++) U[i*n+j] /= pi_sqrt[i];
\r
4748 for(i=0,inew=0; i<n; i++) {
\r
4750 for(j=0,jnew=0; j<i; j++)
\r
4752 U[inew*nnew+jnew] = U[jnew*nnew+inew]
\r
4753 = Q[i*n+j] * pi_sqrt[inew]/pi_sqrt[jnew];
\r
4756 U[inew*nnew+inew] = Q[i*n+i];
\r
4761 status = eigenRealSym(U, nnew, Root, V);
\r
4763 for(i=n-1,inew=nnew-1; i>=0; i--) /* construct Root */
\r
4764 Root[i] = (pi[i]>small ? Root[inew--] : 0);
\r
4765 for(i=n-1,inew=nnew-1; i>=0; i--) { /* construct V */
\r
4767 for(j=n-1,jnew=nnew-1; j>=0; j--)
\r
4769 V[i*n+j] = U[jnew*nnew+inew]*pi_sqrt[jnew];
\r
4773 V[i*n+j] = (i==j);
\r
4777 for(j=0; j<n; j++) V[i*n+j] = (i==j);
\r
4779 for(i=n-1,inew=nnew-1; i>=0; i--) { /* construct U */
\r
4781 for(j=n-1,jnew=nnew-1;j>=0;j--)
\r
4783 U[i*n+j] = U[inew*nnew+jnew]/pi_sqrt[inew];
\r
4787 U[i*n+j] = (i==j);
\r
4792 U[i*n+j] = (i==j);
\r
4796 /* This routine works on P(t) as well as Q. */
\r
4798 if(fabs(Root[0])>1e-10 && noisy) printf("Root[0] = %.5e\n",Root[0]);
\r
4805 /* eigen solution for real symmetric matrix */
\r
4806 void EigenSort(double d[], double U[], int n);
\r
4808 int eigenRealSym(double A[], int n, double Root[], double work[])
\r
4810 /* This finds the eigen solution of a real symmetrical matrix A[n*n]. In return,
\r
4811 A has the right vectors and Root has the eigenvalues.
\r
4812 work[n] is the working space.
\r
4813 The matrix is first reduced to a tridiagonal matrix using HouseholderRealSym(),
\r
4814 and then using the QL algorithm with implicit shifts.
\r
4816 Adapted from routine tqli in Numerical Recipes in C, with reference to LAPACK
\r
4817 Ziheng Yang, 23 May 2001
\r
4820 HouseholderRealSym(A, n, Root, work);
\r
4821 status = EigenTridagQLImplicit(Root, work, n, A);
\r
4822 EigenSort(Root, A, n);
\r
4828 void EigenSort(double d[], double U[], int n)
\r
4830 /* this sorts the eigenvalues d[] in decreasing order and rearrange the (right) eigenvectors U[].
\r
4835 for (i=0; i<n-1; i++) {
\r
4837 for (j=i+1; j<n; j++)
\r
4838 if (d[j] >= p) p = d[k=j];
\r
4842 for (j=0;j<n;j++) {
\r
4844 U[j*n+i] = U[j*n+k];
\r
4853 void HouseholderRealSym(double a[], int n, double d[], double e[])
\r
4855 /* This uses HouseholderRealSym transformation to reduce a real symmetrical matrix
\r
4856 a[n*n] into a tridiagonal matrix represented by d and e.
\r
4857 d[] is the diagonal (eigends), and e[] the off-diagonal.
\r
4860 double scale,hh,h,g,f;
\r
4862 for (i=n-1;i>=1;i--) {
\r
4866 for (k=0;k<=m;k++)
\r
4867 scale += fabs(a[i*n+k]);
\r
4871 for (k=0;k<=m;k++) {
\r
4872 a[i*n+k] /= scale;
\r
4873 h += a[i*n+k]*a[i*n+k];
\r
4876 g=(f >= 0 ? -sqrt(h) : sqrt(h));
\r
4881 for (j=0;j<=m;j++) {
\r
4882 a[j*n+i]=a[i*n+j]/h;
\r
4884 for (k=0;k<=j;k++)
\r
4885 g += a[j*n+k]*a[i*n+k];
\r
4886 for (k=j+1;k<=m;k++)
\r
4887 g += a[k*n+j]*a[i*n+k];
\r
4889 f += e[j]*a[i*n+j];
\r
4892 for (j=0;j<=m;j++) {
\r
4895 for (k=0;k<=j;k++)
\r
4896 a[j*n+k] -= (f*e[k]+g*a[i*n+k]);
\r
4906 /* Get eigenvectors */
\r
4907 for (i=0;i<n;i++) {
\r
4910 for (j=0;j<=m;j++) {
\r
4912 for (k=0;k<=m;k++)
\r
4913 g += a[i*n+k]*a[k*n+j];
\r
4914 for (k=0;k<=m;k++)
\r
4915 a[k*n+j] -= g*a[k*n+i];
\r
4920 for (j=0;j<=m;j++) a[j*n+i]=a[i*n+j]=0;
\r
4924 #define SIGN(a,b) ((b) >= 0.0 ? fabs(a) : -fabs(a))
\r
4926 int EigenTridagQLImplicit(double d[], double e[], int n, double z[])
\r
4928 /* This finds the eigen solution of a tridiagonal matrix represented by d and e.
\r
4929 d[] is the diagonal (eigenvalues), e[] is the off-diagonal
\r
4930 z[n*n]: as input should have the identity matrix to get the eigen solution of the
\r
4931 tridiagonal matrix, or the output from HouseholderRealSym() to get the
\r
4932 eigen solution to the original real symmetric matrix.
\r
4933 z[n*n]: has the orthogonal matrix as output
\r
4935 Adapted from routine tqli in Numerical Recipes in C, with reference to
\r
4936 LAPACK fortran code.
\r
4937 Ziheng Yang, May 2001
\r
4939 int m,j,iter,niter=30, status=0, i,k;
\r
4940 double s,r,p,g,f,dd,c,b, aa,bb;
\r
4942 for (i=1;i<n;i++) e[i-1]=e[i]; e[n-1]=0;
\r
4943 for (j=0;j<n;j++) {
\r
4946 for (m=j;m<n-1;m++) {
\r
4947 dd=fabs(d[m])+fabs(d[m+1]);
\r
4948 if (fabs(e[m])+dd == dd) break; /* ??? */
\r
4951 if (iter++ == niter) {
\r
4955 g=(d[j+1]-d[j])/(2*e[j]);
\r
4957 /* r=pythag(g,1); */
\r
4959 if((aa=fabs(g))>1) r=aa*sqrt(1+1/(g*g));
\r
4960 else r=sqrt(1+g*g);
\r
4962 g=d[m]-d[j]+e[j]/(g+SIGN(r,g));
\r
4965 for (i=m-1;i>=j;i--) {
\r
4969 /* r=pythag(f,g); */
\r
4970 aa=fabs(f); bb=fabs(g);
\r
4971 if(aa>bb) { bb/=aa; r=aa*sqrt(1+bb*bb); }
\r
4972 else if(bb==0) r=0;
\r
4973 else { aa/=bb; r=bb*sqrt(1+aa*aa); }
\r
4984 r=(d[i]-g)*s+2*c*b;
\r
4987 for (k=0;k<n;k++) {
\r
4989 z[k*n+i+1]=s*z[k*n+i]+c*f;
\r
4990 z[k*n+i]=c*z[k*n+i]-s*f;
\r
4993 if (r == 0 && i >= j) continue;
\r
4994 d[j]-=p; e[j]=g; e[m]=0;
\r
5010 int MeanVar (double x[], int n, double *m, double *v)
\r
5014 for (i=0,*m=0; i<n; i++) *m = (*m*i + x[i])/(i + 1.);
\r
5015 for (i=0,*v=0; i<n; i++) *v += square(x[i] - *m);
\r
5016 if (n>1) *v /= (n-1.);
\r
5020 int variance (double x[], int n, int nx, double mx[], double vx[])
\r
5022 /* x[nx][n], mx[nx], vx[nx][nx]
\r
5026 for(i=0; i<nx; i++) mx[i]=0;
\r
5027 for(i=0; i<nx; i++) {
\r
5028 for(k=0; k<n; k++) {
\r
5029 mx[i] = (mx[i]*k + x[i*n+k])/(k + 1.);
\r
5032 for(i=0; i<nx*nx; i++)
\r
5034 for (i=0; i<nx; i++)
\r
5035 for (j=i; j<nx; j++) {
\r
5036 for(k=0; k<n; k++)
\r
5037 vx[i*nx+j] += (x[i*n+k] - mx[i]) * (x[j*n+k] - mx[j]);
\r
5038 vx[j*nx+i] = (vx[i*nx+j] /= (n - 1.));
\r
5043 int correl (double x[], double y[], int n, double *mx, double *my, double *vxx, double *vxy, double *vyy, double *r)
\r
5047 *mx = *my = *vxx = *vxy = *vyy = 0.0;
\r
5048 for (i=0; i<n; i++) {
\r
5049 /* update vxx & vyy before mx & my */
\r
5050 *vxx += square(x[i] - *mx) * i/(i+1.);
\r
5051 *vyy += square(y[i] - *my) * i/(i+1.);
\r
5052 *vxy += (x[i] - *mx) * (y[i] - *my) * i/(i+1.);
\r
5053 *mx = (*mx * i + x[i])/(i+1.);
\r
5054 *my = (*my * i + y[i])/(i+1.);
\r
5059 if (*vxx>0.0 && *vyy>0.0) *r = *vxy/sqrt(*vxx * *vyy);
\r
5065 int bubblesort (float x[], int n)
\r
5067 /* inefficient bubble sort */
\r
5071 for(i=0;i<n;i++) {
\r
5073 if(x[j]<x[i]) { t = x[i]; x[i] = x[j]; x[j] = t; }
\r
5079 int comparedouble (const void *a, const void *b)
\r
5081 double aa = *(double*)a, bb= *(double*)b;
\r
5082 return (aa > bb ? 1 : (aa<bb ? -1 : 0));
\r
5086 int splitline (char line[], int fields[])
\r
5088 /* This finds out how many fields there are in the line, and marks the starting
\r
5089 positions of the fields.
\r
5090 Fields are separated by spaces, and texts are allowed as well.
\r
5092 int lline=1000000, i, nfields=0, InSpace=1;
\r
5095 for(i=0; i<lline && *p && *p!='\n'; i++,p++) {
\r
5101 fields[nfields++]=i;
\r
5102 if(nfields>MAXNFIELDS)
\r
5103 puts("raise MAXNFIELDS?");
\r
5111 int scanfile (FILE*fin, int *nrecords, int *nx, int *HasHeader, char line[], int ifields[])
\r
5113 /* If the first line has letters, it is considered to be the header line, and HasHeader=0 is set.
\r
5115 int i, lline=1000000, nxline, eof=0;
\r
5118 for (*nrecords=0; ; ) {
\r
5119 if (!fgets(line,lline,fin)) break;
\r
5121 if(*nrecords==0 && strchr(line, '\n')==NULL)
\r
5122 puts(" line too short or too long?");
\r
5124 if(*nrecords==0) {
\r
5125 for(i=0; i<lline && line[i]; i++)
\r
5126 if(isalpha(line[i])) {
\r
5127 *HasHeader=1; break;
\r
5130 nxline = splitline(line, ifields);
\r
5131 if(*nrecords==0 && *HasHeader)
\r
5132 printf("First line has variable names, %d variables\n", nxline);
\r
5136 if(*nrecords == 0)
\r
5138 else if (*nx != nxline){
\r
5142 printf("file format error: %d fields in line %d while %d fields in first line.",
\r
5143 nxline, *nrecords+1, *nx);
\r
5144 error2("error in scanfile()");
\r
5148 if(*nx>MAXNFIELDS) error2("raise MAXNFIELDS?");
\r
5151 /* printf("line # %3d: %3d variables\n", *nrecords+1, nxline); */
\r
5156 fgets(line, lline, fin);
\r
5157 splitline(line, ifields);
\r
5169 #define SQRT5 2.2360679774997896964
\r
5170 #define Epanechnikov(t) ((0.75-0.15*(t)*(t))/SQRT5)
\r
5171 int splitline (char line[], int fields[]);
\r
5173 /* density1d and density2d need to be reworked to account for edge effects.
\r
5178 int density1d (FILE* fout, double y[], int n, int nbin, double minx,
\r
5179 double gap, double h, double space[], int propternary)
\r
5181 /* This collects the histogram and uses kernel smoothing and adaptive kernel
\r
5182 smoothing to estimate the density. The kernel is Epanechnikov. The
\r
5183 histogram is collected into fobs, smoothed density into fE, and density
\r
5184 from adaptive kernel smoothing into fEA[].
\r
5185 Data y[] are sorted in increasing order before calling this routine.
\r
5189 int adaptive=0, i,k, iL, nused;
\r
5190 double *fobs=space, *lambda=fobs+nbin, fE, fEA, xt, d, G, alpha=0.5;
\r
5191 double maxx=minx+gap*nbin, edge;
\r
5194 for(i=0; i<nbin; i++) fobs[i]=0;
\r
5195 for(k=0,i=0; k<n; k++) {
\r
5196 for ( ; i<nbin-1; i++)
\r
5197 if(y[k]<=minx+gap*(i+1)) break;
\r
5201 /* weights for adaptive smoothing */
\r
5203 for(k=0;k<n;k++) lambda[k]=0;
\r
5204 for(k=0,G=0,iL=0; k<n; k++) {
\r
5206 for (i=iL,nused=0; i<n; i++) {
\r
5207 d=fabs(xt-y[i])/h;
\r
5210 lambda[k] += 1-0.2*d*d; /* based on Epanechnikov kernel */
\r
5211 /* lambda[k] += Epanechnikov(d)/(n*h); */
\r
5218 G+=log(lambda[k]);
\r
5220 printf("\r\tGetting weights: %2d/%d %d terms %s", k+1,n,nused,printtime(timestr));
\r
5224 for (k=0; k<n; k++) lambda[k] = pow(lambda[k]/G, -alpha);
\r
5225 if(n>1000) printf("\r");
\r
5228 /* smoothing and printing */
\r
5229 for (k=0; k<nbin; k++) {
\r
5230 xt=minx+gap*(k+0.5);
\r
5231 for (i=0,fE=fEA=0; i<n; i++) {
\r
5232 d=fabs(xt-y[i])/h;
\r
5233 if(d>SQRT5) continue;
\r
5234 edge = (y[i]-xt > xt-minx || xt-y[i]>maxx-xt ? 2 : 1);
\r
5235 fE += edge*Epanechnikov(d)/(n*h);
\r
5238 fEA += edge*Epanechnikov(d)/(n*h*lambda[i]);
\r
5241 if(!adaptive) fprintf(fout, "%.6f\t%.6f\t%.6f\n", xt, fobs[k], fE);
\r
5242 else fprintf(fout, "%.6f\t%.6f\t%.6f\t%.6f\n", xt, fobs[k], fE, fEA);
\r
5247 int density2d (FILE* fout, double y1[], double y2[], int n, int nbin,
\r
5248 double minx1, double minx2, double gap1, double gap2,
\r
5249 double var[4], double h, double space[], int propternary)
\r
5251 /* This collects the histogram and uses kernel smoothing and adaptive kernel
\r
5252 smoothing to estimate the 2-D density. The kernel is Epanechnikov. The
\r
5253 histogram is collected into f, smoothed density into fE, and density
\r
5254 from adaptive kernel smoothing into fEA[].
\r
5255 Data y1 and y2 are not sorted, unlike the 1-D routine.
\r
5257 alpha goes from 0 to 1, with 0 being equivalent to fixed width smoothing.
\r
5258 var[] has the 2x2 variance matrix, which is copied into S[4] and inverted.
\r
5260 space[nbin*nbin*3+n] for observed histogram f[nbin*nbin] and for lambda[n].
\r
5264 double *fO=space, *fE=fO+nbin*nbin, *fEA=fE+nbin*nbin, *lambda=fEA+nbin*nbin;
\r
5265 double h2=h*h, c2d, a,b,c,d, S[4], detS, G, x1,x2, alpha=0.5;
\r
5268 for(i=0; i<nbin*nbin; i++)
\r
5269 fO[i]=fE[i]=fEA[i]=0;
\r
5270 for (i=0; i<n; i++) {
\r
5271 for (j=0; j<nbin-1; j++) if(y1[i]<=minx1+gap1*(j+1)) break;
\r
5272 for (k=0; k<nbin-1; k++) if(y2[i]<=minx2+gap2*(k+1)) break;
\r
5273 fO[j*nbin+k] += 1./n;
\r
5277 a=S[0]; b=c=S[1]; d=S[3]; detS=a*d-b*c;
\r
5278 S[0]=d/detS; S[1]=S[2]=-b/detS; S[3]=a/detS;
\r
5279 /* detS=1; S[0]=S[3]=1; S[1]=S[2]=0; */
\r
5280 c2d = 2/(n*Pi*h*h*sqrt(detS));
\r
5282 /* weights for adaptive kernel smoothing */
\r
5283 for (k=0; k<n; k++) lambda[k]=0;
\r
5284 for(k=0,G=0; k<n; k++) {
\r
5287 for(i=0;i<n;i++) {
\r
5290 d = (a*S[0]+b*S[1])*a + (a*S[1]+b*S[3])*b;
\r
5292 if(d<1) lambda[k] += (1-d);
\r
5294 G += log(lambda[k]);
\r
5296 printf("\r\tGetting weights: %2d/%d %s", k+1,n,printtime(timestr));
\r
5299 for(k=0; k<n; k++) lambda[k] = pow(lambda[k]/G, -alpha);
\r
5300 for(k=0; k<n; k++) lambda[k] = 1/square(lambda[k]); /* 1/lambda^2 */
\r
5301 if(n>1000) printf("\r");
\r
5303 /* smoothing and printing */
\r
5304 puts("\t\tSmoothing and printing.");
\r
5305 for(j=0; j<nbin; j++) {
\r
5306 for(k=0; k<nbin; k++) {
\r
5307 x1 = minx1 + gap1*(j+0.5);
\r
5308 x2 = minx2 + gap2*(k+0.5);
\r
5309 if(propternary && x1+x2>1)
\r
5311 for(i=0;i<n;i++) {
\r
5312 a=x1-y1[i], b=x2-y2[i];
\r
5313 d=(a*S[0]+b*S[1])*a + (a*S[1]+b*S[3])*b;
\r
5315 if(d<1) fE[j*nbin+k] += (1-d);
\r
5318 if(d<1) fEA[j*nbin+k] += (1-d)*lambda[i];
\r
5322 for(i=0; i<nbin*nbin; i++) { fE[i]*=c2d; fEA[i]*=c2d; }
\r
5324 if(propternary==2) { /* symmetrize for ternary contour plots */
\r
5325 for(j=0; j<nbin; j++) {
\r
5326 for(k=0; k<=j; k++) {
\r
5327 x1 = minx1 + gap1*(j+0.5);
\r
5328 x2 = minx2 + gap2*(k+0.5);
\r
5329 if(x1+x2>1) continue;
\r
5330 fO[j*nbin+k] = fO[k*nbin+j] = (fO[j*nbin+k] + fO[k*nbin+j])/2;
\r
5331 fE[j*nbin+k] = fE[k*nbin+j] = (fE[j*nbin+k] + fE[k*nbin+j])/2;
\r
5332 fEA[j*nbin+k] = fEA[k*nbin+j] = (fEA[j*nbin+k] + fEA[k*nbin+j])/2;
\r
5337 for(j=0; j<nbin; j++) {
\r
5338 for(k=0; k<nbin; k++) {
\r
5339 x1 = minx1 + gap1*(j+0.5);
\r
5340 x2 = minx2 + gap2*(k+0.5);
\r
5341 if(!propternary || x1+x2<=1)
\r
5342 fprintf(fout, "%.6f\t%.6f\t%.6f\t%.6f\t%.6f\n", x1,x2, fO[j*nbin+k],fE[j*nbin+k],fEA[j*nbin+k]);
\r
5350 int HPDinterval(double x[], int n, double HPD[2], double alpha)
\r
5352 /* This calculates the HPD interval at the alpha level.
\r
5354 int jL0=(int)(n*alpha/2), jU0=(int)(n*(1-alpha/2)), jL,jU, jLb=jL0;
\r
5355 double w0 = x[jU0]-x[jL0], w=w0;
\r
5360 if(n<3) return(-1);
\r
5361 for(jL=0,jU=jL+(jU0-jL0); jU<n; jL++,jU++) {
\r
5362 if(x[jU] - x[jL] < w) {
\r
5364 w = x[jU] - x[jL];
\r
5368 HPD[1] = x[jLb + jU0 - jL0];
\r
5372 double Eff_IntegratedCorrelationTime (double x[], int n, double *mx, double *varx)
\r
5374 /* This calculates Efficiency or Tint using Geyer's (1992) initial positive
\r
5376 Note that this destroys x[].
\r
5378 double Tint=1, rho0=0, rho, m=0, s=0;
\r
5381 /* if(n<1000) puts("chain too short for calculating Eff? "); */
\r
5382 for (i=0; i<n; i++) m += x[i];
\r
5384 for (i=0; i<n; i++) x[i] -= m;
\r
5385 for (i=0; i<n; i++) s += x[i]*x[i];
\r
5386 s = sqrt(s/(n-1.0));
\r
5387 for (i=0; i<n; i++) x[i] /= s;
\r
5389 if(mx) { *mx=m; *varx=s*s; }
\r
5394 for(irho=1; irho<n-10; irho++) {
\r
5395 for (i=0,rho=0; i<n-irho; i++)
\r
5396 rho += x[i]*x[i+irho];
\r
5398 if(irho>10 && rho+rho0<0) break;
\r
5407 double Eff_IntegratedCorrelationTime2 (double x[], int n, int nbatch, double mx)
\r
5409 /* This calculates Eff, by using batch means. Tau, the integrated correlation time, is 1/Eff.
\r
5411 This is found to be unreliable.
\r
5414 double mxb, vx=0, E=0;
\r
5416 if(n<1000) puts("chain too short for calculating Eff? ");
\r
5418 for(i=0; i<nbatch; i++) {
\r
5419 for(j=0,mxb=0; j<lb; j++) {
\r
5421 vx += square(x[i*lb+j] - mx);
\r
5424 E += square(mxb - mx)/nbatch;
\r
5426 E = (vx/n) / (E*lb);
\r
5431 int DescriptiveStatistics (FILE *fout, char infile[], int nbin, int propternary, int SkipColumns)
\r
5433 /* This routine reads n records (observations) each of p continuous variables,
\r
5434 to calculate summary statistics. It also uses kernel density estimation to
\r
5435 smooth the histogram for each variable, as well as calculating 2-D densities
\r
5436 for selected variable pairs. The smoothing used the kerney estimator, with
\r
5437 both fixed window size and adaptive kernel smoothing using variable bandwiths.
\r
5438 The kernel function is Epanechnikov. For 2-D smoothing, Fukunaga's transform is used
\r
5439 (p.77 in B.W. Silverman 1986).
\r
5441 FILE *fin=gfopen(infile,"r");
\r
5442 int n, p, i,j,k, jj,kk, nrho=200;
\r
5443 char *fmt=" %9.6f", *fmt1=" %9.1f", timestr[32];
\r
5444 double *data, *x, *mean, *median, *minx, *maxx, *x005,*x995,*x025,*x975,*xHPD025,*xHPD975,*var;
\r
5445 double *Tint, tmp[2], d;
\r
5446 double h, *y, *gap, *space, v2d[4];
\r
5447 int nf2d=0, ivar_f2d[MAXNF2D][2]={{5,6},{0,2}}, k2d;
\r
5449 static int lline=1000000, ifields[MAXNFIELDS], HasHeader=1;
\r
5451 static char varstr[MAXNFIELDS][32]={""};
\r
5453 if((line=(char*)malloc(lline*sizeof(char)))==NULL) error2("oom ds");
\r
5454 scanfile(fin, &n, &p, &HasHeader, line, ifields);
\r
5455 printf("\n%d records, %d variables\n", n, p);
\r
5456 data = (double*)malloc(p*n*sizeof(double));
\r
5457 mean = (double*)malloc((p*13+p*p+n)*sizeof(double));
\r
5458 if (data==NULL||mean==NULL) error2("oom DescriptiveStatistics.");
\r
5459 memset(data, 0, p*n*sizeof(double));
\r
5460 memset(mean, 0, (p*13+p*p+n)*sizeof(double));
\r
5461 median=mean+p; minx=median+p; maxx=minx+p;
\r
5462 x005=maxx+p; x995=x005+p; x025=x995+p; x975=x025+p; xHPD025=x975+p; xHPD975=xHPD025+p;
\r
5463 var=xHPD975+p; gap=var+p*p, Tint=gap+p; y=Tint+p;
\r
5465 space=(double*)malloc((n+nbin*nbin*3)*sizeof(double));
\r
5466 if(space==NULL) { printf("not enough mem for %d variables\n",n); exit(-1); }
\r
5469 for(i=0; i<p; i++) sscanf(line+ifields[i], "%s", varstr[i]);
\r
5470 for(i=0; i<n; i++)
\r
5471 for(j=0; j<p; j++)
\r
5472 fscanf(fin, "%lf", &data[j*n+i]);
\r
5476 printf("\nGreat offer! I can smooth a few 2-D densities for free. How many do you want? ");
\r
5477 scanf("%d", &nf2d);
\r
5479 if(nf2d>MAXNF2D) error2("I don't want to do that many!");
\r
5480 for(i=0; i<nf2d; i++) {
\r
5481 printf("pair #%d (e.g., type 1 3 to use variables #1 and #3)? ",i+1);
\r
5482 scanf("%d%d", &ivar_f2d[i][0], &ivar_f2d[i][1]);
\r
5487 printf("Collecting mean, median, min, max, percentiles, etc.\n");
\r
5488 for(j=SkipColumns,x=data+j*n; j<p; j++,x+=n) {
\r
5489 memmove(y, x, n*sizeof(double));
\r
5490 Tint[j] = 1/Eff_IntegratedCorrelationTime(y, n, &mean[j], &var[j]);
\r
5491 memmove(y, x, n*sizeof(double));
\r
5492 qsort(y, (size_t)n, sizeof(double), comparedouble);
\r
5493 minx[j] = y[0]; maxx[j] = y[n-1];
\r
5494 median[j] = (n%2==0 ? (y[n/2]+y[n/2+1])/2 : y[(n+1)/2]);
\r
5495 x005[j] = y[(int)(n*.005)]; x995[j] = y[(int)(n*.995)];
\r
5496 x025[j] = y[(int)(n*.025)]; x975[j] = y[(int)(n*.975)];
\r
5498 HPDinterval(y, n, tmp, 0.05);
\r
5499 xHPD025[j] = tmp[0];
\r
5500 xHPD975[j] = tmp[1];
\r
5501 if((j+1)%100==0 || j==p-1)
\r
5502 printf("\r\t\t%6d/%6d done %s", j+1, p, printtime(timestr));
\r
5505 /* variance-covariance matrix */
\r
5507 for(j=SkipColumns; j<p; j++)
\r
5508 for(k=SkipColumns; k<=j; k++)
\r
5509 for(i=0; i<n; i++)
\r
5510 var[j*p+k] += (data[j*n+i] - mean[j]) * (data[k*n+i] - mean[k]);
\r
5511 for(j=SkipColumns; j<p; j++)
\r
5512 for(k=SkipColumns, var[j*p+j]/=(n-1.0); k<j; k++)
\r
5513 var[k*p+j] = var[j*p+k] /= (n-1.0);
\r
5515 fprintf(fout,"\n(A) Descriptive statistics\n\n ");
\r
5516 for (j=SkipColumns; j<p; j++) fprintf(fout," %s", varstr[j]);
\r
5517 fprintf(fout,"\nmean "); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt,mean[j]);
\r
5518 fprintf(fout,"\nmedian "); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt,median[j]);
\r
5519 fprintf(fout,"\nS.D. "); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt,sqrt(var[j*p+j]));
\r
5520 fprintf(fout,"\nmin "); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt,minx[j]);
\r
5521 fprintf(fout,"\nmax "); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt,maxx[j]);
\r
5522 fprintf(fout,"\n2.5%% "); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt,x025[j]);
\r
5523 fprintf(fout,"\n97.5%% "); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt,x975[j]);
\r
5524 fprintf(fout,"\n2.5%%HPD "); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt,xHPD025[j]);
\r
5525 fprintf(fout,"\n97.5%%HPD"); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt,xHPD975[j]);
\r
5526 fprintf(fout,"\nESS "); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt1,n/Tint[j]);
\r
5527 FPN(F0); FPN(fout);
\r
5530 fprintf(fout, "\nCorrelation matrix");
\r
5531 for(j=SkipColumns; j<p; j++) {
\r
5532 fprintf(fout, "\n%-8s ", varstr[j]);
\r
5533 for(k=SkipColumns; k<=j; k++)
\r
5534 fprintf(fout, " %8.5f", var[k*p+j]/sqrt(var[j*p+j]*var[k*p+k]));
\r
5536 fprintf(fout, "\n ");
\r
5537 for(j=SkipColumns; j<p; j++) fprintf(fout,"%9s", varstr[j]);
\r
5539 fprintf(fout, "\n\nHistograms and 1-D densities\n");
\r
5540 for(jj=SkipColumns; jj<p; jj++) {
\r
5541 memmove(y, data+jj*n, n*sizeof(double));
\r
5542 qsort(y, (size_t)n, sizeof(double), comparedouble);
\r
5543 fprintf(fout, "\n%s\nmidvalue freq f(x)\n\n", varstr[jj]);
\r
5544 /* steplength for 1-d kernel density estimation, from Eq 3.24, 3.30, 3.31 */
\r
5545 if(propternary) { minx[jj]=0; maxx[jj]=1; }
\r
5546 gap[jj] = (maxx[jj]-minx[jj])/nbin;
\r
5547 d = sqrt(var[jj*p+jj]);
\r
5548 h = ((y[(int)(n*.75)] - y[(int)(n*.25)])/1.34) * 0.9*pow((double)n,-0.2);
\r
5550 density1d(fout, y, n, nbin, minx[jj], gap[jj], h, space, propternary);
\r
5551 printf(" variable %2d/%d (%s): %s%30s\r", jj+1,p,varstr[jj], printtime(timestr),"");
\r
5554 /* 2-D histogram and density */
\r
5555 if(nf2d<=0) return(0);
\r
5556 h = 2.4*pow((double)n, -1/6.0);
\r
5557 fprintf(fout, "\n2-D histogram and density\n");
\r
5558 for(k2d=0; k2d<nf2d; k2d++) {
\r
5559 jj = min2(ivar_f2d[k2d][0], ivar_f2d[k2d][1]);
\r
5560 kk = max2(ivar_f2d[k2d][0], ivar_f2d[k2d][1]);
\r
5561 printf("2-D smoothing for variables %s & %s\n", varstr[jj], varstr[kk]);
\r
5562 fprintf(fout, "\n%s\t%s\tfreq\tdensity\n\n", varstr[jj], varstr[kk]);
\r
5563 v2d[0] = var[jj*p+jj];
\r
5564 v2d[1] = v2d[2] = var[jj*p+kk];
\r
5565 v2d[3] = var[kk*p+kk];
\r
5566 density2d(fout, data+jj*n, data+kk*n, n, nbin, minx[jj], minx[kk], gap[jj], gap[kk], v2d, h, space, propternary);
\r
5568 free(data); free(mean); free(space); free(line);
\r
5569 printf("\n%10s used\n", printtime(timestr));
\r
5573 int DescriptiveStatisticsSimple (FILE *fout, char infile[], int SkipColumns)
\r
5575 FILE *fin=gfopen(infile,"r");
\r
5577 char *fmt=" %9.6f", *fmt1=" %9.4f", timestr[32];
\r
5578 double *data, *x, *mean, *median, *minx, *maxx, *x005,*x995,*x025,*x975,*xHPD025,*xHPD975,*var;
\r
5579 double *Tint, tmp[2], *y;
\r
5581 static int lline=1000000, ifields[MAXNFIELDS], HasHeader=1;
\r
5582 static char varstr[MAXNFIELDS][96]={""};
\r
5584 if((line=(char*)malloc(lline*sizeof(char)))==NULL) error2("oom ds");
\r
5585 scanfile(fin, &n, &p, &HasHeader, line, ifields);
\r
5586 printf("\n%d records, %d variables\n", n, p);
\r
5588 data = (double*)malloc(p*n*sizeof(double));
\r
5589 mean = (double*)malloc((p*13+n)*sizeof(double));
\r
5590 if (data==NULL||mean==NULL) error2("oom DescriptiveStatistics.");
\r
5591 memset(data, 0, p*n*sizeof(double));
\r
5592 memset(mean, 0, (p*12+n)*sizeof(double));
\r
5593 median=mean+p; minx=median+p; maxx=minx+p;
\r
5594 x005=maxx+p; x995=x005+p; x025=x995+p; x975=x025+p; xHPD025=x975+p; xHPD975=xHPD025+p;
\r
5595 var=xHPD975+p; Tint=var+p; y=Tint+p;
\r
5598 for(i=0; i<p; i++) sscanf(line+ifields[i], "%s", varstr[i]);
\r
5599 for(i=0; i<n; i++)
\r
5600 for(j=0; j<p; j++)
\r
5601 fscanf(fin, "%lf", &data[j*n+i]);
\r
5604 printf("Collecting mean, median, min, max, percentiles, etc.\n");
\r
5605 for(j=SkipColumns,x=data+j*n; j<p; j++,x+=n) {
\r
5606 memmove(y, x, n*sizeof(double));
\r
5607 Tint[j] = 1/Eff_IntegratedCorrelationTime(y, n, &mean[j], &var[j]);
\r
5608 qsort(x, (size_t)n, sizeof(double), comparedouble);
\r
5609 minx[j] = x[0]; maxx[j] = x[n-1];
\r
5610 median[j] = (n%2==0 ? (x[n/2]+x[n/2+1])/2 : x[(n+1)/2]);
\r
5611 x005[j] = x[(int)(n*.005)]; x995[j] = x[(int)(n*.995)];
\r
5612 x025[j] = x[(int)(n*.025)]; x975[j] = x[(int)(n*.975)];
\r
5614 HPDinterval(x, n, tmp, 0.05);
\r
5615 xHPD025[j] = tmp[0];
\r
5616 xHPD975[j] = tmp[1];
\r
5617 if((j+1)%100==0 || j==p-1)
\r
5618 printf("\r\t\t\t%6d/%6d done %s", j+1, p, printtime(timestr));
\r
5621 fprintf(fout,"\n\n ");
\r
5622 for (j=SkipColumns; j<p; j++) fprintf(fout," %s", varstr[j]);
\r
5623 fprintf(fout,"\nmean "); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt,mean[j]);
\r
5624 fprintf(fout,"\nmedian "); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt,median[j]);
\r
5625 fprintf(fout,"\nS.D. "); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt,sqrt(var[j]));
\r
5626 fprintf(fout,"\nmin "); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt,minx[j]);
\r
5627 fprintf(fout,"\nmax "); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt,maxx[j]);
\r
5628 fprintf(fout,"\n2.5%% "); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt,x025[j]);
\r
5629 fprintf(fout,"\n97.5%% "); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt,x975[j]);
\r
5630 fprintf(fout,"\n2.5%%HPD "); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt,xHPD025[j]);
\r
5631 fprintf(fout,"\n97.5%%HPD"); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt,xHPD975[j]);
\r
5632 fprintf(fout,"\nESS* "); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt1,n/Tint[j]);
\r
5633 fprintf(fout,"\nEff* "); for(j=SkipColumns;j<p;j++) fprintf(fout,fmt, 1/Tint[j]);
\r
5636 free(data); free(mean); free(line);
\r
5644 /******************************************
\r
5646 *******************************************/
\r
5648 int H_end (double x0[], double x1[], double f0, double f1,
\r
5649 double e1, double e2, int n)
\r
5650 /* Himmelblau termination rule. return 1 for stop, 0 otherwise.
\r
5654 if((r=norm(x0,n))<e2)
\r
5657 if(distance(x1,x0,n)>=r)
\r
5659 r=fabs(f0); if(r<e2) r=1;
\r
5661 if(fabs(f1-f0)>=r)
\r
5666 int AlwaysCenter=0;
\r
5667 double Small_Diff=1e-6; /* reasonable values 1e-5, 1e-7 */
\r
5669 int gradient (int n, double x[], double f0, double g[],
\r
5670 double (*fun)(double x[],int n), double space[], int Central)
\r
5672 /* f0 = fun(x) is always given.
\r
5675 double *x0=space, *x1=space+n, eh0=Small_Diff, eh; /* 1e-7 */
\r
5678 for(i=0; i<n; i++) {
\r
5679 for(j=0; j<n; j++)
\r
5680 x0[j] = x1[j] = x[j];
\r
5681 eh = pow(eh0*(fabs(x[i])+1), 0.67);
\r
5682 x0[i] -= eh; x1[i] += eh;
\r
5683 g[i] = ((*fun)(x1,n) - (*fun)(x0,n))/(eh*2.0);
\r
5687 for(i=0; i<n; i++) {
\r
5688 for(j=0; j<n; j++)
\r
5690 eh=eh0*(fabs(x[i])+1);
\r
5692 g[i] = ((*fun)(x1,n)-f0)/eh;
\r
5698 int Hessian (int n, double x[], double f0, double g[], double H[],
\r
5699 double (*fun)(double x[], int n), double space[])
\r
5701 /* Hessian matrix H[n*n] by the central difference method.
\r
5702 # of function calls: 2*n*n
\r
5705 double *x1=space, *h=x1+n, h0=Small_Diff*2; /* h0=1e-5 or 1e-6 */
\r
5706 double fpp,fmm,fpm,fmp; /* p:+ m:- */
\r
5708 for(k=0; k<n; k++) {
\r
5709 h[k] = h0*(1 + fabs(x[k]));
\r
5711 printf("Hessian warning: x[%d] = %8.5g < h = %8.5g.\n", k+1, x[k],h[k]);
\r
5713 for(i=0; i<n; i++) {
\r
5714 for (j=i; j<n; j++) {
\r
5715 for(k=0; k<n; k++) x1[k] = x[k];
\r
5718 fpp = (*fun)(x1,n); /* (+hi, +hj) */
\r
5721 fmm = (*fun)(x1,n); /* (-hi, -hj) */
\r
5723 H[i*n+i] = (fpp + fmm - 2*f0)/(4*h[i]*h[i]);
\r
5724 g[i] = (fpp - fmm)/(h[i]*4);
\r
5727 x1[i] += 2*h[i]; fpm = (*fun)(x1,n); /* (+hi, -hj) */
\r
5728 x1[i] -= 2*h[i]; x1[j] += 2*h[j]; fmp = (*fun)(x1,n); /* (-hi, +hj) */
\r
5729 H[i*n+j] = H[j*n+i] = (fpp + fmm - fpm - fmp)/(4*h[i]*h[j]);
\r
5736 int jacobi_gradient (double x[], double J[],
\r
5737 int (*fun) (double x[], double y[], int nx, int ny),
\r
5738 double space[], int nx, int ny);
\r
5740 int jacobi_gradient (double x[], double J[],
\r
5741 int (*fun) (double x[], double y[], int nx, int ny),
\r
5742 double space[], int nx, int ny)
\r
5744 /* Jacobi by central difference method
\r
5745 J[ny][nx] space[2*nx+2*ny]
\r
5748 double *x0=space, *x1=space+nx, *y0=x1+nx, *y1=y0+ny, eh0=1.0e-4, eh;
\r
5751 FOR (j, nx) x0[j]=x1[j]=x[j];
\r
5752 eh=(x[i]==0.0) ? eh0 : fabs(x[i])*eh0;
\r
5753 x0[i] -= eh; x1[i] += eh;
\r
5754 (*fun) (x0, y0, nx, ny);
\r
5755 (*fun) (x1, y1, nx, ny);
\r
5756 FOR (j,ny) J[j*nx+i] = (y1[j]-y0[j])/(eh*2.0);
\r
5761 int nls2 (FILE *fout, double *sx, double * x0, int nx,
\r
5762 int (*fun)(double x[], double y[], int nx, int ny),
\r
5763 int (*jacobi)(double x[], double J[], int nx, int ny),
\r
5764 int (*testx) (double x[], int nx),
\r
5767 /* non-linear least squares: minimization of s=f(x)^2.
\r
5768 by the damped NLS, or Levenberg-Marguard-Morrison(LMM) method.
\r
5769 x[n] C[n,n+1] J[ny,n] y[ny] iworker[n]
\r
5771 int n=nx, ii, i, i1, j, istate=0, increase=0, maxround=500,sspace;
\r
5772 double s0=0.0, s=0.0, t;
\r
5773 double v=0.0, vmax=1.0/e, bigger=2.5, smaller=0.75;
\r
5774 /* v : Marguardt factor, suggested factors in SSL II (1.5,0.5) */
\r
5775 double *x, *g, *p, *C, *J, *y, *space, *space_J;
\r
5777 sspace=(n*(n+4+ny)+ny+2*(n+ny))*sizeof(double);
\r
5778 if((space=(double*)malloc(sspace))==NULL) error2("oom in nls2");
\r
5779 zero (space, n*(n+4+ny)+ny);
\r
5780 x=space; g=x+n; p=g+n; C=p+n; J=C+n*(n+1); y=J+ny*n; space_J=y+ny;
\r
5782 (*fun) (x0, y, n, ny);
\r
5783 for (i=0, s0=0; i<ny; i++) s0 += y[i]*y[i];
\r
5785 FOR (ii, maxround) {
\r
5787 if (jacobi) (*jacobi) (x0, J, n, ny);
\r
5788 else jacobi_gradient (x0, J, fun, space_J, n, ny);
\r
5791 for (j=0,t=0; j<ny*n; j++)
\r
5793 v = sqrt (t) / (double) (ny*n); /* v = 0.0; */
\r
5797 for (j=0,t=0; j<ny; j++) t += J[j*n+i] * y[j];
\r
5799 C[i*(n+1)+n] = -t;
\r
5800 for (j=0; j<=i; j++) {
\r
5801 for (i1=0,t=0; i1<ny; i1++) t += J[i1*n+i] * J[i1*n+j];
\r
5802 C[i*(n+1)+j] = C[j*(n+1)+i] = t;
\r
5804 C[i*(n+1)+i] += v*v;
\r
5807 if (matinv( C,n,n+1, y+ny) == -1) {
\r
5811 FOR (i,n) p[i] = C[i*(n+1)+n];
\r
5813 t = bound (n, x0, p, x, testx);
\r
5815 FOR (i,n) x[i] = x0[i] + t * p[i];
\r
5817 (*fun) (x, y, n, ny);
\r
5818 for (i=0,s=0; i<ny; i++) s += y[i]*y[i];
\r
5821 fprintf (fout,"\n%4d %10.6f",ii+1,s);
\r
5822 /* FOR(i,n) fprintf(fout,"%8.4f",x[i]); */
\r
5824 if (s0<s) increase = 1;
\r
5825 if (H_end(x0,x,s0,s,e,e,n)) break;
\r
5826 if (increase) { v*=bigger; if (v>vmax) { istate=1; break; } }
\r
5827 else { v*=smaller; xtoy (x, x0, n); s0=s; }
\r
5828 } /* ii, maxround */
\r
5829 if (increase) *sx=s0;
\r
5830 else { *sx=s; xtoy(x, x0, n); }
\r
5831 if (ii == maxround) istate=-1;
\r
5838 double bound (int nx, double x0[], double p[], double x[],
\r
5839 int(*testx)(double x[], int nx))
\r
5841 /* find largest t so that x[]=x0[]+t*p[] is still acceptable.
\r
5842 for bounded minimization, p is possibly changed in this function
\r
5846 double factor=20, by=1, small=1e-8; /* small=(SIZEp>1?1e-7:1e-8) */
\r
5850 x[i]=x0[i]+small*p[i];
\r
5851 if ((*testx) (x, nx)) { p[i]=0.0; nd++; }
\r
5854 if (nd==nx) { if (noisy) puts ("bound:no move.."); return (0); }
\r
5856 for (by=0.75; ; ) {
\r
5857 FOR (i,nx) x[i]=x0[i]+factor*p[i];
\r
5858 if ((*testx)(x,nx)==0) break;
\r
5867 double LineSearch (double(*fun)(double x),double *f,double *x0,double xb[2],double step, double e)
\r
5869 /* linear search using quadratic interpolation
\r
5871 From Wolfe M. A. 1978. Numerical methods for unconstrained
\r
5872 optimization: An introduction. Van Nostrand Reinhold Company, New York.
\r
5874 step is used to find the bracket (a1,a2,a3)
\r
5876 This is the same routine as LineSearch2(), but I have not got time
\r
5877 to test and improve it properly. Ziheng note, September, 2002
\r
5879 int ii=0, maxround=100, i;
\r
5880 double factor=2, step1, percentUse=0;
\r
5881 double a0,a1,a2,a3,a4=-1,a5,a6, f0,f1,f2,f3,f4=-1,f5,f6;
\r
5883 /* find a bracket (a1,a2,a3) with function values (f1,f2,f3)
\r
5884 so that a1<a2<a3 and f2<f1 and f2<f3
\r
5887 if(step<=0) return(*x0);
\r
5888 a0=a1=a2=a3=f0=f1=f2=f3=-1;
\r
5889 if(*x0<xb[0]||*x0>xb[1])
\r
5890 error2("err LineSearch: x0 out of range");
\r
5891 f2=f0=fun(a2=a0=*x0);
\r
5892 step1=min2(step,(a0-xb[0])/4);
\r
5893 step1=max2(step1,e);
\r
5894 for(i=0,a1=a0,f1=f0; ; i++) {
\r
5895 a1-=(step1*=factor);
\r
5900 a3=a2; f3=f2; a2=a1; f2=f1;
\r
5904 a1=xb[0]; f1=fun(a1);
\r
5905 if(f1<=f2) { a2=a1; f2=f1; }
\r
5909 /* if(noisy>2) printf("\ta = %.6f\tf = %.6f %5d\n", a2, f2, NFunCall);
\r
5914 if(i==0) { /* *x0 is the best point during the previous search */
\r
5915 step1=min2(step,(xb[1]-a0)/4);
\r
5916 for(i=0,a3=a2,f3=f2; ; i++) {
\r
5917 a3+=(step1*=factor);
\r
5922 { a1=a2; f1=f2; a2=a3; f2=f3; }
\r
5925 a3=xb[1]; f3=fun(a3);
\r
5926 if(f3<f2) { a2=a3; f2=f3; }
\r
5930 if(noisy>2) printf("\ta = %.6f\tf = %.6f %5d\n", a3, f3, NFunCall);
\r
5935 /* iteration by quadratic interpolation, fig 2.2.9-10 (pp 71-71) */
\r
5936 for (ii=0; ii<maxround; ii++) {
\r
5937 /* a4 is the minimum from the parabola over (a1,a2,a3) */
\r
5939 if (a1>a2+1e-99 || a3<a2-1e-99 || f2>f1+1e-99 || f2>f3+1e-99) /* for linux */
\r
5940 { printf("\npoints out of order (ii=%d)!",ii+1); break; }
\r
5942 a4 = (a2-a3)*f1+(a3-a1)*f2+(a1-a2)*f3;
\r
5943 if (fabs(a4)>1e-100)
\r
5944 a4=((a2*a2-a3*a3)*f1+(a3*a3-a1*a1)*f2+(a1*a1-a2*a2)*f3)/(2*a4);
\r
5945 if (a4>a3 || a4<a1) a4=(a1+a2)/2; /* out of range */
\r
5946 else percentUse++;
\r
5950 if (noisy>2) printf("\ta = %.6f\tf = %.6f %5d\n", a4, f4, NFunCall);
\r
5953 if (fabs(f2-f4)*(1+fabs(f2))<=e && fabs(a2-a4)*(1+fabs(a2))<=e) break;
\r
5955 if (a1<=a4 && a4<=a2) { /* fig 2.2.10 */
\r
5956 if (fabs(a2-a4)>.2*fabs(a1-a2)) {
\r
5957 if (f1>=f4 && f4<=f2) { a3=a2; a2=a4; f3=f2; f2=f4; }
\r
5958 else { a1=a4; f1=f4; }
\r
5962 a5=(a2+a3)/2; f5=fun(a5);
\r
5963 if (f5>f2) { a1=a4; a3=a5; f1=f4; f3=f5; }
\r
5964 else { a1=a2; a2=a5; f1=f2; f2=f5; }
\r
5967 a5=(a1+a4)/2; f5=fun(a5);
\r
5968 if (f5>=f4 && f4<=f2)
\r
5969 { a3=a2; a2=a4; a1=a5; f3=f2; f2=f4; f1=f5; }
\r
5971 a6=(a1+a5)/2; f6=fun(a6);
\r
5973 { a1=a6; a2=a5; a3=a4; f1=f6; f2=f5; f3=f4; }
\r
5974 else { a2=a6; a3=a5; f2=f6; f3=f5; }
\r
5979 else { /* fig 2.2.9 */
\r
5980 if (fabs(a2-a4)>.2*fabs(a2-a3)) {
\r
5981 if (f2>=f4 && f4<=f3) { a1=a2; a2=a4; f1=f2; f2=f4; }
\r
5982 else { a3=a4; f3=f4; }
\r
5986 a5=(a1+a2)/2; f5=fun(a5);
\r
5987 if (f5>f2) { a1=a5; a3=a4; f1=f5; f3=f4; }
\r
5988 else { a3=a2; a2=a5; f3=f2; f2=f5; }
\r
5991 a5=(a3+a4)/2; f5=fun(a5);
\r
5992 if (f2>=f4 && f4<=f5)
\r
5993 { a1=a2; a2=a4; a3=a5; f1=f2; f2=f4; f3=f5; }
\r
5995 a6=(a3+a5)/2; f6=fun(a6);
\r
5997 { a1=a4; a2=a5; a3=a6; f1=f4; f2=f5; f3=f6; }
\r
5998 else { a1=a5; a2=a6; f1=f5; f2=f6; }
\r
6004 if (f2<=f4) { *f=f2; a4=a2; }
\r
6007 return (*x0=(a4+a2)/2);
\r
6012 double fun_LineSearch (double t, double (*fun)(double x[],int n),
\r
6013 double x0[], double p[], double x[], int n);
\r
6015 double fun_LineSearch (double t, double (*fun)(double x[],int n),
\r
6016 double x0[], double p[], double x[], int n)
\r
6017 { int i; FOR (i,n) x[i]=x0[i] + t*p[i]; return( (*fun)(x, n) ); }
\r
6021 double LineSearch2 (double(*fun)(double x[],int n), double *f, double x0[],
\r
6022 double p[], double step, double limit, double e, double space[], int n)
\r
6024 /* linear search using quadratic interpolation
\r
6025 from x0[] in the direction of p[],
\r
6026 x = x0 + a*p a ~(0,limit)
\r
6027 returns (a). *f: f(x0) for input and f(x) for output
\r
6029 x0[n] x[n] p[n] space[n]
\r
6031 adapted from Wolfe M. A. 1978. Numerical methods for unconstrained
\r
6032 optimization: An introduction. Van Nostrand Reinhold Company, New York.
\r
6034 step is used to find the bracket and is increased or reduced as necessary,
\r
6035 and is not terribly important.
\r
6037 int ii=0, maxround=10, status, i, nsymb=0;
\r
6038 double *x=space, factor=4, small=1e-10, smallgapa=0.2;
\r
6039 double a0,a1,a2,a3,a4=-1,a5,a6, f0,f1,f2,f3,f4=-1,f5,f6;
\r
6041 /* look for bracket (a1, a2, a3) with function values (f1, f2, f3)
\r
6042 step length step given, and only in the direction a>=0
\r
6046 printf ("\n%3d h-m-p %7.4f %6.4f %8.4f ",Iround+1,step,limit,norm(p,n));
\r
6048 if (step<=0 || limit<small || step>=limit) {
\r
6050 printf ("\nh-m-p:%20.8e%20.8e%20.8e %12.6f\n",step,limit,norm(p,n),*f);
\r
6053 a0=a1=0; f1=f0=*f;
\r
6054 a2=a0+step; f2=fun_LineSearch(a2, fun,x0,p,x,n);
\r
6055 if (f2>f1) { /* reduce step length so the algorithm is decreasing */
\r
6058 if (step<small) return (0);
\r
6060 a2=a0+step; f2=fun_LineSearch(a2, fun,x0,p,x,n);
\r
6061 if (f2<=f1) break;
\r
6062 if(!PAML_RELEASE && noisy>2) { printf("-"); nsymb++; }
\r
6065 else { /* step length is too small? */
\r
6068 if (step>limit) step=limit;
\r
6069 a3=a0+step; f3=fun_LineSearch(a3, fun,x0,p,x,n);
\r
6070 if (f3>=f2) break;
\r
6072 if(!PAML_RELEASE && noisy>2) { printf("+"); nsymb++; }
\r
6073 a1=a2; f1=f2; a2=a3; f2=f3;
\r
6074 if (step>=limit) {
\r
6075 if(!PAML_RELEASE && noisy>2) for(; nsymb<5; nsymb++) printf(" ");
\r
6076 if (noisy>2) printf(" %12.6f%3c %6.4f %5d", *f=f3, 'm', a3, NFunCall);
\r
6077 *f=f3; return(a3);
\r
6082 /* iteration by quadratic interpolation, fig 2.2.9-10 (pp 71-71) */
\r
6083 for (ii=0; ii<maxround; ii++) {
\r
6084 /* a4 is the minimum from the parabola over (a1,a2,a3) */
\r
6085 a4 = (a2-a3)*f1+(a3-a1)*f2+(a1-a2)*f3;
\r
6086 if(fabs(a4)>1e-100)
\r
6087 a4 = ((a2*a2-a3*a3)*f1+(a3*a3-a1*a1)*f2+(a1*a1-a2*a2)*f3)/(2*a4);
\r
6088 if (a4>a3 || a4<a1) { /* out of range */
\r
6093 if((a4<=a2 && a2-a4>smallgapa*(a2-a1)) || (a4>a2 && a4-a2>smallgapa*(a3-a2)))
\r
6098 f4 = fun_LineSearch(a4, fun,x0,p,x,n);
\r
6099 if(!PAML_RELEASE && noisy>2) putchar(status);
\r
6100 if (fabs(f2-f4)<e*(1+fabs(f2))) {
\r
6101 if(!PAML_RELEASE && noisy>2)
\r
6102 for(nsymb+=ii+1; nsymb<5; nsymb++) printf(" ");
\r
6106 /* possible multiple local optima during line search */
\r
6107 if(!PAML_RELEASE && noisy>2 && ((a4<a2&&f4>f1) || (a4>a2&&f4>f3))) {
\r
6108 printf("\n\na %12.6f %12.6f %12.6f %12.6f", a1,a2,a3,a4);
\r
6109 printf( "\nf %12.6f %12.6f %12.6f %12.6f\n", f1,f2,f3,f4);
\r
6111 for(a5=a1; a5<=a3; a5+=(a3-a1)/20) {
\r
6112 printf("\t%.6e ",a5);
\r
6113 if(n<5) FOR(i,n) printf("\t%.6f",x0[i] + a5*p[i]);
\r
6114 printf("\t%.6f\n", fun_LineSearch(a5, fun,x0,p,x,n));
\r
6116 puts("Linesearch2 a4: multiple optima?");
\r
6118 if (a4<=a2) { /* fig 2.2.10 */
\r
6119 if (a2-a4>smallgapa*(a2-a1)) {
\r
6120 if (f4<=f2) { a3=a2; a2=a4; f3=f2; f2=f4; }
\r
6121 else { a1=a4; f1=f4; }
\r
6125 a5=(a2+a3)/2; f5=fun_LineSearch(a5, fun,x0,p,x,n);
\r
6126 if (f5>f2) { a1=a4; a3=a5; f1=f4; f3=f5; }
\r
6127 else { a1=a2; a2=a5; f1=f2; f2=f5; }
\r
6130 a5=(a1+a4)/2; f5=fun_LineSearch(a5, fun,x0,p,x,n);
\r
6132 { a3=a2; a2=a4; a1=a5; f3=f2; f2=f4; f1=f5; }
\r
6134 a6=(a1+a5)/2; f6=fun_LineSearch(a6, fun,x0,p,x,n);
\r
6136 { a1=a6; a2=a5; a3=a4; f1=f6; f2=f5; f3=f4; }
\r
6137 else { a2=a6; a3=a5; f2=f6; f3=f5; }
\r
6142 else { /* fig 2.2.9 */
\r
6143 if (a4-a2>smallgapa*(a3-a2)) {
\r
6144 if (f2>=f4) { a1=a2; a2=a4; f1=f2; f2=f4; }
\r
6145 else { a3=a4; f3=f4; }
\r
6149 a5=(a1+a2)/2; f5=fun_LineSearch(a5, fun,x0,p,x,n);
\r
6150 if (f5>f2) { a1=a5; a3=a4; f1=f5; f3=f4; }
\r
6151 else { a3=a2; a2=a5; f3=f2; f2=f5; }
\r
6154 a5=(a3+a4)/2; f5=fun_LineSearch(a5, fun,x0,p,x,n);
\r
6156 { a1=a2; a2=a4; a3=a5; f1=f2; f2=f4; f3=f5; }
\r
6158 a6=(a3+a5)/2; f6=fun_LineSearch(a6, fun,x0,p,x,n);
\r
6160 { a1=a4; a2=a5; a3=a6; f1=f4; f2=f5; f3=f6; }
\r
6161 else { a1=a5; a2=a6; f1=f5; f2=f6; }
\r
6168 if (f2>f0 && f4>f0) a4=0;
\r
6169 if (f2<=f4) { *f=f2; a4=a2; }
\r
6171 if(noisy>2) printf(" %12.6f%3d %6.4f %5d", *f, ii, a4, NFunCall);
\r
6179 #define Safeguard_Newton
\r
6182 int Newton (FILE *fout, double *f, double (* fun)(double x[], int n),
\r
6183 int (* ddfun) (double x[], double *fx, double dx[], double ddx[], int n),
\r
6184 int (*testx) (double x[], int n),
\r
6185 double x0[], double space[], double e, int n)
\r
6187 int i,j, maxround=500;
\r
6188 double f0=1e40, small=1e-10, h, SIZEp, t, *H, *x, *g, *p, *tv;
\r
6190 H=space, x=H+n*n; g=x+n; p=g+n, tv=p+n;
\r
6192 printf ("\n\nIterating by Newton\tnp:%6d\nInitial:", n);
\r
6193 FOR (i,n) printf ("%8.4f", x0[i]); FPN (F0);
\r
6194 if (fout) fprintf (fout, "\n\nNewton\tnp:%6d\n", n);
\r
6195 if (testx (x0, n)) error2("Newton..invalid initials.");
\r
6196 FOR (Iround, maxround) {
\r
6198 (*ddfun) (x0, f, g, H, n);
\r
6200 *f = (*fun)(x0, n);
\r
6201 Hessian (n, x0, *f, g, H, fun, tv);
\r
6203 matinv(H, n, n, tv);
\r
6204 FOR (i,n) for (j=0,p[i]=0; j<n; j++) p[i]-=H[i*n+j]*g[j];
\r
6206 h=bound (n, x0, p, tv, testx);
\r
6210 #ifdef Safeguard_Newton
\r
6213 FOR (i,n) x[i]=x0[i]+t*p[i];
\r
6214 if ((*f=fun(x,n)) < f0) break;
\r
6218 if (t<small) t=min2(h, .5);
\r
6221 FOR (i,n) x[i]=x0[i]+t*p[i];
\r
6223 printf ("\n%3d h:%7.4f %12.6f x", Iround+1, SIZEp, *f);
\r
6224 FOR (i,n) printf ("%7.4f ", x0[i]);
\r
6227 fprintf (fout, "\n%3d h:%7.4f%12.6f x", Iround+1, SIZEp, *f);
\r
6228 FOR (i,n) fprintf (fout, "%7.4f ", x0[i]);
\r
6231 if ((h=norm(x0,n))<e) h=1;
\r
6232 if (SIZEp<0.01 && distance(x,x0,n)<h*e) break;
\r
6237 xtoy (x, x0, n); *f=fun(x0, n);
\r
6239 if (Iround==maxround) return(-1);
\r
6244 int gradientB (int n, double x[], double f0, double g[],
\r
6245 double (*fun)(double x[],int n), double space[], int xmark[]);
\r
6247 extern int noisy, Iround;
\r
6248 extern double SIZEp;
\r
6250 int gradientB (int n, double x[], double f0, double g[],
\r
6251 double (*fun)(double x[],int n), double space[], int xmark[])
\r
6253 /* f0=fun(x) is always provided.
\r
6254 xmark=0: central; 1: upper; -1: down
\r
6257 double *x0=space, *x1=space+n, eh0=Small_Diff, eh; /* eh0=1e-6 || 1e-7 */
\r
6259 for(i=0; i<n; i++) {
\r
6260 eh = eh0*(fabs(x[i])+1);
\r
6261 if (xmark[i]==0 && (AlwaysCenter || SIZEp<1)) { /* central */
\r
6262 for(j=0; j<n; j++) x0[j] = x1[j] = x[j];
\r
6263 eh = pow(eh, .67); x0[i] -= eh; x1[i] += eh;
\r
6264 g[i] = ((*fun)(x1,n) - (*fun)(x0,n))/(eh*2.0);
\r
6266 else { /* forward or backward */
\r
6267 for(j=0; j<n; j++) x1[j] = x[j];
\r
6268 if (xmark[i]) eh *= -xmark[i];
\r
6270 g[i] = ((*fun)(x1,n) - f0)/eh;
\r
6283 extern FILE *frst;
\r
6285 int ming2 (FILE *fout, double *f, double (*fun)(double x[], int n),
\r
6286 int (*dfun)(double x[], double *f, double dx[], int n),
\r
6287 double x[], double xb[][2], double space[], double e, int n)
\r
6289 /* n-variate minimization with bounds using the BFGS algorithm
\r
6290 g0[n] g[n] p[n] x0[n] y[n] s[n] z[n] H[n*n] C[n*n] tv[2*n]
\r
6292 Size of space should be (check carefully?)
\r
6293 #define spaceming2(n) ((n)*((n)*2+9+2)*sizeof(double))
\r
6294 nfree: # free variables
\r
6295 xmark[i]=0 for inside space; -1 for lower boundary; 1 for upper boundary.
\r
6296 x[] has initial values at input and returns the estimates in return.
\r
6297 ix[i] specifies the i-th free parameter
\r
6300 int i,j, i1,i2,it, maxround=10000, fail=0, *xmark, *ix, nfree;
\r
6301 int Ngoodtimes=2, goodtimes=0;
\r
6302 double small=1.e-30, sizep0=0; /* small value for checking |w|=0 */
\r
6303 double f0, *g0, *g, *p, *x0, *y, *s, *z, *H, *C, *tv;
\r
6304 double w,v, alpha, am, h, maxstep=8;
\r
6306 if(n==0) return(0);
\r
6307 g0=space; g=g0+n; p=g+n; x0=p+n;
\r
6308 y=x0+n; s=y+n; z=s+n; H=z+n; C=H+n*n, tv=C+n*n;
\r
6309 xmark=(int*)(tv+2*n); ix=xmark+n;
\r
6311 for(i=0; i<n; i++) { xmark[i]=0; ix[i]=i; }
\r
6312 for(i=0,nfree=0;i<n;i++) {
\r
6313 if(x[i]<=xb[i][0]) { x[i]=xb[i][0]; xmark[i]=-1; continue; }
\r
6314 if(x[i]>=xb[i][1]) { x[i]=xb[i][1]; xmark[i]= 1; continue; }
\r
6317 if(noisy>2 && nfree<n && n<50) {
\r
6318 FPN(F0); FOR(j,n) printf(" %9.6f", x[j]); FPN(F0);
\r
6319 FOR(j,n) printf(" %9.5f", xb[j][0]); FPN(F0);
\r
6320 FOR(j,n) printf(" %9.5f", xb[j][1]); FPN(F0);
\r
6321 if(nfree<n && noisy>=3) printf("warning: ming2, %d paras at boundary.",n-nfree);
\r
6324 f0=*f=(*fun)(x,n);
\r
6328 printf ("\nIterating by ming2\nInitial: fx= %12.6f\nx=",f0);
\r
6329 FOR(i,n) printf(" %8.5f", x[i]); FPN(F0);
\r
6332 if (dfun) (*dfun) (x0, &f0, g0, n);
\r
6333 else gradientB (n, x0, f0, g0, fun, tv, xmark);
\r
6335 identity (H,nfree);
\r
6336 for(Iround=0; Iround<maxround; Iround++) {
\r
6338 fprintf (fout, "\n%3d %7.4f %13.6f x: ", Iround,sizep0,f0);
\r
6339 FOR (i,n) fprintf (fout, "%8.5f ", x0[i]);
\r
6343 for (i=0,zero(p,n); i<nfree; i++) FOR (j,nfree)
\r
6344 p[ix[i]] -= H[i*nfree+j]*g0[ix[j]];
\r
6346 SIZEp = norm(p,n); /* check this */
\r
6348 for (i=0,am=maxstep; i<n; i++) { /* max step length */
\r
6349 if (p[i]>0 && (xb[i][1]-x0[i])/p[i]<am) am=(xb[i][1]-x0[i])/p[i];
\r
6350 else if (p[i]<0 && (xb[i][0]-x0[i])/p[i]<am) am=(xb[i][0]-x0[i])/p[i];
\r
6354 h=fabs(2*f0*.01/innerp(g0,p,n)); /* check this?? */
\r
6355 h=min2(h,am/2000);
\r
6359 h=norm(s,nfree)/SIZEp;
\r
6362 h = max2(h,1e-5); h = min2(h,am/5);
\r
6364 alpha = LineSearch2(fun,f,x0,p,h,am, min2(1e-3,e), tv,n); /* n or nfree? */
\r
6368 if (AlwaysCenter) { Iround=maxround; break; }
\r
6369 else { AlwaysCenter=1; identity(H,n); fail=1; }
\r
6372 { if(noisy>2) printf(".. "); identity(H,nfree); fail=1; }
\r
6376 FOR(i,n) x[i]=x0[i]+alpha*p[i];
\r
6377 w=min2(2,e*1000); if(e<1e-4 && e>1e-6) w=0.01;
\r
6379 if(Iround==0 || SIZEp<sizep0 || (SIZEp<.001 && sizep0<.001)) goodtimes++;
\r
6381 if((n==1||goodtimes>=Ngoodtimes) && SIZEp<(e>1e-5?1:.001)
\r
6382 && H_end(x0,x,f0,*f,e,e,n))
\r
6386 (*dfun) (x, f, g, n);
\r
6388 gradientB (n, x, *f, g, fun, tv, xmark);
\r
6390 for(i=0; i<n; i++) fprintf(frst,"%9.5f", x[i]); fprintf(frst, "%6d",AlwaysCenter);
\r
6391 for(i=0; i<n; i++) fprintf(frst,"%9.2f", g[i]); FPN(frst);
\r
6393 /* modify the working set */
\r
6394 for(i=0; i<n; i++) { /* add constraints, reduce H */
\r
6395 if (xmark[i]) continue;
\r
6396 if (fabs(x[i]-xb[i][0])<1e-6 && -g[i]<0) xmark[i]=-1;
\r
6397 else if (fabs(x[i]-xb[i][1])<1e-6 && -g[i]>0) xmark[i]=1;
\r
6398 if (xmark[i]==0) continue;
\r
6399 xtoy (H, C, nfree*nfree);
\r
6400 for(it=0; it<nfree; it++) if (ix[it]==i) break;
\r
6401 for (i1=it; i1<nfree-1; i1++) ix[i1]=ix[i1+1];
\r
6402 for (i1=0,nfree--; i1<nfree; i1++) FOR (i2,nfree)
\r
6403 H[i1*nfree+i2]=C[(i1+(i1>=it))*(nfree+1) + i2+(i2>=it)];
\r
6405 for (i=0,it=0,w=0; i<n; i++) { /* delete a constraint, enlarge H */
\r
6406 if (xmark[i]==-1 && -g[i]>w) { it=i; w=-g[i]; }
\r
6407 else if (xmark[i]==1 && -g[i]<-w) { it=i; w=g[i]; }
\r
6409 if (w>10*SIZEp/nfree) { /* *** */
\r
6410 xtoy (H, C, nfree*nfree);
\r
6411 FOR (i1,nfree) FOR (i2,nfree) H[i1*(nfree+1)+i2]=C[i1*nfree+i2];
\r
6412 FOR (i1,nfree+1) H[i1*(nfree+1)+nfree]=H[nfree*(nfree+1)+i1]=0;
\r
6413 H[(nfree+1)*(nfree+1)-1]=1;
\r
6414 xmark[it]=0; ix[nfree++]=it;
\r
6418 printf (" | %d/%d", n-nfree, n);
\r
6419 /* FOR (i,n) if (xmark[i]) printf ("%4d", i+1); */
\r
6421 for (i=0,f0=*f; i<nfree; i++)
\r
6422 { y[i]=g[ix[i]]-g0[ix[i]]; s[i]=x[ix[i]]-x0[ix[i]]; }
\r
6423 FOR (i,n) { g0[i]=g[i]; x0[i]=x[i]; }
\r
6426 /* renewal of H varies with different algorithms */
\r
6428 /* Symmetrical Rank One (Broyden, C. G., 1967) */
\r
6429 for (i=0,w=.0; i<nfree; i++) {
\r
6430 for (j=0,v=.0; j<nfree; j++) v += H[i*nfree+j] * y[j];
\r
6434 if (fabs(w)<small) { identity(H,nfree); fail=1; continue; }
\r
6435 FOR (i,nfree) FOR (j,nfree) H[i*nfree+j] += z[i]*z[j]/w;
\r
6436 #elif (defined DFP)
\r
6437 /* Davidon (1959), Fletcher and Powell (1963). */
\r
6438 for (i=0,w=v=0.; i<nfree; i++) {
\r
6439 for (j=0,z[i]=0; j<nfree; j++) z[i] += H[i*nfree+j] * y[j];
\r
6440 w += y[i]*z[i]; v += y[i]*s[i];
\r
6442 if (fabs(w)<small || fabs(v)<small) { identity(H,nfree); fail=1; continue;}
\r
6443 FOR (i,nfree) FOR (j,nfree)
\r
6444 H[i*nfree+j] += s[i]*s[j]/v - z[i]*z[j]/w;
\r
6446 for(i=0,w=v=0.; i<nfree; i++) {
\r
6447 for(j=0,z[i]=0.; j<nfree; j++) z[i] += H[i*nfree+j]*y[j];
\r
6448 w += y[i]*z[i]; v += y[i]*s[i];
\r
6450 if (fabs(v)<small) { identity(H,nfree); fail=1; continue; }
\r
6451 FOR (i,nfree) FOR (j,nfree)
\r
6452 H[i*nfree+j] += ((1+w/v)*s[i]*s[j]-z[i]*s[j]-s[i]*z[j])/v;
\r
6454 } /* for (Iround,maxround) */
\r
6456 /* try to remove this after updating LineSearch2() */
\r
6458 if(noisy>2) FPN(F0);
\r
6460 if(Iround==maxround) {
\r
6461 if (fout) fprintf (fout,"\ncheck convergence!\n");
\r
6465 xtoy(H, space, n*n); /* H has variance matrix, or inverse of Hessian */
\r
6473 int ming1 (FILE *fout, double *f, double (* fun)(double x[], int n),
\r
6474 int (*dfun) (double x[], double *f, double dx[], int n),
\r
6475 int (*testx) (double x[], int n),
\r
6476 double x0[], double space[], double e, int n)
\r
6478 /* n-D minimization using quasi-Newton or conjugate gradient algorithms,
\r
6479 using function and its gradient.
\r
6481 g0[n] g[n] p[n] x[n] y[n] s[n] z[n] H[n*n] tv[2*n]
\r
6484 int i,j, maxround=1000, fail=0;
\r
6485 double small=1.e-20; /* small value for checking |w|=0 */
\r
6486 double f0, *g0, *g, *p, *x, *y, *s, *z, *H, *tv;
\r
6489 if (testx (x0, n))
\r
6490 { printf ("\nInvalid initials..\n"); matout(F0,x0,1,n); return(-1); }
\r
6491 f0 = *f = (*fun)(x0, n);
\r
6494 printf ("\n\nIterating by ming1\nInitial: fx= %12.6f\nx=", f0);
\r
6495 FOR (i,n) printf ("%8.4f", x0[i]); FPN (F0);
\r
6498 fprintf (fout, "\n\nIterating by ming1\nInitial: fx= %12.6f\nx=", f0);
\r
6499 FOR (i,n) fprintf (fout, "%10.6f", x0[i]);
\r
6501 g0=space; g=g0+n; p=g+n; x=p+n;
\r
6502 y=x+n; s=y+n; z=s+n; H=z+n; tv=H+n*n;
\r
6503 if (dfun) (*dfun) (x0, &f0, g0, n);
\r
6504 else gradient (n, x0, f0, g0, fun, tv, AlwaysCenter);
\r
6506 SIZEp=0; xtoy (x0, x, n); xtoy (g0,g,n); identity (H,n);
\r
6507 FOR (Iround, maxround) {
\r
6508 FOR (i,n) for (j=0,p[i]=0.; j<n; j++) p[i] -= H[i*n+j]*g[j];
\r
6509 t=bound (n, x0, p, tv, testx);
\r
6511 if (Iround == 0) h = fabs(2*f0*.01/innerp(g,p,n));
\r
6512 else h = norm(s,n)/SIZEp;
\r
6513 h = max2(h,1e-5); h = min2(h,t/8);
\r
6514 SIZEp = norm(p,n);
\r
6516 t = LineSearch2 (fun, f, x0, p, h, t, .00001, tv, n);
\r
6518 if (t<=0 || *f<=0 || *f>1e32) {
\r
6520 if(SIZEp>.1 && noisy>2)
\r
6521 printf("\nSIZEp:%9.4f Iround:%5d", SIZEp, Iround+1);
\r
6522 if (AlwaysCenter) { Iround=maxround; break; }
\r
6523 else { AlwaysCenter=1; identity(H,n); fail=1; }
\r
6525 else { identity(H, n); fail=1; }
\r
6529 FOR(i,n) x[i]=x0[i]+t*p[i];
\r
6532 fprintf (fout, "\n%3d %7.4f%14.6f x", Iround+1, SIZEp, *f);
\r
6533 FOR (i,n) fprintf (fout, "%8.5f ", x[i]);
\r
6536 if (SIZEp<0.001 && H_end (x0,x,f0,*f,e,e,n))
\r
6537 { xtoy(x,x0,n); break; }
\r
6539 if (dfun) (*dfun) (x, f, g, n);
\r
6540 else gradient (n,x,*f,g,fun,tv, (AlwaysCenter||fail||SIZEp<0.01));
\r
6542 for (i=0,f0=*f; i<n; i++)
\r
6543 { y[i]=g[i]-g0[i]; s[i]=x[i]-x0[i]; g0[i]=g[i]; x0[i]=x[i]; }
\r
6545 /* renewal of H varies with different algorithms */
\r
6547 /* Symmetrical Rank One (Broyden, C. G., 1967) */
\r
6548 for (i=0,w=.0; i<n; i++) {
\r
6549 for (j=0,t=.0; j<n; j++) t += H[i*n+j] * y[j];
\r
6553 if (fabs(w)<small) { identity(H,n); fail=1; continue; }
\r
6554 FOR (i,n) FOR (j,n) H[i*n+j] += z[i]*z[j]/w;
\r
6555 #elif (defined DFP)
\r
6556 /* Davidon (1959), Fletcher and Powell (1963). */
\r
6557 for (i=0,w=v=0.; i<n; i++) {
\r
6558 for (j=0,z[i]=.0; j<n; j++) z[i] += H[i*n+j] * y[j];
\r
6559 w += y[i]*z[i]; v += y[i]*s[i];
\r
6561 if (fabs(w)<small || fabs(v)<small) { identity(H,n); fail=1; continue;}
\r
6562 FOR (i,n) FOR (j,n) H[i*n+j] += s[i]*s[j]/v - z[i]*z[j]/w;
\r
6564 for (i=0,w=v=0.; i<n; i++) {
\r
6565 for (j=0,z[i]=0.; j<n; j++) z[i] += H[i*n+j] * y[j];
\r
6566 w+=y[i]*z[i]; v+=y[i]*s[i];
\r
6568 if (fabs(v)<small) { identity(H,n); fail=1; continue; }
\r
6569 FOR (i,n) FOR (j,n)
\r
6570 H[i*n+j] += ( (1+w/v)*s[i]*s[j] - z[i]*s[j] - s[i]*z[j] ) / v;
\r
6573 } /* for (Iround,maxround) */
\r
6575 if (Iround==maxround) {
\r
6576 if (fout) fprintf (fout,"\ncheck convergence!\n");
\r
projects / paml.git / blob