Annotation of OpenXM/src/hgm/mh/src/jack-n.c, Revision 1.36
1.1 takayama 1: #include <stdio.h>
2: #include <stdlib.h>
3: #define _ISOC99_SOURCE
4: #include <math.h>
5: #include <string.h>
6: #include "sfile.h"
7: /*
1.36 ! takayama 8: $OpenXM: OpenXM/src/hgm/mh/src/jack-n.c,v 1.35 2016/01/11 10:55:20 takayama Exp $
1.12 takayama 9: Ref: copied from this11/misc-2011/A1/wishart/Prog
10: jack-n.c, translated from mh.rr or tk_jack.rr in the asir-contrib. License: LGPL
11: Koev-Edelman for higher order derivatives.
12: cf. 20-my-note-mh-jack-n.pdf, /Movies/oxvh/priv-j1/2011-12-14-ke-mh-jack.mov
13: Todo:
14: 1. Cash the transposes of partitions.
15: 2. Use the recurrence to obtain beta().
16: 3. Easier input data file format for mh-n.c
17: Changelog:
1.36 ! takayama 18: 2016.01.12 2F1
1.22 takayama 19: 2014.03.15 http://fe.math.kobe-u.ac.jp/Movies/oxvh/2014-03-11-jack-n-c-automatic see also hgm/doc/ref.html, @s/2014/03/15-my-note-jack-automatic-order-F_A-casta.pdf.
1.18 takayama 20: 2014.03.14, --automatic option. Output estimation data.
1.12 takayama 21: 2012.02.21, porting to OpenXM/src/hgm
22: 2011.12.22, --table option, which is experimental.
23: 2011.12.19, bug fix. jjk() should return double. It can become more than max int.
24: 2011.12.15, mh.r --> jack-n.c
1.1 takayama 25: */
26:
1.3 takayama 27: /****** from mh-n.c *****/
28: static int JK_byFile=1;
1.6 takayama 29: static int JK_deallocate=0;
1.3 takayama 30: #define M_n_default 3
1.4 takayama 31: #define Sample_default 1
1.3 takayama 32: static int M_n=0;
1.1 takayama 33: /* global variables. They are set in setParam() */
1.2 takayama 34: static int Mg; /* n */
35: static int Mapprox; /* m, approximation degree */
36: static double *Beta; /* beta[0], ..., beta[m-1] */
37: static double *Ng; /* freedom n. c=(m+1)/2+n/2; Note that it is a pointer */
38: static double X0g; /* initial point */
39: static double *Iv; /* Initial values of mhg sorted by mhbase() in rd.rr at beta*x0 */
40: static double Ef; /* exponential factor at beta*x0 */
41: static double Hg; /* step size of rk defined in rk.c */
42: static int Dp; /* Data sampling period */
43: static double Xng=0.0; /* the last point */
1.4 takayama 44: static int Sample = Sample_default;
1.1 takayama 45:
46: /* for sample inputs */
1.2 takayama 47: static double *Iv2;
48: static double Ef2;
1.1 takayama 49:
50: #ifdef NAN
51: #else
1.2 takayama 52: #define NAN 3.40282e+38 /* for old 32 bit machines. Todo, configure */
1.1 takayama 53: #endif
54:
55: /* #define M_n 3 defined in the Makefile */ /* number of variables */
56: #define M_n0 3 /* used for tests. Must be equal to M_n */
57: #define M_m_MAX 200
1.3 takayama 58: #define M_nmx M_m_MAX /* maximal of M_n */
1.1 takayama 59: #define A_LEN 1 /* (a_1) , (a_1, ..., a_p)*/
60: #define B_LEN 1 /* (b_1) */
1.36 ! takayama 61: static int P_pFq=1;
! 62: static int Q_pFq=1;
! 63: static double A_pFq[A_LEN];
! 64: static double B_pFq[B_LEN];
! 65: static int Orig_1F1=1;
1.9 takayama 66: static int Debug = 0;
1.5 takayama 67: static int Alpha = 2; /* 2 implies the zonal polynomial */
1.2 takayama 68: static int *Darray = NULL;
69: static int **Parray = NULL; /* array of partitions of size M_n */
70: static int *ParraySize = NULL; /* length of each partitions */
1.3 takayama 71: static int M_kap[M_nmx];
1.2 takayama 72: static int M_m=M_m_MAX-2; /* | | <= M_m, bug do check of M_m <=M_m_MAX-2 */
1.1 takayama 73: void (*M_pExec)(void);
1.3 takayama 74: static int HS_mu[M_nmx];
75: static int HS_n=M_nmx; /* It is initialized to M_n in jk_main */
1.1 takayama 76: void (*HS_hsExec)(void);
1.3 takayama 77: static double M_x[M_nmx];
1.1 takayama 78:
79: /* They are used in pmn */
1.2 takayama 80: static int *P_pki=NULL;
81: static int P_pmn=0;
1.1 takayama 82:
83: /* It is used genDarray2(), list partitions... */
1.2 takayama 84: static int DR_parray=0;
1.1 takayama 85:
86: /* Used in genBeta() and enumeration of horizontal strip. */
1.2 takayama 87: static double *M_beta_0=NULL; /* M_beta[0][*] value of beta_{kappa,mu}, M_beta[1][*] N_mu */
88: static int *M_beta_1=NULL;
89: static int M_beta_pt=0;
1.3 takayama 90: static int M_beta_kap[M_nmx];
1.2 takayama 91: static int UseTable = 0;
92:
93: static double **M_jack;
94: static int M_df=1; /* Compute differentials? */
95: static int M_2n=0; /* 2^N */
1.1 takayama 96:
1.3 takayama 97: static double Xarray[M_nmx][M_m_MAX];
1.1 takayama 98: /* (x_1, ..., x_n) */
99: /* Xarray[i][0] x_{i+1}^0, Xarray[i][1], x_{i+1}^1, ... */
100:
1.2 takayama 101: static double *M_qk=NULL; /* saves pochhammerb */
102: static double M_rel_error=0.0; /* relative errors */
1.1 takayama 103:
1.16 takayama 104: /* For automatic degree and X0g setting. */
1.19 takayama 105: /*
106: If automatic == 1, then the series is reevaluated as long as t_success!=1
107: by increasing X0g (evaluation point) and M_m (approx degree);
108: */
1.26 takayama 109: static int M_automatic=1;
1.19 takayama 110: /* Estimated degree bound for series expansion. See mh_t */
1.16 takayama 111: static int M_m_estimated_approx_deg=0;
1.19 takayama 112: /* Let F(i) be the approximation up to degree i.
113: The i-th series_error is defined
114: by |(F(i)-F(i-1))/F(i-1)|.
115: */
116: static double M_series_error;
117: /*
118: M_series_error < M_assigend_series_error (A) is required for the
119: estimated_approx_deg.
120: */
1.26 takayama 121: static double M_assigned_series_error=M_ASSIGNED_SERIES_ERROR_DEFAULT;
1.19 takayama 122: /*
123: Let Ef be the exponential factor ( Ef=(4)/1F1 of [HNTT] )
124: If F(M_m)*Ef < x0value_min (B), the success=0 and X0g is increased.
125: Note that minimal double is about 2e-308
126: */
1.26 takayama 127: static double M_x0value_min=1e-60;
1.19 takayama 128: /*
129: estimated_X0g is the suggested value of X0g.
130: */
1.16 takayama 131: static double M_estimated_X0g=0.0;
1.19 takayama 132: /*
133: X0g should be less than M_X0g_bound.
134: */
135: static double M_X0g_bound = 1e+100;
136: /*
137: success is set to 1 when (A) and (B) are satisfied.
138: */
1.16 takayama 139: static int M_mh_t_success=1;
1.19 takayama 140: /*
141: recommended_abserr is the recommended value of the absolute error
142: for the Runge-Kutta method. It is defined as
143: assigend_series_error(standing for significant digits)*Ig[0](initial value)
144: */
145: static double M_recommended_abserr;
146: /*
1.27 takayama 147: recommended_relerr is the recommended value of the relative error
148: for the Runge-Kutta method..
149: */
150: static double M_recommended_relerr;
151: /*
1.19 takayama 152: max of beta(i)*x/2
153: */
154: static double M_beta_i_x_o2_max;
155: /*
156: minimum of |beta_i-beta_j|
157: */
158: static double M_beta_i_beta_j_min;
159: /*
160: Value of matrix hg
161: */
162: static double M_mh_t_value;
1.25 takayama 163: /*
164: Show the process of updating degree.
165: */
166: int M_show_autosteps=1;
1.16 takayama 167:
1.2 takayama 168: /* prototypes */
169: static void *mymalloc(int size);
1.10 takayama 170: static int myfree(void *p);
171: static int myerror(char *s);
1.2 takayama 172: static double jack1(int K);
173: static double jack1diff(int k);
174: static double xval(int i,int p); /* x_i^p */
175: static int mysum(int L[]);
176: static int plength(int P[]);
177: static int plength_t(int P[]);
1.3 takayama 178: static void ptrans(int P[M_nmx],int Pt[]);
1.2 takayama 179: static int huk(int K[],int I,int J);
180: static int hdk(int K[],int I,int J);
181: static double jjk(int K[]);
182: static double ppoch(double A,int K[]);
183: static double ppoch2(double A,double B,int K[]);
184: static double mypower(double x,int n);
185: static double qk(int K[],double A[A_LEN],double B[B_LEN]);
186: static int bb(int N[],int K[],int M[],int I,int J);
187: static double beta(int K[],int M[]);
1.10 takayama 188: static int printp(int kappa[]);
1.2 takayama 189: static double q3_10(int K[],int M[],int SK);
190: static int nk(int KK[]);
191: static int myeq(int P1[],int P2[]);
192: static int pListPartition(int M,int N);
193: static int pListPartition2(int Less,int From,int To, int M);
194: static void pExec_0();
195: static int pListHS(int Kap[],int N);
196: static int pListHS2(int From,int To,int Kap[]);
197: static void hsExec_0();
198: static int pmn(int M,int N);
199: static int *cloneP(int a[]);
1.10 takayama 200: static int copyP(int p[],int a[]);
1.2 takayama 201: static void pExec_darray(void);
1.10 takayama 202: static int genDarray2(int M,int N);
203: static int isHStrip(int Kap[],int Nu[]);
1.2 takayama 204: static void hsExec_beta(void);
1.10 takayama 205: static int genBeta(int Kap[]);
1.2 takayama 206: static int psublen(int Kap[],int Mu[]);
1.10 takayama 207: static int genJack(int M,int N);
1.2 takayama 208:
209: static int imypower(int x,int n);
1.10 takayama 210: static int usage();
211: static int setParamDefault();
212: static int next(struct SFILE *fp,char *s,char *msg);
1.2 takayama 213: static int setParam(char *fname);
1.8 takayama 214: static int showParam(struct SFILE *fp,int fd);
1.2 takayama 215: static double iv_factor(void);
216: static double gammam(double a,int n);
217: static double mypower(double a,int n);
218:
1.32 takayama 219: #ifdef STANDALONE
220: static int test_ptrans();
221: static int printp2(int kappa[]);
222: static int test_beta();
223: static void mtest4();
224: static void mtest4b();
225: static int plength2(int P1[],int P2[]);
226: static int checkBeta1();
227: static int checkJack1(int M,int N);
228: static int checkJack2(int M,int N);
229: static int mtest1b();
230: static double q3_5(double A[],double B[],int K[],int I);
231: #endif
232:
1.2 takayama 233: double mh_t(double A[A_LEN],double B[B_LEN],int N,int M);
234: double mh_t2(int J);
1.3 takayama 235: struct MH_RESULT *jk_main(int argc,char *argv[]);
1.16 takayama 236: struct MH_RESULT *jk_main2(int argc,char *argv[],int automode,double newX0g,int newDegree);
1.3 takayama 237: int jk_freeWorkArea();
238: int jk_initializeWorkArea();
239:
240: int jk_freeWorkArea() {
241: /* bug, p in the cloneP will not be deallocated.
1.12 takayama 242: Nk in genDarray2 will not be deallocated.
243: */
1.3 takayama 244: int i;
1.6 takayama 245: JK_deallocate=1;
1.3 takayama 246: if (Darray) {myfree(Darray); Darray=NULL;}
247: if (Parray) {myfree(Parray); Parray=NULL;}
248: if (ParraySize) {myfree(ParraySize); ParraySize=NULL;}
249: if (M_beta_0) {myfree(M_beta_0); M_beta_0=NULL;}
250: if (M_beta_1) {myfree(M_beta_1); M_beta_1=NULL;}
251: if (M_jack) {
1.12 takayama 252: for (i=0; M_jack[i] != NULL; i++) {
1.29 takayama 253: if (Debug) oxprintf("Free M_jack[%d]\n",i);
1.12 takayama 254: myfree(M_jack[i]); M_jack[i] = NULL;
255: }
256: myfree(M_jack); M_jack=NULL;
1.3 takayama 257: }
258: if (M_qk) {myfree(M_qk); M_qk=NULL;}
259: if (P_pki) {myfree(P_pki); P_pki=NULL;}
1.6 takayama 260: JK_deallocate=0;
1.13 takayama 261: return(0);
1.3 takayama 262: }
263: int jk_initializeWorkArea() {
264: int i,j;
1.6 takayama 265: JK_deallocate=1;
266: xval(0,0);
267: JK_deallocate=0;
1.3 takayama 268: Darray=NULL;
269: Parray=NULL;
270: ParraySize=NULL;
271: M_beta_0=NULL;
272: M_beta_1=NULL;
273: M_jack=NULL;
274: M_qk=NULL;
275: for (i=0; i<M_nmx; i++) M_kap[i]=HS_mu[i]=0;
276: for (i=0; i<M_nmx; i++) M_x[i]=0;
277: for (i=0; i<M_nmx; i++) for (j=0; j<M_m_MAX; j++) Xarray[i][j]=0;
1.5 takayama 278: for (i=0; i<M_nmx; i++) M_beta_kap[i]=0;
1.3 takayama 279: M_m=M_m_MAX-2;
280: Alpha = 2;
281: HS_n=M_nmx;
282: P_pki=NULL;
283: P_pmn=0;
284: DR_parray=0;
285: M_beta_pt=0;
286: M_df=1;
287: M_2n=0;
288: M_rel_error=0.0;
1.4 takayama 289: Sample = Sample_default;
1.5 takayama 290: Xng=0.0;
291: M_n=0;
1.13 takayama 292: return(0);
1.3 takayama 293: }
1.2 takayama 294:
295: static void *mymalloc(int size) {
1.1 takayama 296: void *p;
1.29 takayama 297: if (Debug) oxprintf("mymalloc(%d)\n",size);
1.8 takayama 298: p = (void *)mh_malloc(size);
1.1 takayama 299: if (p == NULL) {
1.29 takayama 300: oxprintfe("No more memory.\n");
1.3 takayama 301: mh_exit(-1);
1.1 takayama 302: }
303: return(p);
304: }
1.10 takayama 305: static int myfree(void *p) {
1.29 takayama 306: if (Debug) oxprintf("myFree at %p\n",p);
1.13 takayama 307: return(mh_free(p));
1.7 takayama 308: }
1.29 takayama 309: static int myerror(char *s) { oxprintfe("%s: type in control-C\n",s); getchar(); getchar(); return(0);}
1.1 takayama 310:
1.2 takayama 311: static double jack1(int K) {
1.1 takayama 312: double F;
313: extern int Alpha;
1.32 takayama 314: int J,II,JJ,N; /* int I,J,L,II,JJ,N; */
1.1 takayama 315: N = 1;
316: if (K == 0) return((double)1);
317: F = xval(1,K);
318: for (J=0; J<K; J++) {
319: II = 1; JJ = J+1;
320: F *= (N-(II-1)+Alpha*(JJ-1));
321: }
322: return(F);
323: }
1.2 takayama 324: static double jack1diff(int K) {
1.1 takayama 325: double F;
326: extern int Alpha;
1.32 takayama 327: int J,II,JJ,N; /* int I,J,S,L,II,JJ,N; */
1.1 takayama 328: N = 1;
329: if (K == 0) return((double)1);
330: F = K*xval(1,K-1);
331: for (J=0; J<K; J++) {
332: II = 1; JJ = J+1;
333: F *= (N-(II-1)+Alpha*(JJ-1));
334: }
335: return(F);
336: }
337:
1.2 takayama 338: static double xval(int ii,int p) { /* x_i^p */
1.1 takayama 339: extern double M_x[];
340: int i,j;
1.10 takayama 341: static int init=0;
1.6 takayama 342: if (JK_deallocate) { init=0; return(0.0);}
1.1 takayama 343: if (!init) {
344: for (i=1; i<=M_n; i++) {
345: for (j=0; j<M_m_MAX; j++) {
1.12 takayama 346: if (j != 0) {
347: Xarray[i-1][j] = M_x[i-1]*Xarray[i-1][j-1];
348: }else{
349: Xarray[i-1][0] = 1;
350: }
1.1 takayama 351: }
352: }
353: init = 1;
354: }
355: if (ii < 1) myerror("xval, index out of bound.");
356: if (p > M_m_MAX-2) myerror("xval, p is too large.");
357: if (p < 0) {
358: myerror("xval, p is negative.");
1.29 takayama 359: oxprintf("ii=%d, p=%d\n",ii,p);
1.3 takayama 360: mh_exit(-1);
1.1 takayama 361: }
362: return(Xarray[ii-1][p]);
363: }
364:
1.2 takayama 365: static int mysum(int L[]) {
1.1 takayama 366: int S,I,N;
367: N=M_n;
368: S=0;
369: for (I=0; I<N; I++) S += L[I];
370: return(S);
371: }
372:
373: /*
1.12 takayama 374: (3,2,2,0,0) --> 3
1.1 takayama 375: */
1.2 takayama 376: static int plength(int P[]) {
1.1 takayama 377: int I;
378: for (I=0; I<M_n; I++) {
379: if (P[I] == 0) return(I);
380: }
381: return(M_n);
382: }
383: /* plength for transpose */
1.2 takayama 384: static int plength_t(int P[]) {
1.1 takayama 385: int I;
386: for (I=0; I<M_m; I++) {
387: if (P[I] == 0) return(I);
388: }
389: return(M_m);
390: }
391:
392: /*
1.12 takayama 393: ptrans(P) returns Pt
1.1 takayama 394: */
1.3 takayama 395: static void ptrans(int P[M_nmx],int Pt[]) { /* Pt[M_m] */
1.1 takayama 396: extern int M_m;
397: int i,j,len;
1.3 takayama 398: int p[M_nmx];
1.1 takayama 399: for (i=0; i<M_n; i++) p[i] = P[i];
400: for (i=0; i<M_m+1; i++) Pt[i] = 0;
401: for (i=0; i<M_m; i++) {
402: len=plength(p); Pt[i] = len;
403: if (len == 0) return;
404: for (j=0; j<len; j++) p[j] -= 1;
405: }
406: }
407:
1.32 takayama 408: #ifdef STANDALONE
1.10 takayama 409: static int test_ptrans() {
1.1 takayama 410: extern int M_m;
411: int p[M_n0]={5,3,2};
412: int pt[10];
413: int i;
414: M_m = 10;
415: ptrans(p,pt);
1.29 takayama 416: if (Debug) {for (i=0; i<10; i++) oxprintf("%d,",pt[i]); oxprintf("\n");}
1.13 takayama 417: return(0);
1.1 takayama 418: }
1.32 takayama 419: #endif
1.1 takayama 420:
421: /*
422: upper hook length
423: h_kappa^*(K)
424: */
1.2 takayama 425: static int huk(int K[],int I,int J) {
1.1 takayama 426: extern int Alpha;
427: int Kp[M_m_MAX];
428: int A,H;
429: A=Alpha;
1.29 takayama 430: /*oxprintf("h^k(%a,%a,%a,%a)\n",K,I,J,A);*/
1.1 takayama 431: ptrans(K,Kp);
432: H=Kp[J-1]-I+A*(K[I-1]-J+1);
433: return(H);
434: }
435:
436: /*
437: lower hook length
438: h^kappa_*(K)
439: */
1.2 takayama 440: static int hdk(int K[],int I,int J) {
1.1 takayama 441: extern int Alpha;
442: int Kp[M_m_MAX];
443: int A,H;
444: A = Alpha;
1.29 takayama 445: /*oxprintf("h_k(%a,%a,%a,%a)\n",K,I,J,A);*/
1.1 takayama 446: ptrans(K,Kp);
447: H=Kp[J-1]-I+1+A*(K[I-1]-J);
448: return(H);
449: }
450: /*
451: j_kappa. cf. Stanley.
452: */
1.2 takayama 453: static double jjk(int K[]) {
1.1 takayama 454: extern int Alpha;
1.33 takayama 455: int L,I,J;
1.1 takayama 456: double V;
1.33 takayama 457:
1.1 takayama 458: V=1;
459: L=plength(K);
460: for (I=0; I<L; I++) {
461: for (J=0; J<K[I]; J++) {
462: V *= huk(K,I+1,J+1)*hdk(K,I+1,J+1);
463: }
464: }
1.29 takayama 465: if (Debug) {printp(K); oxprintf("<--K, jjk=%lg\n",V);}
1.1 takayama 466: return(V);
467: }
468: /*
469: (a)_kappa^\alpha, Pochhammer symbol
470: Note that ppoch(a,[n]) = (a)_n, Alpha=2
471: */
1.2 takayama 472: static double ppoch(double A,int K[]) {
1.1 takayama 473: extern int Alpha;
474: double V;
475: int L,I,J,II,JJ;
476: V = 1;
477: L=plength(K);
478: for (I=0; I<L; I++) {
479: for (J=0; J<K[I]; J++) {
480: II = I+1; JJ = J+1;
481: V *= (A-((double)(II-1))/((double)Alpha)+JJ-1);
482: }
483: }
484: return(V);
485: }
1.2 takayama 486: static double ppoch2(double A,double B,int K[]) {
1.1 takayama 487: extern int Alpha;
488: double V;
489: int L,I,J,II,JJ;
490: V = 1;
491: L=plength(K);
492: for (I=0; I<L; I++) {
493: for (J=0; J<K[I]; J++) {
494: II = I+1; JJ = J+1;
495: V *= (A-((double)(II-1))/((double)Alpha)+JJ-1);
496: V /= (B-((double)(II-1))/((double)Alpha)+JJ-1);
497: }
498: }
499: return(V);
500: }
1.2 takayama 501: static double mypower(double x,int n) {
1.1 takayama 502: int i;
503: double v;
504: if (n < 0) return(1/mypower(x,-n));
505: v = 1;
506: for (i=0; i<n; i++) v *= x;
507: return(v);
508: }
509: /* Q_kappa
1.12 takayama 510: */
1.2 takayama 511: static double qk(int K[],double A[A_LEN],double B[B_LEN]) {
1.1 takayama 512: extern int Alpha;
513: int P,Q,I;
514: double V;
515: P = A_LEN;
516: Q = B_LEN;
517: V = mypower((double) Alpha,mysum(K))/jjk(K);
1.2 takayama 518: /* to reduce numerical errors, temporary. */
1.1 takayama 519: if (P == Q) {
520: for (I=0; I<P; I++) V = V*ppoch2(A[I],B[I],K);
521: }
522: return(V);
523:
524: for (I=0; I<P; I++) V = V*ppoch(A[I],K);
525: for (I=0; I<Q; I++) V = V/ppoch(B[I],K);
526: return(V);
527: }
528:
529: /*
1.12 takayama 530: B^nu_{kappa,mu}(i,j)
531: bb(N,K,M,I,J)
1.1 takayama 532: */
1.2 takayama 533: static int bb(int N[],int K[],int M[],int I,int J) {
1.1 takayama 534: int Kp[M_m_MAX]; int Mp[M_m_MAX];
535: ptrans(K,Kp);
536: ptrans(M,Mp);
537:
538: /*
1.29 takayama 539: printp(K); oxprintf("K<--, "); printp2(Kp); oxprintf("<--Kp\n");
540: printp(M); oxprintf("M<--, "); printp2(Mp); oxprintf("<--Mp\n");
1.1 takayama 541: */
542:
543: if ((plength_t(Kp) < J) || (plength_t(Mp) < J)) return(hdk(N,I,J));
544: if (Kp[J-1] == Mp[J-1]) return(huk(N,I,J));
545: else return(hdk(N,I,J));
546: }
547: /*
548: beta_{kappa,mu}
549: beta(K,M)
550: */
1.2 takayama 551: static double beta(int K[],int M[]) {
1.1 takayama 552: double V;
553: int L,I,J,II,JJ;
554: V = 1;
555:
556: L=plength(K);
557: for (I=0; I<L; I++) {
558: for (J=0; J<K[I]; J++) {
559: II = I+1; JJ = J+1;
560: V *= (double)bb(K,K,M,II,JJ);
1.29 takayama 561: /* oxprintf("[%d,%d,%lf]\n",I,J,V); */
1.1 takayama 562: }
563: }
564:
565: L=plength(M);
566: for (I=0; I<L; I++) {
567: for (J=0; J<M[I]; J++) {
568: II = I+1; JJ = J+1;
569: V /= (double)bb(M,K,M,II,JJ);
1.29 takayama 570: /* oxprintf("[%d,%d,%lf]\n",I,J,V);*/
1.1 takayama 571: }
572: }
573:
574: return(V);
575: }
1.10 takayama 576: static int printp(int kappa[]) {
1.1 takayama 577: int i;
1.29 takayama 578: oxprintf("(");
1.1 takayama 579: for (i=0; i<M_n; i++) {
1.29 takayama 580: if (i <M_n-1) oxprintf("%d,",kappa[i]);
581: else oxprintf("%d)",kappa[i]);
1.1 takayama 582: }
1.13 takayama 583: return(0);
1.1 takayama 584: }
1.32 takayama 585: #ifdef STANDALONE
1.10 takayama 586: static int printp2(int kappa[]) {
1.1 takayama 587: int i,ell;
1.29 takayama 588: oxprintf("(");
1.1 takayama 589: ell = plength_t(kappa);
590: for (i=0; i<ell+1; i++) {
1.29 takayama 591: if (i <ell+1-1) oxprintf("%d,",kappa[i]);
592: else oxprintf("%d)",kappa[i]);
1.1 takayama 593: }
1.13 takayama 594: return(0);
1.1 takayama 595: }
596:
1.10 takayama 597: static int test_beta() {
1.1 takayama 598: int kappa[M_n0]={2,1,0};
599: int mu1[M_n0]={1,0,0};
600: int mu2[M_n0]={1,1,0};
601: int mu3[M_n0]={2,0,0};
1.29 takayama 602: printp(kappa); oxprintf(","); printp(mu3); oxprintf(": beta = %lf\n",beta(kappa,mu3));
603: printp(kappa); oxprintf(","); printp(mu1); oxprintf(": beta = %lf\n",beta(kappa,mu1));
1.30 takayama 604: printp(kappa); oxprintf(","); printp(mu2); oxprintf(": beta = %lf\n",beta(kappa,mu2)); return(0);
1.1 takayama 605: }
1.32 takayama 606: #endif
1.1 takayama 607: /* main() { test_beta(); } */
608:
609:
610: /*
1.12 takayama 611: cf. w1m.rr
1.1 takayama 612: matrix hypergeometric by jack
613: N variables, up to degree M.
614: */
615: /* todo
1.12 takayama 616: def mhgj(A,B,N,M) {
617: F = 0;
618: P = partition_a(N,M);
619: for (I=0; I<length(P); I++) {
620: K = P[I];
621: F += qk(K,A,B)*jack(K,N);
622: }
623: return(F);
624: }
1.1 takayama 625: */
626:
627:
628: /* The quotient of (3.10) of Koev-Edelman K=kappa, M=mu, SK=k */
1.2 takayama 629: static double q3_10(int K[],int M[],int SK) {
1.1 takayama 630: extern int Alpha;
631: int Mp[M_m_MAX];
1.33 takayama 632: // int ML[M_nmx];
1.3 takayama 633: int N[M_nmx];
1.1 takayama 634: int i,R;
635: double T,Q,V,Ur,Vr,Wr;
636: ptrans(M,Mp);
1.33 takayama 637: for (i=0; i<M_n; i++) {N[i] = M[i];}
1.1 takayama 638: N[SK-1] = N[SK-1]-1;
639:
640: T = SK-Alpha*M[SK-1];
641: Q = T+1;
642: V = Alpha;
643: for (R=1; R<=SK; R++) {
644: Ur = Q-R+Alpha*K[R-1];
645: V *= Ur/(Ur+Alpha-1);
646: }
647: for (R=1; R<=SK-1; R++) {
648: Vr = T-R+Alpha*M[R-1];
649: V *= (Vr+Alpha)/Vr;
650: }
651: for (R=1; R<=M[SK-1]-1; R++) {
652: Wr = Mp[R-1]-T-Alpha*R;
653: V *= (Wr+Alpha)/Wr;
654: }
655: return(V);
656: }
657:
1.32 takayama 658: #ifdef STANDALONE
1.2 takayama 659: static double q3_5(double A[],double B[],int K[],int I) {
1.1 takayama 660: extern int Alpha;
661: int Kp[M_m_MAX];
662: double C,D,V,Ej,Fj,Gj,Hj,Lj;
663: int J,P,Q;
664: ptrans(K,Kp);
665: P=A_LEN;; Q = B_LEN;
666: C = -((double)(I-1))/Alpha+K[I-1]-1;
667: D = K[I-1]*Alpha-I;
668:
669: V=1;
670:
671: for (J=1; J<=P; J++) {
1.12 takayama 672: V *= (A[J-1]+C);
1.1 takayama 673: }
674: for (J=1; J<=Q; J++) {
1.12 takayama 675: V /= (B[J-1]+C);
1.1 takayama 676: }
677:
678: for (J=1; J<=K[I-1]-1; J++) {
1.12 takayama 679: Ej = D-J*Alpha+Kp[J-1];
680: Gj = Ej+1;
681: V *= (Gj-Alpha)*Ej/(Gj*(Ej+Alpha));
1.1 takayama 682: }
683: for (J=1; J<=I-1; J++) {
1.12 takayama 684: Fj=K[J-1]*Alpha-J-D;
685: Hj=Fj+Alpha;
686: Lj=Hj*Fj;
687: V *= (Lj-Fj)/(Lj+Hj);
1.1 takayama 688: }
689: return(V);
690: }
1.32 takayama 691: #endif
692: #ifdef STANDALONE
1.2 takayama 693: static void mtest4() {
1.1 takayama 694: double A[A_LEN] = {1.5};
695: double B[B_LEN]={6.5};
696: int K[M_n0] = {3,2,0};
697: int I=2;
698: int Ki[M_n0]={3,1,0};
699: double V1,V2;
700: V1=q3_5(A,B,K,I);
701: V2=qk(K,A,B)/qk(Ki,A,B);
1.29 takayama 702: oxprintf("%lf== %lf?\n",V1,V2);
1.1 takayama 703: }
1.2 takayama 704: static void mtest4b() {
1.1 takayama 705: int K[M_n0]={3,2,0};
706: int M[M_n0]={2,1,0};
707: int N[M_n0]={2,0};
708: int SK=2;
709: double V1,V2;
710: V1=q3_10(K,M,SK);
711: V2=beta(K,N)/beta(K,M);
1.29 takayama 712: oxprintf("%lf== %lf?\n",V1,V2);
1.1 takayama 713: }
1.32 takayama 714: #endif
1.1 takayama 715:
716: /* main() { mtest4(); mtest4b(); } */
717:
718: /* nk in (4.1),
1.12 takayama 719: */
1.2 takayama 720: static int nk(int KK[]) {
1.1 takayama 721: extern int *Darray;
722: int N,I,Ki;
1.3 takayama 723: int Kpp[M_nmx];
1.1 takayama 724: int i;
725: N = plength(KK);
726: if (N == 0) return(0);
727: if (N == 1) return(KK[0]);
728: for (i=0; i<M_n; i++) Kpp[i] = 0;
729: for (I=0; I<N-1; I++) Kpp[I] = KK[I];
730: Ki = KK[N-1];
731: /* K = (Kpp,Ki) */
732: return(Darray[nk(Kpp)]+Ki-1);
733: }
1.32 takayama 734: #ifdef STANDALONE
1.2 takayama 735: static int plength2(int P1[],int P2[]) {
1.1 takayama 736: int S1,S2;
737: S1 = plength(P1); S2 = plength(P2);
738: if (S1 > S2) return(1);
739: else if (S1 == S2) {
740: S1=mysum(P1); S2=mysum(P2);
741: if(S1 > S2) return(1);
742: else if (S1 == S2) return(0);
743: else return(-1);
744: }
745: else return(-1);
746: }
1.32 takayama 747: #endif
1.2 takayama 748: static int myeq(int P1[],int P2[]) {
1.1 takayama 749: int I,L1;
750: if ((L1=plength(P1)) != plength(P2)) return(0);
751: for (I=0; I<L1; I++) {
752: if (P1[I] != P2[I]) return(0);
753: }
754: return(1);
755: }
756: /*
757: M is a degree, N is a number of variables
758: genDarray(3,3);
759: N(0)=0;
760: N(1)=1;
761: N(2)=2;
762: N(3)=3;
763: N(1,1)=4; D[1] = 4
764: N(2,1)=5; D[2] = 5;
765: N(1,1,1)=6; D[4] = 6;
766: still buggy.
767: */
768:
1.2 takayama 769: static int pListPartition(int M,int N) {
1.1 takayama 770: extern int M_m;
771: extern int M_kap[];
772: int I;
773: /* initialize */
774: if (M_n != N) {
1.29 takayama 775: oxprintfe("M_n != N\n"); mh_exit(-1);
1.1 takayama 776: }
777: M_m = M;
778: /* M_plist = []; */
779: /* end of initialize */
780: (*M_pExec)(); /* exec for 0 */
781: for (I=1; I<=M_n; I++) {
782: pListPartition2(M_m,1,I,M_m);
783: }
784: /* M_plist = reverse(M_plist); */
785: return(1);
786: }
787:
788: /*
789: Enumerate all such that
790: Less >= M_kap[From], ..., M_kap[To], |(M_kap[From],...,M_kap[To])|<=M,
791: */
1.2 takayama 792: static int pListPartition2(int Less,int From,int To, int M) {
1.33 takayama 793: int I;
1.11 takayama 794: mh_check_intr(100);
1.1 takayama 795: if (To < From) {
1.12 takayama 796: (*M_pExec)(); return(0);
1.1 takayama 797: }
798: for (I=1; (I<=Less) && (I<=M) ; I++) {
799: M_kap[From-1] = I;
1.33 takayama 800: pListPartition2(I,From+1,To,M-I);
1.1 takayama 801: }
802: return(1);
803: }
804:
805: /*
1.33 takayama 806: Commands to do for each partition are given here.
1.1 takayama 807: */
1.2 takayama 808: static void pExec_0() {
1.1 takayama 809: if (Debug) {
1.29 takayama 810: oxprintf("M_kap=");
1.12 takayama 811: printp(M_kap);
1.29 takayama 812: oxprintf("\n");
1.1 takayama 813: }
814: }
815:
816: /* Test.
1.12 takayama 817: Compare pListPartition(4,3); genDarray(4,3);
818: Compare pListPartition(5,3); genDarray(5,3);
1.1 takayama 819:
820: */
821:
822: /*
1.12 takayama 823: main() {
1.1 takayama 824: M_pExec = pExec_0;
825: pListPartition(5,3);
1.12 takayama 826: }
1.1 takayama 827: */
828:
829:
830: /*
831: List all horizontal strips.
832: Kap[0] is not a dummy in C code. !(Start from Kap[1].)
833: */
1.2 takayama 834: static int pListHS(int Kap[],int N) {
1.1 takayama 835: extern int HS_n;
836: extern int HS_mu[];
837: int i;
838: HS_n = N;
839: /* Clear HS_mu. Do not forget when N < M_n */
840: for (i=0; i<M_n; i++) HS_mu[i] = 0;
1.13 takayama 841: return(pListHS2(1,N,Kap));
1.1 takayama 842: }
843:
1.2 takayama 844: static int pListHS2(int From,int To,int Kap[]) {
1.1 takayama 845: int More,I;
846: if (To <From) {(*HS_hsExec)(); return(0);}
847: if (From == HS_n) More=0; else More=Kap[From];
848: for (I=Kap[From-1]; I>= More; I--) {
849: HS_mu[From-1] = I;
850: pListHS2(From+1,To,Kap);
851: }
852: return(1);
853: }
854:
1.2 takayama 855: static void hsExec_0() {
1.32 takayama 856: /* int i; */
1.29 takayama 857: if(Debug) {oxprintf("hsExec: "); printp(HS_mu); oxprintf("\n");}
1.1 takayama 858: }
859:
860: /*
861: pListHS([0,4,2,1],3);
862: */
863: /*
1.12 takayama 864: main() {
1.1 takayama 865: int Kap[3]={4,2,1};
866: HS_hsExec = hsExec_0;
867: pListHS(Kap,3);
1.12 takayama 868: }
1.1 takayama 869: */
870:
871: /* The number of partitions <= M, with N parts.
1.12 takayama 872: (0,0,...,0) is excluded.
1.1 takayama 873: */
874: #define aP_pki(i,j) P_pki[(i)*(M+1)+(j)]
1.2 takayama 875: static int pmn(int M,int N) {
1.1 takayama 876: int Min_m_n,I,K,S,T,i,j;
877: extern int P_pmn;
878: extern int *P_pki;
879: Min_m_n = (M>N?N:M);
880: /* P_pki=newmat(Min_m_n+1,M+1); */
881: P_pki = (int *) mymalloc(sizeof(int)*(Min_m_n+1)*(M+1));
882: for (i=0; i<Min_m_n+1; i++) for (j=0; j<M+1; j++) aP_pki(i,j) = 0;
883: for (I=1; I<=M; I++) aP_pki(1,I) = 1;
884: for (K=1; K<=Min_m_n; K++) aP_pki(K,0) = 0;
885: S = M;
886: for (K=2; K<=Min_m_n; K++) {
887: for (I=1; I<=M; I++) {
888: if (I-K < 0) T=0; else T=aP_pki(K,I-K);
889: aP_pki(K,I) = aP_pki(K-1,I-1)+T;
890: S += aP_pki(K,I);
891: }
892: }
893: P_pmn=S;
894: if (Debug) {
1.29 takayama 895: oxprintf("P_pmn=%d\n",P_pmn);
1.1 takayama 896: for (i=0; i<=Min_m_n; i++) {
1.29 takayama 897: for (j=0; j<=M; j++) oxprintf("%d,",aP_pki(i,j));
898: oxprintf("\n");
1.1 takayama 899: }
900: }
901: myfree(P_pki); P_pki=NULL;
902: return(S);
903: }
904:
905: /*
1.29 takayama 906: main() {pmn(4,3); oxprintf("P_pmn=%d\n",P_pmn);}
1.1 takayama 907: */
908:
1.2 takayama 909: static int *cloneP(int a[]) {
1.1 takayama 910: int *p;
911: int i;
912: p = (int *) mymalloc(sizeof(int)*M_n);
913: for (i=0; i<M_n; i++) p[i] = a[i];
914: return(p);
915: }
1.10 takayama 916: static int copyP(int p[],int a[]) {
1.1 takayama 917: int i;
918: for (i=0; i<M_n; i++) p[i] = a[i];
1.13 takayama 919: return(0);
1.1 takayama 920: }
921:
1.2 takayama 922: static void pExec_darray(void) {
1.1 takayama 923: extern int DR_parray;
924: extern int M_kap[];
925: extern int **Parray;
926: extern int *ParraySize;
927: int *K;
928: pExec_0();
929: K = cloneP(M_kap);
930: Parray[DR_parray] = K;
931: ParraySize[DR_parray] = mysum(K);
932: DR_parray++;
933: }
1.10 takayama 934: static int genDarray2(int M,int N) {
1.1 takayama 935: extern int *Darray;
936: extern int **Parray;
937: extern int DR_parray;
938: extern int M_m;
939: int Pmn,I,J,Ksize,i;
940: int **L;
941: int *Nk;
942: int *K;
1.3 takayama 943: int Kone[M_nmx];
1.1 takayama 944:
945: M_m = M;
946: Pmn = pmn(M,N)+1;
1.29 takayama 947: if (Debug) oxprintf("Degree M = %d, N of vars N = %d, Pmn+1=%d\n",M,N,Pmn);
1.1 takayama 948: Darray=(int *) mymalloc(sizeof(int)*Pmn);
949: for (i=0; i<Pmn; i++) Darray[i] = 0;
950: Parray=(int **) mymalloc(sizeof(int *)*Pmn);
951: for (i=0; i<Pmn; i++) Parray[i] = NULL;
952: ParraySize=(int *) mymalloc(sizeof(int *)*Pmn);
953: for (i=0; i<Pmn; i++) ParraySize[i] = 0;
954: DR_parray=0;
955: M_pExec = pExec_darray;
956: pListPartition(M,N); /* pExec_darray() is executed for all partitions */
957: L = Parray;
958:
959: Nk = (int *) mymalloc(sizeof(int)*(Pmn+1));
960: for (I=0; I<Pmn; I++) Nk[I] = I;
961: for (I=0; I<Pmn; I++) {
1.11 takayama 962: mh_check_intr(100);
1.12 takayama 963: K = L[I]; /* N_K = I; D[N_K] = N_(K,1) */
964: Ksize = plength(K);
965: if (Ksize >= M_n) {
1.29 takayama 966: if (Debug) {oxprintfe("Ksize >= M_n\n");}
1.12 takayama 967: continue;
968: }
969: for (i=0; i<M_n; i++) Kone[i] = 0;
970: for(J=0; J<Ksize; J++) Kone[J]=K[J]; Kone[Ksize] = 1;
971: for (J=0; J<Pmn; J++) {
972: if (myeq(L[J],Kone)) Darray[I] = J; /* J is the next of I */
973: }
1.1 takayama 974: }
975: if (Debug) {
1.29 takayama 976: oxprintf("Darray=\n");
977: for (i=0; i<Pmn; i++) oxprintf("%d\n",Darray[i]);
978: oxprintf("-----------\n");
1.1 takayama 979: }
1.13 takayama 980: return(0);
1.1 takayama 981: }
982:
983:
984: /* main() { genDarray2(4,3);} */
985:
986: /* M_beta_0[*] value of beta_{kappa,mu}, M_beta_1[*] N_mu */
1.10 takayama 987: static int isHStrip(int Kap[],int Nu[]) {
1.1 takayama 988: int N1,N2,I,P;
989: N1 = plength(Kap); N2 = plength(Nu);
990: if (N2 > N1) return(0);
991: for (I=0; I<N2; I++) {
992: if (I >= N1-1) P = 0; else P=Kap[I+1];
993: if (Kap[I] < Nu[I]) return(0);
994: if (Nu[I] < P) return(0);
995: }
996: return(1);
997: }
998:
1.2 takayama 999: static void hsExec_beta(void) {
1.1 takayama 1000: int *Mu;
1001: int N,Nmu,Nnu,Done,J,K,OK,I,RR;
1002: int Kapt[M_m_MAX];
1003: int Nut[M_m_MAX];
1.3 takayama 1004: int Nu[M_nmx];
1.1 takayama 1005: int rrMax;
1006: hsExec_0();
1.29 takayama 1007: /* oxprintf("M_beta_pt=%a\n",M_beta_pt); */
1.1 takayama 1008: /* Mu = cdr(vtol(HS_mu)); */
1009: Mu = HS_mu; /* buggy? need cloneP */
1010: if (M_beta_pt == 0) {
1011: M_beta_0[0] = 1; M_beta_1[0] = nk(Mu);
1012: M_beta_pt++; return;
1013: }
1014:
1015: N = HS_n;
1016: Nmu = nk(Mu);
1017: M_beta_1[M_beta_pt] = Nmu;
1018: ptrans(M_beta_kap,Kapt);
1019: /* Mu, Nu is exchanged in this code. cf. the K-E paper */
1020: copyP(Nu,Mu); /* buggy need clone? */
1021: for (I=0; I<N; I++) {
1022: Nu[I]++;
1023: if (!isHStrip(M_beta_kap,Nu)) {Nu[I]--; continue;}
1024: Nnu = nk(Nu);
1025: ptrans(Nu,Nut);
1026: Done=0;
1027: for (J=M_beta_pt-1; J>=0; J--) {
1028: if (M_beta_1[J] == Nnu) {
1.12 takayama 1029: K=I+1;
1030: if (Debug) {
1.29 takayama 1031: oxprintf("Found at J=%d, K=%d, q3_10(Kap,Nu,K)=%lf,Nu,Mu= \n",
1.12 takayama 1032: J,K,q3_10(M_beta_kap,Nu,K));
1.29 takayama 1033: printp(Nu); oxprintf("\n");
1034: printp(Mu); oxprintf("\n");
1.12 takayama 1035: }
1036: /* Check other conditions. See Numata's mail on Dec 24, 2011. */
1037: rrMax = Nu[I]-1;
1038: if ((plength_t(Kapt) < rrMax) || (plength_t(Nut) < rrMax)) {
1.29 takayama 1039: if (Debug) oxprintf(" is not taken (length). \n");
1.12 takayama 1040: break;
1041: }
1042: OK=1;
1043: for (RR=0; RR<rrMax; RR++) {
1044: if (Kapt[RR] != Nut[RR]) { OK=0; break;}
1045: }
1.29 takayama 1046: if (!OK) { if (Debug) oxprintf(" is not taken.\n"); break; }
1.12 takayama 1047: /* check done. */
1048: M_beta_0[M_beta_pt]=M_beta_0[J]*q3_10(M_beta_kap,Nu,K);
1049: Done = 1; break;
1.1 takayama 1050: }
1051: }
1052: if (Done) break; else Nu[I]--;
1053: }
1054: if (!Done) {
1.29 takayama 1055: if (Debug) oxprintf("BUG: not found M_beta_pt=%d.\n",M_beta_pt);
1.13 takayama 1056: /* M_beta_0[M_beta_pt] = NAN; error("Not found."); */
1.1 takayama 1057: M_beta_0[M_beta_pt] = beta(M_beta_kap,Mu);
1058: }
1059: /* Fix the bug of mh.rr */
1060: M_beta_pt++;
1061: }
1.10 takayama 1062: static int genBeta(int Kap[]) {
1.1 takayama 1063: extern double *M_beta_0;
1064: extern int *M_beta_1;
1065: extern int M_beta_pt;
1066: extern int M_beta_kap[];
1067: extern int P_pmn;
1.32 takayama 1068: int I,N;
1.29 takayama 1069: if (Debug) {printp(Kap); oxprintf("<-Kappa, P_pmn=%d\n",P_pmn);}
1.1 takayama 1070: /* M_beta = newmat(2,P_pmn+1); */
1071: M_beta_0 = (double *)mymalloc(sizeof(double)*(P_pmn+1));
1.8 takayama 1072: M_beta_1 = (int *)mymalloc(sizeof(int)*(P_pmn+1));
1.1 takayama 1073: M_beta_pt = 0;
1074: for (I=0; I<=P_pmn; I++) {M_beta_0[I] = NAN; M_beta_1[I] = -1;}
1075: N = plength(Kap);
1076: HS_hsExec = hsExec_beta;
1077: copyP(M_beta_kap,Kap);
1.30 takayama 1078: pListHS(Kap,N); return(0);
1.1 takayama 1079: }
1080: /*
1081: genDarray2(4,3);
1082: genBeta([2,2,0]);
1083: genBeta([2,1,1]);
1084: */
1.32 takayama 1085: #ifdef STANDALONE
1.10 takayama 1086: static int checkBeta1() {
1.1 takayama 1087: int Kap[3] = {2,2,0};
1088: int Kap2[3] = {2,1,0};
1089: int I;
1090: int *Mu;
1091: double Beta_km;
1092: genDarray2(4,3);
1093: genBeta(Kap);
1094: for (I=0; I<M_beta_pt; I++) {
1095: Mu = Parray[M_beta_1[I]];
1096: Beta_km = M_beta_0[I];
1.12 takayama 1097: if (Debug) {
1.29 takayama 1098: printp(Kap); oxprintf("<--Kap, ");
1099: printp(Mu); oxprintf("<--Mu,");
1100: oxprintf("Beta_km(by table)=%lf, beta(Kap,Mu)=%lf\n",Beta_km,beta(Kap,Mu));
1.12 takayama 1101: }
1.1 takayama 1102: }
1.29 takayama 1103: if (Debug) oxprintf("-------------------------------------\n");
1.1 takayama 1104: genBeta(Kap2);
1105: for (I=0; I<M_beta_pt; I++) {
1106: Mu = Parray[M_beta_1[I]];
1107: Beta_km = M_beta_0[I];
1.12 takayama 1108: if (Debug) {
1.29 takayama 1109: printp(Kap2); oxprintf("<--Kap, ");
1110: printp(Mu); oxprintf("<--Mu,");
1111: oxprintf("Beta_km(by table)=%lf, beta(Kap,Mu)=%lf\n",Beta_km,beta(Kap2,Mu));
1.12 takayama 1112: }
1.1 takayama 1113: }
1.13 takayama 1114: return(0);
1.1 takayama 1115: }
1.32 takayama 1116: #endif
1.1 takayama 1117: /*
1.12 takayama 1118: def checkBeta2() {
1.1 takayama 1119: genDarray2(3,3);
1120: Kap = [2,1,0];
1.29 takayama 1121: oxprintf("Kap=%a\n",Kap);
1.1 takayama 1122: genBeta(Kap);
1123: for (I=0; I<M_beta_pt; I++) {
1.12 takayama 1124: Mu = Parray[M_beta[1][I]];
1125: Beta_km = M_beta[0][I];
1.29 takayama 1126: oxprintf("Mu=%a,",Mu);
1127: oxprintf("Beta_km(by table)=%a, beta(Kap,Mu)=%a\n",Beta_km,beta(Kap,Mu));
1.12 takayama 1128: }
1.1 takayama 1129: }
1130: */
1131:
1132: /* main() { checkBeta1(); } */
1133:
1.2 takayama 1134: static int psublen(int Kap[],int Mu[]) {
1.1 takayama 1135: int L1,L2,A,I;
1136: L1 = plength(Kap);
1137: L2 = plength(Mu);
1138: if (L2 > L1) myerror("psub, length mismatches.");
1139: A = 0;
1140: for (I=0; I<L2; I++) {
1141: if (Kap[I] < Mu[I]) myerror("psub, not Kap >= Mu");
1142: A += Kap[I]-Mu[I];
1143: }
1144: for (I=L2; I<L1; I++) A += Kap[I];
1145: return(A);
1146: }
1147:
1148:
1149: /* Table of Jack polynomials
1.12 takayama 1150: Jack[1]* one variable.
1151: Jack[2]* two variables.
1.1 takayama 1152: ...
1.12 takayama 1153: Jack[M_n]* n variables.
1154: Jack[P][J]*
1155: D^J(P variables jack of p variables). Example. J=001 d_1, 010 d_2, 100 d_3
1156: 0<=J<=2^{M_n}-1
1157: Jack[P][J][nk(Kappa)] Jack_Kappa, Kappa is a partition.
1158: 0<=nk(Kappa)<=pmn(M_m,M_n)
1.1 takayama 1159: */
1160:
1161: #define aM_jack(i,j,k) ((M_jack[i])[(j)*(Pmn+1)+(k)])
1.10 takayama 1162: static int genJack(int M,int N) {
1.1 takayama 1163: extern double **M_jack;
1164: extern int M_2n;
1165: extern int P_pmn;
1166: extern int *M_beta_1;
1167: int Pmn,I,J,K,L,Nv,H,P;
1168: int *Kap,*Mu;
1169: double Jack,Beta_km;
1.32 takayama 1170: int Nk,JJ, two_to_I;
1.29 takayama 1171: if (Debug) oxprintf("genJack(%d,%d)\n",M,N);
1.3 takayama 1172: M_jack = (double **) mymalloc(sizeof(double *)*(N+2));
1.1 takayama 1173: M_2n = imypower(2,N);
1174: Pmn = pmn(M,N); /*P_pmn is initializeded.
1175: Warning. It is reset when pmn is called.*/
1176: for (I=0; I<=N; I++) M_jack[I] = (double *)mymalloc(sizeof(double)*(M_2n*(Pmn+1))); /* newmat(M_2n,Pmn+1); */
1.3 takayama 1177: M_jack[N+1] = NULL;
1.1 takayama 1178: genDarray2(M,N); /* Darray, Parray is initialized */
1179: for (I=1; I<=N; I++) aM_jack(I,0,0) = 1;
1180: if (M_df) {
1181: for (I=1; I<=N; I++) {
1182: for (J=1; J<M_2n; J++) aM_jack(I,J,0) = 0;
1183: }
1184: }
1185:
1.3 takayama 1186: /* N must satisfies N > 0 */
1.1 takayama 1187: for (K=1; K<=M; K++) {
1188: aM_jack(1,0,K) = jack1(K);
1189: if (M_df) {
1190: aM_jack(1,1,K) = jack1diff(K); /* diff(jack([K],1),x_1); */
1191: for (J=2; J<M_2n; J++) aM_jack(1,J,K) = 0;
1192: }
1193: }
1.32 takayama 1194: for (I=1; I<=N; I++) { two_to_I = imypower(2,I);
1.1 takayama 1195: for (K=M+1; K<Pmn+1; K++) {
1196: aM_jack(I,0,K) = NAN;
1197: if (M_df) {
1198: for (J=1; J<M_2n; J++) {
1.32 takayama 1199: if (J >= two_to_I) aM_jack(I,J,K) = 0; /* J >= 2^I */
1.12 takayama 1200: else aM_jack(I,J,K) = NAN;
1.1 takayama 1201: }
1202: }
1203: }
1204: }
1205:
1206: /* Start to evaluate the entries of the table */
1207: for (K=1; K<=Pmn; K++) {
1208: Kap = Parray[K]; /* bug. need copy? */
1209: L = plength(Kap);
1210: for (I=1; I<=L-1; I++) {
1211: aM_jack(I,0,K) = 0;
1212: if (M_df) {
1213: for (J=1; J<M_2n; J++) aM_jack(I,J,K) = 0;
1214: }
1215: }
1.29 takayama 1216: if (Debug) {oxprintf("Kappa="); printp(Kap);}
1.1 takayama 1217: /* Enumerate horizontal strip of Kappa */
1218: genBeta(Kap); /* M_beta_pt stores the number of hs */
1219: /* Nv is the number of variables */
1220: for (Nv = (L==1?2:L); Nv <= N; Nv++) {
1221: Jack = 0;
1222: for (H=0; H<M_beta_pt; H++) {
1223: Nk = M_beta_1[H];
1224: Mu = Parray[Nk];
1.12 takayama 1225: if (UseTable) {
1226: Beta_km = M_beta_0[H];
1227: }else{
1228: Beta_km = beta(Kap,Mu);
1229: /* do not use the M_beta table. It's buggy. UseTable is experimental.*/
1230: }
1.29 takayama 1231: if (Debug) {oxprintf("Nv(number of variables)=%d, Beta_km=%lf, Mu=",Nv,Beta_km);
1232: printp(Mu); oxprintf("\n");}
1.1 takayama 1233: P = psublen(Kap,Mu);
1234: Jack += aM_jack(Nv-1,0,Nk)*Beta_km*xval(Nv,P); /* util_v(x,[Nv])^P;*/
1.29 takayama 1235: if (Debug) oxprintf("xval(%d,%d)=%lf\n",Nv,P,xval(Nv,P));
1.1 takayama 1236: }
1237: aM_jack(Nv,0,K) = Jack;
1238: if (M_df) {
1239: /* The case of M_df > 0. */
1240: for (J=1; J<M_2n; J++) {
1.12 takayama 1241: mh_check_intr(100);
1242: Jack = 0;
1243: for (H=0; H<M_beta_pt; H++) {
1244: Nk = M_beta_1[H];
1245: Mu = Parray[Nk];
1246: if (UseTable) {
1247: Beta_km = M_beta_0[H];
1248: }else{
1249: Beta_km = beta(Kap,Mu); /* do not use the M_beta table. It's buggy. */
1250: }
1.29 takayama 1251: if (Debug) {oxprintf("M_df: Nv(number of variables)=%d, Beta_km=%lf, Mu= ",Nv,Beta_km);
1252: printp(Mu); oxprintf("\n"); }
1.12 takayama 1253: P = psublen(Kap,Mu);
1254: if (J & (1 << (Nv-1))) {
1255: JJ = J & ((1 << (Nv-1)) ^ 0xffff); /* NOTE!! Up to 16 bits. mh-15 */
1256: if (P != 0) {
1257: Jack += aM_jack(Nv-1,JJ,Nk)*Beta_km*P*xval(Nv,P-1);
1258: }
1259: }else{
1260: Jack += aM_jack(Nv-1,J,Nk)*Beta_km*xval(Nv,P);
1261: }
1262: }
1263: aM_jack(Nv,J,K) = Jack;
1.29 takayama 1264: if (Debug) oxprintf("aM_jack(%d,%d,%d) = %lf\n",Nv,J,K,Jack);
1.1 takayama 1265: } /* end of J loop */
1266: }
1267: }
1.30 takayama 1268: } return(0);
1.1 takayama 1269: }
1270:
1.32 takayama 1271: #ifdef STANDALONE
1.1 takayama 1272: /* checkJack1(3,3)
1.12 takayama 1273: */
1.10 takayama 1274: static int checkJack1(int M,int N) {
1.1 takayama 1275: int I,K;
1276: extern int P_pmn;
1277: extern double M_x[];
1278: int Pmn; /* used in aM_jack */
1279: /* initialize x vars. */
1280: for (I=1; I<=N; I++) {
1281: M_x[I-1] = ((double)I)/10.0;
1282: }
1283: genJack(M,N);
1284: Pmn = P_pmn;
1285: for (I=1; I<=N; I++) {
1286: for (K=0; K<=P_pmn; K++) {
1287: printp(Parray[K]);
1.29 takayama 1288: oxprintf("<--Kap, Nv=%d, TableJack=%lf\n",I,aM_jack(I,0,K));
1.1 takayama 1289: }
1290: }
1.29 takayama 1291: for (I=1; I<=N; I++) oxprintf("%lf, ",M_x[I-1]);
1292: oxprintf("<--x\n");
1.13 takayama 1293: return(0);
1.1 takayama 1294: }
1295: /*main() { checkJack1(3,3); }*/
1296:
1297:
1.10 takayama 1298: static int checkJack2(int M,int N) {
1.1 takayama 1299: int I,K,J;
1300: extern int P_pmn;
1301: extern double M_x[];
1.10 takayama 1302: extern int M_df;
1.1 takayama 1303: int Pmn; /* used in aM_jack */
1304: M_df=1;
1305: /* initialize x vars. */
1306: for (I=1; I<=N; I++) {
1307: M_x[I-1] = ((double)I)/10.0;
1308: }
1309: genJack(M,N);
1310: Pmn = P_pmn;
1311: for (I=1; I<=N; I++) {
1312: for (K=0; K<=P_pmn; K++) {
1313: printp(Parray[K]);
1.29 takayama 1314: oxprintf("<--Kap, Nv=%d, TableJack=%lf\n",I,aM_jack(I,0,K));
1.1 takayama 1315: }
1316: }
1.29 takayama 1317: for (I=1; I<=N; I++) oxprintf("%lf, ",M_x[I-1]);
1318: oxprintf("<--x\n");
1.1 takayama 1319:
1320: for (I=1; I<=N; I++) {
1321: for (K=0; K<=P_pmn; K++) {
1322: for (J=0; J<M_2n; J++) {
1.12 takayama 1323: printp(Parray[K]);
1.29 takayama 1324: oxprintf("<--Kap, Nv=%d,J(diff)=%d, D^J Jack=%lf\n",
1.12 takayama 1325: I,J,aM_jack(I,J,K));
1326: }
1327: }
1.1 takayama 1328: }
1.13 takayama 1329: return(0);
1.1 takayama 1330: }
1331:
1332: /* main() { checkJack2(3,3); } */
1.32 takayama 1333: #endif
1.1 takayama 1334:
1335: double mh_t(double A[A_LEN],double B[B_LEN],int N,int M) {
1336: double F,F2;
1337: extern int M_df;
1338: extern int P_pmn;
1339: extern double *M_qk;
1340: extern double M_rel_error;
1.15 takayama 1341: extern int M_m;
1.16 takayama 1342: extern int M_m_estimated_approx_deg;
1343: extern double M_assigned_series_error;
1.1 takayama 1344: int Pmn;
1345: int K;
1346: int *Kap;
1347: int size;
1.15 takayama 1348: int i;
1349: double partial_sum[M_m_MAX+1];
1.16 takayama 1350: double iv;
1351: double serror;
1.1 takayama 1352: F = 0; F2=0;
1353: M_df=1;
1354: genJack(M,N);
1.8 takayama 1355: M_qk = (double *)mymalloc(sizeof(double)*(P_pmn+1)); /* found a bug. */
1.1 takayama 1356: Pmn = P_pmn;
1357: size = ParraySize[P_pmn];
1358: for (K=0; K<=P_pmn; K++) {
1.11 takayama 1359: mh_check_intr(100);
1.12 takayama 1360: Kap = Parray[K];
1361: M_qk[K] = qk(Kap,A,B);
1362: F += M_qk[K]*aM_jack(N,0,K);
1363: if (ParraySize[K] < size) F2 += M_qk[K]*aM_jack(N,0,K);
1.29 takayama 1364: if (Debug) oxprintf("ParraySize[K] = %d, size=%d\n",ParraySize[K],size);
1365: if (Debug && (ParraySize[K] == size)) oxprintf("M_qk[K]=%lg, aM_jack=%lg\n",M_qk[K],aM_jack(N,0,K));
1.1 takayama 1366: }
1367: M_rel_error = F-F2;
1.15 takayama 1368:
1.16 takayama 1369: M_m_estimated_approx_deg = -1; serror=1;
1.15 takayama 1370: for (i=0; i<=M_m; i++) {
1371: partial_sum[i] = 0.0; partial_sum[i+1] = 0.0;
1372: for (K=0; K<=P_pmn; K++) {
1373: if (ParraySize[K] == i) partial_sum[i] += M_qk[K]*aM_jack(N,0,K);
1374: }
1375: if (i>0) partial_sum[i] += partial_sum[i-1];
1.31 takayama 1376: if (i>0) serror = myabs((partial_sum[i]-partial_sum[i-1])/partial_sum[i-1]);
1.16 takayama 1377: if ((i>0)&&(M_m_estimated_approx_deg < 0)&&(serror<M_assigned_series_error)) {
1378: M_m_estimated_approx_deg = i; break;
1379: }
1380: }
1381: if (M_m_estimated_approx_deg < 0) {
1382: M_m_estimated_approx_deg = M_m+mymin(5,mymax(1,(int)log(serror/M_assigned_series_error))); /* Heuristic */
1.15 takayama 1383: }
1384: /*
1385: for (K=0; K<=P_pmn; K++) {
1.29 takayama 1386: oxprintf("Kappa="); for (i=0; i<N; i++) oxprintf("%d ",Parray[K][i]); oxprintf("\n");
1387: oxprintf("ParraySize(%d)=%d (|kappa|), M_m=%d\n",K,ParraySize[K],M_m);
1.15 takayama 1388: }
1389: for (i=0; i<=M_m; i++) {
1.29 takayama 1390: oxprintf("partial_sum[%d]=%lg\n",i,partial_sum[i]);
1.15 takayama 1391: }
1392: */
1.16 takayama 1393: M_estimated_X0g = X0g;
1394: iv=myabs(F*iv_factor());
1395: if (iv < M_x0value_min) M_estimated_X0g = X0g*mymax(2,log(log(1/iv))); /* This is heuristic */
1.19 takayama 1396: M_estimated_X0g = mymin(M_estimated_X0g,M_X0g_bound);
1.16 takayama 1397: M_mh_t_success = 1;
1.19 takayama 1398: if (M_estimated_X0g != X0g) M_mh_t_success=0;
1399: if (M_m_estimated_approx_deg > M_m) M_mh_t_success=0;
1.16 takayama 1400:
1.19 takayama 1401: M_series_error = serror;
1402: M_recommended_abserr = iv*M_assigned_series_error;
1.27 takayama 1403: M_recommended_relerr = M_series_error;
1.25 takayama 1404:
1405: if (M_show_autosteps) {
1.29 takayama 1406: oxprintf("%%%%serror=%lg, M_assigned_series_error=%lg, M_m_estimated_approx_deg=%d,M_m=%d\n",serror,M_assigned_series_error,M_m_estimated_approx_deg,M_m);
1407: oxprintf("%%%%x0value_min=%lg, x0g_bound=%lg\n",M_x0value_min, M_X0g_bound);
1408: oxprintf("%%%%F=%lg,Ef=%lg,M_estimated_X0g=%lg, X0g=%lg\n",F,iv_factor(),M_estimated_X0g,X0g);
1409: oxprintfe("%%%%(stderr) serror=%lg, M_assigned_series_error=%lg, M_m_estimated_approx_deg=%d,M_m=%d\n",serror,M_assigned_series_error,M_m_estimated_approx_deg,M_m);
1410: oxprintfe("%%%%(stderr) x0value_min=%lg, x0g_bound=%lg\n",M_x0value_min, M_X0g_bound);
1411: oxprintfe("%%%%(stderr) F=%lg,Ef=%lg,M_estimated_X0g=%lg, X0g=%lg\n",F,iv_factor(),M_estimated_X0g,X0g);
1.25 takayama 1412: }
1.16 takayama 1413:
1.19 takayama 1414: M_mh_t_value=F;
1.1 takayama 1415: return(F);
1416: }
1417: double mh_t2(int J) {
1418: extern double *M_qk;
1419: double F;
1420: int K;
1421: int Pmn;
1422: extern int P_pmn;
1.3 takayama 1423: if (M_qk == NULL) {myerror("Call mh_t first."); mh_exit(-1); }
1.1 takayama 1424: F = 0;
1425: Pmn = P_pmn;
1426: for (K=0; K<P_pmn; K++) {
1.12 takayama 1427: F += M_qk[K]*aM_jack(M_n,J,K);
1.1 takayama 1428: }
1429: return(F);
1430: }
1431:
1.32 takayama 1432: #ifdef STANDALONE
1.10 takayama 1433: static int mtest1b() {
1.1 takayama 1434: double A[1] = {1.5};
1435: double B[1] = {1.5+5};
1436: int I,N,M,J;
1437: double F;
1438: N=3; M=6;
1439: for (I=1; I<=N; I++) {
1440: M_x[I-1] = ((double)I)/10.0;
1441: }
1442: mh_t(A,B,N,M);
1443: for (J=0; J<M_2n; J++) {
1.12 takayama 1444: F=mh_t2(J);
1.29 takayama 1445: oxprintf("J=%d, D^J mh_t=%lf\n",J,F);
1.1 takayama 1446: }
1.30 takayama 1447: return(0);
1.1 takayama 1448: }
1449:
1450: /* main() { mtest1b(); }*/
1.32 takayama 1451: #endif
1.1 takayama 1452:
1453:
1454:
1455: #define TEST 1
1456: #ifndef TEST
1457:
1458: #endif
1459:
1460: /****** from mh-n.c *****/
1461:
1462: #define SMAX 4096
1.29 takayama 1463: #define inci(i) { i++; if (i >= argc) { oxprintfe("Option argument is not given.\n"); return(NULL); }}
1.1 takayama 1464:
1.2 takayama 1465: static int imypower(int x,int n) {
1.1 takayama 1466: int i;
1467: int v;
1.3 takayama 1468: if (n < 0) {myerror("imypower"); mh_exit(-1);}
1.1 takayama 1469: v = 1;
1470: for (i=0; i<n; i++) v *= x;
1471: return(v);
1472: }
1473:
1.11 takayama 1474: #ifdef STANDALONE2
1.32 takayama 1475: int main(int argc,char *argv[]) {
1.3 takayama 1476: mh_exit(MH_RESET_EXIT);
1.12 takayama 1477: /* jk_main(argc,argv);
1.29 takayama 1478: oxprintf("second run.\n"); */
1.2 takayama 1479: jk_main(argc,argv);
1.17 takayama 1480: return(0);
1.2 takayama 1481: }
1.3 takayama 1482: #endif
1483:
1484: struct MH_RESULT *jk_main(int argc,char *argv[]) {
1.16 takayama 1485: int i;
1486: struct MH_RESULT *ans;
1487: extern int M_automatic;
1488: extern int M_mh_t_success;
1489: extern double M_estimated_X0g;
1490: extern int M_m_estimated_approx_deg;
1491: for (i=1; i<argc; i++) {
1492: if (strcmp(argv[i],"--automatic")==0) {
1493: inci(i);
1494: sscanf(argv[i],"%d",&M_automatic);
1495: break;
1496: }
1497: }
1498: ans=jk_main2(argc,argv,0,0.0,0);
1499: if (!M_automatic) return(ans);
1500: if (M_mh_t_success) return(ans);
1501: while (!M_mh_t_success) {
1502: ans=jk_main2(argc,argv,1,M_estimated_X0g,M_m_estimated_approx_deg);
1503: }
1504: return(ans);
1505: }
1506:
1507: struct MH_RESULT *jk_main2(int argc,char *argv[],int automode,double newX0g,int newDegree) {
1.32 takayama 1508: // double *y0;
1509: // double x0,xn;
1510: // double ef;
1511:
1512: int i,j; // int i,j,rank;
1.35 takayama 1513: double a[A_LEN]; double b[B_LEN];
1.1 takayama 1514: extern double M_x[];
1515: extern double *Beta;
1516: extern int M_2n;
1.16 takayama 1517: extern int M_mh_t_success;
1.3 takayama 1518: char swork[1024];
1519: struct MH_RESULT *ans=NULL;
1520: struct SFILE *ofp = NULL;
1521: int idata=0;
1522: JK_byFile = 1;
1523: jk_initializeWorkArea();
1.1 takayama 1524: UseTable = 1;
1.3 takayama 1525: Mapprox=6;
1.1 takayama 1526: for (i=1; i<argc; i++) {
1.12 takayama 1527: if (strcmp(argv[i],"--idata")==0) {
1528: inci(i);
1529: setParam(argv[i]); idata=1;
1530: }else if (strcmp(argv[i],"--degree")==0) {
1531: inci(i);
1532: sscanf(argv[i],"%d",&Mapprox);
1533: }else if (strcmp(argv[i],"--x0")==0) {
1534: inci(i);
1535: sscanf(argv[i],"%lg",&X0g);
1536: }else if (strcmp(argv[i],"--notable")==0) {
1537: UseTable = 0;
1538: }else if (strcmp(argv[i],"--debug")==0) {
1539: Debug = 1;
1540: }else if (strcmp(argv[i],"--help")==0) {
1541: usage(); return(0);
1542: }else if (strcmp(argv[i],"--bystring")==0) {
1.29 takayama 1543: if (idata) {oxprintfe("--bystring must come before --idata option.\n"); mh_exit(-1);}
1.12 takayama 1544: JK_byFile = 0;
1.16 takayama 1545: }else if (strcmp(argv[i],"--automatic")==0) {
1546: inci(i); /* ignore, in this function */
1.23 takayama 1547: }else if (strcmp(argv[i],"--assigned_series_error")==0) {
1.16 takayama 1548: inci(i);
1549: sscanf(argv[i],"%lg",&M_assigned_series_error);
1550: }else if (strcmp(argv[i],"--x0value_min")==0) {
1551: inci(i);
1552: sscanf(argv[i],"%lg",&M_x0value_min);
1.12 takayama 1553: }else {
1.29 takayama 1554: oxprintfe("Unknown option %s\n",argv[i]);
1.12 takayama 1555: usage();
1556: return(NULL);
1557: }
1.1 takayama 1558: }
1.16 takayama 1559: if (!idata) setParam(NULL);
1560: if (automode) {
1561: Mapprox = newDegree;
1562: X0g = newX0g;
1563: }
1.3 takayama 1564:
1565: /* Initialize global variables */
1566: M_n = Mg;
1567: HS_n=M_n;
1.16 takayama 1568: if (!JK_byFile) {
1569: ans = (struct MH_RESULT *)mymalloc(sizeof(struct MH_RESULT));
1570: ans->message = NULL;
1.19 takayama 1571: ans->t_success = 0;
1572: ans->series_error = 1.0e+10;
1573: ans->recommended_abserr = 1.0e-10;
1.16 takayama 1574: }
1.3 takayama 1575: else ans = NULL;
1.26 takayama 1576: if (M_automatic) {
1577: /* Differentiation can be M_m in the bit pattern in the M_n variable case.*/
1578: if (M_n > Mapprox) Mapprox=M_n;
1579: }
1.3 takayama 1580: /* Output by a file=stdout */
1.34 takayama 1581: ofp = mh_fopen("stdout","w",JK_byFile);
1.1 takayama 1582:
1.3 takayama 1583: sprintf(swork,"%%%%Use --help option to see the help.\n"); mh_fputs(swork,ofp);
1584: sprintf(swork,"%%%%Mapprox=%d\n",Mapprox); mh_fputs(swork,ofp);
1.1 takayama 1585: if (M_n != Mg) {
1.12 takayama 1586: myerror("Mg must be equal to M_n\n"); mh_exit(-1);
1.1 takayama 1587: }
1.8 takayama 1588: if (Debug) showParam(NULL,1);
1.1 takayama 1589: for (i=0; i<M_n; i++) {
1.12 takayama 1590: M_x[i] = Beta[i]*X0g;
1.1 takayama 1591: }
1.19 takayama 1592:
1593: M_beta_i_x_o2_max=myabs(M_x[0]/2);
1594: if (M_n <= 1) M_beta_i_beta_j_min = myabs(Beta[0]);
1595: else M_beta_i_beta_j_min = myabs(Beta[1]-Beta[0]);
1596: for (i=0; i<M_n; i++) {
1597: if (myabs(M_x[i]/2) > M_beta_i_x_o2_max) M_beta_i_x_o2_max = myabs(M_x[i]/2);
1598: for (j=i+1; j<M_n; j++) {
1599: if (myabs(Beta[i]-Beta[j]) < M_beta_i_beta_j_min)
1600: M_beta_i_beta_j_min = myabs(Beta[i]-Beta[j]);
1601: }
1602: }
1603:
1.36 ! takayama 1604: if ((P_pFq != A_LEN) || (Q_pFq != B_LEN)) {
! 1605: oxprintfe("It must be P_pFq == A_LEN and Q_pFq == B_LEN in this version. %s\n","");
! 1606: mh_exit(-1);
! 1607: }
! 1608: oxprintfe("%%%%(stderr) Orig_1F1=%d\n",Orig_1F1);
! 1609: if ((P_pFq == 1) && (Q_pFq == 1) && (Orig_1F1)) {
! 1610: A_pFq[0] = a[0] = ((double)Mg+1.0)/2.0;
! 1611: B_pFq[0] = b[0] = ((double)Mg+1.0)/2.0 + ((double) (*Ng))/2.0; /* bug, double check */
! 1612: if (Debug) oxprintf("Calling mh_t with ([%lf],[%lf],%d,%d)\n",a[0],b[0],M_n,Mapprox);
! 1613: }else{
! 1614: for (i=0; i<P_pFq; i++) a[i] = A_pFq[i];
! 1615: for (i=0; i<Q_pFq; i++) b[i] = B_pFq[i];
! 1616: }
1.1 takayama 1617: mh_t(a,b,M_n,Mapprox);
1.19 takayama 1618: if ((!M_mh_t_success) && M_automatic) {
1.16 takayama 1619: jk_freeWorkArea();
1620: return NULL;
1621: }
1.1 takayama 1622: if (imypower(2,M_n) != M_2n) {
1.12 takayama 1623: sprintf(swork,"M_n=%d,M_2n=%d\n",M_n,M_2n); mh_fputs(swork,ofp);
1624: myerror("2^M_n != M_2n\n"); mh_exit(-1);
1.1 takayama 1625: }
1.3 takayama 1626: sprintf(swork,"%%%%M_rel_error=%lg\n",M_rel_error); mh_fputs(swork,ofp);
1.1 takayama 1627: for (j=0; j<M_2n; j++) {
1.12 takayama 1628: Iv[j] = mh_t2(j);
1.1 takayama 1629: }
1630: Ef = iv_factor();
1.8 takayama 1631: showParam(ofp,0);
1.3 takayama 1632:
1633: /* return the result */
1.16 takayama 1634: if (!JK_byFile) {
1.12 takayama 1635: ans->x = X0g;
1636: ans->rank = imypower(2,Mg);
1637: ans->y = (double *)mymalloc(sizeof(double)*(ans->rank));
1638: for (i=0; i<ans->rank; i++) (ans->y)[i] = Iv[i];
1639: ans->size=1;
1640: ans->sfpp = (struct SFILE **)mymalloc(sizeof(struct SFILE *)*(ans->size));
1641: (ans->sfpp)[0] = ofp;
1.19 takayama 1642:
1643: ans->t_success = M_mh_t_success;
1644: ans->series_error = M_series_error;
1645: ans->recommended_abserr = M_recommended_abserr;
1.3 takayama 1646: }
1.29 takayama 1647: if (Debug) oxprintf("jk_freeWorkArea() starts\n");
1.3 takayama 1648: jk_freeWorkArea();
1.29 takayama 1649: if (Debug) oxprintf("jk_freeWorkArea() has finished.\n");
1.3 takayama 1650: return(ans);
1.1 takayama 1651: }
1652:
1.10 takayama 1653: static int usage() {
1.29 takayama 1654: oxprintfe("Usages:\n");
1655: oxprintfe("hgm_jack-n [--idata input_data_file --x0 x0 --degree approxm]\n");
1656: oxprintfe(" [--automatic n --assigned_series_error e --x0value_min e2]\n");
1657: oxprintfe("\nThe command hgm_jack-n [options] generates an input for hgm_w-n, Pr({y | y<xmax}), which is the cumulative distribution function of the largest root of the m by m Wishart matrices with n degrees of freedom and the covariantce matrix sigma.\n");
1658: oxprintfe("The hgm_jack-n uses the Koev-Edelman algorithm to evalute the matrix hypergeometric function.\n");
1659: oxprintfe("The degree of the approximation (Mapprox) is given by the --degree option.\n");
1660: oxprintfe("Parameters are specified by the input_data_file. Otherwise, default values are used.\n\n");
1661: oxprintfe("The format of the input_data_file: (The orders of the input data must be kept.)\n");
1662: oxprintfe(" Mg: m(the number of variables), Beta: beta=sigma^(-1)/2 (diagonized), Ng: n,\n");
1663: oxprintfe(" (Add a comment line %%Ng= before the data Ng to check the number of beta.)\n");
1664: oxprintfe(" X0g: starting value of x(when --x0 option is used, this value is used)\n");
1665: oxprintfe(" Iv: initial values at X0g*Beta (see our paper how to order them), are evaluated in this program. Give zeros or the symbol * to skip rank many inputs.\n");
1666: oxprintfe(" Ef: a scalar factor to the initial value. It is calculated by this program. Give the zero.\n");
1667: oxprintfe(" Hg: h (step size) which is for hgm_w-n, \n");
1668: oxprintfe(" Dp: output data is stored in every Dp steps when output_data_file is specified. This is for hgm_w-n.\n");
1669: oxprintfe(" Xng: terminating value of x. This is for hgm_w-n.\n");
1670: oxprintfe("Optional parameters automatic, ... are interpreted by a parser. See setParam() in jack-n.c and Testdata/tmp-idata2.txt as an example. Optional paramters are given as %%parameter_name=value Lines starting with %%%% or # are comment lines.\n");
1671: oxprintfe("Parameters are redefined when they appear more than once in the idata file and the command line options.\n\n");
1672: oxprintfe("With the --notable option, it does not use the Lemma 3.2 of Koev-Edelman (there is a typo: kappa'_r = mu'_r for 1<=r<=mu_k).\n");
1673: oxprintfe("An example format of the input_data_file can be obtained by executing hgm_jack-n with no option. When there is no --idata file, all options are ignored.\n");
1674: oxprintfe("By --automatic option, X0g and degree are automatically determined from assigend_series_error. The current strategy is described in mh_t in jack-n.c\n");
1675: oxprintfe("Default values for the papameters of the automatic mode: automatic=%d, assigned_series_error=%lg, x0value_min=%lg\n",M_automatic,M_assigned_series_error,M_x0value_min);
1676: oxprintfe("Todo: automatic mode throws away the table of Jack polynomials of the previous degrees and reevaluate them. They should be kept.\n");
1677: oxprintfe("\nExamples:\n");
1678: oxprintfe("[1] ./hgm_jack-n \n");
1679: oxprintfe("[2] ./hgm_jack-n --idata Testdata/tmp-idata3.txt --degree 15 --automatic 0\n");
1680: oxprintfe("[3] ./hgm_jack-n --idata Testdata/tmp-idata2.txt --degree 15 >test2.txt\n");
1681: oxprintfe(" ./hgm_w-n --idata test2.txt --gnuplotf test-g\n");
1682: oxprintfe(" gnuplot -persist <test-g-gp.txt\n");
1683: oxprintfe("[4] ./hgm_jack-n --idata Testdata/tmp-idata3.txt --automatic 1 --assigned_series_error=1e-12\n");
1684: oxprintfe("[5] ./hgm_jack-n --idata Testdata/tmp-idata4.txt\n");
1.13 takayama 1685: return(0);
1.1 takayama 1686: }
1687:
1.10 takayama 1688: static int setParamDefault() {
1.1 takayama 1689: int rank;
1690: int i;
1.3 takayama 1691: Mg = M_n_default ;
1.1 takayama 1692: rank = imypower(2,Mg);
1693: Beta = (double *)mymalloc(sizeof(double)*Mg);
1694: for (i=0; i<Mg; i++) Beta[i] = 1.0+i;
1695: Ng = (double *)mymalloc(sizeof(double)); *Ng = 3.0;
1696: Iv = (double *)mymalloc(sizeof(double)*rank);
1697: Iv2 = (double *)mymalloc(sizeof(double)*rank);
1698: for (i=0; i<rank; i++) Iv[i] = 0;
1699: Ef = 0;
1700: Ef2 = 0.01034957388338225707;
1701: if (M_n == 2) {
1702: Iv2[0] = 1.58693;
1703: Iv2[1] = 0.811369;
1704: Iv2[2] = 0.846874;
1705: Iv2[3] = 0.413438;
1706: }
1707: X0g = (Beta[0]/Beta[Mg-1])*0.5;
1708: Hg = 0.001;
1709: Dp = 1;
1710: Xng = 10.0;
1.13 takayama 1711: return(0);
1.1 takayama 1712: }
1713:
1.10 takayama 1714: static int next(struct SFILE *sfp,char *s,char *msg) {
1.14 takayama 1715: static int check=1;
1.31 takayama 1716: char *ng="%%Ng=";
1.32 takayama 1717: // int i;
1.1 takayama 1718: s[0] = '%';
1719: while (s[0] == '%') {
1.12 takayama 1720: if (!mh_fgets(s,SMAX,sfp)) {
1.29 takayama 1721: oxprintfe("Data format error at %s\n",msg);
1.12 takayama 1722: mh_exit(-1);
1723: }
1.14 takayama 1724: if (check && (strncmp(msg,ng,4)==0)) {
1.31 takayama 1725: if (strncmp(s,ng,5) != 0) {
1.29 takayama 1726: oxprintfe("Warning, there is no %%Ng= at the border of Beta's and Ng, s=%s\n",s);
1.14 takayama 1727: }
1.31 takayama 1728: /* check=0; */
1.14 takayama 1729: }
1.12 takayama 1730: if (s[0] != '%') return(0);
1.1 takayama 1731: }
1.13 takayama 1732: return(0);
1.1 takayama 1733: }
1.10 takayama 1734: static int setParam(char *fname) {
1.1 takayama 1735: int rank;
1736: char s[SMAX];
1.3 takayama 1737: struct SFILE *fp;
1.1 takayama 1738: int i;
1.19 takayama 1739: struct mh_token tk;
1.1 takayama 1740: if (fname == NULL) return(setParamDefault());
1741:
1742: Sample = 0;
1.3 takayama 1743: if ((fp=mh_fopen(fname,"r",JK_byFile)) == NULL) {
1.29 takayama 1744: if (JK_byFile) oxprintfe("File %s is not found.\n",fp->s);
1.12 takayama 1745: mh_exit(-1);
1.1 takayama 1746: }
1747: next(fp,s,"Mg(m)");
1748: sscanf(s,"%d",&Mg);
1749: rank = imypower(2,Mg);
1750:
1751: Beta = (double *)mymalloc(sizeof(double)*Mg);
1752: for (i=0; i<Mg; i++) {
1753: next(fp,s,"Beta");
1.12 takayama 1754: sscanf(s,"%lf",&(Beta[i]));
1.1 takayama 1755: }
1756:
1757: Ng = (double *)mymalloc(sizeof(double));
1.14 takayama 1758: next(fp,s,"%Ng= (freedom parameter n)");
1.1 takayama 1759: sscanf(s,"%lf",Ng);
1760:
1761: next(fp,s,"X0g(initial point)");
1762: sscanf(s,"%lf",&X0g);
1.14 takayama 1763:
1.1 takayama 1764: Iv = (double *)mymalloc(sizeof(double)*rank);
1765: for (i=0; i<rank; i++) {
1.12 takayama 1766: next(fp,s,"Iv(initial values)");
1.14 takayama 1767: if (strncmp(s,"*",1)==0) {
1768: for (i=0; i<rank; i++) Iv[i] = 0.0;
1769: break;
1770: }
1.12 takayama 1771: sscanf(s,"%lg",&(Iv[i]));
1.1 takayama 1772: }
1773:
1774: next(fp,s,"Ef(exponential factor)");
1.14 takayama 1775: if (strncmp(s,"*",1)==0) Ef=0.0;
1776: else sscanf(s,"%lg",&Ef);
1.1 takayama 1777:
1778: next(fp,s,"Hg (step size of rk)");
1779: sscanf(s,"%lf",&Hg);
1780:
1781: next(fp,s,"Dp (data sampling period)");
1782: sscanf(s,"%d",&Dp);
1783:
1784: next(fp,s,"Xng (the last point, cf. --xmax)");
1785: sscanf(s,"%lf",&Xng);
1.19 takayama 1786:
1787: /* Reading the optional parameters */
1788: while ((tk = mh_getoken(s,SMAX-1,fp)).type != MH_TOKEN_EOF) {
1789: /* expect ID */
1790: if (tk.type != MH_TOKEN_ID) {
1.29 takayama 1791: oxprintfe("Syntax error at %s\n",s); mh_exit(-1);
1.19 takayama 1792: }
1793: if (strcmp(s,"automatic")==0) {
1794: if (mh_getoken(s,SMAX-1,fp).type != MH_TOKEN_EQ) {
1.29 takayama 1795: oxprintfe("Syntax error at %s\n",s); mh_exit(-1);
1.19 takayama 1796: }
1797: if ((tk=mh_getoken(s,SMAX-1,fp)).type != MH_TOKEN_INT) {
1.29 takayama 1798: oxprintfe("Syntax error at %s\n",s); mh_exit(-1);
1.19 takayama 1799: }
1800: M_automatic = tk.ival;
1801: continue;
1802: }
1803: if (strcmp(s,"assigned_series_error")==0) {
1804: if (mh_getoken(s,SMAX-1,fp).type != MH_TOKEN_EQ) {
1.29 takayama 1805: oxprintfe("Syntax error at %s\n",s); mh_exit(-1);
1.19 takayama 1806: }
1807: if ((tk=mh_getoken(s,SMAX-1,fp)).type != MH_TOKEN_DOUBLE) {
1.29 takayama 1808: oxprintfe("Syntax error at %s\n",s); mh_exit(-1);
1.19 takayama 1809: }
1810: M_assigned_series_error = tk.dval;
1811: continue;
1812: }
1813: if (strcmp(s,"x0value_min")==0) {
1814: if (mh_getoken(s,SMAX-1,fp).type != MH_TOKEN_EQ) {
1.29 takayama 1815: oxprintfe("Syntax error at %s\n",s); mh_exit(-1);
1.19 takayama 1816: }
1817: if ((tk=mh_getoken(s,SMAX-1,fp)).type != MH_TOKEN_DOUBLE) {
1.29 takayama 1818: oxprintfe("Syntax error at %s\n",s); mh_exit(-1);
1.19 takayama 1819: }
1820: M_x0value_min = tk.dval;
1821: continue;
1822: }
1823: if ((strcmp(s,"Mapprox")==0) || (strcmp(s,"degree")==0)) {
1824: if (mh_getoken(s,SMAX-1,fp).type != MH_TOKEN_EQ) {
1.29 takayama 1825: oxprintfe("Syntax error at %s\n",s); mh_exit(-1);
1.19 takayama 1826: }
1827: if ((tk=mh_getoken(s,SMAX-1,fp)).type != MH_TOKEN_INT) {
1.29 takayama 1828: oxprintfe("Syntax error at %s\n",s); mh_exit(-1);
1.19 takayama 1829: }
1830: Mapprox = tk.ival;
1831: continue;
1832: }
1833: if (strcmp(s,"X0g_bound")==0) {
1834: if (mh_getoken(s,SMAX-1,fp).type != MH_TOKEN_EQ) {
1.29 takayama 1835: oxprintfe("Syntax error at %s\n",s); mh_exit(-1);
1.19 takayama 1836: }
1837: if ((tk=mh_getoken(s,SMAX-1,fp)).type != MH_TOKEN_DOUBLE) {
1.29 takayama 1838: oxprintfe("Syntax error at %s\n",s); mh_exit(-1);
1.19 takayama 1839: }
1840: M_X0g_bound = tk.dval;
1841: continue;
1842: }
1.25 takayama 1843: if (strcmp(s,"show_autosteps")==0) {
1844: if (mh_getoken(s,SMAX-1,fp).type != MH_TOKEN_EQ) {
1.29 takayama 1845: oxprintfe("Syntax error at %s\n",s); mh_exit(-1);
1.25 takayama 1846: }
1847: if ((tk=mh_getoken(s,SMAX-1,fp)).type != MH_TOKEN_INT) {
1.29 takayama 1848: oxprintfe("Syntax error at %s\n",s); mh_exit(-1);
1.25 takayama 1849: }
1850: M_show_autosteps = tk.ival;
1851: continue;
1852: }
1.36 ! takayama 1853: // Format: #p_pFq=2 1.5 3.2
! 1854: if (strcmp(s,"p_pFq")==0) {
! 1855: Orig_1F1=0;
! 1856: if (mh_getoken(s,SMAX-1,fp).type != MH_TOKEN_EQ) {
! 1857: oxprintfe("Syntax error at %s\n",s); mh_exit(-1);
! 1858: }
! 1859: if ((tk=mh_getoken(s,SMAX-1,fp)).type != MH_TOKEN_INT) {
! 1860: oxprintfe("Syntax error at %s\n",s); mh_exit(-1);
! 1861: }
! 1862: P_pFq = tk.ival;
! 1863: for (i=0; i<P_pFq; i++) {
! 1864: if ((tk=mh_getoken(s,SMAX-1,fp)).type == MH_TOKEN_DOUBLE) {
! 1865: A_pFq[i] = tk.dval;
! 1866: }else if (tk.type == MH_TOKEN_INT) {
! 1867: A_pFq[i] = tk.ival;
! 1868: }else{
! 1869: oxprintfe("Syntax error at %s\n",s); mh_exit(-1);
! 1870: }
! 1871: }
! 1872: continue;
! 1873: }
! 1874: if (strcmp(s,"q_pFq")==0) {
! 1875: if (mh_getoken(s,SMAX-1,fp).type != MH_TOKEN_EQ) {
! 1876: oxprintfe("Syntax error at %s\n",s); mh_exit(-1);
! 1877: }
! 1878: if ((tk=mh_getoken(s,SMAX-1,fp)).type != MH_TOKEN_INT) {
! 1879: oxprintfe("Syntax error at %s\n",s); mh_exit(-1);
! 1880: }
! 1881: Q_pFq = tk.ival;
! 1882: for (i=0; i<Q_pFq; i++) {
! 1883: if ((tk=mh_getoken(s,SMAX-1,fp)).type == MH_TOKEN_DOUBLE) {
! 1884: B_pFq[i] = tk.dval;
! 1885: }else if (tk.type == MH_TOKEN_INT) {
! 1886: B_pFq[i] = tk.ival;
! 1887: }else{
! 1888: oxprintfe("Syntax error at %s\n",s); mh_exit(-1);
! 1889: }
! 1890: }
! 1891: continue;
! 1892: }
1.29 takayama 1893: oxprintfe("Unknown ID at %s\n",s); mh_exit(-1);
1.19 takayama 1894: }
1.3 takayama 1895: mh_fclose(fp);
1.13 takayama 1896: return(0);
1.1 takayama 1897: }
1898:
1.10 takayama 1899: static int showParam(struct SFILE *fp,int fd) {
1.1 takayama 1900: int rank,i;
1.3 takayama 1901: char swork[1024];
1.8 takayama 1902: if (fd) {
1.34 takayama 1903: fp = mh_fopen("stdout","w",1);
1.8 takayama 1904: }
1.1 takayama 1905: rank = imypower(2,Mg);
1.3 takayama 1906: sprintf(swork,"%%Mg=\n%d\n",Mg); mh_fputs(swork,fp);
1.1 takayama 1907: for (i=0; i<Mg; i++) {
1.12 takayama 1908: sprintf(swork,"%%Beta[%d]=\n%lf\n",i,Beta[i]); mh_fputs(swork,fp);
1.1 takayama 1909: }
1.3 takayama 1910: sprintf(swork,"%%Ng=\n%lf\n",*Ng); mh_fputs(swork,fp);
1911: sprintf(swork,"%%X0g=\n%lf\n",X0g); mh_fputs(swork,fp);
1.1 takayama 1912: for (i=0; i<rank; i++) {
1.12 takayama 1913: sprintf(swork,"%%Iv[%d]=\n%lg\n",i,Iv[i]); mh_fputs(swork,fp);
1914: if (Sample && (M_n == 2) && (X0g == 0.3)) {
1915: sprintf(swork,"%%Iv[%d]-Iv2[%d]=%lg\n",i,i,Iv[i]-Iv2[i]); mh_fputs(swork,fp);
1916: }
1.3 takayama 1917: }
1918: sprintf(swork,"%%Ef=\n%lg\n",Ef); mh_fputs(swork,fp);
1919: sprintf(swork,"%%Hg=\n%lf\n",Hg); mh_fputs(swork,fp);
1920: sprintf(swork,"%%Dp=\n%d\n",Dp); mh_fputs(swork,fp);
1921: sprintf(swork,"%%Xng=\n%lf\n",Xng);mh_fputs(swork,fp);
1.19 takayama 1922:
1923: sprintf(swork,"%%%% Optional paramters\n"); mh_fputs(swork,fp);
1924: sprintf(swork,"#success=%d\n",M_mh_t_success); mh_fputs(swork,fp);
1925: sprintf(swork,"#automatic=%d\n",M_automatic); mh_fputs(swork,fp);
1926: sprintf(swork,"#series_error=%lg\n",M_series_error); mh_fputs(swork,fp);
1927: sprintf(swork,"#recommended_abserr\n"); mh_fputs(swork,fp);
1.36 ! takayama 1928: sprintf(swork,"#abserror=%lg\n",M_recommended_abserr); mh_fputs(swork,fp);
1.27 takayama 1929: if (M_recommended_relerr < MH_RELERR_DEFAULT) {
1930: sprintf(swork,"%%relerror=%lg\n",M_recommended_relerr); mh_fputs(swork,fp);
1931: }
1.19 takayama 1932: sprintf(swork,"#mh_t_value=%lg # Value of matrix hg at X0g.\n",M_mh_t_value); mh_fputs(swork,fp);
1933: sprintf(swork,"# M_m=%d # Approximation degree of matrix hg.\n",M_m); mh_fputs(swork,fp);
1934: sprintf(swork,"#beta_i_x_o2_max=%lg #max(|beta[i]*x|/2)\n",M_beta_i_x_o2_max); mh_fputs(swork,fp);
1935: sprintf(swork,"#beta_i_beta_j_min=%lg #min(|beta[i]-beta[j]|)\n",M_beta_i_beta_j_min); mh_fputs(swork,fp);
1.36 ! takayama 1936: sprintf(swork,"# change # to %% to read as an optional parameter.\n"); mh_fputs(swork,fp);
! 1937: sprintf(swork,"#p_pFq=%d, ",P_pFq); mh_fputs(swork,fp);
! 1938: for (i=0; i<P_pFq; i++) {
! 1939: if (i != P_pFq-1) sprintf(swork," %lg,",A_pFq[i]);
! 1940: else sprintf(swork," %lg\n",A_pFq[i]);
! 1941: mh_fputs(swork,fp);
! 1942: }
! 1943: sprintf(swork,"#q_pFq=%d, ",Q_pFq); mh_fputs(swork,fp);
! 1944: for (i=0; i<Q_pFq; i++) {
! 1945: if (i != Q_pFq-1) sprintf(swork," %lg,",B_pFq[i]);
! 1946: else sprintf(swork," %lg\n",B_pFq[i]);
! 1947: mh_fputs(swork,fp);
! 1948: }
1.13 takayama 1949: return(0);
1.1 takayama 1950: }
1951:
1.2 takayama 1952: static double gammam(double a,int n) {
1.1 takayama 1953: double v,v2;
1954: int i;
1955: v=mypower(sqrt(M_PI),(n*(n-1))/2);
1956: v2=0;
1957: for (i=1; i<=n; i++) {
1958: v2 += lgamma(a-((double)(i-1))/2.0); /* not for big n */
1959: }
1.29 takayama 1960: if (Debug) oxprintf("gammam(%lg,%d)=%lg\n",a,n,v*exp(v2));
1.1 takayama 1961: return(v*exp(v2));
1962: }
1963:
1.2 takayama 1964: static double iv_factor(void) {
1.1 takayama 1965: double v1;
1966: double t;
1967: double b;
1968: double detSigma;
1969: double c;
1970: int i,n;
1971: n = (int) (*Ng);
1972: v1= mypower(sqrt(X0g),n*M_n);
1973: t = 0.0;
1974: for (i=0; i<M_n; i++) t += -X0g*Beta[i];
1975: v1 = v1*exp(t);
1976:
1977: b = 1; for (i=0; i<M_n; i++) b *= Beta[i];
1978: detSigma = 1.0/(b*mypower(2.0,M_n));
1979:
1980: c = gammam(((double)(M_n+1))/2.0, M_n)/
1.12 takayama 1981: ( mypower(sqrt(2), M_n*n)*mypower(sqrt(detSigma),n)*gammam(((double)(M_n+n+1))/2.0,M_n) );
1.1 takayama 1982: return( c*v1);
1983: }
1984:
1985:
1986:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>