apr_status_t h2_stream_set_response(h2_stream *stream, h2_response *response,
apr_bucket_brigade *bb)
{
apr_status_t status = APR_SUCCESS;
if (!output_open(stream)) {
ap_log_cerror(APLOG_MARK, APLOG_DEBUG, 0, stream->session->c,
"h2_stream(%ld-%d): output closed",
stream->session->id, stream->id);
return APR_ECONNRESET;
}
stream->response = response;
if (bb && !APR_BRIGADE_EMPTY(bb)) {
int move_all = INT_MAX;
/* we can move file handles from h2_mplx into this h2_stream as many
* as we want, since the lifetimes are the same and we are not freeing
* the ones in h2_mplx->io before this stream is done. */
H2_STREAM_OUT(APLOG_TRACE2, stream, "h2_stream set_response_pre");
status = h2_util_move(stream->bbout, bb, 16 * 1024, &move_all,
"h2_stream_set_response");
H2_STREAM_OUT(APLOG_TRACE2, stream, "h2_stream set_response_post");
}
ap_log_cerror(APLOG_MARK, APLOG_DEBUG, status, stream->session->c,
"h2_stream(%ld-%d): set_response(%d)",
stream->session->id, stream->id, response->http_status);
return status;
}
static
void
dowrite(const char *buf, size_t len)
{
size_t done;
ssize_t result;
static unsigned write_errors = 0;
if (!mode.do_output) {
return;
}
if (outputfd < 0) {
output_open();
}
done = 0;
while (done < len) {
result = write(outputfd, buf+done, len-done);
if (result == -1) {
complain(NULL, "%s: write: %s",
mode.output_file, strerror(errno));
complain_failed();
write_errors++;
if (write_errors > 5) {
complain(NULL, "%s: giving up",
mode.output_file);
die();
}
/* XXX is this really a good idea? */
sleep(1);
}
done += (size_t)result;
}
}
static int tulostus()
{
int i,t;
char x[LLENGTH];
i=output_open(eout);
if (i<0) return(1);
if (autocorr) sprintf(x,"Autocorrelations of %s in data %s:",word[2],word[1]);
else sprintf(x,"Auto- and crosscorrelations of %s and %s in data %s:",word[2],word[3],word[1]);
print_line(x);
if (autocorr) sprintf(x," Lag %.8s",word[2]);
else sprintf(x," Lag %8.8s %8.8s Cross+ Cross-",word[2],word[3]);
print_line(x);
t=accuracy-3;
if (autocorr)
sprintf(x,"%3d %10.*f",0,t,1.0);
else
sprintf(x,"%3d %10.*f %10.*f %10.*f %10.*f",0,t,1.0,t,1.0,t,corr,t,corr);
print_line(x);
for (i=0; i<maxlag; ++i)
{
if (autocorr)
sprintf(x,"%3d %10.*f",i+1,t,xx[i]);
else
sprintf(x,"%3d %10.*f %10.*f %10.*f %10.*f",i+1,t,xx[i],t,yy[i],t,xy1[i],t,xy2[i]);
print_line(x);
}
output_close(eout);
return(1);
}
static int printout()
{
output_open(eout);
disp0();
tab_disp();
output_close(eout);
return(1);
}
static int max_var() /* Stepwise_computation_of_Mvar() in pseudocode */
{
int i,j,k;
char text[LLENGTH];
// double a;
int ii;
/* m is p in pseudocode */
/* ii is i in pseudocode */
/* indexing from 1 to p instead of from 0 to m-1 in pseudocode */
tr_max=-1.0; /* Mvar in pseudocode */
for (ii=0; ii<m; ++ii)
{
if (ii==0) for (i=0; i<m; ++i) p[i]=i; /* p is q in pseudocode */
else
{
k=0; p[0]=ii; j=0;
for (i=1; i<m; ++i)
{
p[i]=j+k;
if (i==ii) k=1;
++j;
}
}
k=sum2_Cholesky(rr,m); /* rr is S in pseudocode */
if (k<0)
{
sprintf(sbuf,"\n %d gives the same value as %d",ii+1,-k);
sur_print(sbuf);
}
else
{
sprintf(sbuf,"\n %d %g %g",ii+1,tr,tr_max); sur_print(sbuf);
if (tr>tr_max)
{
tr_max=tr;
for (i=0; i<m; ++i) p_max[i]=p[i];
}
}
if (sur_kbhit()) { i=sur_getch(); if (i=='.') break; }
}
for (i=0; i<m; ++i) p[i]=p_max[i];
for (i=0; i<m; ++i) for (j=0; j<m; ++j)
rr11[i+m*j]=rr[p[i]+m*p[j]];
save_var(rr11,m,text);
output_open(eout);
fnconv(tr_max,accuracy+2,text);
sprintf(sbuf,"Mvar[%s]=%s (Total variability in a %d*%d matrix)",
word[1],sppois(text),m,m);
print_line(sbuf);
print_line("MAT LOAD COVVAR.M,END+2 / Optimally permuted covariance matrix");
return(1);
}
apr_status_t h2_stream_schedule(h2_stream *stream, int eos,
h2_stream_pri_cmp *cmp, void *ctx)
{
apr_status_t status;
AP_DEBUG_ASSERT(stream);
AP_DEBUG_ASSERT(stream->session);
AP_DEBUG_ASSERT(stream->session->mplx);
if (!output_open(stream)) {
return APR_ECONNRESET;
}
if (stream->scheduled) {
return APR_EINVAL;
}
if (eos) {
close_input(stream);
}
/* Seeing the end-of-headers, we have everything we need to
* start processing it.
*/
status = h2_request_end_headers(stream->request, stream->pool, eos);
if (status == APR_SUCCESS) {
if (!eos) {
stream->bbin = apr_brigade_create(stream->pool,
stream->session->c->bucket_alloc);
}
stream->input_remaining = stream->request->content_length;
status = h2_mplx_process(stream->session->mplx, stream->id,
stream->request, eos, cmp, ctx);
stream->scheduled = 1;
ap_log_cerror(APLOG_MARK, APLOG_DEBUG, 0, stream->session->c,
"h2_stream(%ld-%d): scheduled %s %s://%s%s",
stream->session->id, stream->id,
stream->request->method, stream->request->scheme,
stream->request->authority, stream->request->path);
}
else {
h2_stream_rst(stream, H2_ERR_INTERNAL_ERROR);
ap_log_cerror(APLOG_MARK, APLOG_DEBUG, 0, stream->session->c,
"h2_stream(%ld-%d): RST=2 (internal err) %s %s://%s%s",
stream->session->id, stream->id,
stream->request->method, stream->request->scheme,
stream->request->authority, stream->request->path);
}
return status;
}
static int max_varp(double *rr,int m)
{
int i,j;
char text[LLENGTH];
char text2[LLENGTH];
// double a;
for (i=0; i<m; ++i) perm1[i]=i;
l=0L;
tr_max=-1.0; tr_min=1e10;
while (1)
{
++l;
comp_varp(rr,m);
sprintf(sbuf,"\n %d %g %g",l,tr,tr_max); sur_print(sbuf);
fprintf(f,"%g\n",tr);
if (tr>tr_max)
{
tr_max=tr;
for (i=0; i<m; ++i) perm_max[i]=perm1[i];
}
if (tr>=0.0 && tr<tr_min)
{
tr_min=tr;
}
if (sur_kbhit()) { i=sur_getch(); if (i=='.') break; }
i=next_perm(m,perm1,perm2);
if (i<0) break;
}
for (i=0; i<m; ++i) perm1[i]=perm_max[i];
comp_varp(rr,m);
for (i=0; i<m; ++i) for (j=0; j<m; ++j)
rr11[i+m*j]=rr[perm1[i]+m*perm1[j]];
save_varp(rr11,m,text);
output_open(eout);
fnconv(tr,accuracy+2,text);
fnconv(tr_min,accuracy+2,text2);
sprintf(sbuf,"Mvar[%s]=%s minM[%s]=%s dim=%d",
word[1],sppois(text),word[1],sppois(text2),m);
print_line(sbuf);
print_line("MAT LOAD COVVAR.M,END+2 / Optimally permuted covariance matrix");
return(1);
}
static int m_printout()
{
int i,k,h;
char line[LLENGTH];
char mean[32];
char stddev[32];
output_open(eout);
print_line(" Means, std.devs and frequency distributions of variables");
sprintf(line," in %s N=%d",
word[1],n);
if (weight_variable>=0)
{
strcat(line," Weight="); strncat(line,d.varname[weight_variable],8);
}
print_line(line);
strcpy(line," Frequencies");
print_line(line);
h=sprintf(line," Variable Mean Std.dev. N(missing)");
for (k=0; k<n_class; ++k) h+=sprintf(line+h,"%4d ",k+1);
print_line(line);
for (i=0; i<d.m_act; ++i)
{
if (d.v[i]==weight_variable) continue;
if (w[i]==0.0)
sprintf(line," %-8.8s - - %6d",d.varname[d.v[i]],
(int)(n-f[i]));
else
{
fnconv(sum[i]/w[i],accuracy+2,mean);
if (w[i]>1.0)
fnconv(sqrt((sum2[i]-sum[i]*sum[i]/w[i])/(w[i]-1)),accuracy+2,stddev);
else
{ strncpy(stddev,space,accuracy+2); stddev[accuracy+2]=EOS;
stddev[accuracy+1]='-';
}
h=sprintf(line," %-8.8s %s %s %6d ",d.varname[d.v[i]],
mean,stddev,(int)(n-f[i]));
for (k=0; k<n_class; ++k)
h+=sprintf(line+h,"%4ld ",f2[k+i*n_class]);
}
print_line(line);
}
output_close(eout);
return(1);
}
/**
* Init the Sally tool
* @param argc number of arguments
* @param argv arguments
*/
static void sally_init()
{
int ehash;
const char *cfg_str;
if (verbose > 1)
config_print(&cfg);
/* Set delimiters */
config_lookup_string(&cfg, "features.ngram_delim", &cfg_str);
if (strlen(cfg_str) > 0)
fvec_delim_set(cfg_str);
/* Check for TFIDF weighting */
config_lookup_string(&cfg, "features.vect_embed", &cfg_str);
if (!strcasecmp(cfg_str, "tfidf"))
idf_create(input);
/* Load stop words */
config_lookup_string(&cfg, "input.stopword_file", &cfg_str);
if (strlen(cfg_str) > 0)
stopwords_load(cfg_str);
/* Check for feature hash table */
config_lookup_int(&cfg, "features.explicit_hash", &ehash);
config_lookup_string(&cfg, "features.hash_file", &cfg_str);
if (ehash || strlen(cfg_str) > 0) {
info_msg(1, "Enabling feature hash table.");
fhash_init();
}
/* Open input */
config_lookup_string(&cfg, "input.input_format", &cfg_str);
input_config(cfg_str);
info_msg(1, "Opening '%0.40s' with input module '%s'.", input, cfg_str);
entries = input_open(input);
if (entries < 0)
fatal("Could not open input source");
/* Open output */
config_lookup_string(&cfg, "output.output_format", &cfg_str);
output_config(cfg_str);
info_msg(1, "Opening '%0.40s' with output module '%s'.", output, cfg_str);
if (!output_open(output))
fatal("Could not open output destination");
}
static int hfmodem_open(struct inode *inode, struct file *file)
{
struct hfmodem_state *dev = &hfmodem_state[0];
if (dev->active)
return -EBUSY;
if (!dev->scops)
return -EPERM;
/*
* clear vars
*/
memset(&dev->l1, 0, sizeof(dev->l1));
dev->dma.last_dmaptr = 0;
dev->dma.lastfrag = 0;
dev->dma.fragptr = 0;
dev->dma.ptt_frames = 0;
/*
* allocate memory
*/
if (!(dev->dma.buf = kmalloc(HFMODEM_FRAGSIZE * (HFMODEM_NUMFRAGS+HFMODEM_EXCESSFRAGS), GFP_KERNEL | GFP_DMA)))
return -ENOMEM;
/*
* allocate resources
*/
if (request_dma(dev->io.dma, hfmodem_drvname)) {
kfree_s(dev->dma.buf, HFMODEM_FRAGSIZE * (HFMODEM_NUMFRAGS+HFMODEM_EXCESSFRAGS));
return -EBUSY;
}
if (request_irq(dev->io.irq, hfmodem_interrupt, SA_INTERRUPT, hfmodem_drvname, dev)) {
free_dma(dev->io.dma);
kfree_s(dev->dma.buf, HFMODEM_FRAGSIZE * (HFMODEM_NUMFRAGS+HFMODEM_EXCESSFRAGS));
return -EBUSY;
}
request_region(dev->io.base_addr, dev->scops->extent, hfmodem_drvname);
/* clear requests */
dev->active++;
MOD_INC_USE_COUNT;
hfmodem_refclock_init(dev);
output_open(dev);
dev->scops->init(dev);
dev->scops->prepare_input(dev);
dev->scops->trigger_input(dev);
return 0;
}
static int goodness_of_fit_test(FREQ *f,int m,int n)
{
int i,j;
double a,x2;
if (n!=2)
{
sprintf(sbuf,"\nTable must have 2 columns (expected and observed) frquencies!");
sur_print(sbuf); WAIT; return(-1);
}
if (m<2)
{
sprintf(sbuf,"\nTable must have at least two rows!");
sur_print(sbuf); WAIT; return(-1);
}
e=(double *)muste_malloc(m*sizeof(double));
ecum=(double *)muste_malloc(m*sizeof(double));
o=(int *)muste_malloc(m*sizeof(int));
n2=0; for (i=0; i<m; ++i) { o[i]=f[i]; n2+=o[i]; }
n1=0; for (i=0; i<m; ++i) n1+=f[i+m];
a=(double)n2/(double)n1;
for (i=0; i<m; ++i) e[i]=a*f[i+m];
a=0.0; for (i=0; i<m; ++i) { a+=e[i]; ecum[i]=a; }
for (i=0; i<m; ++i) ecum[i]/=ecum[m-1];
g_print=&sur_print;
x2=chi_square(m);
// Rprintf("\nx2=%g n2=%d",x2,n2); getch();
maxcount=1000000L;
i=spfind("SIMUMAX");
if (i>=0) maxcount=atol(spb[i]);
i=rand_init(); if (i<0) return(-1);
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(-1);
}
conf_coeff=muste_inv_std(1.0-(1.0-conf_level)/2);
disp0fit(m,n,x2);
dn=10000L;
i=spfind("GAP");
if (i>=0) dn=atol(spb[i]);
count=0L; pcount=0L; dcount=0L; ecount=0L;
while (1)
{
++count; ++dcount;
for (i=0; i<m; ++i) o[i]=0;
for (j=0; j<n2; ++j)
{
a=(*rand1)();
i=0;
while (a>ecum[i]) ++i;
++o[i];
}
// Rprintf("\no: "); for (i=0; i<m; ++i) Rprintf("%d ",o[i]);
// a=chi_square(m); Rprintf("\na=%g",a);
if (chi_square(m)>=x2) ++pcount;
if (dcount>=dn)
{
tab_disp();
if (count>=maxcount) break;
if (sur_kbhit()) { sur_getch(); break; }
WAIT;
dcount=0;
}
}
// Rprintf("\np=%g",(double)pcount/(double)count); getch();
g_print=&print_line;
output_open(eout);
disp0fit(m,n,x2);
tab_disp();
output_close(eout);
return(1);
}
/****************
main(argc,argv)
int argc; char *argv[];
*******************/
void muste_facta(char *argv)
{
int i,j,h;
unsigned int ui;
double da,db;
char x[LLENGTH];
double sumlogsii;
// extern double cdf_chi2();
char acc[32];
// if (argc==1) return;
s_init(argv);
if (g<3)
{
init_remarks();
rem_pr("Usage: FACTA <corr.matrix>,k,L ");
rem_pr(" k=number of factors ");
rem_pr(" L=first line for the results ");
rem_pr(" Factor matrix saved as FACT.M ");
rem_pr(" ");
rem_pr(" METHOD=ULS Unweighted Least Squares ");
rem_pr(" METHOD=GLS Generalized Least Squares ");
rem_pr(" METHOD=ML Maximum Likelihood (default) ");
rem_pr(" Test statistics by N=<number of observations>");
rem_pr("More information by FACTA? ");
wait_remarks(2);
s_end(argv);
return;
}
results_line=0;
if (g>3)
{
results_line=edline2(word[3],1);
if (results_line==0) return;
}
i=sp_init(r1+r-1); if (i<0) return;
i=matrix_load(word[1],&E,&p,&n,&rlab,&clab,&lr,&lc,&type,expr);
if (i<0) { s_end(argv); return; } // RS CHA argv[1]
if (p!=n)
{
sprintf(sbuf,"\n%s not a square matrix!",word[1]); sur_print(sbuf); WAIT; return;
}
k=atoi(word[2]);
if (k<1 || k>p-1)
{
sprintf(sbuf,"Incorrect number (%d) of factors!",k);
if (etu==2)
{
sprintf(tut_info,"___@6@FACTA@%s@",sbuf); s_end(argv); // RS CHA argv[1]
return;
}
sur_print("\n"); sur_print(sbuf); WAIT; return;
}
*mess=EOS;
i=spfind("FEPS");
if (i>=0)
{
double eps;
eps=1.0-atof(spb[i]);
for (i=0; i<p; ++i)
for (j=0; j<p; ++j) { if (i==j) continue; E[i+j*p]*=eps; }
}
ind=3; i=spfind("METHOD");
if (i>=0)
{
if (muste_strcmpi(spb[i],"ULS")==0) ind=1;
if (muste_strcmpi(spb[i],"GLS")==0) ind=2;
}
for (i=0; i<p; ++i)
{
if (E[i*(p+1)]!=0.0) continue;
sprintf(sbuf,"Variable %.*s is a constant!",lr,rlab+i*lr);
if (etu==2)
{
sprintf(tut_info,"___@1@FACTA@%s@",sbuf); s_end(argv); // RS CHA argv[1]
return;
}
sur_print("\n"); sur_print(sbuf); WAIT; return;
}
/*
if (ind==1)
{
for (i=0; i<p; ++i)
{
if (fabs(E[i*(p+1)]-1.0)<0.0001) continue;
Rprintf("\n%s is not a correlation matrix as supposed in ULS!",
word[1]); WAIT; return;
}
}
*/
i=varaa_tilat(); if (i<0) return;
for (ui=0; ui<p*p; ++ui) S[ui]=E[ui];
sumlogsii=0.0; for (i=0; i<p; ++i) sumlogsii+=log(S[i*(p+1)]);
i=nwtrap();
if (i<0)
{
if (etu!=2)
{ sur_print("\nSolution not found!"); WAIT; return; }
s_end(argv); // RS CHA argv[1]
return;
}
h=output_open(eout); if (h<0) return;
strcpy(x,"Factor analysis: ");
switch (ind)
{
case 1: strcat(x,"Unweighted Least Squares (ULS) solution"); break;
case 2: strcat(x,"Generalized Least Squares (GLS) solution"); break;
case 3: strcat(x,"Maximum Likelihood (ML) solution"); break;
}
print_line(x);
if (*mess)
{
strcpy(x," "); strcat(x,mess);
print_line(x);
if (etu!=2) { WAIT; }
}
i=spfind("N");
if (i>=0)
{
if (ind>1)
{
double n1,c0,chi20,d0,m0,ck,chi2k,dk,mk,rho,pr;
char *q;
n1=atof(spb[i]);
if (n1<(double)k) { sur_print("\nIncorrect N!"); WAIT; return; }
c0=n1-1.0-(2.0*p+5.0)/6.0;
chi20=c0*(sumlogsii-log(det));
d0=p*(p-1.0)/2.0;
m0=chi20/d0;
ck=c0-2.0*k/3.0;
chi2k=ck*f0;
dk=((p-k)*(p-k)-p-k)/2.0;
mk=chi2k/dk;
rho=(m0-mk)/(m0-1.0);
// pr=cdf_chi2(chi2k,dk,1e-10);
pr=0.0;
sprintf(x,"factors=%d Chi^2=%g df=%d P=%5.3f reliability=%g",
k,chi2k,(int)dk,pr,rho);
if (rho>1.0) { q=strstr(x,"rel"); *q=EOS; } /* 3.6.1995 */
print_line(x);
}
else
{
double n1,uu,dk,pr;
n1=atof(spb[i]);
if (n1<(double)k) { sur_print("\nIncorrect N!"); WAIT; return; }
for (i=0; i<p; ++i) for (j=0; j<i; ++j)
{
da=0.0;
for (h=0; h<k; ++h) da+=L[i+p*h]*L[j+p*h];
S[i+p*j]=da; S[j+p*i]=da;
} /* Huom. S-diagonaali säilytetään */
mat_dcholinv(S,p,&uu);
uu=(n1-1.0)*log(uu/det);
dk=((p-k)*(p-k)+p-k)/2.0; /* ei sama kuin yllä! */
// pr=cdf_chi2(uu,dk,1e-10);
pr=0.0;
sprintf(x,"factors=%d Chi^2=%g df=%d P=%5.3f",
k,uu,(int)dk,pr);
print_line(x);
}
}
output_close(eout);
f_orientation(L,p,k);
text_labels(clab,k,lc,"F");
matrix_save("FACT.M",L,p,k,rlab,clab,lr,lc,0,"F",0,0);
strncpy(clab+k*lc,"h^2 ",8);
for (i=0; i<p; ++i)
{
da=0.0;
for (j=0; j<k; ++j)
{
db=L[i+p*j];
S[i+p*j]=db;
da+=db*db;
}
S[i+p*k]=da;
}
strcpy(acc,"12.1234567890123456");
acc[accuracy-1]=EOS;
matrix_print(S,p,k+1,rlab,clab,lr,lc,p,k+1,NULL,NULL,acc,c3,
results_line,eout,"Factor matrix");
s_end(argv);
}
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 rnd_printout()
{
int i,k;
double a,a1,a2,a3,sumx,sumx2,sumy,sumy2,df;
double mean,stddev,amax;
char s1[LLENGTH],s2[LLENGTH],s3[LLENGTH];
if (n<3L) { sprintf(sbuf,"\nOnly %d active observations!",n);
sur_print(sbuf); WAIT; return(-1);
}
output_open(eout);
mean=sum1/(double)n;
stddev=sqrt((sum2-sum1*sum1/(double)n)/(double)(n-1));
sprintf(sbuf,"Testing randomness of %s in data %s",word[2],word[1]);
print_line(sbuf);
fnconv2(mean,accuracy+2,s1); fnconv2(stddev,accuracy+2,s2);
fnconv2(stddev/sqrt((double)n),accuracy+2,s3);
sprintf(sbuf,"N=%d mean=%s stddev=%s SE[mean]=%s",n,s1,s2,s3); print_line(sbuf);
if (stddev<1e-15) { sprintf(sbuf,"\nVariable %s is constant=%g",
word[2],mean); sur_print(sbuf); WAIT; return(-1);
}
if (n_sub) sub_results();
if (fr_n) fr_results();
for (imax=MAXRUN-1; imax>=0; --imax)
{
if (runs_up[imax]+runs_down[imax]>0) break;
}
runs_hald();
runtest2();
if (maxlag)
{
amax=0.0;
a=sum1*sum1/(double)n;
a1=sum2-a;
print_line(" ");
print_line(" Lag Autocorrelation");
sumx=sumy=sum1; sumx2=sumy2=sum2;
for (i=0; i<maxlag; ++i)
{
a=first_x[i];
sumx-=a; sumx2-=a*a;
a=lagv[lagpos];
sumy-=a; sumy2-=a*a;
if (lagpos>0) --lagpos; else lagpos=maxlag-1;
df=n-(int)(i+1);
a=lagvv[i]-sumx*sumy/df;
a1=sumx2-sumx*sumx/df; a2=sumy2-sumy*sumy/df;
a2=a/sqrt(a1*a2);
if (fabs(a2)>amax) amax=fabs(a2);
a3=2*muste_cdf_std(-fabs(a2)*sqrt((double)n));
fnconv(a2,accuracy,s1);
/* Rprintf("\nlag=%d sumx=%g sumx2=%g sumy=%g sumy2=%g S=%g",
i+1,sumx,sumx2,sumy,sumy2,lagvv[i]); getch();
*/
k=sprintf(sbuf,"%6d %s",i+1,s1);
if (a3<0.1)
{
k+=sprintf(sbuf+k," P=%g",a3);
}
if (i==maxlag-1) { fnconv2(amax,accuracy,s1); k+=sprintf(sbuf+k," max.autocorr.=%s",s1); }
print_line(sbuf);
}
}
if (maxgap) gap_results();
if (permlen) perm_results();
if (poklen) poker_results();
if (couplen) coup_results();
output_close(eout);
return(1);
}
void update(void* instance)
{
InstancePtr inst = (InstancePtr) instance;
MyInstancePtr my = inst->my;
int options = trim_int(inst->in_options->number, 0, INT_MAX);
int on_top = options & 1;
int frame = options & 2;
int mirrorx = options & 4;
int mirrory = options & 8;
int invert = options & 16;
int monitor = trim_int(inst->in_monitor->number, 0, 3);
int win_xsize = trim_int(inst->in_xsize->number, 0, 2048);
int win_ysize = trim_int(inst->in_ysize->number, 0, 2048);
double brightness = trim_double(inst->in_brightness->number, 0, 1);
double contrast = trim_double(inst->in_contrast->number, 0, 4);
double gamma = trim_double(inst->in_gamma->number, 0.01, 4);
int fb_xsize = inst->in_in->xsize;
int fb_ysize = inst->in_in->ysize;
int result;
char buffer[TEMP_BUF_SIZE] = "";
const char* driver_name = inst->in_driver->text;
const char* server_name = inst->in_server->text;
if (strcmp(driver_name, my->driver_name->text) != 0 ||
strcmp(server_name, my->server_name->text) != 0 ||
my->drv == 0)
{
if (my->drv != 0)
{
get_drv_window_pos(my->drv, &my->win_xpos,&my->win_ypos);
output_close(my->driver_name->text, my->server_name->text);
my->drv = 0;
}
string_assign(my->driver_name, inst->in_driver);
string_assign(my->server_name, inst->in_server);
my->drv = output_open(driver_name, server_name);
if (my->drv == 0)
return;
}
assert(my->drv != 0);
if (my->drv->inst == 0)
{
/** initialize the driver **/
my->drv->inst = my->drv->new_instance(server_name,
my->win_xpos, my->win_ypos,
my->width, my->height,
s_mmx_supported,
buffer, sizeof(buffer));
if (my->drv->inst == 0)
{
s_log(0, buffer);
output_close(driver_name, server_name);
my->drv = 0;
return;
}
// reset parameters to make sure they are initialized below
my->frame = -1;
my->monitor = -1;
my->on_top = -1;
}
assert(my->drv != 0);
assert(my->drv->inst != 0);
if (on_top != my->on_top && my->drv->always_on_top)
{
int res = my->drv->always_on_top(my->drv->inst,
on_top,
buffer, sizeof(buffer));
if (!res)
s_log(0, buffer);
my->on_top = on_top;
}
if (monitor != my->monitor && my->drv->to_monitor)
{
int res = my->drv->to_monitor(my->drv->inst,
monitor,
buffer, sizeof(buffer));
if (!res)
s_log(0, buffer);
my->monitor = monitor;
}
if (win_xsize == 0 || win_ysize == 0)
{
win_xsize = fb_xsize;
win_ysize = fb_ysize;
}
// if (win_xsize != my->width || win_ysize != my->height)
{
int res = my->drv->resize(my->drv->inst, win_xsize, win_ysize,
buffer, sizeof(buffer));
if (!res)
{
char msg[128];
snprintf(msg, sizeof(msg), "Could not resize: %s", buffer);
s_log(0, msg);
}
my->width = win_xsize;
my->height = win_ysize;
}
if (frame != my->frame && my->drv->frame)
{
int res = my->drv->frame(my->drv->inst,
frame,
buffer, sizeof(buffer));
if (!res)
s_log(0, buffer);
my->frame = frame;
}
{
struct blit_params params;
params.mirrorx = mirrorx;
params.mirrory = mirrory;
params.brightness = brightness;
params.contrast = contrast;
params.gamma = gamma;
params.invert = invert;
result = my->drv->blit(my->drv->inst,
(const uint8_t*) inst->in_in->framebuffer,
inst->in_in->xsize,
inst->in_in->ysize,
¶ms,
buffer, sizeof(buffer));
}
if (!result)
{
s_log(0, buffer);
}
}
int main(int argc, char** argv)
{
char *record;
char *block; //endiamesos xwros mnhmhs ston opoio ekxwroun ta block oi reducers//
int i,j,fd;
char buffer[56]; //pinakas ston opoion sxhmatizoume to katallhlo format gia ta pipenames//
pid_t pid;
int status;
fd_set read_set, active_set; //ta set me tous file descriptors pou xrhsimopoiei h select//
BUFFERS *buffers; //deikths sthn arxh twn buffers//
struct sigaction sig_act;
if (argc!=3) //onoma ektelesimou, #Mappers, #Reducers//
{
printf("Usage:%s #Mappers #Reducers\n",argv[0]);
return -1;
}
sig_act.sa_handler=handler1; //Signal Handler1 gia ton patera//
sig_act.sa_flags=0;
//prosthetw ta simata sto set tou patera.
if ((sigemptyset(&sig_act.sa_mask ) == -1) || (sigaction(SIGINT,&sig_act,NULL) == -1 )
|| (sigaction(SIGQUIT,&sig_act,NULL) == -1 ) || (sigaction(SIGTERM,&sig_act,NULL) == -1 ))
{
perror("FAIL TO INSTAL SIGNAL HANDLER FOR SIGUSR1");
return -1;
}
Mappers=atoi(argv[1]);
Reducers=atoi(argv[2]);
for(i=0;i<Mappers;i++) //dhmiourgia twn pipes prin dhmiourgh8oun ta paidia//
{
for (j=0;j<Reducers;j++)
{
buffer[0]='\0';
sprintf(buffer,".pipe.%d.%d",i+1,j+1);
if ( mkfifo(buffer,0666 )==-1)
{
perror("mkfifo");
removepipes(Mappers,Reducers);
return -1;
}
}
}
mkdir("./output_folder",0700); //dhmiourgoume ton output folder//
for(i=0;i<Mappers+Reducers;i++) //kanena paidi den exei dhmiourgh8ei akoma//
pids[i]=0;
for(i=0;i<Mappers+Reducers;i++)
{
pids[i]=pid=fork();
if (pid<0) //periptwsh apotyxias fork()//
{ //epeidh den 3eroume posa paidia exoun gennh8ei epityxws,ara posa prepei na//
perror("fork failed\n"); //skotwsoume,o pateras stelnei ena SIGINT ston eauto tou kai o handler tou patera//
kill(getpid(),SIGINT); //eidopoiei ta gennhmena paidia na termatisoun//
removepipes(Mappers,Reducers);
return -1;
}
else if ( pid==0 ) //to paidi vgainei apo to loop ka8ws mono h Initial prepei na kanei fork()//
break;
}
if (pid==0) //an eimaste sto paidi//
{
sigset_t ign_signals;
//prosthetw sta 3 simata sto set twn paidiwn kai meta ta mplokarw//
if ( (sigemptyset(&ign_signals ) == -1) || (sigaddset(&ign_signals,SIGINT) == -1 ) || (sigaddset(&ign_signals,SIGQUIT) == -1 )
|| (sigaddset(&ign_signals,SIGTERM) == -1 ))
{
kill(getppid(),SIGINT);
}
else
sigprocmask(SIG_BLOCK,&ign_signals,NULL);
sig_act.sa_handler=handler2; //Signal Handler2-o handler twn paidiwn//
sig_act.sa_flags=0;
//orizw ton handler na antistoixei sto SIGUSR1, pou stelnei o parent//
if ((sigemptyset(&sig_act.sa_mask ) == -1) || (sigaction(SIGUSR1,&sig_act,NULL) == -1 ))
kill(getppid(),SIGINT);
for(i=0;i<Mappers+Reducers;i++) //anazhtw ston pinaka me ta pids to 10 mhdeniko,pou ypodeiknyei th seira gennhshs//
if (pids[i]==0)
break;
i++; //auti einai i thesi mou, gia na 3exwrizw an eimai maper i reducer//
if (i<=Mappers) //kwdikas tou mapper//
{
MRIFILE* fp;
buffers=calloc(Reducers,sizeof(struct BUFFERS)); //desmeuoume mnhmh gia tosous buffers osoi einai kai oi reducers//
for (j=0;j<Reducers && !error ;j++)
{
buffer[0]='\0';
sprintf(buffer,".pipe.%d.%d",i,j+1); //dinoume onoma sta pipe//
if ( (fd=open(buffer,O_WRONLY))<0 ) //anoigei to pipe gia grapsimo//
{
if ( errno != EINTR ) //an yparxei la8os k den einai apo shma//
kill(getppid(),SIGINT); //steile to shma //
perror("Mapper::open"); //alliws ginetai allo la8os sthn open//
free(buffers); //kai apodesmevoume tous porous tou mapper//
return -1;
}
initialize(buffers, j, fd); //arxikopoioume tous buffers//
}
DIR *dip;
struct dirent *dit;
if ( (dip = opendir("input_folder")) == NULL) //anoigoume ton inputfolder//
{
if ( errno != EINTR ) //an yparxei la8os k den einai apo shma//
kill(getppid(),SIGINT); //steile to shma //
perror("Mapper::opendir"); //alliws ginetai allo la8os sthn open//
}
while ((dit = readdir(dip)) != NULL && !error) //oso exoume files gia diavasma//
{
if ( strncmp(dit->d_name,"file_",5) == 0) //an oi prwtoi 5 xarakthres twn 2 autwn string einai idioi,dhladh an einai file_//
{
int filenumber; //ari8mos arxeiou input//
sscanf(dit->d_name,"file_%d",&filenumber); //kanw retrieve ton ari8mo tou trexodos arxeiou//
if ( filenumber%Mappers+1==i) //apofasizoume me katakermatismo poios mapper 8a diavazei apo ka8e file//
{
char filename[50];
sprintf(filename,"./input_folder/%s",dit->d_name);
fp=input_open(filename); //anoigoume to file//
while ( (record=input_next(fp))!= NULL ) //kai oso uparxoun eggrafes gia diavasma//
{ //kaleitai h addrecord gia pros8hkh eggrafwn stous buffers//
addrecord(buffers,record,partition(map(record).key,Reducers));
}
input_close(fp); //kleinoume to file//
}
}
}
closedir(dip); //kleinoume kai ton katalogo//
for (j=0; j<Reducers && error==0; j++)
{
if ( buffers[j].curbyte != 4 ){
if ( my_write(buffers[j].pipedesc,buffers[j].block)!= BLKSIZE ) //grafoume sto pipe oses eggrafes exoun 3emeinei//
printf("error here\n");
}
}
for (j=0;j<Reducers;j++)
{
close(buffers[j].pipedesc); //kleinoume ta pipe afou exoume diavasei//
}
free(buffers); //afou teleiwnoume me to diavasma apodesmevoume taous buffers//
}
else //kwdikas tou reducer//
{
char **keys;
char **values;
char *tempkey; //deikths sthn prwth 8esh tou pinaka twn keys//
char **tempval; //deikths sthn prwth 8esh tou pinaka twn values//
int counter;
int total_records=0;
int memsize=100;
int whoami; //8esh mias diergasias ston pinaka twn paidiwn//
whoami=i;
char buffer[40];
MROFILE *fp;
sprintf(buffer,"./output_folder/file_%d",whoami-Mappers); //ka8orismos twn files sto output folder gia ton ka8e reducer
fp=output_open(buffer);
if ( (keys=calloc(memsize,sizeof(char*))) == NULL //an exoume provlhma me th desmeush tou pinaka gia ta keys,h' ta values//
|| (values=calloc(memsize,sizeof(char*)))==NULL //h' to block ,tote//
|| (block=calloc(BLKSIZE,sizeof(char)))==NULL )
{
kill(getppid(),SIGINT); //stelnoume shma ston patera//
}
FD_ZERO(&read_set); //mhdenizoume to set twn file descriptors twn pipe//
for (j=0;j<Mappers;j++)
{
buffer[0]='\0';
sprintf(buffer,".pipe.%d.%d",j+1,i-Mappers);
if ( (fd=open(buffer,O_RDONLY))<0 ) //anoigoume to pipe gia diavasma//
{
if ( errno != EINTR ) //an yparxei la8os kai den einai apo shma//
kill(getppid(),SIGINT); //tote stelnoume to shma//
perror("Reducer::open");
break;
}
FD_SET(fd,&read_set); //pros8etoume ton fd sto readset//
}
active_set=read_set;
int closed=0; //arxikopoioume to plh8os twn diavasmenwn fds//
while ( error==0 && closed != Mappers) //oso uparxoun fds sto active set kai den lavei shma//
{
read_set=active_set;
int chosen;
if ( (chosen=select(FD_SETSIZE,&read_set,NULL,NULL,NULL)) < 0)
{
if ( errno != EINTR ){
kill(getppid(),SIGINT);
error=1;
}
perror("select"); //alliws yparxei provlhma sth select//
break;
}
else //h select epistrefei ton katallhlo fd//
{
for (i = 0; i < FD_SETSIZE; i++) //gia olous tous fds pou yparxoun mesa sto set//
{
if (FD_ISSET (i, &read_set)) //an o i fd einai melos tou read set otan epistrepsei h select//
{
if ( (chosen=my_read(i,block))<0 ) //diavase apo ton i fd//
{
if ( errno != EINTR )
{
kill(getppid(),SIGINT);
error=1;
}
perror("read");
break;
}
else if ( chosen==0 )
{
FD_CLR (i, &active_set); //afairei ton i fd apo to active set//
closed++; //au3anetai kata ena o ari8mos twn fds pou diavasthkan//
close(i); //kleinei o i fd//
if ( closed == Mappers )
break;
}
else
retrieve_records(block,&keys,&values,&total_records,&memsize);
}
}
}
}
printf("%s\n",keys[10000]);
printf("%d\n",total_records);
if ( error==0 ) //an den exoume lavei shma//
{
sort(keys, values, total_records,compare);
tempkey=keys[0]; //o deikths tempkey deixnei sthn 1h 8esh tou pinaka twn keys//
tempval=values;
counter=1;
for ( i=1; i<total_records; i++)
{
if ( compare(tempkey,keys[i]) == 0 ) //an ta kleidia se dyo diadoxikes 8eseis tou pinaka einai idia//
counter++; //au3anetai kata 1 to plh8os twn eggrafwn me to idio kleidi//
else //an ta kleidia se dyo diadoxikes 8eseis tou pinaka einai diaforetika//
{
output_next(fp,reduce(tempkey,tempval,counter));//kaleitai h reduce kai grafoume to apotelesma sto output file.//
counter=1; //epilegoume neo kleidi//
tempkey=keys[i]; //h kainouria 8esh tou tempkey//
tempval=values+i; //h kainouria 8esh tou tempval//
}
}
}
output_close(fp); //kleinoume to output file tou kathe reducer//
if ( block != NULL ) //apodesmeush twn porwn tou reducer//
free(block);
if ( keys != NULL && values!= NULL ) //an den exei ginei la8os kata th desmeush//
{ //apodesmeuoume olh th dunamika desmeumenh mnhmh//
for(i=0;i<memsize;i++)
{
if ( keys[i]!=NULL && values[i]!=NULL )
{
free(keys[i]);
free(values[i]);
}
}
free(keys);
free(values);
}
for (i = 0; i < FD_SETSIZE; i++) //kleinoume olous tous file descriptors pou vriskodai sto active set//
if (FD_ISSET (i, &active_set))
close(i);
}
}
else //alliws an eisai ston patera,Initial process//
{
while ( (pid=r_wait(NULL))>0 ) //perimenei ta paidia tou na teleiwsoun//
{
fprintf(stderr,"Child %d finished\n",pid);
}
removepipes(Mappers,Reducers); //svhsimo twn pipes//
}
return 0;
}
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;
}
static int tulosta()
{
int i,k,imin,h;
int j,jj;
int gr;
int n_used;
double min;
char rivi[LLENGTH];
char x[LLENGTH];
hav=muste_fopen(tempfile,"r+b");
output_open(eout);
sprintf(rivi,"Stepwise cluster analysis by Wilks' Lambda criterion");
eoutput(rivi);
sprintf(rivi,"Data %s N=%d",aineisto,n); eoutput(rivi);
k=sprintf(rivi,"Variables: ");
for (i=0; i<m; ++i)
{
strcpy(x,d.varname[d.v[i]]);
h=strlen(x); while (h && x[h-1]==' ') x[--h]=EOS;
k+=sprintf(rivi+k,"%s",x);
if (i<m-1) k+=sprintf(rivi+k,", ");
if (k>c3-10) { eoutput(rivi); k=0; }
}
if (k) eoutput(rivi);
n_used=0;
for (i=0; i<n_saved; ++i)
{
if (freq[i]==0) break;
++n_used;
}
if (it==1)
{
sprintf(rivi," Lambda=%g Clustering saved in %s",f2,d.varname[gvar]);
eoutput(rivi);
}
if (it>1)
{
sprintf(rivi,"Best clusterings found in %d trials are saved as follows:",it);
eoutput(rivi);
eoutput(" Lambda freq Grouping var");
imin=0;
for (i=0; i<n_used; ++i)
{
min=1e100;
for (k=0; k<n_used; ++k)
{
if (lambda2[k]<min) { imin=k; min=lambda2[k]; }
}
lambda2[imin]+=1000.0; ii[i]=imin;
/* ennen 7.11.89 =1e100 */
sprintf(rivi,"%10.10f %6d %s",min,freq[imin],d.varname[gvar2[i]]);
eoutput(rivi);
}
}
sur_print("\nSaving clusterings...");
for (jj=0L; jj<n; ++jj)
{
if (sur_kbhit())
{
i=sur_getch(); prind=1-prind;
}
if (prind) { sprintf(sbuf," %d",jj+1); sur_print(sbuf); }
hav_read2(jj,&j);
if (it==1)
{
hav_read1(jj,&gr);
data_save(&d,j,gvar,(double)gr);
}
else
{
for (i=0; i<n_used; ++i)
{
hav_read4(jj,ii[i],&gr);
data_save(&d,j,gvar2[i],(double)gr);
}
}
}
if (it==1)
{
sprintf(x,"clustering in %d groups: Lambda=%g",ng,f2);
kirjoita_lauseke(gvar,x);
}
else
{
for (i=0; i<n_used; ++i)
{
sprintf(x,"clustering %d in %d groups: Lambda=%g",i+1,ng,lambda2[ii[i]]-1000.0);
kirjoita_lauseke(gvar2[i],x);
}
} /* 7.11.89 */
output_close(eout);
muste_fclose(hav);
return(1);
}
int
merge_main(int argc, char *argv[])
{
int ret = 0, ch;
bool success = false;
/* Initialize parser */
parser = ucl_parser_new(UCLCMD_PARSER_FLAGS);
/* Set the default output type */
output_type = UCL_EMIT_CONFIG;
/* options descriptor */
static struct option longopts[] = {
{ "cjson", no_argument, &output_type,
UCL_EMIT_JSON_COMPACT },
{ "debug", optional_argument, NULL, 'd' },
{ "delimiter", required_argument, NULL, 'D' },
{ "expand", no_argument, &expand, 1 },
{ "file", required_argument, NULL, 'f' },
{ "json", no_argument, &output_type,
UCL_EMIT_JSON },
{ "keys", no_argument, &show_keys, 1 },
{ "input", no_argument, NULL, 'i' },
{ "msgpack", no_argument, &output_type,
UCL_EMIT_MSGPACK },
{ "noop", no_argument, &noop, 1 },
{ "nonewline", no_argument, &nonewline, 1 },
{ "noquotes", no_argument, &show_raw, 1 },
{ "output", required_argument, NULL, 'o' },
{ "shellvars", no_argument, NULL, 'l' },
{ "ucl", no_argument, &output_type,
UCL_EMIT_CONFIG },
{ "yaml", no_argument, &output_type, UCL_EMIT_YAML },
{ NULL, 0, NULL, 0 }
};
while ((ch = getopt_long(argc, argv, "cdD:ef:i:jklmnNo:quy", longopts, NULL)) != -1) {
switch (ch) {
case 'c':
output_type = UCL_EMIT_JSON_COMPACT;
break;
case 'd':
if (optarg != NULL) {
debug = strtol(optarg, NULL, 0);
} else {
debug = 1;
}
break;
case 'D':
input_sepchar = optarg[0];
output_sepchar = optarg[0];
break;
case 'e':
expand = 1;
break;
case 'f':
filename = optarg;
if (strcmp(optarg, "-") == 0) {
/* Input from STDIN */
root_obj = parse_input(parser, stdin);
} else {
root_obj = parse_file(parser, filename);
}
break;
case 'i':
include_file = optarg;
break;
case 'j':
output_type = UCL_EMIT_JSON;
break;
case 'k':
show_keys = 1;
break;
case 'l':
output_sepchar = '_';
break;
case 'm':
output_type = UCL_EMIT_MSGPACK;
break;
case 'n':
noop = 1;
break;
case 'N':
nonewline = 1;
break;
case 'o':
outfile = optarg;
output = output_open(outfile);
break;
case 'q':
show_raw = 1;
break;
case 'u':
output_type = UCL_EMIT_CONFIG;
break;
case 'y':
output_type = UCL_EMIT_YAML;
break;
case 0:
break;
default:
fprintf(stderr, "Error: Unexpected option: %i\n", ch);
usage();
break;
}
}
argc -= optind;
argv += optind;
if (argc == 0) {
usage();
}
if (filename == NULL) {
root_obj = parse_input(parser, stdin);
}
if (argc > 1) { /* XXX: need test for if > 2 inputs */
success = merge_mode(argv[0], argv[1]);
} else {
success = merge_mode(argv[0], NULL);
}
if (success) {
get_mode("");
} else {
fprintf(stderr, "Error: Failed to apply the merge operation.\n");
ret = 1;
}
cleanup();
return(ret);
}
