Category : Miscellaneous Language Source Code
Archive   : NEURAL.ZIP
Filename : SILOAM.C

 
Output of file : SILOAM.C contained in archive : NEURAL.ZIP
#define PGM_ID "SILOAM CI-C86 Ver. 0f 11/22/86 for PC-DOS 2.x+"

/*
* An Adaptive Template Matching Image Categorizer
* (An Experimental Computer Vision Program)
*
* This program implements a trainable pattern classifier as
* a committee network of threshold logic units. It learns to
* recognize patterns by being trained from a set of prototype
* patterns presented in a training file. The training file is
* organized as a set of visual images represented as an orthogonal
* array of picture elements, or pixels. Each pixel is a number
* representing the gray-scale value of that point in the image.
* Associated with each pattern is a number, or tag, that
* represents the category to which that pattern belongs.
*
* R. J. Brown
* Elijah Laboratories International
* 5225 N.W. 27th Court
* Margata, Fl. 33063
* (305) 979-1567
*
* Ownership: I hereby place this program in the public domain.
*
* System: Red River ATlas 10 Mhz 80286 IBM-PC/AT clone
*
* Compiler: C86 Version 2.30H; Computer Innovations, Inc.
*
*/

/* Note to all readers from MKF:
* I made several small modifications to the original program.
* None of the modifications have been shared with the author.
* I tried to call once or twice, and I guess he is busy too.
* THIS IS OBVIOUSLY A MODIFIED VERSION of Robert Brown's work.
* Please read the April '87 article in Dr. Dobb's journal.
* Some changes were made because I compiled on DEC Vax 11/750
* running Ultrix 1.2 - but they were minor.
* I compiled using: cc siloam.c -lm -o siloam
* The main changes were made to actually use the program to do
* pattern recognition. I have added some routines (which are
* derived almost completely from the existing routines) to
* give pattern recognition results as an optional selection.
* The recognition was really being done anyhow. Below is an
* example of a training file. NOTE: I selected floating point.
* What I did not do: I did not add storage routines that would
* allow you to save the current state of the network, or
* remember a previous state of the network. Any act of
* recognition requires training too. I don't think it
* would be difficult to implement once you get a feel for
* the program, and the structures used. I didn't have the
* time, and still don't. I wanted to see how well it worked,
* and still plan to implement several training algorithms,
* and compare them ...
*
* If you implement the above, please send me a copy? Thanks,
* My initials should be everywhere I was, I put them in so
* you could tell what was changed, easily.
*
* Mike Finegan @ University of Cincinnati - Elec. & Comp. Eng.
* ...!hal!uccba!ucece1!finegan
*
* A MUCH NEEDED EXAMPLE OF PATTERN FILE FORMAT!
* This would be the file contents for two images,
* each to be learned as a different class. MKF 6/87
* as follows minus the asteriks :
*
* hdr 2 4 5
* 0. 1. 0. 0.
* 1. 1. 0. 0.
* 0. 1. 0. 0.
* 0. 1. 0. 0.
* 1. 1. 1. 0.
* 1
* 0. 1. 1. 0.
* 1. 0. 0. 1.
* 0. 0. 1. 0.
* 0. 1. 0. 0.
* 1. 1. 1. 1.
* 2
*
*/
#include /* needed for stream input/output */
#include /* needed for sqrt() - ULTRIX MKF 6/87 */

#define FALSE 0 /* boolean constant for 'false' */
#define TRUE 1 /* boolean constant for 'true', was !FALSE MKF 6/87*/
/*
*#define NULL ((int *)0) -- the pointer to nowhere
* not needed/liked on ULTRIX-32 MKF 6/87
*/

#define void /* function that returns no value */

#define forall(index,limit)\
for((index)=0;(index)<(limit);(index)++) /* looping word */


#define kase(id,stmt) \
case(id): { \
stmt; \
break; \
} /* shorthand form for case statement */
#define u(x) ((unsigned) (x)) /* shorthand for '(unsigned)' cast */

#define INFINITY 1.0e25 /* added by MKF 6/87, command line definition ? */

#define ELTYPE float /* both originally command line definitions? MKF*/
#define DOTYPE float

typedef unsigned char byte; /* an 8-bit byte of storage */
typedef unsigned int word; /* a 16-bit word of storage */
/* wordsize machine dependent MKF 6/87 */

typedef word boolean; /* a decision variable
* a 'true' or 'false' value only */

typedef ELTYPE element; /* an element is a real number */
typedef DOTYPE DOT; /* type of a dot product may be bigger */
typedef element *vector; /* a vector is a set of elements */

typedef vector tlu; /* a tlu is a vector */

typedef struct { /* the collection of */
tlu *wtpt; /* a set of tlu weight points, */
DOT *dot; /* and dot product save cells */
} committee; /* is a committee */

typedef char *pointer; /* a general pointer to whatever... */


/************************************************************************
*
* G l o b a l V a r i a b l e D e f i n i t i o n s
*
************************************************************************/

FILE *pat, /* the input training pattern file */
*fopen(); /* the file opener */
byte pathname[64], /* ascii filename of input file */
rememname[64], /* ascii filename of patterns to remember MKF */
*index(); /* string search library function */

int ncom, /* number of committees in the network */
patwide, /* pattern width in pixels */
pathite, /* pattern height in pixels */
pats_so_far, /* how many patterns in file so far */
pats_missed, /* how many patterns were mis-recognized so far */
missed, /* # of patterns missed on this pass */
tlus_trained, /* how many tlu's have been adjusted so far */
npass, /* number of current pass thru current file */
log_level, /* level of detail for run_time logging */
dim, /* number of elements in a vector (dimension) */
ntlu, /* number of tlu's per committee */
corr_incr, /* fixed increment correction constant */
*vote, /* pointer to vote count array */
fclose(); /* file closing (pointer) function */

boolean goofed, /* mis-recognition indicator for training loop */
start_over, /* select start over on error training strategy */
absolute, /* flag for absolute correction training method */
*decsn, /* pointer to network's decision array */
*class, /* pointer to class (category) array */
my_read_pattern(); /* function declared after main ... MKF 6/87*/

DOT patmag; /* pattern magnitude (used for training) */

element fraction, /* correction fraction for training */
maxel=0, /* maximum element in a weight point */
radius; /* average radius (distance from origin)
* of tlu weight point at initialization */

vector pattern; /* pointer to current input pattern */

committee *net; /* pointer to network as an array of committees */


/************************************************************************
*
* L i b r a r y R o u t i n e s
*
************************************************************************/

extern double atof(); /* ascii to float library conversion routine */
extern double sqrt(); /* square root library function */
extern pointer calloc(); /* memory allocation library routine */
extern long time(); /* benchmark timinmg routine */


/************************************************************************
*
* B A N N E R -- D i s p l a y P r o g r a m I. D.
*
************************************************************************/

void banner() { /* display program identification information */
printf("\n%s",PGM_ID); /* Program Identification is #define'd
* at top of source file */
printf("\t\tMODIFIED VERSION");/* Not to be a pain (deletable)MKF */
printf("\nWritten by: R. J. Brown, Elijah Laboratories Intn'l");
printf("\nThis program is in the Public Domain.\n");
}

/***********************************************************************
*
* H E L P D i s p l a y S c r e e n
*
***********************************************************************/

void help() { /* some user friendly help for the uninitiated! */

printf("Simple Image Learning On Adaptive Machinery\n");
printf("An Adaptive Template Matching Image Categorizer\n");
/* printf("\n"); MKF 6/87 */
printf("\tR. T. Brown, Elijah Laboratories International\n");
printf("\t5150 W. Copans Rd. Suite 1135, Margate Fl 33063\n");
printf("\n");
printf("usage:\tsiloam filename[.ext]\n\n");
printf("where:\tfilename -- is the input pattern file.\n\n");
printf("options:\t-r##.# __ gives initialization radius.\n");
printf("\t\t-t## -- gives number of TLU's per committee.\n");
printf("\t\t -o -- start over on error.\n"); /* less \n MKF 6/87 */
printf("choose one: -i## -- fixed increment correction, ## = incr.\n");
printf("\t\t -a -- absolute correction.\n");
printf("\t\t-f##.# -- fractional correction, ##.# is lambda.\n");
printf("\t\t -l# -- logging level: 0=least; 3=most.\n");
/* below was added MKF 6/87 */
printf("\t\t -q** -- filename of patterns to remember, ** is name.\n");
exit(0);
}


/***********************************************************************
*
* S I G N -- T h e S i g n O f A n I n t g e r
*
***********************************************************************/

int sign(x) /* the absolute value of an element */
element x; /* argument is an element */
{
return( x<0 ? -1 /* if number is negative, make it positive */
: 1 ); /* else return +1 */
}

/***********************************************************************
*
* I S I G N -- T h e S i g n O f A n I n t g e r
*
***********************************************************************/

int isign(x) /* the absolute value of an element */
int x; /* argument is an int */
{
return( x<0 ? -1 /* if number is negative, make it positive */
: 1 ); /* else return +1 */
}

/***********************************************************************
*
* A B S -- A b s o l u t e V a l u e O f A n E l e m e n t
*
***********************************************************************/

element eabs(x) /* the absolute value of an element */
element x; /* argument is an element */
{
return( x<0 ? -x /* if number is negative, make it positive */
: x ); /* else return it like it is */
}

/***********************************************************************
*
* I A B S -- T h e S i g n O f A n I n t g e r
*
***********************************************************************/

int iabs(x) /* the absolute value of an integer */
int x; /* argument is an integer */
{
return( x<0 ? -x /* if number is negative, make it positive */
: x ); /* else return it like it is */
}

/************************************************************************
*
* A L P H A -- S t e p F u n c t i o n
*
************************************************************************/

int alpha(x) /* step function return zero or one */
int x; /* argument is an integer (in this program...) */
{
return( x>0 ? 1 /* if argument strictly positive, return one */
: 0 ); /* else return zero */
}

/***********************************************************************
*
* M O V E -- S t r i n g M o v e F u n c t i o n
*
***********************************************************************/

char *move(src,dat) /* move a string returning ptr to end of result */
char *src,*dat; /* pointers to source & destination strings */
{
while(0!=((*dat++)=(*src++))); /* copy bytes until end of source */
return(--dat);
}


/************************************************************************
*
* R A D I U S S T A T I S T I C S -- S u m m a r y I n f o
*
************************************************************************/

void radius_statistics() { /* show how weight points are distributed */
element r, /* current radius accumulator */
*pe; /* pointer to current element */
float mu=0, /* mean of radii */
sigma=0; /* standard deviation of radii */

committee *pc=net; /* pointer to current committee */

vector *pt; /* pointer to current tlu */

int c, /* committee loop counter */
t, /* tlu loop counter */
e, /* element loop counter */
n=ncom*ntlu; /* number of tlu's altogether */

forall(c,ncom) { /* for all committees... */
pt = (pc++)->wtpt; /* point to first tlu */
forall(t,ntlu) { /* for all tlu's */
pe = *(pt++); /* point to first element */
r=0.0; /* initialize radius tally */
forall(e,dim) { /* forall elements... */
r+=(*pe)*(*pe); /* accumulate radius sgr'd */
pe++; /* point to next element */
}
mu+=sqrt((float)r); /* accumulate sum of radii */
sigma+=(float)r; /* accumulate variance variable */
}
}
}


/***********************************************************************
*
* R E A D H E A D E R -- R e a d F i l e H e a d e r
*
***********************************************************************/

void read_header() /* read training file header information */
{

rewind(pat); /* rewind pattern file */
pats_so_far=0; /* reset pattern sequence counter */

fscanf(pat, /* header comes from pattern file */

"hdr %d %d %d \n", /* header must start with 'hdr'
* then read header information
* composed of three numbers */

/* put this information into the following global variables */

&ncom, /* number of committees in network */
&patwide, /* pattern width in pixels */
&pathite); /* pattern height in pixels */
}


/************************************************************************
*
* R A N D O M -- R a n d o m N u m b e r G e n e r a t o r
*
************************************************************************/


element random() { /* generate a uniformly distributed
* random number from the open interval (0...1) */

return(rand()/16384.); /* return scaled random integer */
}

/************************************************************************
*
* I N I T V A L -- I n i t i a l E l e m e n t V a l u e
*
************************************************************************/

element init_val(radius) /* generate init'l value for element a tlu */
element radius; /* the average radius of a weight point */
{
return( /* return the */
(radius*sqrt(3.))/(sqrt((float)dim)) /* average weight value */
* (2.*random()-1) /* scaled randomly by a */
); /* uniform distribution */
}

/************************************************************************
*
* I N I T I A L I A Z E -- A l l o c a t e S t o r a g e, E t c.
*
************************************************************************/

void initialize() { /* allocate & initialize network array storage */

committee *pc; /* pointer to current committee of network */
tlu *pt; /* pointer to current tlu of committee */
element *pe, /* pointer toi current element of tlu */
x; /* current initialization weight value */

int c, /* committee index in neetwork */
t, /* tlu index in committee */
e; /* element index in tlu */

printf("\ninitializing"); /* say what's taking so long */


dim=patwide*pathite+1; /* number of elements in a tlu */

pattern=(vector)calloc(u(dim), /* allocate the pattern */
u(sizeof(element))); /* vector */

class=(boolean *)calloc(u(ncom), /* allocate the class array */
u(sizeof(boolean))); /* which will contain the
* desired decision bits from the committees, as read from the
* training file. The actual verdict of the network will be
* compared with this to see if training is required. */

vote=(int *)calloc(u(ncom), /* allocate the votes array */
u(sizeof(int))); /* which will contain
* count of votes for each
* committee. */

decsn=(boolean *)calloc(u(ncom), /* allocate the decision */
u(sizeof(int))); /* array which will contain
* the bits of the answer,
* one bit per committee. */

pc=net=(committee *)calloc(u(ncom), /* allocate the network */
u(sizeof(committee))); /* as an array of committees*/

forall(c,ncom) { /* for all committees in the network... */
pc->wtpt=pt=(tlu *)calloc(u(ntlu), /* allocate a committee */
u(sizeof(tlu))); /* as an array of tlu's */
pc++->dot=(DOTYPE *)calloc(u(ntlu), /* together with dot */
u(sizeof(DOT))); /* product save cells */

forall(t,ntlu) { /* for all tlu's in the committee... */
pe= *(pt++)=(element *)calloc(u(dim), /* allocate a tlu */
u(sizeof(element))); /* as an array
* of elements */

forall(e,dim) { /* for each weight */
if(radius==0) *pe++=(e!=0); /* grow connections? */
else { /* or adjust weights? */
x=eabs(*(pe++)=init_val( /* adjust, get initial */
(element)radius)); /* weight value */
if(x }
}
/* initialize each element to a random value such that the average
* radius, or distance from the origin, of each weight point is 'radius'.
* this will produce a distribution of weight poiunts clustered near the
* surface of a hyper-sphere as the starting condition. If the radius is
* zero, then all weights will be set to zero except for the threshold
* setting weight. This is analogous to forcing the program to grow new
* interneural connections on an as-needed basis, supposedly just like
* the real brain does! */
}
}
printf("\n"); /* perform new-line when initialize is done */
}

/***********************************************************************
*
* D O T P R O D -- F o r m A D o t P r o d u c t
*
***********************************************************************/

DOT dotprod(x,y) /* form the scalar product of two vectors */
vector x,y; /* both arguments are vectors */
{
DOT z=0; /* result accumulator, initialized to zero */
int i; /* element index, used as loop counter */

forall(i,dim) /* for all elements in each vector... */
z+=(*x++)*(*y++); /* compute the dot product */

return(z); /* return it to the caller */
}

/************************************************************************
*
* R E A D C L A S S -- R e a d T h e C l a s s T a g
*
************************************************************************/

boolean read_class() { /* read the class tag number for the image */

int i, /* loop counter for index in class array */
tmp; /* temp cell to hold decimal category */
boolean *pcl=class; /* pointer to class (category) array */

if(fscanf(pat,"%d",&tmp)!=1) /* read the pattern category */
return(FALSE); /* return FALSE for end of file */

forall(i,ncom) { /* for each committee in network */
*pcl++=tmp&1; /* extract desired committee output */
tmp>>=1; /* advance to next committee */
}

*pcl=1; /* augment with a 1 to prevent singularity */
pats_so_far++; /* update pattern sequence counter */

return(TRUE); /* return TRUE if class read successfully */
}

/************************************************************************
*
* R E A D P A T T E R N -- R e a d N e x t P a t t e r n
*
************************************************************************/

boolean read_pattern() { /* read next pattern from training file */

int i,j; /* loop counters for row & column of image */
element *pe=pattern; /* pointer to element of pattern vector */
float tmp; /* temp cell for input conversion */

forall(i,patwide) /* for each row in the image, */
forall(j,pathite) /* for each pioxel in that row, */
if(fscanf(pat,"%f",&tmp) /* input value of pixel */
!=1) return(FALSE); /* return FALSE if end-of-file */
else *pe++=(element)tmp; /* convert to type element */

return(read_class()); /* read in its class as an array
* of correct decisions for each committee in the network. If the
* entire pattern is read, together with its class, return TRUE. */
}

/************************************************************************
*
* C O U N T V O T E S -- C o u n t T h e V o t e s
*
************************************************************************/

int count_votes(pc) /* count the votes for each tlu in a committee */
committee *pc; /* second parameter is a pointer to a committee */
{
DOT *pd=pc->dot; /* dot product save cell poointer */
tlu *pt=pc->wtpt; /* tlu pointer */

int ti, /* tlu index (loop counter) */
count=0; /* the count of votes for the committee */

forall(ti,ntlu) /* forall tlus in committee */
count+=sign( /* count votes as + or - */
*pd++= /* & save dot product as */
dotprod(*pt++,pattern) /* weight point dotted with */
); /* pattern vector */
return(count); /* return tally */
}

/************************************************************************
*
* R E C O G N I Z E -- Recognize A Pattern
*
************************************************************************/

void recognize() { /* recognize a pattern by taking the decision
* of each committee to be a bit in the category
* number for the pattern
*/

int i, /* loop counter */
*pv=vote; /* pointer to vote count array */

boolean *pdec=decsn;/* pointer to decision array.
* this holds the decision bits for each
* of the committees in the network.
*/

committee *pc=net; /* pointer to current committee in network */

forall(i,ncom) /* for all committees in the network... */
*pdec++=alpha(*pv++=count_votes(pc++)); /* how many votes ? */
}

/************************************************************************
*
* S G E T W E A K T L U -- S w a y W h i c h O n e ?
*
************************************************************************/

int get_weak_tlu(ci) /* choose tlu most vulnerable to be swayed */
int ci; /* argument is committee index */
{
int weak=0, /* index of weakest tlu so far */
sv=isign(vote[ci]), /* sign of committee's vote */
ti; /* tlu index */

DOT *pd=(&net[ci])->dot, /* pointer to dot product array */
conviction=INFINITY, /* lowest conviction so far */
d; /* saved dot product value */

forall(ti,ntlu) { /* for all of the tlu's in this committee... */

d=pd[ti]; /* get the saved dot product value */

if(sign(d)==sv) { /* if tlu voted incorrectly */
if(eabs(d) * least conviction of any that have been examined so far, */

weak=ti; /* then remember it as the best one so
* far to adjust to sway the vote of this committee. */

conviction=eabs(d); /* update lowest conviction */
}
}
}
return(weak); /* return subscript of weakest tlu in committee */
}

/************************************************************************
*
* A D J U S T M E N T -- C o r r e c t i o n C o e f f i c i e n t
*
************************************************************************/

element adjustment(ci,ti) /* compute correction coefficient */
int ci, /* committee index */
ti; /* tlu index */
{
DOT d=(&net[ci])->dot[ti]; /* saved dot product */

if(corr_incr) /* fixed increment correction */
return(corr_incr*sign(d));

if(absolute)
return((int)(d/patmag)+sign(d));

if(fraction) /* fractional correction */
return(d*fraction/patmag);

return(myabort("No correction method specified."));
}

/************************************************************************
*
* A D J U S T -- C h a n g e T L U ' s W e i g h t s
*
************************************************************************/

void adjust(ci,ti) /* adjust the weights of a single tlu */
int ci, /* committee index */
ti; /* tlu index */
{
vector pw=(&net[ci])->wtpt[ti], /* pointer to a weight */
pp=pattern; /* pointer to a pixel */

element lambda=adjustment(ci,ti), /* the correction coefficient */
wt,awt; /* temps for max weight point */

int i; /* element index & loop counter */

tlus_trained++; /* count adjustment of tlu */

forall(i,dim) { /* foreach coefficient */
wt=(*pw++)-=lambda*(*pp++); /* adjust weights */
awt=eabs(wt); /* save magnitude */
if(maxel maxel=awt; /* yes, update max element */
if(log_level) { /* if any logging, */
printf("\nmaxel=%f", /* then display the */
(float)maxel); /* new maximum value */
}
}
}

if(log_level>=3)
printf("\n\tcom=%d\tlu=%d\tlambda=%g",
ci,ti,(float)lambda);
}

/************************************************************************
*
* S W A Y T L U S -- S w a y T L U s T o C h a n g e V o t e
*
************************************************************************/

void sway_tlus(ci) /* sway enough tlu's to change the vote */
int ci; /* parameter is committee index */
{
int i, /* loop counter */
lost_by=iabs(vote[ci]/2)+1, /* how many votes we lost by */
weak_tlu; /* weakest wrong tlu in committee */

DOT *pd=(&net[ci])->dot; /* pointer to dot product array */

forall(i,lost_by) { /* do this enough times to sway the vote... */

weak_tlu=get_weak_tlu(ci); /* find most vulnerable tlu */

adjust(ci,weak_tlu); /* adjust its weights to change
* its mind about the pattern */
pd[weak_tlu]*=sign(pd[weak_tlu]); /* flip sign of dot product
* so this tlu won't be considered again in this loop */

/* is the *= right? THIS WILL FLIP SIGN, but was =-
* which would flip sign and make magnitude 1.0 or
* would subtract +/- 1.0 from +/- value
* do what you say, or do what I think you mean ...
* MKF 6/12/87
*/

}
}

/************************************************************************
*
* S H O W B I T S -- D i s p l a y B i t s O n C R T
*
************************************************************************/

void show_bits(ps,pb) /* display a bit vector on the screen */
char *ps; /* the label for the bit vector */
boolean *pb; /* the pointer to the bit vector */
{
int i, /* loop counter */
k=1, /* power of two */
v=0; /* value accumulator */

forall(i,ncom) { /* for all committes */
if(*pb++) v+=k; /* convert binary to decimal */
k<<=1; /* advance to next bit */
}
printf("\t%s %d",ps,v); /* display label and value */
}

/************************************************************************
*
* T R A I N -- T r a i n T h e N e t w o r k
*
************************************************************************/

train() { /* train the network to recognize the pattern */

int ci; /* committee index */

goofed=FALSE; /* give benefit of doubt -- assume didn't goof */

patmag=dotprod(pattern,pattern); /* find pattern magnitude */

forall(ci,ncom) /* for all the committes in the network... */

if(decsn[ci]!=class[ci]) { /* if the committee goofed up, */
goofed=TRUE; /* then say so, */
pats_missed++; /* count misrecognized pattern, */
sway_tlus(ci); /* and change enough tlu's
* so it won't goof up on this pattern next time ! */
}

if(goofed) { /* did we goof? */
missed++; /* yes, count the boo boo ! */
if(log_level<=2) { /* if detail requested, */
printf("\n"); /* start a new line */
show_bits("siloam ",decsn); /* show machine's decision */
show_bits("really ",class); /* display what really is */
}
}
}

/************************************************************************
*
* T O T C O N S -- T o t a l N u m b e r O f C o n n e c t s
*
************************************************************************/

int totcons() { /* count total # of connections */
committee *n=net; /* neural network pointer */
tlu *c, /* committee pointer */
t; /* tlu pointer */
int i,j,k, /* loop indices */
no=0; /* totalizer accumulator */

forall(i,ncom) { c=n++->wtpt; /* for each committee... */
forall(j,ntlu) { t=(*c++); /* for each tlu in the committee*/
forall(k,dim-1) /* for each element in the tlu */
if(*t++!=0) no++; /* count it if it is connected */
}
}
return(no); /* return the count */
}

/************************************************************************
*
* S I L O A M O u t s i d e C o n t r o l S t r u c t u r e
*
************************************************************************/

void siloam() { /* outside control structure for pattern recognizer */

long start,stop; /* timer value cells for benchmarking */
int cons,new,old=0; /* connection counters */

read_header(); /* read header information in the training file */

initialize(); /* allocate the committees of TLUs and
* initialize the weight points randomly */

radius_statistics();/* print starting radius statistics */

npass=0; /* initialize pass counter */
start=time(NULL); /* remember start time */

do { /* start over in training file,
* we made a mistake... */

missed=0; /* reset misrecognition counter */

read_header(); /* rewind training file
* and skip over header information... */

while(read_pattern()) { /* keep reading patterns until we've
* done the entire training file and recognized them all */

recognize(); /* attempt to recognize the pattern */

train(); /* adjust any weights necessary to get
* the correct recognition if we goofed */

if(goofed&&start_over) break; /* select training strategy*/
} /* end of while loop to read next pattern */

npass++; /* increment pass counter */
if(log_level<=1) { /* give pass summary report */
cons=totcons(); /* count the connections */
new=cons-old; /* compute how many new ones */
old=cons; /* remember for next time */
printf("\npass # %d\tmissed %d\tcons=%d\tnew=%d",
npass, missed, cons, new);
}
} while(missed); /* end of do loop to train network */

stop=time(NULL); /* get stop time */

/********************* print end of run summary *********************/

printf("\n");
printf("\ntraining completed in %ld seconds.\n",stop-start);
printf("\nnumber of committees:\t%d",ncom );
printf("\nnumber of tlu's total:\t%d",ncom*ntlu );
printf("\nnumber of elements:\t%d",ncom*ntlu*dim );
printf("\nnumber of connections:\t%d",totcons() );
printf("\n");

printf("\nnumber of passes thru file: %d",npass);
printf("\nnumber of patterns in file: %d",pats_so_far);
printf("\nnumber of mis-recognitions: %d",pats_missed);
printf("\nnumber of tlu adjustments: %d",tlus_trained);
printf("\nmaximum element magnitude: %f",(float)maxel);
printf("\n");

radius_statistics(); /* print ending radius statistics */

}

/************************************************************************
*
* M A I N P r o g r a m S t a r t s H e r e
*
************************************************************************/

main(paramct,params) /********* main program entry point *************/

int paramct; /* number of parameters on command line */
char *params[]; /* array of pointers to strings for each param */

{
int i; /* array index variable */

banner(); /* print program name, version, & release date */

printf("\nInvoked By:"); /* show how the program */
for(i=1;i printf("\nelement type is %s","ELTYPE"); /* show arithmetic used */
printf("\n");

/********************* parse the command line ***********************/

if(paramct==1) help(); /* if no params, then give help and quit ! */
pathname[0]=0; /* else set pattern filename to null string */
rememname[0]=0; /* and set remem filename to null MKF 6/87*/

for(i=1;i
if('-'==params[i][0]) /* is it an option ? */

switch(toupper(params[i][1])) { /* yes, which one ? */

kase('O',start_over=TRUE) /* strategy */
kase('L',log_level=atoi(¶ms[i][2])) /* log detail */
kase('T',ntlu=atoi(¶ms[i][2])) /* # of TLUs */
kase('R',corr_incr=atoi(¶ms[i][2])) /* fixed incr */
kase('A',absolute=TRUE) /* absolute */
kase('F',fraction=atof(¶ms[i][2])) /* fractional */
/* below added MKF 6/87*/
kase('Q',strcpy(rememname,¶ms[i][2]))/* remember? */
}

/******************* parse filename *****************************/

else if(index(¶ms[i][0],'.')) /* is '.' in it ? */
move(¶ms[i][0],pathname); /* yes, pattern file */

else move(".pat", /* no, default extension is */
move(¶ms[i][0],pathname)); /* '.pat' for pattern file */
}

/**************** check for command line errors *********************/

if(pathname[0]==0) /* check for missing pattern file name */
myabort(
"pattern filename not specified!");

if(ntlu==0) /* check for missing number of TLUs */
myabort(
"number of TLUs per committee not specified!");

/************************ open pattern file *************************/

if(!(pat=fopen(pathname,"r"))) /* if open fails, myabort */
myabort(
"can't open pattern file!");


/********* perform the training and recognition algorithm ***********/

srand(1); /* make random number generator repeatable --
* ...this may be removed, if desired, after the
* debug phase is complete! */

siloam(); /* call the outside control structure for the
* trainable pattern recognizer. */

fclose(pat); /* Was left up to the operating system MKF 6/87 */

/**************** Actually do some recognition! **************MKF****/

if(rememname[0] != 0) /* Only call remember() if requested by
* command line arguments. */
remember(); /* MKF 6/87 */

}

/**************************** Other Functions ********************MKF****/

/************************************************************************
*
* M Y A B O R T -- C l e a n l y A b o r t
* MKF 6/87
************************************************************************/
void myabort(message)
char *message;
{
fprintf(stderr,"Aborting: %s\n",message);
exit(1);
}

/************************************************************************
*
* I N D E X -- D o e s S t r i n g C o n t a i n C h a r ?
*
* Not(?) a standard C function, so added by me MKF 6/87
*
************************************************************************/
byte *index(string,character)
byte *string;
byte character;
{
int i = 0;
while(string[i] != NULL)
if(string[i] == character)
break;
else
i++;

return((byte *)string[i]);
}

/************************************************************************
*
* R E M E M B E R -- R e m e m b e r P a t t e r n s
* MKF 6/87
************************************************************************/

/* The 'remembering' files should contain patterns of the same dimensions
* as the training patterns, but with no header or class information.
*/

void remember()
{
int remembered_so_far = 1;
char ps[25];

/*********************** parse filename *****************************/

if(index(rememname,'.')) /* is '.' in it ? */
; /* yes, pattern file */

else move(".pat", /* no, default extension is */
move(rememname,rememname)); /* '.pat' for pattern file */

/**************** check for command line errors *********************/

if(rememname[0]==0) /* check for missing pattern file name */
myabort(
"remembering filename not specified!");

/************************ open pattern file *************************/

if(!(pat=fopen(rememname,"r"))) /* if open fails, myabort */
myabort(
"can't open remembering pattern file!");

/****************** read the pattern & recognize it *****************/

fprintf(stdout,"Now in the Recognition Phase:\n\n");

while(my_read_pattern()) {
recognize();
sprintf(ps,"pattern \#%d is",remembered_so_far++);
show_bits(ps,decsn);
fprintf(stdout,"\n");
}
fclose(pat);
}

/************************************************************************
*
* M Y R E A D P A T T E R N -- R e a d N e x t P a t t e r n
* MKF 6/87
************************************************************************/

boolean my_read_pattern() { /* read pattern from remembering file */

int i,j; /* loop counters for row & column of image */
element *pe=pattern; /* pointer to element of pattern vector */
float tmp; /* temp cell for input conversion */

forall(i,patwide) /* for each row in the image, */
forall(j,pathite) /* for each pixel in that row, */
if(fscanf(pat,"%f",&tmp) /* input value of pixel */
!=1) return(FALSE); /* return FALSE if end-of-file */
else *pe++=(element)tmp; /* convert to type element */

return(TRUE); /* return true without looking for which class
* it is, since that is what we want the program to tell us! */
}


  3 Responses to “Category : Miscellaneous Language Source Code
Archive   : NEURAL.ZIP
Filename : SILOAM.C

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/