static int disp0()
{
int k;
if (r>r3-6) r=1;
LOCATE(r+2,9);
k=sprintf(sbuf,"Testing a %d*%d table by simulation:",m,n);
sprintf(sbuf+k," X^2=%g P=%6f",
chi2+eps,1-muste_cdf_chi2(chi2+eps,(double)((m-1)*(n-1)),1e-15));
(*g_print)(sbuf);
LOCATE(r+3,9);
sprintf(sbuf,"%.*s G^2=%g P=%6f",k,space,
g2+eps,1-muste_cdf_chi2(g2+eps,(double)((m-1)*(n-1)),1e-15));
(*g_print)(sbuf);
LOCATE(r+4,9);
sprintf(sbuf,"%s%s",descr[fix],tdescr[test]);
(*g_print)(sbuf);
LOCATE(r+5,9);
sprintf(sbuf," N P Confidence interval (%g)",conf_level);
(*g_print)(sbuf);
LOCATE(r3+2,9); PR_EBLD;
sprintf(sbuf,"To interrupt, press any key! (max N is %d)",maxcount);
sur_print(sbuf);
return(1);
}
static int tutki(char *s)
{
char *p;
int len,n,riv,sar;
if (s98_file) return(1);
len=strlen(s);
if (len<12) return(1);
++testi;
p=s;
n=0;
while (*p) {
if(((unsigned char)*p>30 && (unsigned char)*p<167) || (unsigned char)*p==(unsigned char)TAB // RS CHA (int)
|| strchr(win_aeao,*p)!=NULL ) ++n;
++p;
}
/* PR_EIN2; sprintf(sbuf,"\nlen=%d n=%d",len,n); sur_print(sbuf); getch(); */
if ((double)n/(double)len<0.9 || len-n>15)
{
CURSOR_POS(&riv,&sar);
LOCATE(r3-5,1);
PR_EIN2;
sur_print("\n----------------------------------------");
sur_print("\n Obviously not a text file! ");
sur_print("\n Press ENTER! ");
sur_print("\n----------------------------------------");
sur_getch();
testi=10;
LOCATE(riv,sar);
return(-1);
}
return(1);
}
void headline(char *valinta)
{
char aika[26];
int rr,cc;
char x[LLENGTH];
int k;
pvmaika(aika);
CURSOR_POS(&rr,&cc);
LOCATE(1,1);
PR_EUDL;
sprintf(x," %4u",c1+c-1);
write_string(x,6,'4',1,1);
sprintf(x,"%3u",c1); write_string(x,3,')',1,7);
sprintf(x," %s ",system_name);
write_string(x,strlen(system_name)+2,'7',1,10);
k=23+c3-72; // RS CHA 20 -> 23
strcpy(sbuf,edisk); unsubst_survo_path_in_editor(sbuf);
sprintf(x," %s %*.*s%7d%5d ",aika,k,k,sbuf,r2,c2);
write_string(x,strlen(x),'4',1,19); // RS 20 -> 19
if (*valinta==EOS) { check_alarm(aika); LOCATE(rr,cc); PR_ENRM; return; }
LOCATE(r3+2,1); PR_EINV;
snprintf(sbuf,c3+8,"%s",valinta); sur_print(sbuf);
check_alarm(aika);
LOCATE(rr,cc);
PR_ENRM;
/* RS Original version
char aika[26];
int rr,cc;
char x[LLENGTH];
int k;
pvmaika(aika);
CURSOR_POS(&rr,&cc);
LOCATE(1,1);
PR_EUDL;
sprintf(x," %4u",c1+c-1);
write_string(x,6,'4',1,1);
sprintf(x,"%3u",c1); write_string(x,3,')',1,7);
CURSOR_ON; sprintf(x," %s ",system_name);
write_string(x,strlen(system_name)+2,'7',1,10);
k=20+c3-72;
sprintf(x," %s %*.*s%7d%5d ",aika,k,k,edisk,r2,c2);
write_string(x,strlen(x),'4',1,20);
if (*valinta==EOS) { check_alarm(aika); LOCATE(rr,cc); PR_ENRM; return; }
LOCATE(r3+2,1); PR_EINV;
sprintf(sbuf,"%s",valinta); sur_print(sbuf);
check_alarm(aika);
LOCATE(rr,cc);
*/
}
static int lis_rivit(int jj,long kpl)
{
char x[LLENGTH];
int m;
putsaa();
PR_EBLD;
LOCATE(r3+2,1);
if (kpl>(long)r2) {
ei_tilaa();
return(-1);
}
m=spec_find("INSERT",x,LLENGTH); // 20.7.2006
if (m<0 || (m>=0 && atoi(x)==0) )
{
sprintf(x,"newalert");
sur_play_sound(x);
sprintf(x,"Not enough empty lines. Insert space for %ld lines (Y/N) ?",kpl);
LOCATE(r3+2,strlen(x)+2);
m=nextch(x);
if (m!='y' && m!='Y') return(-1);
PR_ENRM;
}
return(insert_lines(jj,(int)kpl));
}
//***************************************************
void init_castle_contents(void)
{
unsigned j, k, x, y, level ;
/* Init. all rooms to 101 (hidden, empty rooms) */
for (level=0; level<8; level++) {
for (y=0; y<8; y++) {
for (x=0; x<8; x++) {
castle[x][y][level].contents = EMPTY_ROOM ;
castle[x][y][level].is_known = 0 ;
} } }
/* Place entrance */
castle[0][3][0].contents = CASTLE_ENTRANCE ;
castle[0][3][0].is_known = 1 ;
// place two stairs per level
for (level=0; level<7; level++) {
place_stairs(level) ;
place_stairs(level) ;
}
// place objects on each floor
for (level=0; level<8; level++) {
// place monsters
for (j=MONSTER_BASE; j<=MONSTER_END; j++)
LOCATE(level, j) ;
for (k=0; k<3; k++) {
// place room contents
for (j=OBJECT_BASE; j<=OBJECT_END; j++)
LOCATE(level, j) ;
LOCATE(level, VENDOR) ; // place vendor
}
}
// place treasures
for (j=TREASURE_BASE; j<=TREASURE_END; j++) {
place_treasure(j) ;
}
for (j=0; j<3; j++) {
place_curse(j) ;
}
// place the runestaff
place_runestaff() ;
place_orb() ; // place orb last, so it ends up in empty room
}
main() {
LIST L, p, p2;
char ans, element;
MAKENULL(&L);
do {
clrscr();
printf("\n MENU\n");
printf("[1] Insert\n");
printf("[2] Delete\n");
printf("[3] Display\n");
printf("[4] Search\n");
printf("[5] Quit\n\n");
printf("Enter chosen number: ");
ans = toupper(getche());
switch (ans) {
case '1':
/* case 1 has an approximated running time of 3n + 12 */
printf("\n\nEnter an element to insert: ");
element = getche();
p = INS_POS(element, L);
INSERT(element, p);
break;
case '2' :
/* case 2 has an approximated running time of 8n + 10 */
printf("\n\nEnter element to delete: ");
element = getche();
p = LOCATE(element,L);
DELETE(element, p);
break;
case '3' :
/* case 3 has an approximated running time of 3n + 4 */
printf("\n\n");
PRINTLIST(L);
break;
case '4' :
/* case 4 has an approximated running time of 4n + 14 */
printf("\n\nEnter element to search: ");
element = getch();
p = LOCATE(element,L);
SEARCH(element, p);
break;
case '5' :
break;
}
} while (ans != '5');
DELETEALL(p); /* DELETEALL has an approximated runnning time of 4n + 1 */
}
static void nayta_cdisp()
{
LOCATE(rdisp,1);
PR_EIN2;
sprintf(sbuf,"%3d ",cdisp+1);
sur_print(sbuf);
}
/**
* Allocates a data chunk of specified length.
* The provided data is copied into the chunk.
* If memory allocation succeeds, a pointer to the data chunk is returned.
* Otherwise, this function returns 0.
*/
dagdb_pointer dagdb_data_create(dagdb_size length, const void *data) {
dagdb_pointer r = dagdb_malloc(sizeof(Data) + length);
if (!r) return 0;
Data* d = LOCATE(Data,r);
d->length = length;
memcpy(d->data, data, length);
return r | DAGDB_TYPE_DATA;
}
/**
* Allocates an element with specified key.
* The data and backref pointers are copied into the element.
* If memory allocation succeeds, a pointer to the element is returned.
* Otherwise, this function returns 0.
*/
dagdb_pointer dagdb_element_create(dagdb_key key, dagdb_pointer data, dagdb_pointer backref) {
dagdb_pointer r = dagdb_malloc(sizeof(Element));
if (!r) return 0;
Element* e = LOCATE(Element, r);
memcpy(e->key, key, DAGDB_KEY_LENGTH);
e->data = data;
e->backref = backref;
return r | DAGDB_TYPE_ELEMENT;
}
static void ei_tilaa()
{
putsaa();
PR_EBLK;
LOCATE(r3+2,1);
sur_print("Not lines enough in the edit field! (Press any key!)");
WAIT;
PR_ENRM;
}
static int Wdisp()
{
int rr,cc;
/* 29.10.89 */
/* CURSOR_OFF; headline(""); cursor(r,c); CURSOR_ON; */
CURSOR_OFF; CURSOR_POS(&rr,&cc); headline(""); LOCATE(rr,cc); CURSOR_ON;
/* 4.6.90 */
return(1);
}
/**
* Returns 0 if memory allocation fails.
*/
dagdb_pointer dagdb_kvpair_create(dagdb_pointer key, dagdb_pointer value) {
assert(dagdb_get_pointer_type(key) == DAGDB_TYPE_ELEMENT);
dagdb_pointer r = dagdb_malloc(sizeof(KVPair));
if (!r) return 0;
KVPair* p = LOCATE(KVPair, r);
p->key = key;
p->value = value;
return r | DAGDB_TYPE_KVPAIR;
}
/**
* Recursively removes this try.
*/
void dagdb_trie_delete(dagdb_pointer location)
{
assert(dagdb_get_pointer_type(location) == DAGDB_TYPE_TRIE);
Trie* t = LOCATE(Trie, location);
for(uint_fast32_t i=0; i<16; i++) {
if (dagdb_get_pointer_type(t->entry[i]) == DAGDB_TYPE_TRIE)
dagdb_trie_delete(t->entry[i]);
}
dagdb_free(location, sizeof(Trie));
}
static int tab_disp()
{
double p1;
double se;
double lower,upper;
LOCATE(r+6,9); PR_EUDL;
p1=(double)pcount/(double)count;
se=sqrt(p1*(1.0-p1)/(double)count);
lower=p1-conf_coeff*se; if (lower<0.0) lower=0.0;
upper=p1+conf_coeff*se; if (upper>1.0) upper=1.0;
sprintf(sbuf,"%10d %.8f %.8f lower limit",
count,p1,lower);
(*g_print)(sbuf);
LOCATE(r+7,9);
sprintf(sbuf," s.e. %.8f %.8f upper limit",se,upper);
(*g_print)(sbuf);
dcount=0L;
headline("");
return(1);
}
void *hash_remove(hash_t tab, void *key) {
list_iter_t i = LOCATE(tab, key);
if (enditer(i))
return 0;
else {
struct hash_node *node = list_remove(list_container(i), i);
void *val = node->val;
free(node);
return val;
}
}
static int disp_show(long jseur)
{
int i;
long k,max;
char x[LLENGTH];
int crivi,csar;
CURSOR_OFF;
if (jseur<1L || jseur>jmax) jseur=1L;
LOCATE(rdisp+1,1);
if (!sur_kbhit()) tyhjenna_ikkuna();
// SCROLL_UP(rdisp,r3,ndisp);
max=jseur+(long)ndisp;
if (max>jmax+1L) max=jmax+1L;
if (edit==3) {
if (max>=last_line32) max=last_line32+1;
}
mdisp=0;
for (k=jseur; k<max; ++k)
{
i=etsi(k);
if (i<0) {
muste_fclose(text);
return(-1);
}
i=lue_rivi(line);
if (edit!=2 && feof(text) && !*line) {
rewind(text);
jmax=k-1;
break;
}
if (i<0) return(-1);
i=sprintf(x,"%6ld ",k); /* if (!edit) i+=sprintf(x+i," "); */
if (strlen(line)<cdisp)
i+=sprintf(x+i,"%.*s",c3+1,space); /* -13.7.94 c-1 */
else
i+=sprintf(x+i,"%.*s",c3+1,line+cdisp); /* -13.7.94 c-1 */
CURSOR_POS(&crivi,&csar);
write_string(x,i,'4',crivi,1);
if (i<c3+8) write_string(space,c3+8-i,'4',crivi,i+1);
if (k<max-1) sur_print("\n");
++mdisp;
j=k+1L;
if (edit!=2 && edit!=3 && rivit((long)j)<0L) talleta_alku((long)j,muste_ftell(text));
}
CURSOR_ON;
return(1);
}
static int disp0fit(int m,int n,double chi2)
{
if (r>r3-6) r=1;
LOCATE(r+2,9);
sprintf(sbuf,"Goodness of fit test of %d*%d table %s",m,n,word[1]);
(*g_print)(sbuf);
LOCATE(r+3,9);
sprintf(sbuf,"Common Chi-squared test: X^2=%g P=%6f",
chi2+eps,1-muste_cdf_chi2(chi2+eps,(double)(m-1),1e-15));
(*g_print)(sbuf);
LOCATE(r+4,9);
sprintf(sbuf,"Estimating the P value by simulation:");
(*g_print)(sbuf);
LOCATE(r+5,9);
sprintf(sbuf," N P Confidence interval (%g)",conf_level);
(*g_print)(sbuf);
LOCATE(r3+2,9); PR_EBLD;
sprintf(sbuf,"To interrupt, press any key! (max N is %d)",maxcount);
sur_print(sbuf);
return(1);
}
static void check_alarm(char *aika) /* 14.8.1992 */
{
int k;
char x[LLENGTH];
k=hae_apu("alarm",x);
if (k && !sur_alarm)
{
if (strncmp(x,aika+11,8)<=0)
{
display_off=0;
LOCATE(1,1); BEEP; PR_EBLK;
sur_print("\n ALARM!!! Press # "); PR_ENRM;
while (k!='#') k=sur_getch();
// LOCATE(1,1); PR_ENRM; sur_print("\n ");
++sur_alarm; disp();
}
}
}
void dagdb_element_key(uint8_t * key, dagdb_pointer location)
{
assert(dagdb_get_pointer_type(location) == DAGDB_TYPE_ELEMENT);
Element* e = LOCATE(Element, location);
memcpy(key, e->key, DAGDB_KEY_LENGTH);
}
static int text_show(long rivi1)
{
int i;
long jseur;
int m;
char llines[16], sline[51];
char luku[8];
long li;
char y1[LLENGTH],y2[LLENGTH];
char ch;
int len;
long jd;
char *p;
*sline=EOS;
edit=laji();
if (edit<0) return(-1);
if (edit==1 || edit==2) jmax=ted2;
putsaa();
j=1l;
jseur=rivi1;
if (!muste_dd_call) // RS 30.5.2014
{
i=spec_find("SHOWLOAD",sbuf,LLENGTH);
if (i>=0)
{
direct_showload(sbuf);
return(1);
}
}
luo_ikkuna();
tyhjenna_ikkuna();
putsaa();
disp_show(jseur);
if (g>2 && *word[2]=='"') // 19.7.2006
{
strcpy(sline,word[2]+1);
p=strchr(sline,'"');
if (p!=NULL)
{
*p=EOS;
while ((p=strchr(sline,'_'))!=NULL) *p=' ';
li=search(sline,jseur);
if (li<=0L) li=1;
jseur=li;
disp_show(jseur);
}
}
while (1)
{
if (edit!=0)
m=nextch("SHOW: ENTER=Exit N=Next P=Prev E=End L=Load S=Search C=Copy");
else
m=nextch("SHOW: ENTER=Exit N=Next P=Prev E=End L=Load S=Search C=Copy D,d=Edit W=Win_char U=UTF-8");
switch (m)
{
case CODE_EXIT:
case CODE_RETURN:
return(1);
case CODE_NEXT:
case 'N':
case 'n':
jseur+=(long)ndisp;
if (jseur+(long)(ndisp-1)>jmax) jseur=jmax-(long)ndisp+1L;
if (jseur<1L) jseur=1L;
disp_show(jseur);
break;
case CODE_PREV:
case 'P':
case 'p':
jseur-=(long)ndisp;
if (jseur<1L) jseur=1L;
else if (jseur>jmax-(long)ndisp) jseur=jmax-(long)ndisp+1L;
disp_show(jseur);
break;
case CODE_HOME:
if (cdisp) {
cdisp-=c3+1;
if (cdisp<0) cdisp=0;
nayta_cdisp();
}
else jseur=1L;
disp_show(jseur);
break;
case CODE_DOWN:
if (jseur+(long)mdisp>jmax) break;
j=jseur+(long)mdisp;
i=etsi(j);
if (i<0) {
muste_fclose(text);
return(-1);
}
/* 4.3.1996 */
i=lue_rivi(line);
if (edit!=2 && feof(text) && !*line) {
jmax=j;
break;
}
if (i<0) return(-1);
SCROLL_UP(rdisp,r3,1);
PR_EUDL;
// i=sprintf(sbuf,"%6ld %s",j,line+cdisp);
// i=sprintf(sbuf,"%6ld ",j);
i=sprintf(sbuf,"%6d ",(int)j);
strncat(sbuf,line+cdisp,c3+1);
i=strlen(sbuf);
if (i>c3+8)
// write_string(sbuf,c3+8,shadow_code[sdisp],rdisp+mdisp,1);
write_string(sbuf,c3+8,'4',rdisp+mdisp,1);
else
{
// write_string(sbuf,i,shadow_code[sdisp],rdisp+mdisp,1);
write_string(sbuf,i,'4',rdisp+mdisp,1);
// write_string(space,c3+8-i,shadow_code[sdisp],rdisp+mdisp,1+i);
write_string(space,c3+8-i,'4',rdisp+mdisp,1+i);
}
/*****************************************************
PR_EUDL; LOCATE(rdisp+mdisp,1);
strncpy(sbuf,space,c3+8);
i=sprintf(sbuf,"%6ld ",j);
if (strlen(line)<cdisp)
sprintf(sbuf+i,"%.*s",c3+2,space);
else
sprintf(sbuf+i,"%.*s",c3+2,line+cdisp);
write_string(sbuf,c3+8,shadow_code[sdisp],rdisp+mdisp,1);
*******************************************************/
++j;
++jseur;
if (edit!=3 && edit!=2) talleta_alku((long)j,muste_ftell(text));
break;
case CODE_UP:
if (jseur<=1L) break;
--jseur;
i=etsi(jseur);
lue_rivi(line);
SCROLL_DOWN(rdisp,r3,1);
PR_EUDL;
// i=sprintf(sbuf,"%6ld %s",j,line+cdisp);
// i=sprintf(sbuf,"%6ld ",j);
i=sprintf(sbuf,"%6d ",(int)j);
strncat(sbuf,line+cdisp,c3+1);
i=strlen(sbuf);
if (i>c3+8)
// write_string(sbuf,c3+8,shadow_code[sdisp],rdisp+1,1);
write_string(sbuf,c3+8,'4',rdisp+1,1);
else
{
// write_string(sbuf,i,shadow_code[sdisp],rdisp+1,1);
write_string(sbuf,i,'4',rdisp+1,1);
// write_string(space,c3+8-i,'\237',rdisp+1,1+i);
write_string(space,c3+8-i,'4',rdisp+1,1+i);
}
j=jseur+1L;
break;
case CODE_RIGHT:
++cdisp;
nayta_cdisp();
disp_show(jseur);
break;
case CODE_LEFT:
--cdisp;
if (cdisp<0) cdisp=0;
nayta_cdisp();
disp_show(jseur);
break;
case CODE_END:
cdisp+=c3+1;
nayta_cdisp();
disp_show(jseur);
break;
/*****************************************************
case CODE_HELP:
show_help();
dispw();
nayta_cdisp();
disp_show(jseur);
break;
******************************************************/
/* tavalliset napit !special */
case 'L':
case 'l':
strcpy(llines,muste_ltoa(jseur,luku,10));
strcat(llines,",");
strcat(llines,muste_ltoa(jseur+(long)mdisp-1L,luku,10));
putsaa();
LOCATE(r3+2,1);
prompt("Lines to be loaded ? ",llines,15);
i=load(llines);
if (i<0) return(1);
putsaa();
break;
case 'S':
case 's':
putsaa();
LOCATE(r3+2,1);
prompt("Text to be found? ",sline,50);
li=search(sline,jseur);
putsaa();
if (li<=0L) break;
jseur=li;
disp_show(jseur);
break;
case 'E':
case 'e':
i=etsi(jmax);
if (i<0) jseur=j-(long)ndisp+1L;
else jseur=jmax-(long)ndisp+1L;
disp_show(jseur);
break;
case 'C':
case 'c':
strcpy(llines,muste_ltoa(jseur,luku,10));
strcat(llines,",");
strcat(llines,muste_ltoa(jseur+(long)mdisp-1L,luku,10));
putsaa();
LOCATE(r3+2,1);
prompt("Lines to be copied ? ",llines,15);
LOCATE(r3+2,35);
PR_EINV;
prompt("To file ? ",cfile,32);
i=copy_file(llines,cfile);
putsaa();
break;
case 'D':
case 'd':
if (edit) break;
jd=jseur;
if (m=='d') jd=jseur+(long)(mdisp-1);
li=rivit(jd);
muste_fseek(text,li,0);
lue_rivi(line);
for (i=0; i<EDITLEV; ++i)
{
ch=line[i+cdisp];
y1[i]=ch;
if (ch==EOS) break;
}
len=i;
y1[i]=EOS;
strcpy(y2,y1);
putsaa();
LOCATE(r3+2,1);
prompt(" Edit: ",y1,len);
if (strlen(y1)<EDITLEV) strncat(y1,space,EDITLEV-strlen(y1));
if (strlen(y2)<EDITLEV) strncat(y2,space,EDITLEV-strlen(y2));
if (strcmp(y1,y2)!=0)
{
muste_fclose(text);
text=muste_fopen(tfile,"r+t");
muste_fseek(text,li+(long)cdisp,0);
for (i=0; i<len; ++i) putc((int)y1[i],text);
muste_fclose(text);
text=muste_fopen(tfile,"rt");
muste_fseek(text,li+(long)cdisp,0);
}
putsaa();
disp_show(jseur);
break;
case 'W': // 26.3.2003;
case 'w':
if (win_conv==0 || win_conv==1) // RS 26.1.2014
{
win_conv=1-win_conv;
if (win_conv)
w_codes_load(2);
disp_show(jseur);
}
break;
case 'U': // RS 26.1.2014
case 'u':
if (win_conv==0 || win_conv==999)
{
if (win_conv==0)
{
strcpy(cur_encoding,muste_encoding);
strcpy(muste_encoding,"UTF-8");
win_conv=999;
}
else
{
if (win_conv==999) win_conv=0;
}
disp_show(jseur);
}
break;
/*
case 'A': for (i=0; i<100; ++i) Rprintf(" %ld",rivit[i]);
Rprintf(" jmax=%d mdisp=%d",jmax,mdisp);
break;
*/
}
}
}
int tutch()
{
int Wdisp();
int nop();
int m,ch;
char nimi[16];
m=getc(tutor);
while (m==TUT_COMMENT_CODE) m=getc(tutor); /* 22.10.88 */
if (m==10) { m=13; muste_fixme("\nFIXME: Check LF in sucro!!!"); } // RS 17.11.2013
if (m==CODE_PRE)
{
ch=getc(tutor); ungetc(ch,tutor);
if (ch=='T') tut_special_code=1;
}
if (!feof(tutor))
{
if (sur_kbhit())
{
ch=sur_getch(); // RS CHA nextkey("");
switch (ch)
{
/* 23.1.2001 */ case '+': --tut_wait_c; if (tut_wait_c<1) tut_wait_c=1; // RS CHA 2 -> 1
break;
case '-': ++tut_wait_c; break;
case '*': if (etu1<0) break;
--etu1; if (etu1<=0) etu1=1; break;
case '/': if (etu1<0) break;
++etu1; if (etu1>20) etu1=20; break;
case '.': etu=0; muste_fclose(tutor); return(0);
case CODE_HELP:
etu2=2; if (etu1<2) etu1=2; break;
default: break; // RS CHA FIXME???while(!sur_kbhit()) ; sur_getch(); break;
}
}
if (m==TUT_EFFECTS_OFF) { etu2=etu3=0; return(255); }
if (m==CODE_PRE && tut_special_code) { tut_special(); return(255); }
/* lis. 4.10.88 */
if (etu>1 && etu2!=2) sur_wait((long)tut_wait_c*etu1,nop,0);
if (etu2>0)
{
int rr,cc;
if (tut_special_code) return(m); /* 23.10.89 ennen etu2==2 && */
CURSOR_POS(&rr,&cc);
CURSOR_OFF; LOCATE(r3+2,c3-10);
if (etu2==1) sur_print(" "); else { PR_EBLK; sur_print(" Press "); }
PR_EINV; label(m,nimi); sprintf(sbuf,"%s",nimi); sur_print(sbuf);
LOCATE(rr,cc);
PR_ENRM; CURSOR_ON;
if (etu2==1) { if (etu1>1) sur_wait((long)4*(long)(tut_wait_c*etu1),Wdisp,0); }
else press_key(m);
CURSOR_OFF; LOCATE(r3+2,c3-10);
/* Rprintf("%s"," "); */
sur_print(" ");
LOCATE(rr,cc);
CURSOR_ON;
}
return(m);
}
muste_fclose(tutor);
etu=0; return(0);
}
dagdb_pointer dagdb_element_backref(dagdb_pointer location) {
assert(dagdb_get_pointer_type(location) == DAGDB_TYPE_ELEMENT);
Element* e = LOCATE(Element, location);
return e->backref;
}
const void *dagdb_data_access(dagdb_pointer location) {
assert(dagdb_get_pointer_type(location) == DAGDB_TYPE_DATA);
Data* d = LOCATE(Data,location);
return d->data;
}
dagdb_size dagdb_data_length(dagdb_pointer location) {
assert(dagdb_get_pointer_type(location) == DAGDB_TYPE_DATA);
Data* d = LOCATE(Data,location);
return d->length;
}
void dagdb_data_delete(dagdb_pointer location) {
assert(dagdb_get_pointer_type(location) == DAGDB_TYPE_DATA);
Data* d = LOCATE(Data,location);
dagdb_free(location, sizeof(Data) + d->length);
}
void *hash_get(hash_t tab, void *key) {
list_iter_t i = LOCATE(tab, key);
return enditer(i) ? 0 : VAL(i);
}
dagdb_pointer dagdb_kvpair_value(dagdb_pointer location) {
assert(dagdb_get_pointer_type(location) == DAGDB_TYPE_KVPAIR);
KVPair* p = LOCATE(KVPair, location);
return p->value;
}
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);
}
bool hash_exist(hash_t tab, void *key) {
return !enditer(LOCATE(tab, key));
}
