void cmd_eeprom(const char* cmd)
{
if (strstr( cmd, "load") )
{
data_load();
strcpy_P(cmd_line, PSTR("Persistent data loaded."));
}
else if (strstr( cmd, "save") )
{
data_save();
strcpy_P(cmd_line, PSTR("Persistent data saved."));
}
}
static int xall(void)
{
int i,j,k;
double x,y;
int var1;
int vartotal;
int howmany;
i=data_open(word[1],&d); if (i<0) return -1;
i=mask(&d); if (i<0) return -1;
i=conditions(&d); if (i<0) return -1;
var1=varfind(&d,word[2]); if (var1<0) return -1;
vartotal=atoi(word[3]);
if (g>4) howmany=atoi(word[4]); else howmany=1;
if (howmany<1) return -1;
muste_kv_s_disp("\nConverting \"X ALL\" responses in %d variables...", vartotal);
muste_kv_s_disp("\nMoving values of %d variables at a time...", howmany);
if ((var1+howmany*vartotal) > d.m) {
muste_kv_s_err("Not enough variables after %s!", word[2]);
return -1;
}
for (j=d.l1; j<=d.l2; j++) {
if (unsuitable(&d,j)) continue;
muste_kv_s_disp(" %d",j);
for (i=(var1+howmany*vartotal-howmany); i>=var1; i-=howmany) {
data_load(&d,j,i,&x);
if (x==MISSING8) {
data_save(&d,j,i,MISSING8); /* (data in edit field) */
for (k=1; k<howmany; k++) { /* 31.5.97 */
data_save(&d,j,i+k,MISSING8);
}
continue;
}
if (howmany==1 && ((int)x == i)) continue;
if (((int)x < 1) || ((int)x > vartotal)) continue; /* 20.5.97 */
data_save(&d,j,i,MISSING8);
data_save(&d,j,var1+howmany*(int)x-howmany,x);
for (k=1; k<howmany; k++) { /* 20.5.97 */
data_load(&d,j,i+k,&y);
data_save(&d,j,i+k,MISSING8);
data_save(&d,j,var1+howmany*(int)x-howmany+k,y);
}
}
}
data_close(&d);
return 1;
}
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 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);
}
static int linear_combinations()
{
int i,k,m;
int j;
double val;
// int miss;
int keyind;
int l;
int prind_count;
extern double sis_tulo();
sur_print("\nComputing and saving linear combinations: ");
keyind=1;
i=hae_apu("prind",sbuf); if (i) keyind=atoi(sbuf);
i=spfind("PRIND"); if (i>=0) keyind=atoi(spb[i]);
for (i=0; i<cdim; ++i)
if (outvar[i]>=0) { sprintf(sbuf," %.*s",8,d.varname[outvar[i]]); sur_print(sbuf); }
sur_print("\n");
for (i=0; i<cdim; ++i) if (outvar[i]>=0) break;
if (i==cdim)
{
sprintf(sbuf,"\nParameters missing in %s!",word[2]);
sur_print(sbuf); WAIT; return(-1);
}
prind_count=0;
for (j=d.l1; j<=d.l2; ++j)
{
++prind_count;
if (prind_count==100)
{
prind_count=0;
if (sur_kbhit()) { sur_getch(); keyind=1-keyind; }
}
if (unsuitable(&d,j)) continue;
if (keyind) { sprintf(sbuf," %d",j); sur_print(sbuf); }
for (k=0; k<rdim; ++k)
{
m=var[k];
if (m==-1) y[k]=1.0;
else
{
l=j+lag[k];
if (l>=1L && l<=d.n)
data_load(&d,l,m,&y[k]);
else
y[k]=MISSING8;
}
}
for (i=0; i<cdim; ++i)
{
if (outvar[i]==-1) continue;
// miss=0;
for (k=0; k<rdim; ++k) if (y[k]==MISSING8) break;
if (k<rdim) val=MISSING8;
else val=sis_tulo(A+i*rdim,y,1,1,rdim);
k=data_save(&d,j,outvar[i],val); if (k<0) return(-1);
}
}
return(1);
}
void cmd_reboot(void)
{
data_save();
wdt_enable(WDTO_15MS);
}
void muste_powers(char *argv)
{
int i,k;
int j;
double a,b;
degree=2;
var_type='8';
s_init(argv);
if (g<2)
{
sur_print("\nUsage: POWERS <SURVO_data>");
sur_print("\n POW_VARS=<list_of_variables>");
sur_print("\n DEGREE=<max_power> TYPE=<1|2|4|8>");
WAIT; return;
}
strcpy(aineisto,word[1]);
i=data_open3(aineisto,&d,1,1,1,1);
if (i<0) { s_end(argv[1]); return; }
i=spec_init(r1+r-1); if (i<0) return;
i=conditions(&d); if (i<0) { s_end(argv[1]); return; }
i=list_of_vars(); if (i<0) return;
i=spfind("DEGREE");
if (i>=0) degree=atoi(spb[i]);
if (degree>MAX_POW)
{
sprintf(sbuf,"\nMax. degree is %d.",MAX_POW);
sur_print(sbuf); WAIT; return;
}
i=spfind("TYPE");
if (i>=0) var_type=*spb[i];
i=power_combinations(); if (i<0) return;
for (j=1L; j<=d.n; ++j)
{
for (i=0; i<nvar; ++i)
{
if (unsuitable(&d,j)) continue;
data_load(&d,j,var_ind[i],&a);
// Rprintf("\nvar=%d a=%g|",vara); getch();
val[i][1]=a; b=a;
for (k=2; k<=degree; ++k)
{
b*=a;
val[i][k]=b;
// Rprintf("\nval: %d %d %g %g|",i,k,a,val[i][k]); getch();
}
}
for (k=0; k<ncomb; ++k)
{
a=1.0;
for (i=0; i<nvar; ++i)
if (pow_v[k][i]>0) a*=val[i][pow_v[k][i]];
// Rprintf("\na=%g|",a); getch();
data_save(&d,j,pow_ind[k],a);
}
}
data_close(&d); // 8.8.2011/SM
s_end(argv);
}