[BACK]Return to jack-n.c CVS log [TXT][DIR] Up to [local] / OpenXM / src / hgm / mh / src

Annotation of OpenXM/src/hgm/mh/src/jack-n.c, Revision 1.37

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>