drt@chinet.chi.il.us (Donald Tveter) (09/16/90)
Posting-number: Volume 14, Issue 87
Submitted-by: Donald Tveter <drt@chinet.chi.il.us>
Archive-name: back-prop/part04
#! /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 4 (of 4)."
# Contents: int.c real.c misc.c
# Wrapped by drt@chinet on Fri Aug 31 08:18:36 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'int.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'int.c'\"
else
echo shar: Extracting \"'int.c'\" \(14277 characters\)
sed "s/^X//" >'int.c' <<'END_OF_FILE'
X/* *********************************************************** */
X/* file int.c: Contains the network evaluation and weight */
X/* adjustment procedures for the integer versions */
X/* bp and sbp. */
X/* */
X/* Copyright (c) 1990 by Donald R. Tveter */
X/* */
X/* The code here has been optimized for use with the Motorola */
X/* MC 68010 processor and version 3.5 of the UNIX (tm) PC */
X/* C compiler where UNIX is a trademark of Bell Laboratories. */
X/* *********************************************************** */
X
X#include "ibp.h"
X#include <stdio.h>
X
Xextern WTTYPE alpha;
Xextern char backprop;
Xextern WTTYPE D;
Xextern WTTYPE decay;
Xextern char deriv;
Xextern WTTYPE eta;
Xextern WTTYPE eta2;
Xextern WTTYPE etamax;
Xextern WTTYPE kappa;
Xextern LAYER *last;
Xextern LAYER *start;
Xextern WTTYPE theta1;
Xextern WTTYPE theta2;
Xextern WTTYPE toler;
Xextern int totaldiff;
Xextern char update;
X
Xvoid forward() /* computes unit activations */
X{
X register WTNODE *w;
X register UNIT *u;
X register UNIT *predu;
X LAYER *layer;
X register int sum;
X register int x;
X register short fract;
X register short val;
X register int intpart;
X
X layer = start->next;
X while (layer != NULL)
X {
X u = (UNIT *) layer->units;
X while (u != NULL)
X {
X sum = 0;
X w = (WTNODE *) u->wtlist;
X while (w != NULL)
X {
X predu = (UNIT *) w->backunit;
X#ifdef SMART
X# ifdef SYMMETRIC
X sum = sum + (*(w->weight) * predu->oj) / 1024;
X# else
X sum = sum + (w->weight * predu->oj) / 1024;
X# endif
X#else
X# ifdef SYMMETRIC
X x = (*(w->weight) * predu->oj);
X# else
X x = w->weight * predu->oj;
X# endif
X if (x >= 0) sum = sum + (x >> 10);
X else sum = sum - ( (-x) >> 10);
X#endif
X w = w->next;
X };
X sum = (D * sum) / 1024;
X if (sum > 0) x = sum; else x = -sum;
X intpart = x >> 10;
X fract = x - (intpart << 10);
X switch (intpart)
X {
X case 0: val = 512 + ((237 * fract) >> 10); /* 0 <= x < 1 */
X break;
X case 1: val = 748 + ((153 * fract) >> 10); /* 1 <= x < 2 */
X break;
X case 2: val = 901 + ((73 * fract) >> 10); /* 2 <= x < 3 */
X break;
X case 3:
X case 4: val = 976 + (((x - 3072) * 20) >> 10); /* 3 <= x < 5 */
X break;
X default: val = 1024; /* x >= 5 */
X };
X if (sum < 0) u->oj = 1024 - val; else u->oj = val;
X u = u->next;
X };
X layer = layer->next;
X };
X};
X
Xshort backoutput() /* computes weight changes from the output layer */
X{
X register short deltaj;
X register int temp;
X register short temp2;
X register short temp3;
X register short adiff;
X register UNIT *bunit;
X register WTNODE *w;
X register UNIT *u;
X register PATNODE *t;
X register short notclose;
X
X notclose = last->unitcount;
X u = (UNIT *) last->units;
X t = (PATNODE *) last->currentpat->pats;
X while (u != NULL)
X {
X temp3 = u->oj;
X temp2 = t->val - temp3;
X if (temp2 > 0) adiff = temp2; else adiff = -temp2;
X if (adiff < toler) notclose = notclose - 1;
X totaldiff = totaldiff + adiff;
X if (adiff >= toler || backprop) /* then compute errors */
X {
X if (deriv == 'd') /* diff. step size method */
X deltaj = temp2;
X else if (deriv == 'f') /* Fahlman's derivative */
X {
X temp = temp2 * (104448 + temp3 * ((short)(1024 - temp3)));
X if (temp > 0) deltaj = (temp + 524288) >> 20;
X else deltaj = -((524288 - temp) >> 20);
X }
X else /* the derivative in the original formula */
X {
X temp = temp2 * (temp3 * ((short)(1024 - temp3)));
X if (temp > 0) deltaj = (temp + 524288) >> 20;
X else deltaj = -((524288 - temp) >> 20);
X }
X w = (WTNODE *) u->wtlist;
X#ifdef SYMMETRIC
X while (w->next != NULL) /* skips threshold unit at end */
X#else
X while (w != NULL)
X#endif
X {
X bunit = (UNIT *) w->backunit;
X#ifdef SYMMETRIC
X *(w->total) = *(w->total) + deltaj * bunit->oj;
X#else
X w->total = w->total + deltaj * bunit->oj;
X if (bunit->layernumber > 1)
X bunit->error = bunit->error + deltaj * w->weight;
X#endif
X w = w->next;
X }
X };
X u = u->next;
X t = t->next;
X };
X return(notclose);
X}
X
X#ifndef SYMMETRIC
X
Xvoid backinner() /* Computes slopes and passes back */
X{ /* errors from hidden layers. */
X register short deltaj;
X register int temp;
X register short temp3;
X register UNIT *bunit;
X register WTNODE *w;
X register UNIT *u;
X LAYER *layer;
X
X layer = last->backlayer;
X while (layer->backlayer != NULL)
X {
X u = (UNIT *) layer->units;
X while (u != NULL)
X {
X temp3 = u->oj;
X if (deriv == 'f') /* Fahlman's derivative */
X temp = (((short)((temp3*((short)(1024-temp3))+512) >> 10))
X + 102) * u->error;
X else /* either for the original or diff. step size */
X temp = ((short)((temp3*((short)(1024-temp3))+512) >> 10))
X * u->error;
X if (temp > 0) deltaj = (temp + 524288) >> 20;
X else deltaj = -((524288 - temp) >> 20);
X w = (WTNODE *) u->wtlist;
X while (w != NULL)
X {
X bunit = (UNIT *) w->backunit;
X w->total = w->total + deltaj * bunit->oj;
X if (bunit->layernumber > 1)
X bunit->error = bunit->error + deltaj * w->weight;
X w = w->next;
X };
X u = u->next;
X };
X layer = layer->backlayer;
X };
X}
X
X#endif
X
Xvoid updatej() /* Jacob's delta-bar-delta method for weight updates */
X{
X register short rkappa;
X register short temp2;
X register short dbarm1;
X register short rdecay;
X register int temp;
X register UNIT *u;
X register WTNODE *w;
X LAYER *layer;
X
X/* w->olddw is used for delta-bar minus 1 */
X
X rkappa = kappa;
X rdecay = decay;
X layer = last;
X while (layer->backlayer != NULL)
X {
X u = (UNIT *) layer->units;
X while (u != NULL)
X {
X w = (WTNODE *) u->wtlist;
X while (w != NULL)
X {
X#ifdef SYMMETRIC
X if (((UNIT *) w->backunit)->unitnumber > u->unitnumber)
X {
X if (*(w->total) > 0) temp2 = (*(w->total) + 512) >> 10;
X else temp2 = -((512 - *(w->total)) >> 10);
X dbarm1 = *(w->olddw);
X temp = theta2 * temp2 + theta1 * dbarm1;
X if (temp > 0) *(w->olddw) = (temp + 512) >> 10;
X else *(w->olddw) = -((512 - temp) >> 10);
X if ((temp2 > 0) && (dbarm1 > 0))
X *(w->eta) = *(w->eta) + rkappa;
X else if ((temp2 < 0) && (dbarm1 < 0))
X *(w->eta) = *(w->eta) + rkappa;
X else if ((temp2 > 0) && (dbarm1 < 0))
X *(w->eta) = (*(w->eta) * rdecay) >> 10;
X else if ((temp2 < 0) && (dbarm1 > 0))
X *(w->eta) = (*(w->eta) * rdecay) >> 10;
X if (*(w->eta) > etamax) *(w->eta) = etamax;
X temp = temp2 * *(w->eta);
X if (temp > 0) temp2 = (temp + 512) >> 10;
X else temp2 = -((512 - temp) >> 10);
X *(w->weight) = *(w->weight) + temp2;
X };
X#else
X if (w->total > 0) temp2 = (w->total + 512) >> 10;
X else temp2 = -((512 - w->total) >> 10);
X dbarm1 = w->olddw;
X temp = theta2 * temp2 + theta1 * dbarm1;
X if (temp > 0) w->olddw = (temp + 512) >> 10;
X else w->olddw = -((512 - temp) >> 10);
X if (temp2 > 0 && dbarm1 > 0) w->eta = w->eta + rkappa;
X else if (temp2 < 0 && dbarm1 < 0) w->eta = w->eta + rkappa;
X else if (temp2 > 0 && dbarm1 < 0)
X w->eta = (w->eta * rdecay) >> 10;
X else if (temp2 < 0 && dbarm1 > 0)
X w->eta = (w->eta * rdecay) >> 10;
X if (w->eta > etamax) w->eta = etamax;
X temp = temp2 * w->eta;
X if (temp > 0) temp2 = (temp + 512) >> 10;
X else temp2 = -((512 - temp) >> 10);
X w->weight = w->weight + temp2;
X#endif
X w = w->next;
X };
X u = u->next;
X };
X layer = layer->backlayer;
X };
X}
X
Xvoid updateo() /* update weights for the original method */
X{ /* and the differential step size algorithm */
X register short reta;
X register short ralpha;
X register int temp;
X register UNIT *u;
X register WTNODE *w;
X LAYER *layer;
X
X ralpha = alpha;
X reta = eta;
X layer = last;
X while (layer->backlayer != NULL)
X {
X if (layer != last && update == 'd') reta = eta2;
X u = (UNIT *) layer->units;
X while (u != NULL)
X {
X w = (WTNODE *) u->wtlist;
X while (w != NULL)
X {
X#ifdef SYMMETRIC
X if (((UNIT *) w->backunit)->unitnumber > u->unitnumber)
X {
X if (*(w->total) > 0)
X temp = ((*(w->total) + 512) >> 10) * reta
X + ralpha * *(w->olddw);
X else temp = -((512 - *(w->total)) >> 10) * reta
X + ralpha * *(w->olddw);
X if (temp > 0) *(w->olddw) = (temp + 512) >> 10;
X else *(w->olddw) = -((512 - temp) >> 10);
X *(w->weight) = *(w->weight) + *(w->olddw);
X };
X#else
X if (w->total > 0)
X temp = ((w->total + 512) >> 10) * reta + ralpha * w->olddw;
X else
X temp = -((512 - w->total) >> 10) * reta + ralpha * w->olddw;
X if (temp > 0) w->olddw = (temp + 512) >> 10;
X else w->olddw = -((512 - temp) >> 10);
X w->weight = w->weight + w->olddw;
X#endif
X w = w->next;
X };
X u = u->next;
X };
X layer = layer->backlayer;
X };
X}
X
Xshort cbackoutput() /* The continuous update version */
X{ /* of back-propagation */
X register short deltaj;
X register int etadeltaj;
X register int temp;
X register int temp2;
X register short temp3;
X register short adiff;
X register UNIT *bunit;
X register WTNODE *w;
X register UNIT *u;
X register PATNODE *t;
X register short ralpha;
X register short notclose;
X
X ralpha = alpha;
X notclose = last->unitcount;
X u = (UNIT *) last->units;
X t = (PATNODE *) last->currentpat->pats;
X while (u != NULL)
X {
X temp3 = u->oj;
X temp2 = t->val - temp3;
X if (temp2 > 0) adiff = temp2; else adiff = -temp2;
X if (adiff < toler) notclose = notclose - 1;
X totaldiff = totaldiff + adiff;
X if (adiff >= toler || backprop)
X {
X if (deriv == 'd') /* the differential step size method */
X deltaj = temp2;
X else if (deriv == 'f') /* Fahlman's derivative */
X { /* deltaj = (t->val - u->oj) * [0.1 + u->oj*(1.0 - u->oj)] */
X temp = temp2 * (104448 + temp3 * ((short)(1024 - temp3)));
X if(temp > 0) deltaj = (temp + 524288) >> 20;
X else deltaj = -((524288 - temp) >> 20);
X }
X else /* the original derivative */
X { /* deltaj = (t->val - u->oj) * u->oj * (1.0 - u->oj) */
X temp = temp2 * (temp3 * ((short)(1024 - temp3)));
X if(temp > 0) deltaj = (temp + 524288) >> 20;
X else deltaj = -((524288 - temp) >> 20);
X };
X etadeltaj = deltaj * eta;
X w = (WTNODE *) u->wtlist;
X#ifdef SYMMETRIC
X while (w->next != NULL)
X#else
X while (w != NULL)
X#endif
X { /* get a slope for each weight */
X bunit = (UNIT *) w->backunit;
X temp = etadeltaj * bunit->oj;
X if(temp > 0) temp = (temp + 524288) >> 20;
X else temp = -((524288 - temp) >> 20);
X#ifdef SYMMETRIC
X temp2 = ralpha * *(w->olddw);
X#else
X temp2 = ralpha * w->olddw;
X#endif
X if (temp2 > 0) temp3 = temp + ((temp2 + 512) >> 10);
X else temp3 = temp - ((512 - temp2) >> 10);
X#ifdef SYMMETRIC
X *(w->olddw) = temp3;
X#else
X w->olddw = temp3;
X#endif
X /* w->weight = w->weight + w->olddw */
X#ifdef SYMMETRIC
X temp3 = *(w->weight) + temp3;
X *(w->weight) = temp3;
X#else
X temp3 = w->weight + temp3;
X w->weight = temp3;
X if (bunit->layernumber > 1)
X bunit->error = bunit->error + deltaj * temp3;
X#endif
X w = w->next;
X }
X }
X u = u->next;
X t = t->next;
X }
X return(notclose);
X}
X
X#ifndef SYMMETRIC
X
Xvoid cbackinner() /* Same as cbackoutput, except errors are */
X{ /* calculated differently */
X register short deltaj;
X register int etadeltaj;
X register int temp;
X register int temp2;
X register short temp3;
X register short reta;
X register short ralpha;
X register UNIT *bunit;
X register WTNODE *w;
X register UNIT *u;
X LAYER *layer;
X
X if (update == 'C') reta = eta2; else reta = eta;
X ralpha = alpha;
X layer = last->backlayer;
X while (layer->backlayer != NULL)
X {
X u = (UNIT *) layer->units;
X while (u != NULL)
X {
X temp3 = u->oj;
X if (deriv == 'f') /* Fahlman's derivative */
X temp = (((temp3 * ((short)(1024 - temp3)) + 512) >> 10) + 102)
X * u->error;
X else /* diff. step size and original derivative */
X temp = ((temp3 * ((short)(1024 - temp3)) + 512) >> 10)
X * u->error;
X if (temp > 0) deltaj = (temp + 524288) >> 20;
X else deltaj = -((524288 - temp) >> 20);
X etadeltaj = reta * deltaj;
X w = (WTNODE *) u->wtlist;
X while (w != NULL)
X {
X bunit = (UNIT *) w->backunit;
X temp = etadeltaj * bunit->oj;
X if (temp > 0) temp = (temp + 524288) >> 20;
X else temp = -((524288 - temp) >> 20);
X temp2 = ralpha * w->olddw;
X if (temp2 > 0) temp3 = temp + ((temp2 + 512) >> 10);
X else temp3 = temp - ((512 - temp2) >> 10);
X w->olddw = temp3;
X temp3 = w->weight + temp3;
X w->weight = temp3;
X if (bunit->layernumber > 1)
X bunit->error = bunit->error + deltaj * temp3;
X w = w->next;
X };
X u = u->next;
X };
X layer = layer->backlayer;
X };
X}
X
X#endif
END_OF_FILE
if test 14277 -ne `wc -c <'int.c'`; then
echo shar: \"'int.c'\" unpacked with wrong size!
fi
# end of 'int.c'
fi
if test -f 'real.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'real.c'\"
else
echo shar: Extracting \"'real.c'\" \(10454 characters\)
sed "s/^X//" >'real.c' <<'END_OF_FILE'
X/* *********************************************************** */
X/* file real.c: contains the network evaluation and weight */
X/* adjustment procedures for the 64-bit floating point program */
X/* */
X/* Copyright (c) 1990 by Donald R. Tveter */
X/* */
X/* *********************************************************** */
X
X#include "rbp.h"
X#include <stdio.h>
X
Xextern char activation;
Xextern double alpha;
Xextern char backprop;
Xextern double D;
Xextern double decay;
Xextern char deriv;
Xextern double eta;
Xextern double eta2;
Xextern double etamax;
Xextern double kappa;
Xextern LAYER *last;
Xextern LAYER *start;
Xextern double theta1;
Xextern double theta2;
Xextern double toler;
Xextern double totaldiff;
Xextern char update;
X
Xextern double exp(); /* a built-in function */
X
Xvoid forward() /* computes unit activations */
X{
X UNIT *u, *predu;
X LAYER *layer;
X WTNODE *b;
X double fract, x, val;
X double sum;
X int intpart;
X
X layer = start->next;
X while (layer != NULL)
X {
X u = (UNIT *) layer->units;
X while (u != NULL)
X {
X sum = 0.0;
X b = (WTNODE *) u->wtlist;
X while (b != NULL)
X {
X predu = (UNIT *) b->backunit;
X#ifdef SYMMETRIC
X sum = sum + *(b->weight) * predu->oj;
X#else
X sum = sum + b->weight * predu->oj;
X#endif
X b = b->next;
X };
X sum = sum * D;
X if (activation == 's') u->oj = 1.0 / (1.0 + exp(-sum));
X else
X { /* piecewise linear, the fast way */
X if (sum >= 0.0) x = sum; else x = - sum;
X intpart = x;
X fract = x - intpart;
X switch (intpart)
X {
X case 0: val = 0.5 + 0.231 * fract; /* 0 <= x < 1 */
X break;
X case 1: val = 0.731059 + 0.149738 * fract; /* 1 <= x < 2 */
X break;
X case 2: val = 0.880797 + 0.071777 * fract; /* 2 <= x < 3 */
X break;
X case 3:
X case 4: val = 0.9525741 + (x - 3.0) * 0.02; /* 3 <= x < 5 */
X break;
X default: val = 1.0; /* x >= 5 */
X };
X if (sum < 0.0) u->oj = 1.0 - val; else u->oj = val;
X } /* end of the fast way */
X u = u->next;
X };
X layer = layer->next;
X };
X}
X
Xshort backoutput() /* back propagate errors from the output units */
X{ /* send down errors for any previous layers */
X double deltaj, diff, adiff;
X register UNIT *u, *bunit;
X register WTNODE *w;
X register PATNODE *t;
X register short notclose;
X
X notclose = last->unitcount;
X u = (UNIT *) last->units;
X t = (PATNODE *) last->currentpat->pats;
X while (u != NULL)
X {
X diff = t->val - u->oj;
X if (diff > 0) adiff = diff; else adiff = -diff;
X if (adiff < toler) notclose = notclose - 1;
X totaldiff = totaldiff + adiff;
X if (adiff >= toler || backprop)
X {
X if (deriv == 'd') /* differential step size */
X deltaj = diff;
X else if (deriv == 'f') /* Fahlman's derivative */
X deltaj = diff * (0.1 + u->oj * (1.0 - u->oj));
X else /* the original derivative */
X deltaj = diff * u->oj * (1.0 - u->oj);
X w = (WTNODE *) u->wtlist;
X#ifdef SYMMETRIC
X while (w->next != NULL)
X#else
X while (w != NULL)
X#endif
X {
X bunit = (UNIT *) w->backunit;
X#ifdef SYMMETRIC
X *(w->total) = *(w->total) + deltaj * bunit->oj;
X#else
X w->total = w->total + deltaj * bunit->oj;
X if (bunit->layernumber > 1) /* pass back the error */
X bunit->error = bunit->error + deltaj * w->weight;
X#endif
X w = w->next;
X };
X }
X u = u->next;
X t = t->next;
X }
X return(notclose);
X}
X
X#ifndef SYMMETRIC
X
Xvoid backinner() /* compute weight changes for hidden layers */
X{ /* send down errors for any previous layers */
X LAYER *layer;
X double deltaj;
X register UNIT *bunit;
X register WTNODE *w;
X register UNIT *u;
X
X layer = last->backlayer;
X while (layer->backlayer != NULL)
X {
X u = (UNIT *) layer->units;
X while (u != NULL)
X {
X if (deriv == 'f') /* Fahlman's derivative */
X deltaj = (0.1 + u->oj * (1.0 - u->oj)) * u->error;
X else /* original and diff. step size derivative */
X deltaj = (u->oj * (1.0 - u->oj)) * u->error;
X w = (WTNODE *) u->wtlist;
X while (w != NULL)
X {
X bunit = (UNIT *) w->backunit;
X w->total = w->total + deltaj * bunit->oj;
X if (bunit->layernumber > 1)
X bunit->error = bunit->error + deltaj * w->weight;
X w = w->next;
X };
X u = u->next;
X };
X layer = layer->backlayer;
X };
X}
X
X#endif
X
Xvoid updatej() /* Jacob's delta-bar-delta method for changing weights */
X{
X register short stotal;
X register short sdbarm1;
X register UNIT *u;
X register WTNODE *w;
X LAYER *layer;
X
X /* w->olddw is used for delta-bar minus 1 */
X
X layer = last;
X while (layer->backlayer != NULL)
X {
X u = (UNIT *) layer->units;
X while (u != NULL)
X {
X w = (WTNODE *) u->wtlist;
X while (w != NULL)
X {
X#ifdef SYMMETRIC
X if (((UNIT *) w->backunit)->unitnumber > u->unitnumber)
X {
X if (*(w->total) > 0) stotal = 1;
X else if (*(w->total) < 0) stotal = -1;
X else stotal = 0;
X if (*(w->olddw) > 0) sdbarm1 = 1;
X else if (*(w->olddw) < 0) sdbarm1 = -1;
X else sdbarm1 = 0;
X *(w->olddw) = theta2 * *(w->total) + theta1 * *(w->olddw);
X if ((stotal > 0) && (sdbarm1 > 0))
X *(w->eta) = *(w->eta) + kappa;
X else if ((stotal < 0) && (sdbarm1 < 0))
X *(w->eta) = *(w->eta) + kappa;
X else if ((stotal > 0) && (sdbarm1 < 0))
X *(w->eta) = *(w->eta) * decay;
X else if ((stotal < 0) && (sdbarm1 > 0))
X *(w->eta) = *(w->eta) * decay;
X if (*(w->eta) > etamax) *(w->eta) = etamax;
X *(w->weight) = *(w->weight) + *(w->total) * *(w->eta);
X };
X#else
X if (w->total > 0) stotal = 1;
X else if (w->total < 0) stotal = -1;
X else stotal = 0;
X if (w->olddw > 0) sdbarm1 = 1;
X else if (w->olddw < 0) sdbarm1 = -1;
X else sdbarm1 = 0;
X w->olddw = theta2 * w->total + theta1 * w->olddw;
X if ((stotal > 0) && (sdbarm1 > 0)) w->eta = w->eta + kappa;
X else if ((stotal < 0) && (sdbarm1 < 0)) w->eta = w->eta + kappa;
X else if ((stotal > 0) && (sdbarm1 < 0)) w->eta = w->eta * decay;
X else if ((stotal < 0) && (sdbarm1 > 0)) w->eta = w->eta * decay;
X if (w->eta > etamax) w->eta = etamax;
X w->weight = w->weight + w->total * w->eta;
X#endif
X w = w->next;
X };
X u = u->next;
X };
X layer = layer->backlayer;
X };
X}
X
Xvoid updateo() /* update weights for the original and the */
X{ /* differential step size methods */
X double reta;
X register UNIT *u;
X register WTNODE *w;
X LAYER *layer;
X
X reta = eta;
X layer = last;
X while (layer->backlayer != NULL)
X {
X if (layer != last && update == 'd') reta = eta2;
X u = (UNIT *) layer->units;
X while (u != NULL)
X {
X w = (WTNODE *) u->wtlist;
X while (w != NULL)
X {
X#ifdef SYMMETRIC
X if (((UNIT *) w->backunit)->unitnumber > u->unitnumber)
X {
X *(w->olddw) = *(w->total) * reta + alpha * *(w->olddw);
X *(w->weight) = *(w->weight) + *(w->olddw);
X };
X#else
X w->olddw = w->total * reta + alpha * w->olddw;
X w->weight = w->weight + w->olddw;
X#endif
X w = w->next;
X };
X u = u->next;
X };
X layer = layer->backlayer;
X };
X}
X
Xshort cbackoutput() /* backoutput for continuous updates */
X{
X double deltaj, etadeltaj, diff, adiff;
X register UNIT *u, *bunit;
X register WTNODE *b;
X register PATNODE *t;
X register short notclose;
X
X notclose = last->unitcount;
X u = (UNIT *) last->units;
X t = (PATNODE *) last->currentpat->pats;
X while (u != NULL)
X {
X diff = t->val - u->oj;
X if (diff > 0) adiff = diff; else adiff = -diff;
X if (adiff < toler) notclose = notclose - 1;
X totaldiff = totaldiff + adiff;
X if (adiff >= toler || backprop)
X {
X if (deriv == 'd') /* differential step size derivative */
X deltaj = diff;
X else if (deriv == 'f') /* Fahlman's derivative */
X deltaj = diff * (0.1 + u->oj * (1.0 - u->oj));
X else /* the original derivative */
X deltaj = diff * u->oj * (1.0 - u->oj);
X etadeltaj = deltaj * eta;
X b = (WTNODE *) u->wtlist;
X#ifdef SYMMETRIC
X while (b->next != NULL)
X#else
X while (b != NULL)
X#endif
X {
X bunit = (UNIT *) b->backunit;
X#ifdef SYMMETRIC
X *(b->olddw) = etadeltaj * bunit->oj + alpha * *(b->olddw);
X *(b->weight) = *(b->weight) + *(b->olddw);
X#else
X b->olddw = etadeltaj * bunit->oj + alpha * b->olddw;
X b->weight = b->weight + b->olddw;
X if (bunit->layernumber > 1)
X bunit->error = bunit->error + deltaj * b->weight;
X#endif
X b = b->next;
X };
X };
X u = u->next;
X t = t->next;
X }
X return(notclose);
X}
X
X#ifndef SYMMETRIC
X
Xvoid cbackinner() /* backinner for continuous updates */
X{
X LAYER *layer;
X double deltaj, etadeltaj, reta;
X register UNIT *bunit, *u;
X register WTNODE *b;
X
X if (update == 'D') reta = eta2; else reta = eta;
X layer = last->backlayer;
X while (layer->backlayer != NULL)
X {
X u = (UNIT *) layer->units;
X while (u != NULL)
X {
X if (deriv == 'f') /* Fahlman's derivative */
X deltaj = (0.1 + u->oj * (1.0 - u->oj)) * u->error;
X else /* the diff. step size and original derivative */
X deltaj = (u->oj * (1.0 - u->oj)) * u->error;
X etadeltaj = reta * deltaj;
X b = (WTNODE *) u->wtlist;
X while (b != NULL)
X {
X bunit = (UNIT *) b->backunit;
X b->olddw = etadeltaj * bunit->oj + alpha * b->olddw;
X b->weight = b->weight + b->olddw;
X if (bunit->layernumber > 1)
X bunit->error = bunit->error + deltaj * b->weight;
X b = b->next;
X };
X u = u->next;
X };
X layer = layer->backlayer;
X };
X}
X#endif
END_OF_FILE
if test 10454 -ne `wc -c <'real.c'`; then
echo shar: \"'real.c'\" unpacked with wrong size!
fi
# end of 'real.c'
fi
if test -f 'misc.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'misc.c'\"
else
echo shar: Extracting \"'misc.c'\" \(11006 characters\)
sed "s/^X//" >'misc.c' <<'END_OF_FILE'
X/* **************************************************** */
X/* file misc.c: contains pattern manipulation routines */
X/* and miscellaneous other functions. */
X/* */
X/* Copyright (c) 1990 by Donald R. Tveter */
X/* */
X/* **************************************************** */
X
X#include <stdio.h>
X#ifdef INTEGER
X#include "ibp.h"
X#else
X#include "rbp.h"
X#endif
X
Xextern short backoutput();
Xextern void backinner();
Xextern short cbackoutput();
Xextern void cbackinner();
Xextern WTTYPE rdr();
Xextern WTTYPE readchar();
Xextern void saveweights();
Xextern WTTYPE scale();
Xextern double unscaleint();
Xextern void updatej();
Xextern void updateo();
X
Xextern char backprop;
Xextern FILE *data;
Xextern char datafilename[50];
Xextern UNIT *hlayer;
Xextern UNIT *ilayer;
Xextern char informat;
Xextern UNIT *jlayer;
Xextern UNIT *klayer;
Xextern LAYER *last;
Xextern int lastprint;
Xextern int npats;
Xextern int prevnpats;
Xextern int readerror;
Xextern int saverate;
Xextern int skiprate;
Xextern LAYER *start;
Xextern char summary;
Xextern WTTYPE toler;
X#ifdef INTEGER
Xextern int totaldiff;
X#else
Xextern double totaldiff;
X#endif
Xextern int totaliter;
Xextern int unlearnedpats;
Xextern char update;
Xextern WTTYPE wtlimit;
Xextern char wtlimithit;
Xextern int wttotal;
X
Xvoid nullpatterns() /* dispose of any patterns before reading more */
X{
X PATLIST *pl, *nextpl;
X PATNODE *pn, *nextpn;
X if (start->patstart != NULL)
X {
X pl = start->patstart;
X nextpl = pl->next;
X while (pl != NULL)
X {
X pn = pl->pats;
X nextpn = pn->next;
X while (pn != NULL)
X {
X free(pn);
X pn = nextpn;
X nextpn = pn->next;
X };
X free(pl);
X pl = nextpl;
X nextpl = pl->next;
X };
X pl = last->patstart;
X nextpl = pl->next;
X while (pl != NULL)
X {
X pn = pl->pats;
X nextpn = pn->next;
X while (pn != NULL)
X {
X free(pn);
X pn = nextpn;
X nextpn = pn->next;
X };
X free(pl);
X pl = nextpl;
X nextpl = pl->next;
X };
X };
X start->patstart = NULL;
X last->patstart = NULL;
X npats = 0;
X prevnpats = 0;
X}
X
Xvoid resetpats()
X{
X start->currentpat = NULL;
X last->currentpat = NULL;
X}
X
Xvoid findendofpats(layer) /* purpose is to set all layer->currentpat */
XLAYER *layer; /* fields to end of pattern list so more */
X /* patterns can be added at the end. */
X{
X PATLIST *pl;
X
X pl = (PATLIST *) layer->patstart;
X while (pl->next != NULL) pl = pl->next;
X layer->currentpat = pl;
X}
X
Xint copyhidden(input,hidden,l)
XUNIT *input, **hidden;
Xint l;
X{
X if (hidden == NULL)
X {
X printf("ran out of hidden units in layer %d\n",l);
X return(1);
X }
X input->oj = (*hidden)->oj;
X *hidden = (*hidden)->next;
X return(0);
X}
X
Xvoid nextpat()
X{
X if (start->currentpat == NULL)
X {
X start->currentpat = start->patstart;
X last->currentpat = last->patstart;
X }
X else
X {
X start->currentpat = (start->currentpat)->next;
X last->currentpat = (last->currentpat)->next;
X };
X}
X
Xvoid setonepat() /* sets up patterns on input units */
X{
X register PATNODE *p;
X register UNIT *u;
X register LAYER *innerlayers;
X UNIT *hunit, *iunit, *junit, *kunit;
X PATLIST *pl;
X
X hunit = hlayer;
X iunit = ilayer;
X junit = jlayer;
X kunit = klayer;
X pl = start->currentpat;
X p = (PATNODE *) pl->pats;
X u = (UNIT *) start->units;
X while (p != NULL)
X {
X if (p->val > KCODE) u->oj = p->val;
X else if (p->val == HCODE)
X {if (copyhidden(u,&hunit,2) == 1) return;}
X else if (p->val == ICODE)
X {if (copyhidden(u,&iunit,3) == 1) return;}
X else if (p->val == JCODE)
X {if (copyhidden(u,&junit,4) == 1) return;}
X else if (copyhidden(u,&kunit,5) == 1) return;
X u = u->next;
X p = p->next;
X };
X
X innerlayers = start->next;
X while (innerlayers->next != NULL)
X { /* set errors on the inner layer units to 0 */
X u = (UNIT *) innerlayers->units;
X while (u != NULL)
X {
X u->error = 0;
X u = u->next;
X };
X innerlayers = innerlayers->next;
X };
X}
X
Xvoid limitwts()
X{
X register LAYER *layer;
X register UNIT *u;
X register WTNODE *w;
X
X layer = start->next;
X while (layer != NULL)
X {
X u = (UNIT *) layer->units;
X while (u != NULL)
X {
X w = (WTNODE *) u->wtlist;
X while (w != NULL)
X {
X#ifdef SYMMETRIC
X if (*(w->weight) > wtlimit)
X {
X *(w->weight) = wtlimit;
X wtlimithit = 1;
X }
X else if (*(w->weight) < -wtlimit)
X {
X *(w->weight) = -wtlimit;
X wtlimithit = 1;
X };
X#else
X if (w->weight > wtlimit)
X {
X w->weight = wtlimit;
X wtlimithit = 1;
X }
X else if (w->weight < -wtlimit)
X {
X w->weight = -wtlimit;
X wtlimithit = 1;
X };
X#endif
X w = w->next;
X };
X u = u->next;
X };
X layer = layer->next;
X };
X}
X
X#ifndef SYMMETRIC
X
Xvoid whittle(amount) /* removes weights whose absolute */
XWTTYPE amount; /* value is less than amount */
X{LAYER *layer;
X UNIT *u;
X WTNODE *w, *wprev;
X
X layer = start->next;
X while (layer != NULL)
X {
X u = (UNIT *) layer->units;
X while (u != NULL)
X {
X w = (WTNODE *) u->wtlist;
X wprev = (WTNODE *) NULL;
X while (w->next != (WTNODE *) NULL)
X {
X if ((w->weight) < amount && (w->weight) > -amount)
X {
X if (wprev == NULL) (WTNODE *) u->wtlist = w->next;
X else (WTNODE *) wprev->next = w->next;
X wttotal = wttotal - 1;
X }
X else wprev = w;
X w = w->next;
X }
X u = u->next;
X }
X layer = layer->next;
X }
X}
X
X#endif
X
Xvoid oneset() /* go through the patterns once and update weights */
X{ int i;
X LAYER *layer;
X register UNIT *u;
X register WTNODE *w;
X short numbernotclose, attempted, passed;
X
Xbegin:
X layer = last; /* make all b->totals = 0 */
X while (layer->backlayer != NULL)
X {
X u = (UNIT *) layer->units;
X while (u != NULL)
X {
X w = (WTNODE *) u->wtlist;
X while (w != NULL)
X {
X#ifdef SYMMETRIC
X *(w->total) = 0;
X#else
X w->total = 0;
X#endif
X w = w->next;
X };
X u = u->next;
X };
X layer = layer->backlayer;
X };
X attempted = 0;
X passed = 0;
X unlearnedpats = npats;
X resetpats();
X for(i=1;i<=npats;i++)
X {
X nextpat();
X if (last->currentpat->bypass <= 0)
X {
X setonepat();
X forward();
X attempted = attempted + 1;
X if (update == 'c' || update == 'C')
X numbernotclose = cbackoutput();
X else numbernotclose = backoutput();
X if (numbernotclose != 0)
X {
X#ifndef SYMMETRIC
X if (update == 'c' || update == 'C') cbackinner();
X else backinner();
X#endif
X }
X else /* this one pattern has been learned */
X {
X passed = passed + 1;
X unlearnedpats = unlearnedpats - 1;
X last->currentpat->bypass = skiprate;
X#ifndef SYMMETRIC
X if (backprop)
X {
X if (update == 'c' || update == 'C') cbackinner();
X else backinner();
X };
X#endif
X }
X }
X else last->currentpat->bypass = last->currentpat->bypass - 1;
X };
X if (unlearnedpats == 0) return;
X if (attempted == passed)
X {
X resetpats();
X for (i=1;i<=npats;i++)
X {
X nextpat();
X last->currentpat->bypass = 0;
X };
X goto begin;
X };
X if (update == 'j') updatej();
X else if (update == 'o' || update == 'd') updateo();
X if (wtlimit != 0) limitwts();
X}
X
Xvoid kick(size,amount) /* give the network a kick */
XWTTYPE size;
XWTTYPE amount;
X{ LAYER *layer;
X UNIT *u;
X WTNODE *w;
X WTTYPE value;
X WTTYPE delta;
X int sign;
X
X layer = start->next;
X while (layer != NULL)
X {
X u = (UNIT *) layer->units;
X while (u != NULL)
X {
X w = (WTNODE *) u->wtlist;
X while (w != NULL)
X {
X#ifdef SYMMETRIC
X value = *(w->weight);
X#else
X value = w->weight;
X#endif
X if (value != 0) sign = 1;
X else if (rand() > 16383) sign = -1;
X else sign = 1;
X delta = (sign * amount * rand()) / 32768;
X if (value >= size) value = value - delta;
X else if (value < -size) value = value + delta;
X#ifdef SYMMETRIC
X if (((UNIT *) w->backunit)->unitnumber != u->unitnumber)
X *(w->weight) = value;
X#else
X w->weight = value;
X#endif
X w = w->next;
X }
X u = u->next;
X }
X layer = layer->next;
X }
X}
X
Xvoid printpats(first,finish,printheader,printerrors,callfromrun)
Xint first,finish,printheader,printerrors,callfromrun;
X{
X int i;
X double err;
X
X if (summary == '+' && callfromrun)
X {
X printf("%6d ",totaliter);
X printf("%6d learned ",npats-unlearnedpats);
X printf("%6d unlearned ",unlearnedpats);
X err = unscaleint(totaldiff) / (npats * last->unitcount);
X printf("%7.5lf error/unit\n",err);
X return;
X };
X lastprint = totaliter;
X if (printheader == 1)
X printf("%d iterations, file = %s\n",totaliter,datafilename);
X resetpats();
X for (i=2;i<=first;i++) nextpat();
X for (i=first;i<=finish;i++)
X {
X nextpat();
X setonepat();
X printf("%3d ",i);
X forward();
X printoutunits(last,printerrors);
X };
X}
X
Xvoid run(n,prpatsrate)
Xint n; /* the number of iterations to run */
Xint prpatsrate; /* rate at which to print output patterns */
X
X{ int i;
X char wtlimitbefore;
X
X printf("running . . .\n");
X for (i=1;i<=n;i++)
X {
X totaldiff = 0;
X wtlimitbefore = wtlimithit;
X oneset();
X totaliter = totaliter + 1;
X if (wtlimitbefore == 0 && wtlimithit == 1)
X printf(">>>>> WEIGHT LIMIT HIT <<<<< at %d\n",totaliter);
X if (unlearnedpats == 0)
X {
X if (update != 'c' && update != 'C') totaliter = totaliter - 1;
X if ((prpatsrate > 0) && (lastprint != totaliter))
X printpats(1,npats,1,1,1);
X printf("patterns learned to within %4.2lf",unscale(toler));
X printf(" at iteration %d\n",totaliter);
X return;
X };
X if (totaliter % saverate == 0) saveweights();
X if ((prpatsrate > 0) && ((i % prpatsrate == 0) || (i == n)))
X printpats(1,npats,1,1,1);
X };
X}
END_OF_FILE
echo shar: 1 control character may be missing from \"'misc.c'\"
if test 11006 -ne `wc -c <'misc.c'`; then
echo shar: \"'misc.c'\" unpacked with wrong size!
fi
# end of 'misc.c'
fi
echo shar: End of archive 4 \(of 4\).
cp /dev/null ark4isdone
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