#include #include #define _ISOC99_SOURCE #include #include #include "sfile.h" /* $OpenXM: OpenXM/src/hgm/mh/src/jack-n.c,v 1.16 2014/03/11 05:20:45 takayama Exp $ Ref: copied from this11/misc-2011/A1/wishart/Prog jack-n.c, translated from mh.rr or tk_jack.rr in the asir-contrib. License: LGPL Koev-Edelman for higher order derivatives. cf. 20-my-note-mh-jack-n.pdf, /Movies/oxvh/priv-j1/2011-12-14-ke-mh-jack.mov Todo: 1. Cash the transposes of partitions. 2. Use the recurrence to obtain beta(). 3. Easier input data file format for mh-n.c Changelog: 2014.03.11, 2012.02.21, porting to OpenXM/src/hgm 2011.12.22, --table option, which is experimental. 2011.12.19, bug fix. jjk() should return double. It can become more than max int. 2011.12.15, mh.r --> jack-n.c */ /****** from mh-n.c *****/ static int JK_byFile=1; static int JK_deallocate=0; #define M_n_default 3 #define Sample_default 1 static int M_n=0; /* global variables. They are set in setParam() */ static int Mg; /* n */ static int Mapprox; /* m, approximation degree */ static double *Beta; /* beta[0], ..., beta[m-1] */ static double *Ng; /* freedom n. c=(m+1)/2+n/2; Note that it is a pointer */ static double X0g; /* initial point */ static double *Iv; /* Initial values of mhg sorted by mhbase() in rd.rr at beta*x0 */ static double Ef; /* exponential factor at beta*x0 */ static double Hg; /* step size of rk defined in rk.c */ static int Dp; /* Data sampling period */ static double Xng=0.0; /* the last point */ static int Sample = Sample_default; /* for sample inputs */ static double *Iv2; static double Ef2; #ifdef NAN #else #define NAN 3.40282e+38 /* for old 32 bit machines. Todo, configure */ #endif /* #define M_n 3 defined in the Makefile */ /* number of variables */ #define M_n0 3 /* used for tests. Must be equal to M_n */ #define M_m_MAX 200 #define M_nmx M_m_MAX /* maximal of M_n */ #define A_LEN 1 /* (a_1) , (a_1, ..., a_p)*/ #define B_LEN 1 /* (b_1) */ static int Debug = 0; static int Alpha = 2; /* 2 implies the zonal polynomial */ static int *Darray = NULL; static int **Parray = NULL; /* array of partitions of size M_n */ static int *ParraySize = NULL; /* length of each partitions */ static int M_kap[M_nmx]; static int M_m=M_m_MAX-2; /* | | <= M_m, bug do check of M_m <=M_m_MAX-2 */ void (*M_pExec)(void); static int HS_mu[M_nmx]; static int HS_n=M_nmx; /* It is initialized to M_n in jk_main */ void (*HS_hsExec)(void); static double M_x[M_nmx]; /* They are used in pmn */ static int *P_pki=NULL; static int P_pmn=0; /* It is used genDarray2(), list partitions... */ static int DR_parray=0; /* Used in genBeta() and enumeration of horizontal strip. */ static double *M_beta_0=NULL; /* M_beta[0][*] value of beta_{kappa,mu}, M_beta[1][*] N_mu */ static int *M_beta_1=NULL; static int M_beta_pt=0; static int M_beta_kap[M_nmx]; static int UseTable = 0; static double **M_jack; static int M_df=1; /* Compute differentials? */ static int M_2n=0; /* 2^N */ static double Xarray[M_nmx][M_m_MAX]; /* (x_1, ..., x_n) */ /* Xarray[i][0] x_{i+1}^0, Xarray[i][1], x_{i+1}^1, ... */ static double *M_qk=NULL; /* saves pochhammerb */ static double M_rel_error=0.0; /* relative errors */ /* For automatic degree and X0g setting. */ static int M_m_estimated_approx_deg=0; static double M_assigned_series_error=0.00001; static int M_automatic=0; static double M_x0value_min=0.1; static double M_estimated_X0g=0.0; static int M_mh_t_success=1; #define myabs(x) ((x)<0?(-(x)):(x)) #define mymax(x,y) ((x)>(y)?(x):(y)) #define mymin(x,y) ((x)<(y)?(x):(y)) /* prototypes */ static void *mymalloc(int size); static int myfree(void *p); static int myerror(char *s); static double jack1(int K); static double jack1diff(int k); static double xval(int i,int p); /* x_i^p */ static int mysum(int L[]); static int plength(int P[]); static int plength_t(int P[]); static void ptrans(int P[M_nmx],int Pt[]); static int test_ptrans(); static int huk(int K[],int I,int J); static int hdk(int K[],int I,int J); static double jjk(int K[]); static double ppoch(double A,int K[]); static double ppoch2(double A,double B,int K[]); static double mypower(double x,int n); static double qk(int K[],double A[A_LEN],double B[B_LEN]); static int bb(int N[],int K[],int M[],int I,int J); static double beta(int K[],int M[]); static int printp(int kappa[]); static int printp2(int kappa[]); static int test_beta(); static double q3_10(int K[],int M[],int SK); static double q3_5(double A[],double B[],int K[],int I); static void mtest4(); static void mtest4b(); static int nk(int KK[]); static int plength2(int P1[],int P2[]); static int myeq(int P1[],int P2[]); static int pListPartition(int M,int N); static int pListPartition2(int Less,int From,int To, int M); static void pExec_0(); static int pListHS(int Kap[],int N); static int pListHS2(int From,int To,int Kap[]); static void hsExec_0(); static int pmn(int M,int N); static int *cloneP(int a[]); static int copyP(int p[],int a[]); static void pExec_darray(void); static int genDarray2(int M,int N); static int isHStrip(int Kap[],int Nu[]); static void hsExec_beta(void); static int genBeta(int Kap[]); static int checkBeta1(); static int psublen(int Kap[],int Mu[]); static int genJack(int M,int N); static int checkJack1(int M,int N); static int checkJack2(int M,int N); static int mtest1b(); static int imypower(int x,int n); static int usage(); static int setParamDefault(); static int next(struct SFILE *fp,char *s,char *msg); static int gopen_file(void); static int setParam(char *fname); static int showParam(struct SFILE *fp,int fd); static double iv_factor(void); static double gammam(double a,int n); static double mypower(double a,int n); double mh_t(double A[A_LEN],double B[B_LEN],int N,int M); double mh_t2(int J); struct MH_RESULT *jk_main(int argc,char *argv[]); struct MH_RESULT *jk_main2(int argc,char *argv[],int automode,double newX0g,int newDegree); int jk_freeWorkArea(); int jk_initializeWorkArea(); int jk_freeWorkArea() { /* bug, p in the cloneP will not be deallocated. Nk in genDarray2 will not be deallocated. */ int i; JK_deallocate=1; if (Darray) {myfree(Darray); Darray=NULL;} if (Parray) {myfree(Parray); Parray=NULL;} if (ParraySize) {myfree(ParraySize); ParraySize=NULL;} if (M_beta_0) {myfree(M_beta_0); M_beta_0=NULL;} if (M_beta_1) {myfree(M_beta_1); M_beta_1=NULL;} if (M_jack) { for (i=0; M_jack[i] != NULL; i++) { if (Debug) printf("Free M_jack[%d]\n",i); myfree(M_jack[i]); M_jack[i] = NULL; } myfree(M_jack); M_jack=NULL; } if (M_qk) {myfree(M_qk); M_qk=NULL;} if (P_pki) {myfree(P_pki); P_pki=NULL;} JK_deallocate=0; return(0); } int jk_initializeWorkArea() { int i,j; JK_deallocate=1; xval(0,0); JK_deallocate=0; Darray=NULL; Parray=NULL; ParraySize=NULL; M_beta_0=NULL; M_beta_1=NULL; M_jack=NULL; M_qk=NULL; for (i=0; i M_m_MAX-2) myerror("xval, p is too large."); if (p < 0) { myerror("xval, p is negative."); printf("ii=%d, p=%d\n",ii,p); mh_exit(-1); } return(Xarray[ii-1][p]); } static int mysum(int L[]) { int S,I,N; N=M_n; S=0; for (I=0; I 3 */ static int plength(int P[]) { int I; for (I=0; I S2) return(1); else if (S1 == S2) { S1=mysum(P1); S2=mysum(P2); if(S1 > S2) return(1); else if (S1 == S2) return(0); else return(-1); } else return(-1); } static int myeq(int P1[],int P2[]) { int I,L1; if ((L1=plength(P1)) != plength(P2)) return(0); for (I=0; I= M_kap[From], ..., M_kap[To], |(M_kap[From],...,M_kap[To])|<=M, */ static int pListPartition2(int Less,int From,int To, int M) { int I,R; mh_check_intr(100); if (To < From) { (*M_pExec)(); return(0); } for (I=1; (I<=Less) && (I<=M) ; I++) { M_kap[From-1] = I; R = pListPartition2(I,From+1,To,M-I); } return(1); } /* partition に対してやる仕事をこちらへ書く. */ static void pExec_0() { if (Debug) { printf("M_kap="); printp(M_kap); printf("\n"); } } /* Test. Compare pListPartition(4,3); genDarray(4,3); Compare pListPartition(5,3); genDarray(5,3); */ /* main() { M_pExec = pExec_0; pListPartition(5,3); } */ /* List all horizontal strips. Kap[0] is not a dummy in C code. !(Start from Kap[1].) */ static int pListHS(int Kap[],int N) { extern int HS_n; extern int HS_mu[]; int i; HS_n = N; /* Clear HS_mu. Do not forget when N < M_n */ for (i=0; i= More; I--) { HS_mu[From-1] = I; pListHS2(From+1,To,Kap); } return(1); } static void hsExec_0() { int i; if(Debug) {printf("hsExec: "); printp(HS_mu); printf("\n");} } /* pListHS([0,4,2,1],3); */ /* main() { int Kap[3]={4,2,1}; HS_hsExec = hsExec_0; pListHS(Kap,3); } */ /* The number of partitions <= M, with N parts. (0,0,...,0) is excluded. */ #define aP_pki(i,j) P_pki[(i)*(M+1)+(j)] static int pmn(int M,int N) { int Min_m_n,I,K,S,T,i,j; extern int P_pmn; extern int *P_pki; Min_m_n = (M>N?N:M); /* P_pki=newmat(Min_m_n+1,M+1); */ P_pki = (int *) mymalloc(sizeof(int)*(Min_m_n+1)*(M+1)); for (i=0; i= M_n) { if (Debug) {fprintf(stderr,"Ksize >= M_n\n");} continue; } for (i=0; i N1) return(0); for (I=0; I= N1-1) P = 0; else P=Kap[I+1]; if (Kap[I] < Nu[I]) return(0); if (Nu[I] < P) return(0); } return(1); } static void hsExec_beta(void) { int *Mu; int N,Nmu,Nnu,Done,J,K,OK,I,RR; int Kapt[M_m_MAX]; int Nut[M_m_MAX]; int Nu[M_nmx]; int rrMax; hsExec_0(); /* printf("M_beta_pt=%a\n",M_beta_pt); */ /* Mu = cdr(vtol(HS_mu)); */ Mu = HS_mu; /* buggy? need cloneP */ if (M_beta_pt == 0) { M_beta_0[0] = 1; M_beta_1[0] = nk(Mu); M_beta_pt++; return; } N = HS_n; Nmu = nk(Mu); M_beta_1[M_beta_pt] = Nmu; ptrans(M_beta_kap,Kapt); /* Mu, Nu is exchanged in this code. cf. the K-E paper */ copyP(Nu,Mu); /* buggy need clone? */ for (I=0; I=0; J--) { if (M_beta_1[J] == Nnu) { K=I+1; if (Debug) { printf("Found at J=%d, K=%d, q3_10(Kap,Nu,K)=%lf,Nu,Mu= \n", J,K,q3_10(M_beta_kap,Nu,K)); printp(Nu); printf("\n"); printp(Mu); printf("\n"); } /* Check other conditions. See Numata's mail on Dec 24, 2011. */ rrMax = Nu[I]-1; if ((plength_t(Kapt) < rrMax) || (plength_t(Nut) < rrMax)) { if (Debug) printf(" is not taken (length). \n"); break; } OK=1; for (RR=0; RR L1) myerror("psub, length mismatches."); A = 0; for (I=0; I= Mu"); A += Kap[I]-Mu[I]; } for (I=L2; I 0 */ for (K=1; K<=M; K++) { aM_jack(1,0,K) = jack1(K); if (M_df) { aM_jack(1,1,K) = jack1diff(K); /* diff(jack([K],1),x_1); */ for (J=2; J= 2^I) aM_jack(I,J,K) = 0; else aM_jack(I,J,K) = NAN; } } } } /* Start to evaluate the entries of the table */ for (K=1; K<=Pmn; K++) { Kap = Parray[K]; /* bug. need copy? */ L = plength(Kap); for (I=1; I<=L-1; I++) { aM_jack(I,0,K) = 0; if (M_df) { for (J=1; J 0. */ for (J=1; J0) partial_sum[i] += partial_sum[i-1]; serror = myabs((partial_sum[i]-partial_sum[i-1])/partial_sum[i-1]); if ((i>0)&&(M_m_estimated_approx_deg < 0)&&(serror M_m) M_mh_t_success=0; } printf("%%%%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); printf("%%%%F=%lg,Ef=%lg,M_estimated_X0g=%lg, X0g=%lg\n",F,iv_factor(),M_estimated_X0g,X0g); return(F); } double mh_t2(int J) { extern double *M_qk; double F; int K; int Pmn; extern int P_pmn; if (M_qk == NULL) {myerror("Call mh_t first."); mh_exit(-1); } F = 0; Pmn = P_pmn; for (K=0; K= argc) { fprintf(stderr,"Option argument is not given.\n"); return(NULL); }} static int imypower(int x,int n) { int i; int v; if (n < 0) {myerror("imypower"); mh_exit(-1);} v = 1; for (i=0; imessage = NULL; } else ans = NULL; /* Output by a file=stdout */ ofp = mh_fopen("stdout","w",JK_byFile); sprintf(swork,"%%%%Use --help option to see the help.\n"); mh_fputs(swork,ofp); sprintf(swork,"%%%%Mapprox=%d\n",Mapprox); mh_fputs(swork,ofp); if (M_n != Mg) { myerror("Mg must be equal to M_n\n"); mh_exit(-1); } if (Debug) showParam(NULL,1); for (i=0; ix = X0g; ans->rank = imypower(2,Mg); ans->y = (double *)mymalloc(sizeof(double)*(ans->rank)); for (i=0; irank; i++) (ans->y)[i] = Iv[i]; ans->size=1; ans->sfpp = (struct SFILE **)mymalloc(sizeof(struct SFILE *)*(ans->size)); (ans->sfpp)[0] = ofp; } if (Debug) printf("jk_freeWorkArea() starts\n"); jk_freeWorkArea(); if (Debug) printf("jk_freeWorkArea() has finished.\n"); return(ans); } static int usage() { fprintf(stderr,"Usages:\n"); fprintf(stderr,"hgm_jack-n [--idata input_data_file --x0 x0 --degree approxm]\n"); fprintf(stderr," [--automatic n --assigend_series_error e --x0value_min e2]\n"); fprintf(stderr,"\nThe command hgm_jack-n [options] generates an input for hgm_w-n, Pr({y | ytest2.txt\n"); fprintf(stderr," ./hgm_w-n --idata test2.txt --gnuplotf test-g\n"); fprintf(stderr," gnuplot -persist s); mh_exit(-1); } next(fp,s,"Mg(m)"); sscanf(s,"%d",&Mg); rank = imypower(2,Mg); Beta = (double *)mymalloc(sizeof(double)*Mg); for (i=0; i