int main()
{
int i,k;
FILE *fp;
/* read the table that has the reemission frequencies */
read_ftable(&reemit);
/* read the table that has the reemission probabilities */
read_ptable2(&reemit);
if (( fp = fopen("ptable_test.dat", "w")) == NULL)
{
fprintf(stderr, "FAILED TO OPEN ptable_test.dat FILE. \n");
return;
}
/* Note: the first row in ptable.dat is for T=1 */
for (k=0; k<NFREQ ; k++)
{
for (i=1;i<200; i=i+10)
fprintf(fp,"%.4e ", reemit.prob[i][k]);
fprintf(fp,"\n");
}
fclose(fp);
if (( fp = fopen("ftable_test.dat", "w")) == NULL)
{
fprintf(stderr, "FAILED TO OPEN ftable_test.dat FILE. \n");
return;
}
for (k=0; k<NFREQ ; k=k++)
{
fprintf(fp,"%.4e\n ",reemit.freq[k]);
}
fclose(fp);
return 0;
}
void muste_tabtest(char *argv)
{
int i;
// char ch;
int ncvar;
// char nimi[LLENGTH];
char s[LLENGTH];
extern int print_line();
int ltotal;
// if (argc==1) return;
s_init(argv);
i=spec_init(r1+r-1); if (i<0) return;
r_original=r;
results_line=0;
if (g<2)
{
init_remarks();
rem_pr("Usage: TABTEST <table_of_frequencies>,L");
rem_pr("");
rem_pr("TABTEST performs various tests for independence etc. by simulation");
rem_pr("for a two-dimensional table of frequencies. The table is");
rem_pr("given in edit field in the form used by the TAB operations.");
rem_pr("The table can be also given in a simpler form without any labels:");
rem_pr("TABLE TEST / Example");
rem_pr("7 2 0");
rem_pr("3 1 5");
rem_pr("");
rem_pr("Different assumptions about the stochastic structure of the table are");
rem_pr("determined by a FIX specification with following alternatives:");
rem_pr(" FIX=Fisher Both row and column margins fixed (exact test)");
rem_pr(" FIX=RC Both row and column margins fixed");
rem_pr(" FIX=C Column margins (vertical sums) fixed");
rem_pr(" FIX=R Row margins (horizontal sums) fixed");
rem_pr(" FIX=N No fixed margins, only the grand total fixed");
rem_pr(" FIX=F(i,j) Element of row i and column j fixed");
wait_remarks(1);
rem_pr("The test statistics used in simulation is selected by a TEST specification:");
rem_pr("TEST=X^2 is the common Pearson's chi-square statistics: sum of (O-E)^2/E .");
rem_pr("TEST=G^2 is the likelihood statistics: sum of -2*O*log(O/E) .");
rem_pr("TEST=PROB is the probability of the simulated table. The unknown");
rem_pr(" margin probabilities are replaced by simulated relative");
rem_pr(" frequencies. We call this `Probability statistics'.");
rem_pr("In case FIX=Fisher, TEST=PROB is always selected.");
rem_pr("In other cases TEST=X^2 is default.");
wait_remarks(1);
rem_pr("Maximum number of replicates is given by SIMUMAX (default 10000000).");
rem_pr("The seed number of the random number generator (either 'rand' or 'urand')");
rem_pr("is given by RAND (default RAND=rand(12345). See RAND? .");
rem_pr("The process may be interrupted by pressing any key.");
rem_pr("");
rem_pr("The results are displayed after each 100 replicates as a table of the form");
rem_pr(" N P Confidence interval (level=0.95) ");
rem_pr("# of replicates Estimate of P lower limit ");
rem_pr(" s.e. Standard error upper limit ");
rem_pr("");
rem_pr("The confidence level for P is set by CONF=p (0.8<p<1). Default is CONF=0.95");
wait_remarks(1);
rem_pr("The two-way table is also saved as a matrix by using the specification");
rem_pr("MATRIX=<name_of_a_matrix_file> , say, MATRIX=T .");
rem_pr("This matrix can be analyzed further, for example, by the sucro command");
rem_pr("/CHI2 T");
rem_pr("which computes various derived tables as matrices such as the expected");
rem_pr("frequencies and decomposition of the X^2 statistics in cells and ");
rem_pr("margins. ");
wait_remarks(1);
rem_pr("........................................................................");
rem_pr("Example:");
rem_pr("TABLE T / This 2x2 table is tested with default settings.");
rem_pr("7 2");
rem_pr("1 4");
rem_pr("");
rem_pr("TABTEST T,CUR+1");
wait_remarks(2);
s_end(argv[1]);
return;
}
if (g>2)
{
results_line=edline2(word[2],1,1);
if (results_line==0) return;
}
ptext=text;
i=read_ftable(word[1],&f,&dim,&ncvar,nc,varname,cname,type,&ndec);
if (i<0) return;
if (dim!=2)
{
sur_print("\nTABTEST can handle two-way tables only!");
WAIT; return;
}
m=nc[1]; n=nc[0];
i=spfind("FIX");
if (i>=0 && muste_strcmpi(spb[i],"FIT")==0)
{
i=goodness_of_fit_test(f,m,n);
if (i>0) s_end(argv[1]);
return;
}
i=spfind("MATRIX");
if (i>=0)
{
i=table_to_matrix(spb[i],f,m,n,varname,cname);
if (i<0) return;
}
ltotal=0L;
for (i=0; i<m*n; ++i)
{
ltotal+=f[i];
if (f[i]<0L)
{
sur_print("\nNegative \"frequencies\" in the table!!!");
WAIT; return;
}
}
if (ltotal>MAXTOTAL)
{
sprintf(sbuf,"\nTotal frequency %d too great! (max=%d)",
ltotal,MAXTOTAL);
WAIT; return;
}
total=ltotal;
total0=total;
test=X2;
i=spfind("TEST");
if (i>=0)
{
strcpy(s,spb[i]); muste_strupr(s);
if (strncmp(s,"PR",2)==0) test=PROB;
else if (strncmp(s,"X2",2)==0 || strncmp(s,"X^2",3)==0) test=X2;
else if (strncmp(s,"G2",2)==0 || strncmp(s,"G^2",3)==0) test=G2;
else
{
sur_print("\nError in TEST specification!");
sur_print("\nAlternatives TEST=PROB, TEST=X2, TEST=G2");
WAIT; return;
}
}
conf_level=0.95;
i=spfind("CONF");
if (i>=0) conf_level=atof(spb[i]);
if (conf_level<0.8 || conf_level>=1.0)
{
sur_print("\nError in CONF=p! Confidence level p must be 0.8<p<1");
WAIT; return;
}
conf_coeff=muste_inv_std(1.0-(1.0-conf_level)/2);
c_margins();
i=find_fix(); if (i<0) return;
c_logn();
c_chi2(&chi2,f); chi2-=eps;
c_g2(&g2,f); g2-=eps;
if (fix==FISHER) test=PROB;
if (test==PROB)
{
switch (fix)
{
case FIX_RC:
case FISHER: c_prob(&prob,f); break;
case FIX_C: c_cprob(&prob,f); break;
case FIX_R: c_rprob(&prob,f); break;
case FIX_N: c_nprob(&prob,f); break;
case FIX_F: c_fprob(&prob,f); break;
}
prob-=eps;
}
if (fix!=FIX_RC && fix!=FISHER) cumul_freq();
g_print=&sur_print;
maxcount=10000000L;
i=spfind("SIMUMAX");
if (i>=0) maxcount=atol(spb[i]);
disp0();
i=simulation(); if (i<0) return;
g_print=&print_line;
printout();
r=r_original;
s_end(argv);
}
