io.c

#ifdef INTEGER #include "ibp.h" #else #include "rbp.h" #endif /* built-in C functions */

int sign, number, ch2;

readerror = 0;
sign = scanfordigit();
if (readerror)
 {
  if (readerror == 1) texterror();
  return(0);
 };
number = 0;
do ch2 = readch(); while (ch2 == ' ');
while (ch2 >= '0' && ch2 <= '9')
 {
  number = number * 10 + (ch2 - '0');
  ch2 = readch();
 };
bufferptr = bufferptr - 1;
number = sign * number;
if (number < min || number > max)
 {
  sprintf(outstr,"out of range value: %d",number); pg(stdout,outstr);
  if (data == stdin) pg(stdout,"\n");
  else {sprintf(outstr," in %c command\n",command); pg(stdout,outstr);};
  readerror = 1;
 };
return(number);
}

REAL readreal(op,min,command)
int op;
REAL min;
int command;
{
REAL fractpart, divisor, intpart, sign;
double number;
int ch2, numread, i;

readerror = 0;
sign = (REAL) scanfordigit();
if (readerror || (sign == 0 && !readingpattern))
 {
  if (readerror == 1) texterror();
  return(0);
 };
ch2 = readch();
if (ch2 == 'H' && readingpattern) return(unscale(CAPHCODE));
else if (ch2 == 'X' && readingpattern) return(unscale(CAPXCODE));
else if (ch2 == 'h' && readingpattern) return(unscale(HCODE));
else if (ch2 == 'i' && readingpattern) return(unscale(ICODE));
else if (ch2 == 'o' && readingpattern) return(unscale(OCODE));
else if (ch2 == 'd' && readingpattern) return(unscale(DIFFCODE));
else if (ch2 == 's' && readingpattern) return(unscale(SKIPCODE));
else if (ch2 == 'x' && readingpattern) return(unscale(unknown));
i = 0;
while ((ch2 >= '0' && ch2 <='9') || ch2 == '+' || ch2 == '-' ||
       ch2 == 'e' || ch2 == 'E' || ch2 == '.')
 {
  outstr[i] = ch2;
  i = i+1;
  ch2 = readch();
 };
outstr[i] = 0;
bufferptr = bufferptr - 1;
numread = sscanf(outstr,"%lf",&number);
if (numread == 0)
 {
  pg(stdout,"bad real value\n");
  readerror = 1;
  return(0.0);
 };
number = sign * number;
if (op == GT && number > min) return(number);
else if (op == GE && number >= min) return(number);
else
 {
  sprintf(outstr,"erroneous value: %f",number); pg(stdout,outstr);
  if (data == stdin) pg(stdout,"\n");
  else {sprintf(outstr," in %c command\n",command); pg(stdout,outstr);};
  readerror = 1;
  return(0.0);
 };
}

WTTYPE rdr(op,min,command) /* reads REAL real numbers and converts */
int op;                    /* them to 16-bit integers if necessary */
REAL min;
int command;
{
REAL x;
WTTYPE ix;
 
x = readreal(op,min,command);
if (readerror) return(0);
ix = scale(x);
if (readerror) return(0);
return(ix);
}

REAL readchar()   /* reads data in compressed format */
{
int ch2;
readerror = 0;
ch2 = readch();
do {
          switch (ch2) {
case '\n':
case ' ': ch2 = readch();
          break;
case '1': return(1.0);
case '0': return(0.0);
case 'X': return(unscale(CAPXCODE));
case 'x': return(unscale(unknown));
case '*': do ch2 = readch(); while(ch2 != '\n');
          break;
case 'H': return(unscale(CAPHCODE));
case 'h': return(unscale(HCODE));
case 's': return(unscale(SKIPCODE));
case 'd': return(unscale(DIFFCODE));
case EOF: readerror = 2;
          return(0.0);
case '}': readerror = 3;
          return(0.0);
default:  texterror();
          readerror = 1;
          return(0.0);};
} while (0 == 0);
}

void readapat(pn,relation,minimum,command,informat)
PATNODE *pn;
int relation;
REAL minimum;
int command;
char informat;
{
  REAL val;
  int unitnumber;
  UNIT *u;
  if (informat == 'r') val = rdr(relation,minimum,command);
  else val = scale(readchar());
  if (val == ICODE)
   {
    recurinit = '+';
    pn->layer = 1;
    pn->val = ICODE;
    unitnumber = readint(1,start->unitcount,'r');
    if (readerror != 0) return;
    pn->unitno = unitnumber;
    u = locateunit(1,unitnumber);
    pn->addr = &(u->oj);
   }
  else if (val == HCODE)
   {
    recurinit = '+';
    pn->addr = (WTTYPE *) -1;
    pn->layer = 2;
    pn->val = HCODE;
    pn->unitno = HCODE;
   }
  else if (val == CAPXCODE)
   {
    pn->addr = (WTTYPE *) -1;
    pn->layer = 2;
    pn->val = CAPXCODE;
    pn->unitno = CAPXCODE;
   }
  else if (val == CAPHCODE)
   {
    recurinit = '+';
    pn->addr = (WTTYPE *) -1;
    pn->layer = 2;
    pn->val = CAPHCODE;
    pn->unitno = CAPHCODE;
   }
  else if (val == OCODE)
   {
    recurinit = '+';
    pn->layer = nlayers;
    pn->val = OCODE;
    unitnumber = readint(1,last->unitcount,'r');
    if (readerror != 0) return;
    pn->unitno = unitnumber;
    u = locateunit((int) pn->layer,unitnumber);
    pn->addr = &(u->oj);
   }
  else if (val == SKIPCODE)
   {
    pn->addr = (WTTYPE *) -1;
    pn->layer = 0;
    pn->val = SKIPCODE;
    pn->unitno = SKIPCODE;
   }
  else if (val == DIFFCODE)
   {
    pn->addr = (WTTYPE *) -1;
    pn->layer = nlayers;
    pn->val = DIFFCODE;
    pn->unitno = DIFFCODE;
   }
  else
   {
    pn->addr = NULL;
    pn->val = val;
    pn->layer = 0;   /* unused */
    pn->unitno = 0;  /* unused */
   };
}

void readpatson(layer,list,command)
LAYER *layer;
int list;
int command;

{PATLIST *pl, *prev;
 PATNODE *pn;
 int i, answer, veclength;

pl = (PATLIST *) malloc(sizeof(PATLIST));
pl->next = NULL;
pl->pats = NULL;     /* no patterns read yet */
if (layer->patstart[list] == NULL)
 {
  prev = NULL;
  layer->patstart[list] = pl;
 }
else
 {
  prev = layer->currentpat[list];
  prev->next = pl;
 };
layer->currentpat[list] = pl;

veclength = layer->unitcount;
pn = (PATNODE *) malloc(veclength * sizeof(PATNODE));
pl->pats = pn;
if (layer == last && probtype == 'c')
 {
  answer = readint(1,veclength,command);
  if (readerror != 0) return;
  for (i=1;i<=veclength;i++)
   {
    if (i == answer) pn->val = classon; else pn->val = classoff;
    pn->addr = NULL;
    pn->layer = nlayers;
    pn->unitno = i;
    pn++;
   };
  return;
 };
for (i=1;i<=veclength;i++)
 {
  readapat(pn,GE,(REAL) HCODE,command,informat);
  if ((readerror == 3 || readerror == 2) && i == 1 && layer == start)
   {
    if (prev != NULL) prev->next = NULL;
    free(pn);
    free(pl);
    readerror = readerror + 2;
    return;
   }
  else if (readerror != 0) return;
  if (pn->unitno == CAPHCODE || pn->unitno == CAPXCODE) return; else pn++;
 };
return;
}

int readpats(list,command)
int list, command;
{ int i, j;
  PATLIST *pl;

/* look for scaling parameters, if any, in a TRAINing set */

if (list == TRAIN)
   {
    REAL temp;
    WTTYPE trans, sca;
    int ch1, ch2, k, col, nfactors;
    UNIT *u;
    ch1 = readch();
    if (ch1 == '\n') ch1 = readch();
    ch2 = readch();
    if (ch1 != '*' || ch2 != '$') bufferptr = bufferptr - 2;
    else /* there are scaling parameters */
       {
        nfactors = readint(0,MAXINT,'r');
        do ch1 = readch(); while (ch1 != '\n');
        u = start->units;
        for (k=1;k<=nfactors;k++)
           {
            if (u == NULL)
               {
                pg(stdout,"not enough input units for these patterns\n");
                exit(99);
               };
            ch1 = readch();
            ch2 = readch();
            if (ch1 != '*' || ch2 != '$')
               {
                pg(stdout,"error in input scaling list\n");
                goto readthepatterns;
               }
            else
               {
                col = readint(k,k,'r');
                if (readerror == 1)
                   {
                    pg(stdout,"error in scaling list\n");
                    goto readthepatterns;
                   };
                trans = rdr(GE,(REAL) -MAXINT,'r');
                if (readerror == 1)
                   {
                    pg(stdout,"error in scaling list\n");
                    goto readthepatterns;
                   }
                else u->translate = trans;
                sca = rdr(GE,(REAL) -MAXINT,'r');
                if (readerror == 1)
                   {
                    pg(stdout,"error in scaling list\n");
                    goto readthepatterns;
                   }
                else u->userscale = sca;
                u = u->next;
                do ch1 = readch(); while (ch1 != '\n');
               };
           };
/* do the output unit scaling factors if its not a classification problem */
        if (probtype != 'c')
           {
            u = last->units;
            for (k=1;k<=last->unitcount;k++)
               {
                ch1 = readch();
                ch2 = readch();
                if (ch1 != '*' || ch2 != '$')
                   {
                    pg(stdout,"error in output scaling list\n");
                    goto readthepatterns;
                   }
                else
                   {
                    col = readint(k,k,'r');
                    if (readerror == 1)
                       {
                        pg(stdout,"error in scaling list\n");
                        goto readthepatterns;
                       };
                    trans = rdr(GE,(REAL) -MAXINT,'r');
                    if (readerror == 1)
                       {
                        pg(stdout,"error in scaling list\n");
                        goto readthepatterns;
                       }
                    else u->translate = trans;
                    sca = rdr(GE,(REAL) -MAXINT,'r');
                    if (readerror == 1)
                       {
                        pg(stdout,"error in scaling list\n");
                        goto readthepatterns;
                       }
                    else u->userscale = sca;
                    u = u->next;
                    do ch1 = readch(); while (ch1 != '\n');
                   }; /* end else */
               }; /* end for */
       }; /* ends prob type */
     }; /* else there are scaling parameters */
   }; /* if its a training set file */

readthepatterns:
i = 0;
readerror = 0;
while (readerror == 0)
 {
  readpatson(start,list,command);
  if (readerror) break;
  readpatson(last,list,command);
  if (readerror) break;
  i = i + 1;
 };
if (readerror == 5) return(i);
else if (readerror == 4)
 {