static int table_to_matrix(char *name,FREQ *f,int m,int n,char **varname,char **cname)
{
int i;
unsigned int k;
/*
Rprintf("\nm=%d n=%d",m,n); getch();
Rprintf("\n"); for (i=0; i<2; ++i) Rprintf("%s ",varname[i]);
Rprintf("\n"); for (i=0; i<m+n; ++i) Rprintf("%s ",cname[i]); getch();
*/
tt=(double *)muste_malloc(m*n*sizeof(double));
if (tt==NULL) { not_enough_memory(); return(-1); }
rlab=muste_malloc(8*m);
if (rlab==NULL) { not_enough_memory(); return(-1); }
clab=muste_malloc(8*n);
if (clab==NULL) { not_enough_memory(); return(-1); }
for (k=0; k<m*n; ++k)
{
tt[k]=f[k];
}
lab_copy(m,cname+n,rlab);
lab_copy(n,cname,clab);
sprintf(expr,"Table_%s/%s",varname[1],varname[0]);
i=matrix_save(name,tt,m,n,rlab,clab,8,8,-1,expr,0,0);
muste_free(tt); muste_free(rlab); muste_free(clab);
return(i);
}
static int m_space_allocation()
{
sum=(double *)muste_malloc(m*sizeof(double));
if (sum==NULL) { not_enough_memory(); return(-1); }
sum2=(double *)muste_malloc(m*sizeof(double));
if (sum2==NULL) { not_enough_memory(); return(-1); }
f=(long *)muste_malloc(m*sizeof(long));
if (f==NULL) { not_enough_memory(); return(-1); }
w=(double *)muste_malloc(m*sizeof(double));
if (w==NULL) { not_enough_memory(); return(-1); }
f2=(long *)muste_malloc(m*n_class*sizeof(long));
if (w==NULL) { not_enough_memory(); return(-1); }
return(1);
}
static int build_stats(t_item *link, t_args *args)
{
int ret;
ret = 2;
link->stats = NULL;
if ((link->stats = (struct stat *)malloc(sizeof(struct stat))))
{
if (args->options->l == 1 || args->options->t == 1 ||
args->options->re == 1)
{
if ((ret = lstat(link->path, link->stats)) != 0)
cannot_access(link, args);
}
else
{
if ((ret = stat(link->path, link->stats)) != 0)
{
if ((ret = lstat(link->path, link->stats)) != 0)
cannot_access(link, args);
}
}
}
else
not_enough_memory(args);
return (ret);
}
t_item *new_link(char const *name, t_item *parent, t_args *args)
{
t_item *link;
link = NULL;
if ((link = (t_item *)malloc(sizeof(t_item))))
{
set_new_link(link);
link->name = ft_strdup(name);
link->parent = (t_item *)parent;
if (link->parent)
link->path = get_path(link);
else
link->path = link->name;
if (build_stats(link, args) != 0)
return (NULL);
if (parent == NULL && ((args->options->l == 1 &&
is_symbolic_link(link) == 0) || (args->options->l == 0)))
create_children(link, args);
}
else
not_enough_memory(args);
return (link);
}
void muste_cluster(char *argv)
{
int i,k;
double a;
char ch;
// if (argc==1) return;
s_init(argv);
if (g<2)
{
sur_print("\nUsage: CLUSTER <SURVO_data>,<output_line>");
WAIT; return;
}
tulosrivi=0;
if (g>2)
{
tulosrivi=edline2(word[2],1,1);
if (tulosrivi==0) return;
}
strcpy(aineisto,word[1]);
i=data_open(aineisto,&d); if (i<0) return;
i=sp_init(r1+r-1); if (i<0) return;
i=mask(&d); if (i<0) return;
scales(&d);
i=conditions(&d); if (i<0) return;
gvar=activated(&d,'G');
if (gvar<0)
{
sur_print("\nNo grouping variable (activated by 'G') given!");
WAIT; return;
}
ivar=-1; ivar=activated(&d,'I');
i=spfind("TRIALS");
if (i>=0) maxiter=atoi(spb[i]);
i=rand_init(); if (i<0) return; /* 30.4.1994 */
i=spfind("TEMPFILE");
if (i>=0) strcpy(tempfile,spb[i]);
else { strcpy(tempfile,etmpd); strcat(tempfile,"SURVO.CLU"); }
i=spfind("PRIND");
if (i>=0 && atoi(spb[i])>0) prind=1;
data_load(&d,1L,gvar,&a);
i=data_save(&d,1L,gvar,a);
if (i<0) return;
gvar2=(int *)muste_malloc(d.m_act*sizeof(int));
if (gvar2==NULL) { not_enough_memory(); return; }
k=0; n_saved=0; m=0;
for (i=0; i<d.m_act; ++i)
{
ch=d.vartype[d.v[i]][1];
if (ch=='G')
{
++k;
gvar2[n_saved]=d.v[i]; /* gvar=gvar2[0] */
++n_saved; continue;
}
if (ch=='I') { ++k; continue; }
d.v[m++]=d.v[i];
}
/*
printf("\nivar=%d gvar=%d m=%d\n",ivar,gvar,m); getch();
for (i=0; i<m; ++i) Rprintf(" %d",d.v[i]); getch();
printf("\n"); for (i=0; i<n_saved; ++i) Rprintf(" %d",gvar2[i]); getch();
*/
i=spfind("GROUPS");
if (i<0) ng=2; else ng=atoi(spb[i]);
if (ng<2) ng=2;
ng2=ng+2;
mn=m; if (mn<ng) mn=ng;
first_line=r+1; if (r+n_saved>r3) first_line=1;
n_show=n_saved; if (n_show>r3) n_show=r3;
i=varaa_tilat(); if (i<0) return;
i=lue_havainnot(); if (i<0) return;
hav_muistissa=havainnot_muistiin();
ortogonalisoi();
if (ivar_init) alustava_luokittelu();
LOCATE(first_line,1);
SCROLL_UP(first_line,r3+1,r3);
sur_print("\nCluster analysis: Iteration 1:");
while (sur_kbhit()) sur_getch();
it=0;
while (1)
{
while (1)
{
if (it) init_gr();
i=init_tilat();
if (i>=0) break;
if (maxiter==1) return;
}
iteroi();
++it;
if (maxiter>1) vertaa_muihin();
if (it==maxiter) break;
LOCATE(first_line,1);
sprintf(sbuf,"\nIteration %d (Cluster analysis)",it);
sur_print(sbuf);
for (i=0; i<n_show; ++i)
{
if (freq[i]==0) break;
sprintf(sbuf,"\n%d %g %d ",i+1,lambda2[i],freq[i]); sur_print(sbuf);
}
if (sur_kbhit())
{
i=sur_getch(); if (i=='.') break;
}
}
tulosta();
data_close(&d);
sur_delete(tempfile);
s_end(argv);
}
static int varaa_tilat()
{
T=(double *)muste_malloc(m*m*sizeof(double));
if (T==NULL) { not_enough_memory(); return(-1); }
xx=(double *)muste_malloc(m*sizeof(double));
if (xx==NULL) { not_enough_memory(); return(-1); }
v1=(double *)muste_malloc(mn*sizeof(double));
if (v1==NULL) { not_enough_memory(); return(-1); }
v2=(double *)muste_malloc(mn*sizeof(double));
if (v2==NULL) { not_enough_memory(); return(-1); }
S=(double *)muste_malloc(ng*m*sizeof(double));
if (S==NULL) { not_enough_memory(); return(-1); }
N1=(double *)muste_malloc(ng*sizeof(double));
if (N1==NULL) { not_enough_memory(); return(-1); }
H1=(double *)muste_malloc(ng*ng*sizeof(double));
if (H1==NULL) { not_enough_memory(); return(-1); }
H2=(double *)muste_malloc(ng*ng*sizeof(double));
if (H2==NULL) { not_enough_memory(); return(-1); }
Q=(double *)muste_malloc(ng2*ng2*sizeof(double));
if (Q==NULL) { not_enough_memory(); return(-1); }
lambda2=(double *)muste_malloc(n_saved*sizeof(double));
if (lambda2==NULL) { not_enough_memory(); return(-1); }
freq=(int *)muste_malloc(n_saved*sizeof(int));
if (freq==NULL) { not_enough_memory(); return(-1); }
ii=(int *)muste_malloc(n_saved*sizeof(int));
if (ii==NULL) { not_enough_memory(); return(-1); }
return(1);
}
void muste_t2test(char *argv)
{
int i,k;
int l,l2;
// if (argc==1) return(1);
s_init(argv);
if (g<3)
{
sur_print("\nUsage: T2TEST <data1>,<data2>,<output_line>");
WAIT; return;
}
tulosrivi=0;
if (g>3)
{
tulosrivi=edline2(word[3],1,1);
if (tulosrivi==0) return;
}
simumax=10000;
i=spec_init(r1+r-1); if (i<0) return;
if ((i=spfind("RESULTS"))>=0) results=atoi(spb[i]);
x=NULL;
v=NULL;
xx=NULL;
ind=NULL;
s=NULL;
s2=NULL;
ss[0]=NULL;
ss2[0]=NULL;
ss[1]=NULL;
ss2[1]=NULL;
ss_inv=NULL;
ss_apu=NULL;
ss_apu2=NULL;
ero=NULL;
i=hae_apu("prind",sbuf); if (i) prind=atoi(sbuf);
if ((i=spfind("PRIND"))>=0) prind=atoi(spb[i]);
if ((i=spfind("SIMUMAX"))>=0) simumax=atol(spb[i]);
method=1;
if ((i=spfind("METHOD"))>=0) method=atoi(spb[i]);
fixed=0;
if ((i=spfind("FIXED"))>=0) fixed=atoi(spb[i]);
orig_samples=1;
spec_rnd();
strcpy(tempname,etmpd); strcat(tempname,"SURVOHOT.TMP");
tempfile=muste_fopen(tempname,"wb");
if (tempfile==NULL)
{
sprintf(sbuf,"\nCannot open temporary file %s!",tempname);
sur_print(sbuf); WAIT; return;
}
strcpy(aineisto[0],word[1]);
i=data_read_open(aineisto[0],&d); if (i<0) return;
i=mask(&d); if (i<0) return;
m=d.m_act;
if (m==0)
{
sur_print("\nNo active variables!");
WAIT; return;
}
x=(double *)muste_malloc(m*sizeof(double));
if (x==NULL) { not_enough_memory(); return; }
v=(int *)muste_malloc(m*sizeof(int));
if (v==NULL) { not_enough_memory(); return; }
for (i=0; i<m; ++i) v[i]=d.v[i];
sur_print("\n");
talleta(1); /* data 1 */
data_close(&d);
strcpy(aineisto[1],word[2]);
i=data_read_open(aineisto[1],&d); if (i<0) return;
i=mask(&d); if (i<0) return;
if (d.m_act!=m) { data_error(); return; }
for (i=0; i<m; ++i)
{
if (v[i]!=d.v[i]) {data_error(); return; }
}
talleta(2); /* data 2 */
data_close(&d);
muste_fclose(tempfile);
n[0]=n[1]+n[2];
tempfile=muste_fopen(tempname,"rb");
xx=(double *)muste_malloc(n[0]*m*sizeof(double));
if (xx==NULL) { not_enough_memory(); return; }
fread(xx,sizeof(double),n[0]*(int)m,tempfile);
muste_fclose(tempfile);
ind=muste_malloc(n[0]);
if (ind==NULL) { not_enough_memory(); return; }
s=muste_malloc(m*sizeof(double));
if (s==NULL) { not_enough_memory(); return; }
s2=muste_malloc(m*m*sizeof(double));
if (s2==NULL) { not_enough_memory(); return; }
for (l=0; l<n[0]; ++l) ind[l]='1';
laske_summat(s,s2);
// Rprintf("s: %g %g\n",s[0],s[1]); getch();
ss[0]=muste_malloc(m*sizeof(double));
if (ss[0]==NULL) { not_enough_memory(); return; }
ss2[0]=muste_malloc(m*m*sizeof(double));
if (ss2[0]==NULL) { not_enough_memory(); return; }
ss[1]=muste_malloc(m*sizeof(double));
if (ss[1]==NULL) { not_enough_memory(); return; }
ss2[1]=muste_malloc(m*m*sizeof(double));
if (ss2[1]==NULL) { not_enough_memory(); return; }
ss_inv=muste_malloc(m*m*sizeof(double));
if (ss_inv==NULL) { not_enough_memory(); return; }
ss_apu=muste_malloc(m*m*sizeof(double));
if (ss_apu==NULL) { not_enough_memory(); return; }
ss_apu2=muste_malloc(m*m*sizeof(double));
if (ss_apu2==NULL) { not_enough_memory(); return; }
ero=muste_malloc(m*sizeof(double));
if (ero==NULL) { not_enough_memory(); return; }
// Todelliset otokset
for (l=0; l<n[0]; ++l) ind[l]='0';
for (l=0; l<n[1]; ++l) ind[l]='1';
t2_0=T2();
p_hot=1.0-muste_cdf_f((double)(n[0]-m-1)/(n[0]-2)/(double)m*t2_0,
(double)m,(double)(n[1]+n[2]-m-1),1e-15);
if (method==2)
{
t2_BF0=T2_BF();
yao_test();
print_t2_yao();
}
// Rprintf("\nt2: %g %g",t2_0,t2_BF0); getch();
else
print_t2_hot();
if (fixed) orig_samples=0;
++scroll_line;
nn1=0L; k=0;
if (simumax) sur_print("\nInterrupt by '.'");
for (nn=1; nn<=simumax; ++nn)
{
// Rprintf("\nnn=%d",nn);
for (l=0; l<n[0]; ++l) ind[l]='0';
for (l=0; l<n[1]; ++l)
{
while (1)
{
l2=n[0]*uniform_dev();
if (ind[l2]=='1') continue;
ind[l2]='1'; break;
}
}
if (method==1)
{
t2_1=T2();
// Rprintf("t2: %g %g\n",t2_1,t2_0); getch();
if (t2_1>t2_0) ++nn1;
}
else
{
t2_1=T2_BF();
// Rprintf("t2: %g %g\n",t2_1,t2_BF0); getch();
if (t2_1>t2_BF0) ++nn1;
}
++k;
// Rprintf("t2=%g\n",t2_1); i=getch(); if (i=='.') break;
/**********************************
if (sur_kbhit())
{
i=sur_getch(); if (i=='.') break;
prind=1-prind;
}
***********************************/
if (k>=1000 && prind)
{
sprintf(sbuf,"\n%d %g ",nn,(double)nn1/(double)nn);
sur_print(sbuf);
k=0;
}
}
// Rprintf("4"); sur_getch();
output_open(eout);
--nn;
if (method==1)
{
eoutput("Hotelling's two-sample test for equality of mean vectors:");
sprintf(sbuf,"T2=%g p=%d n1=%d n2=%d P1=%g",
t2_0,m,n[1],n[2],p_hot);
}
else
{
eoutput("Yao's two-sample test for equality of mean vectors:");
sprintf(sbuf,"T2=%g P1=%g (assuming nonequal cov.matrices)",
t2_BF0,p_yao);
}
eoutput(sbuf);
if (simumax>0L)
{
eoutput("Randomization test:");
p_sim=(double)nn1/(double)nn;
sprintf(sbuf,"N=%d P=%g (s.e. %g) %s",
nn,p_sim,sqrt(p_sim*(1-p_sim)/nn),method_text[method-1]);
eoutput(sbuf);
}
output_close(eout);
s_end(argv);
return;
}
void muste_covtest(char *argv)
{
int i,k,h,kk;
int l,l2,li;
// if (argc==1) return(1);
s_init(argv[1]);
if (g<2)
{
sur_print("\nUsage: COVTEST <output_line>");
sur_print("\n SAMPLES=<data(1),...,<data(m)>");
WAIT; return;
}
tulosrivi=0;
if (g>1)
{
tulosrivi=edline2(word[1],1,1);
if (tulosrivi==0) return;
}
i=spec_init(r1+r-1); if (i<0) return;
if ((i=spfind("RESULTS"))>=0) results=atoi(spb[i]);
i=hae_apu("prind",sbuf); if (i) prind=atoi(sbuf);
if ((i=spfind("PRIND"))>=0) prind=atoi(spb[i]);
simumax=10000;
if ((i=spfind("SIMUMAX"))>=0) simumax=atol(spb[i]);
spec_rnd();
strcpy(tempname,etmpd); strcat(tempname,"SURVOCOV.TMP");
tempfile=fopen(tempname,"wb");
if (tempfile==NULL)
{
sprintf(sbuf,"\nCannot open temporary file %s!",tempname);
sur_print(sbuf); WAIT; return;
}
i=spfind("SAMPLES");
if (i<0)
{
sur_print("SAMPLES=<data(1),...,<data(m)> missing!");
WAIT; return;
}
strcpy(y,spb[i]);
ns=split(y,otos,S_MAX);
if (ns<2)
{
sur_print("At least 2 samples must be given by SAMPLES!");
WAIT; return;
}
x=NULL;
v=NULL;
xx=NULL;
ind=NULL;
nt=0L;
for (k=0; k<ns; ++k)
{
strcpy(aineisto,otos[k]);
i=data_read_open(aineisto,&d); if (i<0) return;
i=mask(&d); if (i<0) return;
if (d.m_act==0)
{
sur_print("\nNo active variables!");
WAIT; return;
}
if (k==0)
{
m=d.m_act;
x=(double *)muste_malloc(m*sizeof(double));
if (x==NULL) { not_enough_memory(); return; }
v=(int *)muste_malloc(m*sizeof(int));
if (v==NULL) { not_enough_memory(); return; }
for (i=0; i<m; ++i) v[i]=d.v[i];
}
if (k!=0)
{
if (d.m_act!=m) { data_error(k); return; }
for (i=0; i<m; ++i)
{
if (v[i]!=d.v[i]) { data_error(k); return; }
}
}
sur_print("\n");
talleta(k); /* data k */
data_close(&d);
}
muste_fclose(tempfile);
tempfile=fopen(tempname,"rb");
xx=(double *)muste_malloc(nt*m*sizeof(double));
if (xx==NULL) { not_enough_memory(); return; }
fread(xx,sizeof(double),nt*(int)m,tempfile);
muste_fclose(tempfile);
ind=muste_malloc(sizeof(short)*nt);
if (ind==NULL) { not_enough_memory(); return; }
for (k=0; k<ns+1; ++k)
{
s[k]=NULL;
s[k]=muste_malloc(m*sizeof(double));
if (s[k]==NULL) { not_enough_memory(); return; }
s2[k]=NULL;
s2[k]=muste_malloc(m*m*sizeof(double));
if (s2[k]==NULL) { not_enough_memory(); return; }
}
l=0;
for (k=0; k<ns; ++k)
for (li=0L; li<n[k]; ++li) ind[l++]=k;
laske_summat();
l=0;
for (k=0; k<ns; ++k)
for (li=0; li<n[k]; ++li)
{
for (h=0; h<m; ++h)
xx[l+h]-=s[k][h]/n[k];
l+=m;
}
t0=testi();
os1=(double)(nt-ns)*m/2*log((double)(nt-ns));
nim2=0.0; a=0.0;
for (k=0; k<ns; ++k)
{
nim2+=(n[k]-1)*muste_log((double)(n[k]-1));
a+=1.0/(n[k]-1);
}
x2=t0/2+os1-(double)m/2*nim2;
a=1-(a-1.0/(nt-ns))*(2*m*m+3*m-1)/6.0/(m+1)/(k-1);
x2*=-2*a;
// Rprintf("x2=%g\n",x2); getch();
df=(double)m/2*(m+1)*(ns-1);
pr_x2=1.0-muste_cdf_chi2(x2,df,1e-7);
/*****************************************************
os1=n*p/2*log(n)
os1=10326.054776478
os2=0.5*(n1*log(det1)+n2*log(det2)+n3*log(det3))
os2=8299.3933358899
nim1=n/2*log(det)
nim1=9932.2525957076
nim2=p/2*(n1*log(n1)+n2*log(n2)+n3*log(n3))
nim2=8697.69129334
logL=os1+os2-nim1-nim2
logL=-4.4957766798343
a=1-(1/n1+1/n2+1/n3-1/n)*(2*p*p+3*p-1)/6/(p+1)/(k-1)
X2=-2*a*logL
X2=8.9516537694752
df=p/2*(p+1)*(k-1)
********************************************************/
print_t0(x2,df,pr_x2);
++scroll_line;
nn1=0L; kk=0;
for (nn=1; nn<=simumax; ++nn)
{
for (l=0; l<nt; ++l) ind[l]=0;
for (k=1; k<ns; ++k)
{
for (l=0L; l<n[k]; ++l)
{
while (1)
{
l2=nt*uniform_dev();
if (ind[l2]!=(short)0) continue;
ind[l2]=k; break;
}
}
}
t1=testi();
if (t1<t0) ++nn1;
++kk;
/*************************
if (kbhit())
{
i=getch(); if (i=='.') break;
prind=1-prind;
}
******************************/
if (kk==1000)
{
if (prind)
{
sprintf(sbuf,"\n%d %g ",nn,(double)nn1/(double)nn);
sur_print(sbuf);
}
kk=0;
}
}
output_open(eout);
--nn;
eoutput("Comparing covariance matrices:");
sprintf(sbuf,"Asymptotic X^2 test: X2=%g df=%g P=%g",x2,df,pr_x2);
eoutput(sbuf);
p_sim=(double)nn1/(double)nn;
sprintf(sbuf,"Randomization test: N=%d P=%g (s.e. %g)",
nn,p_sim,sqrt(p_sim*(1-p_sim)/nn));
eoutput(sbuf);
output_close(eout);
s_end(argv);
return;
}
static int read_ftable(char *name,FREQ **f,int *pdim,int *pncvar,int *nc,
char **varname,char **cname,char *type,int *pndec)
{
int i,j,k,j1,j2,apos,j0,ivar,rep,h,h2,n=0,len;
unsigned int ncell,cell,ncell2,step;
char x[LLENGTH], *px[EP4];
char *p;
int ncol,nrow;
int nlabel,nlab;
int posr[MAXDIM];
FREQ cvalue;
j=wfind("TABLE",name,1);
if (j<0)
{
sprintf(sbuf,"\nTABLE %s not found in the edit field!",name);
sur_print(sbuf); WAIT; return(-1);
}
edread(x,j);
i=split(x+1,px,5);
if (i>2 && strcmp(px[2],"/")==0) i=2;
if (i==2)
{
*pdim=2;
i=j; k=0;
while (1)
{
++i;
edread(x,i);
if (i==j+1) n=split(x+1,px,EP4);
if (strncmp(x+1,space,c2)==0) break;
++k;
}
ncell=k*n;
if (*f==NULL)
*f=(FREQ *)muste_malloc(ncell*sizeof(FREQ));
else
*f=(FREQ *)muste_realloc(*f,ncell*sizeof(FREQ));
if (*f==NULL)
{ not_enough_memory(); return(-1); }
for (i=0; i<k; ++i)
{
edread(x,j+1+i);
h=split(x+1,px,EP4);
if (i==0) n=h;
else
{
if (h!=n)
{
sprintf(sbuf,"\nError in table on edit line %d !",i);
sur_print(sbuf); WAIT; return(-1);
}
}
for (h=0; h<n; ++h) (*f)[i+k*h]=atoi(px[h]);
}
nc[1]=k; nc[0]=n;
varname[0]="C"; varname[1]="R";
p=text;
for (i=0; i<n; ++i)
{
cname[i]=p;
sprintf(sbuf,"C%d",i+1);
strcpy(p,sbuf); p+=strlen(sbuf); *p=EOS; ++p;
}
for (i=0; i<k; ++i)
{
cname[i+n]=p;
sprintf(sbuf,"R%d",i+1);
strcpy(p,sbuf); p+=strlen(sbuf); *p=EOS; ++p;
}
return(1);
}
if (i<5)
{
edread(x,j); i=strlen(x); while (x[i-1]==' ') x[--i]=EOS;
sprintf(sbuf,"\nInvalid definition: %s",x+1); sur_print(sbuf);
sprintf(sbuf,"\non line %d",j); sur_print(sbuf);
sur_print("\nCorrect form: TABLE <name>,L1,L2,<type_of_table>");
WAIT; return(-1);
}
j1=edline2(px[2],1,1); if (j1==0) return(-1);
j2=edline2(px[3],j1,1); if (j2==0) return(-1);
strncpy(type,px[4],15); type[15]=EOS;
ncell=0;
for (j=j1; j<=j2; ++j)
{
edread(x,j);
p=strchr(x+1,'*'); if (p!=NULL) break;
}
if (j>j2)
{
sprintf(sbuf,"\nLine of row classifiers ending with *'s missing in table %s!",
name); sur_print(sbuf); WAIT; return(-1);
}
apos=p-x;
j0=j; ncol=j0-j1; k=0;
for (j=j0+1; j<=j2; ++j)
{
edread(x,j);
i=split(x+apos,px,EP4);
if (i==0) continue;
if (k==0) k=i;
if (i!=k)
{
sprintf(sbuf,"\nNumber of elements on line %d conflicts previous lines!",
j); sur_print(sbuf);
WAIT; return(-1);
}
ncell+=k;
}
if (*f==NULL)
*f=(FREQ *)muste_malloc(ncell*sizeof(FREQ));
else
*f=(FREQ *)muste_realloc(*f,ncell*sizeof(FREQ));
if (*f==NULL)
{ not_enough_memory(); return(-1); }
nlabel=0;
ivar=0; rep=1;
for (j=j1; j<j0; ++j)
{
edread(x,j);
n=split(x+1,px,EP4);
if (n<3)
{
sprintf(sbuf,"\nError in column classifier on line %d",j);
sur_print(sbuf); WAIT; return(-1);
}
h=(n-1)/rep;
if (h*rep!=n-1)
{
sprintf(sbuf,"\nError in labels on line %d",j); sur_print(sbuf); WAIT; return(-1);
}
nc[ivar]=h;
varname[ivar]=ptext;
i=store_label(px[0]); if (i<0) return(-1);
for (h=0; h<nc[ivar]; ++h)
{
if (nlabel>=MAXT)
{
sur_print("\nToo many labels!"); WAIT; return(-1);
}
cname[nlabel++]=ptext;
i=store_label(px[h+1]);
}
rep*=nc[ivar]; ++ivar;
}
edread(x,j0);
i=split(x+1,px,EP4);
nrow=i-1; ivar=ncol;
for (i=0; i<nrow; ++i)
{
posr[i]=px[i]-x;
varname[ivar++]=ptext;
h=store_label(px[i]);
}
posr[nrow]=apos;
ivar=ncol;
ncell2=k;
for (i=0; i<nrow; ++i)
{
nc[ivar]=0; nlab=nlabel;
for (j=j0+1; j<=j2; ++j)
{
edread(x,j);
h=posr[i];
while (x[h]==' ' && h<posr[i+1]) ++h;
if (h==posr[i+1]) continue;
h2=h; while (x[h2]!=' ' && h2<posr[i+1]) ++h2;
x[h2]=EOS;
for (h2=0; h2<nc[ivar]; ++h2)
{
if (strcmp(x+h,cname[nlab+h2])==0) break;
}
if (h2<nc[ivar]) continue;
++nc[ivar];
if (nlabel>=MAXT)
{
sur_print("\nToo many labels!"); WAIT; return(-1);
}
cname[nlabel++]=ptext;
h2=store_label(x+h); if (h2<0) return(-1);
}
ncell2*=nc[ivar];
++ivar;
}
if (ncell2!=ncell)
{
sur_print("\nError in (row) labels!");
i=0;
for (ivar=0; ivar<ncol+nrow; ++ivar)
{
sprintf(sbuf,"\n%s:",varname[ivar]); sur_print(sbuf);
for (h=0; h<nc[ivar]; ++h) { sprintf(sbuf," %s",cname[i+h]); sur_print(sbuf); }
i+=nc[ivar];
}
WAIT; return(-1);
}
*pdim=ncol+nrow;
h=0;
step=ncell/k;
*pndec=0;
for (j=j0+1; j<=j2; ++j)
{
edread(x,j);
i=split(x+apos,px,k);
if (i==0) continue;
cell=h;
for (i=0; i<k; ++i)
{
len=strlen(px[i])-1;
if (px[i][len]=='-') { cvalue=MISSING_VALUE; ++missing_values; }
else if (strcmp(px[i],"*0")==0) cvalue=STRUCTURAL_ZERO;
else cvalue=atof(px[i]); /* depends on FREQ */
(*f)[cell]=cvalue;
cell+=step;
p=strchr(px[i],'.');
if (p!=NULL)
{
h2=len-(p-px[i]);
if (h2>*pndec) *pndec=h2;
}
}
++h;
}
*pncvar=ncol;
return(1);
}
