drt@chinet.chi.il.us (Donald Tveter) (09/16/90)
Posting-number: Volume 14, Issue 85
Submitted-by: Donald Tveter <drt@chinet.chi.il.us>
Archive-name: back-prop/part02
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 2 (of 4)."
# Contents: bp.c
# Wrapped by drt@chinet on Fri Aug 31 08:17:40 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'bp.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'bp.c'\"
else
echo shar: Extracting \"'bp.c'\" \(36100 characters\)
sed "s/^X//" >'bp.c' <<'END_OF_FILE'
X/* ************************************************** */
X/* file bp.c: contains the main program and network */
X/* creation routines. */
X/* */
X/* Copyright (c) 1990 by Donald R. Tveter */
X/* */
X/* ************************************************** */
X
X#include <stdio.h>
X#include <malloc.h>
X#include <signal.h>
X#include <setjmp.h>
X#define SIGINT 2
X#define MAXINT 2147483647
X
X#ifdef INTEGER
X#include "ibp.h"
X#else
X#include "rbp.h"
X#endif
X
Xextern int rand(); /* built-in C function */
Xextern int srand(); /* built-in C function */
X
Xextern void forward(); /* from int.c or real.c */
X
X#ifdef INTEGER
Xextern int scale(); /* from io.c */
Xextern double unscale(); /* from io.c */
X#endif
X
Xextern int copyhidden(); /* from misc.c */
Xextern void findendofpats(); /* from misc.c */
Xextern void help(); /* from io.c */
Xextern void kick(); /* from misc.c */
Xextern void nullpatterns(); /* from misc.c */
Xextern void printoutunits(); /* from misc.c */
Xextern void printpats(); /* from misc.c */
Xextern void printweights(); /* from io.c */
Xextern void run(); /* from misc.c */
Xextern WTTYPE rdr(); /* from io.c */
Xextern int readch(); /* from io.c */
Xextern double readchar(); /* from io.c */
Xextern int readint(); /* from io.c */
Xextern void restoreweights();/* from io.c */
Xextern void saveweights(); /* from io.c */
Xextern void texterror(); /* from io.c */
Xextern void whittle(); /* from misc.c */
X
X/* global variables used in all versions */
X
Xchar activation; /* activation function, p or s */
XWTTYPE alpha; /* momentum term */
Xchar backprop; /* flags whether to back propagate error for */
X /* units close to their targets */
Xint bufferend; /* index of last character in input line */
Xint bufferptr; /* position of next character in buffer */
Xchar buffer[buffsize];/* holds contents of one input line */
Xint ch; /* general purpose character variable */
Xchar cmdfilename[50]; /* name of file to take extra commands from */
Xjmp_buf cmdloopstate; /* to save state in case of a SIGINT */
XWTTYPE D; /* sigmoid sharpness */
XFILE *data; /* file for original data */
Xchar datafilename[50];/* copy of the data file name saved here */
XWTTYPE dbdeta; /* the initial eta value for the DBD method */
XWTTYPE decay; /* the decay parameter for the DBD method */
Xchar deriv; /* flags type of derivative to use */
Xint echo; /* controls echoing of characters during input */
XWTTYPE eta; /* basic learning rate */
XWTTYPE eta2; /* DSZ learning rate for inner layers */
XWTTYPE etamax; /* the maximum eta for the DBD method */
Xint extraconnect; /* flags the use of connections between */
X /* non-adjacent layers */
Xint format[maxformat];/* each value in format indicates where to put */
X /* a blank for compressed output mode or a */
X /* carriage return for real output */
XUNIT *hlayer; /* pointer to list of units in second layer */
XUNIT *ilayer; /* pointer to list of units in third layer */
Xchar informat; /* controls format to read numbers */
XWTTYPE initialkick; /* the range weights are initialized to */
Xint iter; /* for counting iterations in one run */
XUNIT *jlayer; /* pointer to list of units in fourth layer */
XWTTYPE kappa; /* the DBD learning parameter */
XUNIT *klayer; /* pointer to list of units in fifth layer */
XLAYER *last; /* has address of the output layer */
Xint lastprint; /* last iteration pattern responses printed */
Xint lastsave; /* last time weights were saved */
Xshort nlayers; /* number of layers in network */
Xint npats; /* number of patterns currently in use */
Xchar outformat; /* controls format to print output */
Xint prevnpats; /* previous number of patterns, initially 0 */
XWTTYPE qmark; /* value for ? in compressed input */
Xint readerror; /* flags an error in reading a value */
Xint readingpattern; /* flags reading pattern state */
Xint saverate; /* rate at which to save weights */
Xunsigned seed; /* seed for generating random weights */
Xshort skiprate; /* number of times to bypass a learned pattern */
XLAYER *start; /* has address of the input layer */
Xchar summary; /* flags summary output mode */
XWTTYPE theta1; /* the DBD parameter */
XWTTYPE theta2; /* 1 - theta1 */
XWTTYPE toler; /* value used in testing for completion */
XWTTYPE toosmall; /* weights smaller than toosmall were removed */
X#ifdef INTEGER
Xint totaldiff; /* totals errors to find average error per unit */
X#else
Xdouble totaldiff;
X#endif
Xint totaliter; /* counts total iterations for the program */
Xint unlearnedpats; /* number unlearned in last learning cycle */
Xchar update; /* flags type of update rule to use */
Xchar wtformat; /* controls format to save and restore weights */
XWTTYPE wtlimit; /* adjustable limit on weights */
Xchar wtlimithit; /* flags whether the limit has been hit */
Xint wttotal; /* total number of weights in use */
X
X/* global variable for the symmetric integer version */
X
X#ifdef SYMMETRIC
XWTTYPE stdthresh; /* the standard threshold weight value */
X#endif
X
XUNIT *locateunit(layerno,unitno) /* given a layer number and unit */
Xint layerno, unitno; /* number this routine returns the */
X{int i; /* address of the unit */
X UNIT *u;
X LAYER *layer;
X
X if (layerno >= 1 && layerno <= nlayers)
X {
X layer = start;
X for(i=1;i<=(layerno-1);i++) layer = layer->next;
X u = (UNIT *) layer->units;
X while (u != NULL && u->unitnumber != unitno) u = u->next;
X if (u == NULL)
X printf("there is no unit %3d in layer %3d\n",unitno,layerno);
X }
X else
X {
X printf("there is no layer %3d\n",layerno);
X return(NULL);
X };
X return(u);
X}
X
X#ifdef SYMMETRIC
X
Xint wtaddress(i,j,biasunit,type,size) /* Returns the address of a */
Xint i,j; /* weight (1), olddw (2), */
Xint biasunit; /* eta (3) or total (4). */
Xint type; /* One is created if it */
Xint size; /* doesn't already exist. */
X
X{ int k, addr;
X UNIT *u;
X WTNODE *w;
X
X if (biasunit == 1) addr = (int) malloc(size);
X else if (j >= i) addr = (int) malloc(size);
X else /* the item already exists, so find its address */
X {
X u = locateunit(2,j);
X w = (WTNODE *) u->wtlist;
X k = 1;
X while (k < i)
X {
X w = w->next;
X k = k + 1;
X };
X if (type == 1) addr = (int) w->weight;
X else if (type == 2) addr = (int) w->olddw;
X else if (type == 3) addr = (int) w->eta;
X else addr = (int) w->total;
X };
X return(addr);
X}
X
Xvoid setweight(w,i,j,biasunit) /* set initial values in w */
XWTNODE *w;
Xint i, j;
Xint biasunit;
X{WTTYPE *s;
X
X s = (WTTYPE *) wtaddress(i,j,biasunit,1,WTSIZE);
X *s = 0;
X w->weight = s;
X s = (WTTYPE *) wtaddress(i,j,biasunit,2,WTSIZE);
X *s = 0;
X w->olddw = s;
X s = (WTTYPE *) wtaddress(i,j,biasunit,3,WTSIZE);
X *s = eta;
X w->eta = s;
X#ifdef INTEGER
X w->total = (int *) wtaddress(i,j,biasunit,4,sizeof(int));
X#else
X w->total = (double *) wtaddress(i,j,biasunit,4,WTSIZE);
X#endif
X}
X
X#else
X
Xvoid setweight(w,i,j,biasunit) /* set initial values in w */
XWTNODE *w;
Xshort i,j;
Xint biasunit;
X{
X w->weight = 0;
X w->olddw = 0;
X w->eta = dbdeta;
X}
X
X#endif
X
XLAYER *mklayer(prevlayer,n) /* creates a layer of n units, pointers */
XLAYER *prevlayer; /* and weights back to the units in the */
Xint n; /* previous layer and links this new */
X /* layer into the list of layers */
X{UNIT *front, *p, *q, *bias, *prev, *ptr;
X WTNODE *wfront, *wprev, *w;
X LAYER *lptr;
X int i, j, count;
X
X/* make a list of nodes in this layer */
X
X count = 1;
X front = (UNIT *) malloc(sizeof(UNIT));
X front->unitnumber = count;
X front->layernumber = nlayers;
X prev = front;
X for(i=1;i<n;i++)
X {
X count = count + 1;
X ptr = (UNIT *) malloc(sizeof(UNIT));
X prev->next = ptr;
X ptr->unitnumber = count;
X ptr->layernumber = nlayers;
X prev = ptr;
X };
X prev->next = NULL;
X
X/* make a LAYER node to point to this list of units */
X
X lptr = (LAYER *) malloc(sizeof(LAYER));
X lptr->unitcount = n;
X lptr->patstart = NULL;
X lptr->currentpat = NULL;
X lptr->backlayer = prevlayer;
X lptr->next = NULL;
X (UNIT *) lptr->units = front; /* connect the list of units */
X
X/* return if this is the input layer */
X
X if (prevlayer == NULL) return(lptr);
X prevlayer->next = lptr;
X
X/* If we are working on a deeper layer, for every node in this layer, */
X/* create a linked list back to units in the previous layer. */
X
X i = 1;
X q = front;
X while (q != NULL) /* do a unit */
X {
X j = 1; /* handle first connection */
X p = (UNIT *) prevlayer->units;
X wfront = (WTNODE *) malloc(sizeof(WTNODE));
X wttotal = wttotal + 1;
X (WTNODE *) q->wtlist = wfront;
X wprev = wfront;
X (UNIT *) wfront->backunit = p;
X setweight(wfront,i,j,0);
X p = p->next;
X while (p != NULL) /* handle rest of connections */
X {
X j = j + 1;
X w = (WTNODE *) malloc(sizeof(WTNODE));
X wttotal = wttotal + 1;
X wprev->next = w;
X (UNIT *) w->backunit = p;
X setweight(w,i,j,0);
X wprev = w;
X p = p->next;
X };
X j = j + 1;
X bias = (UNIT *) malloc(sizeof(UNIT)); /* create a bias unit */
X bias->oj = scale(1.0);
X bias->layernumber = nlayers;
X bias->unitnumber = 32767; /* bias unit is unit 32767 */
X w = (WTNODE *) malloc(sizeof(WTNODE)); /* connect to end of list */
X wttotal = wttotal + 1;
X wprev->next = w;
X (UNIT *) w->backunit = bias;
X setweight(w,n+2,i,1);
X w->next = NULL;
X q = q->next;
X i = i + 1;
X };
X return(lptr);
X}
X
X#ifndef SYMMETRIC
X
Xvoid connect(a,b,range) /* add a connection from unit a to unit b */
XUNIT *a, *b; /* connections go in increasing order */
XWTTYPE range;
X
X{WTNODE *wnew, *w, *wprev;
X UNIT *wunit;
X int farenough;
X
X wnew = (WTNODE *) malloc(sizeof(WTNODE));
X wttotal = wttotal + 1;
X wnew->eta = dbdeta;
X wnew->weight = range * rand() / 32768;
X if (rand() > 16383) wnew->weight = -wnew->weight;
X wnew->olddw = 0;
X (UNIT *) wnew->backunit = a;
X w = (WTNODE *) b->wtlist;
X wprev = NULL;
X wunit = (UNIT *) w->backunit;
X farenough = 0; /* insert the weight in order */
X while (w != NULL && !farenough)
X if (wunit->layernumber > a->layernumber) farenough = 1;
X else if (wunit->layernumber == a->layernumber)
X {
X while (w != NULL && !farenough)
X {
X if (wunit->unitnumber < a->unitnumber &&
X wunit->layernumber == a->layernumber)
X {
X wprev = w;
X w = w->next;
X wunit = (UNIT *) w->backunit;
X }
X else farenough = 1;
X };
X }
X else
X {
X wprev = w;
X w = w->next;
X wunit = (UNIT *) w->backunit;
X }
X if (wprev == NULL)
X {
X wnew->next = w;
X (WTNODE *) b->wtlist = wnew;
X }
X else
X {
X wnew->next = w;
X wprev->next = wnew;
X };
X}
X
Xvoid addhiddenunit(layerno,range)
Xint layerno; /* add hidden unit to end of the layer */
XWTTYPE range;
X{
X LAYER *lptr, *prevlayer, *nextlayer;
X UNIT *u, *prevu, *p, *bias;
X WTNODE *wnode;
X int i, unitno;
X
X lptr = start;
X for (i=1;i <= (layerno - 1); i++) lptr = lptr->next;
X unitno = lptr->unitcount;
X lptr->unitcount = unitno + 1;
X prevu = locateunit(layerno,unitno);
X if (prevu == NULL) return;
X u = (UNIT *) malloc(sizeof(UNIT));
X prevu->next = u;
X u->next = NULL;
X u->unitnumber = unitno + 1;
X u->layernumber = layerno;
X bias = (UNIT *) malloc(sizeof(UNIT));
X bias->oj = scale(1.0);
X bias->layernumber = layerno;
X bias->unitnumber = 32767; /* bias unit is unit 32767 */
X wnode = (WTNODE *) malloc(sizeof(WTNODE));
X wttotal = wttotal + 1;
X wnode->weight = range * rand() / 32768;
X if (rand() > 16383) wnode->weight = -wnode->weight;
X wnode->olddw = 0;
X wnode->eta = dbdeta;
X wnode->next = NULL;
X (UNIT *) wnode->backunit = bias;
X (WTNODE *) u->wtlist = wnode;
X prevlayer = lptr->backlayer;
X p = (UNIT *) prevlayer->units;
X while (p != NULL)
X {
X connect(p,u,range);
X p = p->next;
X };
X nextlayer = lptr->next;
X p = (UNIT *) nextlayer->units;
X while (p != NULL)
X {
X connect(u,p,range);
X p = p->next;
X };
X}
X
X#endif
X
Xvoid readpatson(layer,command) /* reads the patterns for layer */
XLAYER *layer;
Xint command;
X
X{PATNODE *p, *prevp;
X PATLIST *pl;
X int i;
X
X pl = (PATLIST *) malloc(sizeof(PATLIST));
X pl->next = NULL;
X pl->bypass = 0; /* number of times to bypass this pattern */
X pl->pats = NULL; /* no patterns read yet */
X if (layer->patstart == NULL) (PATLIST *) layer->patstart = pl;
X else layer->currentpat->next = pl;
X layer->currentpat = pl;
X
X prevp = NULL; /* read in each number */
X for (i=1;i<=layer->unitcount;i++)
X {
X p = (PATNODE *) malloc(sizeof(PATNODE));
X if (informat == 'r') p->val = rdr(GE,(double) HCODE,command);
X else p->val = scale(readchar());
X if (readerror == 1)
X {
X printf("pattern not read\n");
X return;
X };
X p->next = NULL;
X if (prevp == NULL) pl->pats = p; else prevp->next = p;
X prevp = p;
X };
X}
X
Xvoid readpats(new,command) /* reads the input and output patterns */
Xint new;
Xint command;
X{ int i;
X PATLIST *pl;
X
X for (i=prevnpats + 1;i<=npats;i++)
X {
X readpatson(start,command);
X if (readerror == 1) goto failure;
X readpatson(last,command);
X if (readerror == 1) goto failure;
X };
X return;
Xfailure:
X if (data != stdin)
X {
X printf("error while reading pattern %d\n",i);
X exit(5);
X };
X if (new == 0)
X {
X resetpats();
X for (i=1;i<prevnpats;i++) setonepat();
X pl = (PATLIST *) start->currentpat;
X pl->next = NULL;
X pl = (PATLIST *) last->currentpat;
X pl->next = NULL;
X };
X printf("no patterns added\n");
X printf("%d patterns in use\n",prevnpats);
X npats = prevnpats;
X}
X
Xvoid init() /* initializes almost everything */
X{int i;
X
X activation = 'p'; /* piece-wise activation function */
X alpha = scale(0.5);
X backprop = 1; /* always back-propagate errors */
X bufferend = 0;
X bufferptr = buffsize + 1;
X ch = ' ';
X D = scale(1.0);
X dbdeta = scale(0.5);
X decay = scale(0.5);
X deriv = 'f'; /* use Fahlman's derivative */
X eta = scale(0.5);
X eta2 = scale(0.05);
X etamax = scale(30.0);
X extraconnect = 0;
X format[0] = 0; /* set default places for breaks in output patterns */
X for(i=1;i<=maxformat-1;i++) format[i] = format[i-1] + 10;
X informat = 'c'; /* input format is compressed */
X initialkick = -1; /* weights have not been kicked yet */
X kappa = scale(0.5);
X lastprint = 0;
X lastsave = 0;
X outformat = 'r'; /* output format is real */
X skiprate = 0;
X prevnpats = 0;
X qmark = scale(0.5);
X saverate = 100000; /* effectively, never save weights */
X seed = 0;
X#ifdef SYMMETRIC
X stdthresh = -32768; /* indicates no threshold set */
X#endif
X summary = '-'; /* don't summarize learning */
X theta1 = scale(0.5);
X theta2 = scale(1.0) - theta1;
X toler = scale(0.1);
X toosmall = -1; /* indicates no weights whittled away */
X totaliter = 0;
X update = 'o'; /* update formulas are the original */
X wtformat = 'r'; /* save weights in real format */
X wtlimit = scale(0.0); /* no limit on weights */
X wtlimithit = 0; /* weight limit not yet hit */
X wttotal = 0;
X}
X
Xvoid restartcmdloop() /* for a SIGINT, restart in cmdloop */
X{
X if (data != stdin) ch = EOF;
X signal(SIGINT,restartcmdloop);
X longjmp(cmdloopstate,1);
X}
X
Xvoid cmdloop() /* read commands and process them */
X{
X int finished, layerno, unitno, layer1, layer2, node1, node2;
X int i, itemp, itemp2;
X WTTYPE temp, temp2;
X UNIT *u, *n1, *n2, *hunit, *iunit, *junit, *kunit;
X LAYER *p;
X char string[81];
X WTNODE *w;
X
X setjmp(cmdloopstate); /* position to recover from SIGINT */
X finished = 0; /* loop until finished == 1 */
X do{
Xrestart:
X#ifdef SYMMETRIC
X if (data == stdin) printf("[?!*AabCEefHhijklmnoPpQqRrSsTtWwx]? ");
X#else
X if (data == stdin) printf("[?!*AabCcEefHhijklmnoPpQqRrSstWwx]? ");
X#endif
X while(ch == ' ' || ch == '\n') ch = readch();
X switch (ch) {
Xcase EOF: if (data == stdin) exit(6); else data = stdin;
X printf("taking commands from stdin now\n");
X bufferend = 0; /* force a read from stdin */
X bufferptr = buffsize + 1; /* when readch is called */
X ch = ' ';
X goto restart;
Xcase '?': printf("\n%d iterations, s %1d ",totaliter,seed);
X printf("k 0 %5.3lf, ",unscale(initialkick));
X printf("file = %s\n",datafilename);
X printf("Algorithm: a%c",activation);
X if (backprop) printf(" b+"); else printf(" b-");
X printf(" D%5.2lf d%c ",unscale(D),deriv);
X printf("l%6.2lf s%1d u%c\n",unscale(wtlimit),skiprate,update);
X printf("e %7.5lf %7.5lf",unscale(eta),unscale(eta2));
X printf(" --- a %7.5lf\n",unscale(alpha));
X printf("j d %8.5lf e %8.5lf",unscale(decay),unscale(dbdeta));
X printf(" k %8.5lf m %8.5lf",unscale(kappa),unscale(etamax));
X printf(" t %8.5lf\n",unscale(theta1));
X printf("tolerance = %4.2lf\n",unscale(toler));
X printf("f i%c o%c",informat,outformat);
X printf(" s%c w%c\n",summary,wtformat);
X printf("format breaks after: ");
X for (i=1;i<=10;i++) printf("%4d",format[i]);
X printf("\n ");
X for (i=11;i<=maxformat-1;i++) printf("%4d",format[i]);
X printf("\nlast time weights were saved: %d\n",lastsave);
X printf("saving weights every %d iterations\n",saverate);
X if (wtlimithit) printf(">>>>> WEIGHT LIMIT HIT <<<<<\n");
X printf("network size: ");
X p = start;
X while (p != NULL)
X {
X printf(" %1d",p->unitcount);
X p = p->next;
X };
X if (extraconnect == 1) printf(" with extra connections");
X printf(" (total: %1d weights)\n",wttotal);
X if (toosmall != -1)
X {
X printf("removed non-bias weights with absolute ");
X printf("value below %4.2lf\n",unscale(toosmall));
X };
X#ifdef SYMMETRIC
X if (stdthresh != -32768)
X printf("thresholds frozen at %lf\n", unscale(stdthresh));
X#endif
X printf("%d patterns ",npats);
X printf("%d learned ",npats-unlearnedpats);
X printf("%d unlearned on last pass\n",unlearnedpats);
X printf("? = %lf\n",unscale(qmark));
X printf("for help, type h followed by");
X printf(" the letter of the command\n\n");
X break;
Xcase '!': i = 0;
X ch = readch();
X while (ch != '\n' && i <= 80)
X {
X string[i] = ch;
X ch = readch();
X i = i + 1;
X };
X bufferptr = bufferptr - 1; /* ungetc(ch,data); */
X string[i] = '\0';
X system(string);
X break;
Xcase '*': break; /* * on a line is a comment */
Xcase 'A': while (ch != '\n' && ch != '*')
X {
X ch = readch();
X if (ch == 'a')
X {
X do ch = readch(); while (ch == ' ');
X if (ch == 'p') activation = 'p';
X#ifndef INTEGER
X else if (ch == 's') activation = 's';
X#endif
X else texterror();
X }
X else if (ch == 'b')
X {
X do ch = readch(); while (ch == ' ');
X if (ch == '+') backprop = 1;
X else if (ch == '-') backprop = 0;
X else texterror();
X }
X else if (ch == 'D')
X {
X temp = rdr(GT,0.0,'A');
X if (readerror == 0) D = temp;
X }
X else if (ch == 'd')
X {
X do ch = readch(); while (ch == ' ');
X if (ch == 'd' || ch == 'f' || ch == 'o') deriv = ch;
X else texterror();
X }
X else if (ch == 'l')
X {
X temp = rdr(GE,0.0,'A');
X if (readerror == 0)
X {
X wtlimit = temp;
X if (wtlimit == 0) wtlimithit = 0;
X };
X }
X else if (ch == 's')
X {
X itemp = readint(0,32767,'s');
X if (readerror == 0) skiprate = itemp;
X }
X else if (ch == 'u')
X {
X do ch = readch(); while (ch == ' ');
X if (ch == 'c' || ch == 'C' || ch == 'd' ||
X ch == 'j' || ch == 'o') update = ch;
X else texterror();
X }
X else if (ch == '*' || ch == '\n' || ch == ' ');
X else texterror();
X }
X bufferptr = bufferptr - 1;
X break;
Xcase 'a': temp = rdr(GE,0.0,'a');
X if (readerror == 0) alpha = temp;
X break;
Xcase 'b': itemp = 0;
X ch = readch();
X while (ch != '\n' && ch != '*')
X {
X bufferptr = bufferptr - 1;
X itemp2 = readint(format[itemp],MAXINT,'b');
X if (readerror == 1) goto endb;
X itemp = itemp + 1;
X if (itemp < maxformat) format[itemp] = itemp2;
X else printf("format too long\n");
X ch = readch();
X while (ch == ' ') ch = readch();
X /* if its the start of a number, back up */
X if (ch != '\n') bufferptr = bufferptr - 1;
X };
X if (itemp < maxformat-1)
X for (i=itemp+1;i <= maxformat-1; i++)
X format[i] = format[i-1] + 10;
X bufferptr = bufferptr - 1;
X endb: break;
Xcase 'C': if (toosmall != -1)
X {
X printf("cannot restart with the weights removed\n");
X break;
X };
X wtlimithit = 0;
X totaliter = 0;
X lastsave = 0;
X initialkick = -1;
X lastprint = 0;
X seed = 0;
X p = start->next;
X while (p != NULL)
X {
X u = (UNIT *) p->units;
X while (u != NULL)
X {
X w = (WTNODE *) u->wtlist;
X while (w != NULL)
X {
X#ifdef SYMMETRIC
X if (w->next != NULL)
X { /* skip threshold weight */
X *(w->weight) = 0;
X *(w->olddw) = 0;
X *(w->eta) = dbdeta;
X };
X#else
X w->weight = 0;
X w->olddw = 0;
X w->eta = dbdeta;
X#endif
X w = w->next;
X };
X u = u->next;
X };
X p = p->next;
X };
X break;
X#ifndef SYMMETRIC
Xcase 'c': layer1 = readint(1,nlayers,'c');
X if (readerror == 1) break;
X node1 = readint(1,MAXINT,'c');
X if (readerror == 1) break;
X layer2 = readint(1,nlayers,'c');
X if (readerror == 1) break;
X node2 = readint(1,MAXINT,'c');
X if (readerror == 1) break;
X if (layer1 >= layer2)
X {
X printf("backward connections in c command not");
X printf(" implemented\n");
X break;
X };
X n1 = locateunit(layer1,node1);
X n2 = locateunit(layer2,node2);
X if (n1 != NULL && n2 != NULL)
X {
X connect(n1,n2,0);
X extraconnect = 1;
X }
X else printf("connection not made: %d %d %d %d\n",
X layer1, node1, layer2, node2);
X break;
X#endif
X
Xcase 'E': itemp = readint(0,1,'E');
X if (readerror == 1) break;
X else echo = itemp;
X break;
Xcase 'e': temp = rdr(GT,0.0,'e');
X if (readerror == 0) eta = temp;
X while (ch == ' ') ch = readch();
X if (ch != '\n' && ch != '*')
X {
X bufferptr = bufferptr - 1;
X temp = rdr(GT,0.0,'r');
X if (readerror != 1) eta2 = temp;
X }
X else eta2 = eta / 10;
X bufferptr = bufferptr - 1;
X break;
Xcase 'f': while (ch != '\n' && ch != '*')
X {
X ch = readch();
X if (ch == 'i')
X {
X do ch = readch(); while (ch == ' ');
X if (ch == 'c' || ch == 'r') informat = ch;
X else texterror();
X }
X else if (ch == 'o')
X {
X do ch = readch(); while (ch == ' ');
X if (ch == 'a' || ch == 'c' || ch == 'r') outformat = ch;
X else texterror();
X }
X else if (ch == 's')
X {
X do ch = readch(); while (ch == ' ');
X if (ch == '+' || summary == '-') summary = ch;
X else texterror();
X }
X else if (ch == 'w')
X {
X do ch = readch(); while (ch == ' ');
X if (ch == 'r' || ch == 'R' || ch == 'b' || ch == 'B')
X wtformat = ch;
X else texterror();
X }
X else if (ch == ' ' || ch == '*' || ch == '\n');
X else texterror();
X }
X bufferptr = bufferptr - 1;
X break;
X#ifndef SYMMETRIC
Xcase 'H': itemp = readint(2,nlayers,'H');
X if (readerror == 1) break;
X temp = rdr(GE,0.0,'H');
X if (readerror == 0) addhiddenunit(itemp,temp);
X break;
X#endif
Xcase 'h': help();
X break;
Xcase 'i': ch = readch();
X while(ch == ' ') ch = readch();
X itemp = 0;
X while(ch != ' ' && ch != '\n' && itemp < 49)
X {
X cmdfilename[itemp] = ch;
X itemp = itemp + 1;
X ch = readch();
X };
X cmdfilename[itemp] = '\0';
X if ((data = fopen(cmdfilename,"r")) == (FILE *) NULL)
X {
X printf("cannot open: %s\n",cmdfilename);
X data = stdin;
X printf("taking commands from stdin now\n");
X }
X bufferend = 0;
X bufferptr = buffsize + 1;
X ch = ' ';
X goto restart;
Xcase 'j': while (ch != '\n' && ch != '*')
X {
X ch = readch();
X if (ch == 'd')
X {
X temp = rdr(GT,0.0,'j');
X if (readerror == 0) decay = temp;
X }
X else if (ch == 'e')
X {
X temp = rdr(GT,0.0,'d');
X if (readerror == 0)
X {
X dbdeta = temp;
X p = start->next;
X while (p != NULL)
X {
X u = (UNIT *) p->units;
X while (u != NULL)
X {
X w = (WTNODE *) u->wtlist;
X while (w != NULL)
X {
X#ifdef SYMMETRIC
X *(w->eta) = dbdeta;
X#else
X w->eta = dbdeta;
X#endif
X w = w->next;
X }
X u = u->next;
X }
X p = p->next;
X }
X }
X }
X else if (ch == 'k')
X {
X temp = rdr(GT,0.0,'j');
X if (readerror == 0) kappa = temp;
X }
X else if (ch == 'm')
X {
X temp = rdr(GT,0.0,'j');
X if (readerror == 0) etamax = temp;
X }
X else if (ch == 't')
X {
X temp = rdr(GE,0.0,'j');
X if (readerror == 0)
X {
X theta1 = temp;
X theta2 = scale(1.0) - theta1;
X };
X }
X else if (ch == '*' || ch == '\n' || ch == ' ');
X else texterror();
X }
X bufferptr = bufferptr - 1;
X break;
Xcase 'k': temp = rdr(GE,0.0,'k');
X if (readerror == 1) break;
X temp2 = rdr(GT,0.0,'k');
X if (readerror == 0)
X {
X if (initialkick == -1 && temp == 0) initialkick = temp2;
X kick(temp,temp2);
X }
X break;
Xcase 'l': layerno = readint(1,nlayers,'l');
X if (readerror == 1) break;
X p = start;
X for (i=2;i<=layerno;i++) p = p->next;
X printoutunits(p,0);
X break;
Xcase 'm': nlayers = 0;
X ch = readch();
X p = NULL;
X while (ch != '\n' && ch != '*')
X {
X itemp = readint(1,MAXINT,'m');
X if (readerror == 1) goto endm;
X nlayers = nlayers + 1;
X p = mklayer(p,itemp);
X if (nlayers == 1) start = p;
X ch = readch();
X while (ch == ' ') ch = readch();
X /* if its the start of a number, back up */
X if (ch != '\n') bufferptr = bufferptr - 1;
X };
X last = p;
X p = start;
X p = p->next;
X hlayer = (UNIT *) p->units;
X p = p->next;
X if (p != NULL)
X {
X ilayer = (UNIT *) p->units;
X p = p->next;
X if (p != NULL)
X {
X jlayer = (UNIT *) p->units;
X p = p->next;
X if (p != NULL) klayer = (UNIT *) p->units;
X }
X };
X bufferptr = bufferptr - 1;
X nullpatterns();
X endm: break;
Xcase 'n': if (start == NULL)
X {
X printf("the network must be defined first\n");
X break;
X };
X itemp = readint(1,MAXINT,'n');
X if (readerror == 1) break;
X nullpatterns();
X npats = itemp;
X readingpattern = 1;
X readpats(1,'n');
X readingpattern = 0;
X unlearnedpats = npats;
X break;
Xcase 'o': do ch = readch(); while (ch == ' ' || ch == '\n');
X if (ch == 'r' || ch == 'a' || ch == 'c') outformat = ch;
X else printf("incorrect output format: %c\n",ch);
X break;
Xcase 'P': do ch = readch(); while (ch == ' ');
X bufferptr = bufferptr - 1;
X if (ch == '\n' || ch == '*') itemp = 0;
X else
X {
X itemp = readint(0,npats,'P');
X if (readerror == 1) break;
X };
X if (itemp == 0) printpats(1,npats,0,1,0);
X else printpats(itemp,itemp,0,1,0);
X break;
Xcase 'p': u = (UNIT *) start->units;
X readingpattern = 1;
X hunit = hlayer;
X iunit = ilayer;
X junit = jlayer;
X kunit = klayer;
X while (u != NULL)
X {
X if (informat == 'r') u->oj = rdr(GE,(double) HCODE,'p');
X else u->oj = scale(readchar());
X if (readerror == 1) goto endp;
X if (u->oj <= KCODE) /* do hidden unit codes */
X {
X if (u->oj == HCODE)
X {if (copyhidden(u,&hunit,2) == 1) goto endp;}
X else if (u->oj == ICODE)
X {if (copyhidden(u,&iunit,3) == 1) goto endp;}
X else if (u->oj == JCODE)
X {if (copyhidden(u,&junit,4) == 1) goto endp;}
X else if (copyhidden(u,&kunit,5) == 1) goto endp;
X };
X u = u->next;
X };
X forward();
X printoutunits(last,0);
X endp: readingpattern = 0;
X break;
Xcase 'Q': temp = rdr(GT,(double) KCODE,'Q');
X if (readerror == 0) qmark = temp;
X break;
Xcase 'q': finished = 1;
X break;
Xcase 'R': restoreweights();
X break;
Xcase 'r': if (start == NULL)
X {
X printf("the network must be defined first\n");
X break;
X };
X iter = readint(1,MAXINT,'r');
X if (readerror == 1) break;
X while (ch == ' ') ch = readch();
X if (ch != '\n' && ch != '*')
X {
X bufferptr = bufferptr - 1;
X itemp = readint(1,MAXINT,'r');
X if (readerror != 1) run(iter,itemp);
X }
X else run(iter,-1);
X bufferptr = bufferptr - 1;
X break;
Xcase 'S': do ch = readch(); while (ch == ' ');
X bufferptr = bufferptr - 1;
X if (ch == '\n' || ch == '*') itemp = 0;
X else
X {
X itemp = readint(0,MAXINT,'S');
X if (readerror == 1) break;
X };
X if (itemp == 0) saveweights();
X else saverate = itemp;
X break;
Xcase 's': seed = readint(0,MAXINT,'s');
X srand(seed);
X break;
X#ifdef SYMMETRIC
Xcase 'T': stdthresh = rdr(GT,-unscale(32767),'T');
X if (readerror == 1) break;
X u = (UNIT *) last->units;
X while (u != NULL)
X {
X w = (WTNODE *) u->wtlist;
X while (w->next != NULL) w = w->next;
X *(w->weight) = stdthresh;
X u = u->next;
X };
X break;
X#endif
Xcase 't': temp = rdr(GT,0.0,'t');
X if (readerror == 1) break;
X else if (temp < scale(1.0)) toler = temp;
X else printf("tolerance value out of range\n");
X break;
X#ifndef SYMMETRIC
Xcase 'W': temp = rdr(GT,0.0,'W');
X if (readerror == 0)
X {
X toosmall = temp;
X whittle(temp);
X printf("total weights now: %1d\n",wttotal);
X };
X break;
X#endif
Xcase 'w': layerno = readint(2,nlayers,'w');
X if (readerror == 1) break;
X unitno = readint(1,MAXINT,'w');
X if (readerror == 1) break;
X u = locateunit(layerno,unitno);
X if (u != NULL) printweights(u);
X break;
Xcase 'x': if (start == NULL)
X {
X printf("the network must be defined first\n");
X break;
X };
X itemp = readint(1,MAXINT,'x');
X if (readerror == 1) break;
X prevnpats = npats;
X npats = npats + itemp;
X findendofpats(start);
X findendofpats(last);
X readingpattern = 1;
X readpats(0,'x');
X readingpattern = 0;
X unlearnedpats = npats;
X break;
Xdefault : texterror();
X break;
X };
X ch = readch();
X while(ch != '\n') ch = readch();
X }while (finished == 0);
X}
X
Xvoid main(argc,argv)
Xint argc;
Xchar *argv[];
X{
X char *fnamestr, *i;
X
Xprintf("Fast Backpropagation Copyright (c) 1990 by Donald R. Tveter\n");
X
X setbuf(stdout,NULL); /* set unbuffered output */
X if (argc == 1) /* check for file argument, if any */
X {
X printf("missing data file name, stdin assumed\n");
X data = stdin;
X *datafilename = '\0';
X }
X else
X if ((data = fopen(argv[1],"r")) == (FILE *) NULL)
X {
X printf("cannot open: %s\n",argv[1]);
X exit(1);
X }
X else /* make a copy of the file name in a global variable */
X {
X fnamestr = argv[1];
X i = datafilename;
X while(*fnamestr != '\0') *i++ = *fnamestr++;
X };
X init();
X signal(SIGINT,restartcmdloop); /* restart from interrrupt */
X cmdloop();
X}
END_OF_FILE
if test 36100 -ne `wc -c <'bp.c'`; then
echo shar: \"'bp.c'\" unpacked with wrong size!
fi
# end of 'bp.c'
fi
echo shar: End of archive 2 \(of 4\).
cp /dev/null ark2isdone
MISSING=""
for I in 1 2 3 4 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 4 archives.
rm -f ark[1-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0