1742 lines
52 KiB
Plaintext
1742 lines
52 KiB
Plaintext
|
||
PROGRAM Note_Generator (INPUT,OUTPUT);
|
||
{
|
||
This program demonstrates a small application which uses three
|
||
major neural network models to advantage in a cooperative,
|
||
integrated manner. The problem is that of generating musical
|
||
notes in a well-formed, but not repetitious manner. The scale of
|
||
notes is limited, and only one note is generated per time interval.
|
||
}
|
||
|
||
{
|
||
|
||
Copyright 1989 by Wesley R. Elsberry. All rights reserved.
|
||
|
||
Commercial use of this software is prohibited without written consent of
|
||
the author.
|
||
|
||
For information, bug reports, and updates contact
|
||
|
||
Wesley R. Elsberry
|
||
528 Chambers Creek Drive South
|
||
Everman, Texas 76140
|
||
Telephone: (817) 551-7018
|
||
|
||
}
|
||
|
||
|
||
USES
|
||
DOS, {Turbo Pascal MS-DOS functions}
|
||
CRT, {Turbo Pascal IBM-PC screen and keyboard functions}
|
||
ANN, {Artificial Neural Network functions}
|
||
Struct, {Linked-list structure functions}
|
||
Misc1, {Miscellaneous functions}
|
||
ANSI_Z, {ANSI screen control functions}
|
||
BP_unit, {Back-propagation network functions}
|
||
Globals, {Global types and constants}
|
||
ClasInst; {Classical Instructor function}
|
||
|
||
VAR
|
||
inf : TEXT; {Input file handle}
|
||
outf : TEXT; {Output file handle}
|
||
main_ii, {Loop variable}
|
||
main_jj : INTEGER; {Loop variable}
|
||
main_done : BOOLEAN; {Loop variable}
|
||
main_time : Time_rec_; {Record for time info}
|
||
Time1, Time2 : Time_rec_;
|
||
Testr : REAL;
|
||
Inchar : char;
|
||
note_rec : note_record_;
|
||
ii : INTEGER;
|
||
snet : BP_net_;
|
||
|
||
{For Beethoven (ART 1)}
|
||
F1 : F1_layer_ptr_;
|
||
F2 : F2_layer_ptr_;
|
||
{End VAR declarations}
|
||
|
||
{---------------------------------------------------------}
|
||
|
||
PROCEDURE Wait;
|
||
{}
|
||
BEGIN {}
|
||
{ Writeln('Press a key...');}
|
||
{ READ(inchar);}
|
||
END; {}
|
||
|
||
{----------------------------------------------------------}
|
||
|
||
|
||
|
||
PROCEDURE report_notes (VAR cmn : Common_area_);
|
||
|
||
TYPE
|
||
outstr_ = STRING[10];
|
||
|
||
VAR
|
||
ii : INTEGER;
|
||
raoutf : FILE OF CHAR;
|
||
raoutfname : STRING;
|
||
och : CHAR;
|
||
|
||
BEGIN
|
||
{open note file}
|
||
{skip to end}
|
||
{write note}
|
||
{close}
|
||
|
||
raoutfname := FSEARCH('BEETHOVN.MUS',GETENV('PATH'));
|
||
IF raoutfname <> '' THEN BEGIN
|
||
Assign(raoutf,raoutfname);
|
||
Reset(raoutf);
|
||
END
|
||
ELSE BEGIN
|
||
Assign(raoutf,'BEETHOVN.MUS');
|
||
Rewrite(raoutf);
|
||
END;
|
||
Seek (raoutf, FileSize(raoutf));
|
||
{go to end of file}
|
||
IF note_rec.c = 2 THEN BEGIN
|
||
och := ascii_cr;
|
||
Write(raoutf,och);
|
||
och := ascii_lf;
|
||
Write(raoutf,och);
|
||
och := ascii_asterisk;
|
||
Write(raoutf,och);
|
||
och := ascii_equal;
|
||
Write(raoutf,och);
|
||
och := ascii_asterisk;
|
||
Write(raoutf,och);
|
||
och := ascii_cr;
|
||
Write(raoutf,och);
|
||
och := ascii_lf;
|
||
Write(raoutf,och);
|
||
END;
|
||
och := Chr(note_rec.n[note_rec.c-1]+48);
|
||
Write(raoutf,och);
|
||
och := ascii_cr;
|
||
Write(raoutf,och);
|
||
och := ascii_lf;
|
||
Write(raoutf,och);
|
||
IF note_rec.c = 153 THEN BEGIN
|
||
och := ascii_cr;
|
||
Write(raoutf,och);
|
||
och := ascii_lf;
|
||
Write(raoutf,och);
|
||
och := ascii_asterisk;
|
||
Write(raoutf,och);
|
||
och := ascii_equal;
|
||
Write(raoutf,och);
|
||
och := ascii_asterisk;
|
||
Write(raoutf,och);
|
||
och := ascii_cr;
|
||
Write(raoutf,och);
|
||
och := ascii_lf;
|
||
Write(raoutf,och);
|
||
END;
|
||
Close(raoutf);
|
||
ANSI_CUP(2,0);
|
||
Write('Notes generated: ');
|
||
ANSI_CUP(2,25);
|
||
Write((note_rec.c-1):3);
|
||
END;
|
||
|
||
|
||
PROCEDURE record_a_note (VAR cmn : Common_area_);
|
||
|
||
CONST
|
||
Init : BOOLEAN = FALSE;
|
||
c : INTEGER = 1;
|
||
|
||
TYPE
|
||
outstr_ = STRING[10];
|
||
|
||
VAR
|
||
ii : INTEGER;
|
||
raoutf : FILE OF CHAR;
|
||
raoutfname : STRING;
|
||
och : CHAR;
|
||
|
||
BEGIN
|
||
IF NOT init THEN BEGIN
|
||
FillChar(note_rec.n,SizeOf(note_rec.n),#0);
|
||
note_rec.c := 1;
|
||
Init := TRUE;
|
||
END;
|
||
FOR ii := 1 TO V_len_out-1 DO BEGIN
|
||
{}
|
||
cmn.notes[ii] := cmn.notes[ii+1];
|
||
END; {}
|
||
cmn.notes[V_len_out] := 0;
|
||
note_rec.n[note_rec.c] := cmn.notes[v_len_out-1];
|
||
INC(note_rec.c);
|
||
report_notes(cmn);
|
||
END;
|
||
|
||
|
||
PROCEDURE play_a_note(VAR cn : BYTE);
|
||
|
||
BEGIN
|
||
CASE cn OF
|
||
1 : Sound(n_c_mid);
|
||
2 : Sound(n_d);
|
||
3 : Sound(n_e);
|
||
4 : Sound(n_f);
|
||
5 : Sound(n_g);
|
||
6 : Sound(n_a);
|
||
7 : Sound(n_b);
|
||
8 : Sound(n_c_hi);
|
||
ELSE
|
||
NoSound;
|
||
END;
|
||
Delay(180);
|
||
NoSound;
|
||
Delay(55);
|
||
END;
|
||
|
||
|
||
PROCEDURE play_notes (nr : note_record_);
|
||
|
||
VAR
|
||
ii : INTEGER;
|
||
|
||
BEGIN
|
||
ii := 1;
|
||
FOR ii := 1 TO nr.c DO play_a_note ( nr.n[ii]);
|
||
END;
|
||
|
||
|
||
|
||
PROCEDURE {Change_global_factors}
|
||
user_keys;
|
||
|
||
CONST
|
||
Initialized : BOOLEAN = FALSE;
|
||
|
||
VAR
|
||
inch : CHAR;
|
||
instr : STRING;
|
||
tempr : REAL;
|
||
err : INTEGER;
|
||
|
||
PROCEDURE display_global_factors;
|
||
|
||
BEGIN
|
||
ANSI_CUP(13,12);
|
||
Write('*res: ',HTN_co_res:5:4);
|
||
ANSI_CUP(14,12);
|
||
Write('*cap: ',HTN_co_cap:5:4);
|
||
ANSI_CUP(15,12);
|
||
Write(' *wt: ',HTN_co_wt:5:4);
|
||
ANSI_CUP(16,12);
|
||
Write('*inp: ',HTN_co_inp:5:4);
|
||
ANSI_CUP(17,12);
|
||
Write('epsi: ',epsilon:5:4);
|
||
ANSI_CUP(18,12);
|
||
Write('iter: ',HTN_co_iter:5:4);
|
||
ANSI_CUP(9,55);
|
||
Write('*Vigilance: ',ART_co_vigilance:5:4);
|
||
ANSI_CUP(23,0);
|
||
END;
|
||
|
||
|
||
BEGIN
|
||
IF NOT Initialized THEN BEGIN
|
||
ANSI_CUP(23,0);
|
||
Write
|
||
('Type "C" to change factors, "P" to play notes so far.');
|
||
display_global_factors;
|
||
ANSI_CUP(23,0);
|
||
Initialized := TRUE;
|
||
END; {IF NOT Initialized}
|
||
|
||
IF check_kbd_status THEN BEGIN
|
||
IF dir_console_IO(inch) THEN BEGIN
|
||
inch := UpCase(inch);
|
||
IF inch = 'C' THEN BEGIN
|
||
ANSI_CUP(21,0);
|
||
Write(
|
||
'Change: 1)epsi 2)*res 3)*cap 4)*wt 5)*inp 6)iter 7)*vigilance'
|
||
);
|
||
REPEAT
|
||
WHILE (NOT dir_console_IO(inch)) DO ;
|
||
UNTIL (inch IN ['1','2','3','4','5','6','7']);
|
||
REPEAT
|
||
ANSI_CUP(21,0);
|
||
ANSI_EEOL;
|
||
ANSI_CUP(21,0);
|
||
Write('Input value: ');
|
||
Readln(instr);
|
||
Val(instr,tempr,ii);
|
||
UNTIL (ii = 0);
|
||
CASE inch OF
|
||
'1' : epsilon := tempr;
|
||
'2' : HTN_co_res := tempr;
|
||
'3' : HTN_co_cap := tempr;
|
||
'4' : HTN_co_wt := tempr;
|
||
'5' : HTN_co_inp := tempr;
|
||
'6' : HTN_co_iter := tempr;
|
||
'7' : ART_co_vigilance := tempr;
|
||
END;
|
||
ANSI_CUP(22,0);
|
||
ANSI_EEOL;
|
||
display_global_factors;
|
||
ANSI_CUP(23,0);
|
||
END
|
||
ELSE IF inch = 'P' THEN BEGIN
|
||
play_notes(note_rec);
|
||
END; {Else if inch}
|
||
END;
|
||
END;
|
||
END;
|
||
|
||
{----------------------------------------------------------}
|
||
|
||
PROCEDURE Bach(VAR cmn : Common_Area_);
|
||
{Generates a new note from past sequence and frequency information.
|
||
Uses a Hopfield-Tank network to accomplish this task. }
|
||
{INPUTS:
|
||
Sequence of notes, 4 notes long
|
||
OUTPUT:
|
||
Single note, valued from 1 to 8
|
||
}
|
||
|
||
{Hopfield-Tank network. Given data and input values,
|
||
processes for output.}
|
||
|
||
PROCEDURE HTN(VAR cma : Common_Area_);
|
||
|
||
CONST
|
||
Initialized : BOOLEAN = FALSE;
|
||
|
||
TYPE
|
||
W_A_ptr_ = ^Weight_Array_;
|
||
weight_array_ = ARRAY[1..64,1..64] OF REAL;
|
||
file_string_ = STRING[127];
|
||
neuron_ = RECORD
|
||
a : REAL; {activation value}
|
||
r : REAL; {resistance}
|
||
c : REAL; {capacitance}
|
||
o : REAL; {output}
|
||
i : REAL; {input}
|
||
END;
|
||
neuron_array_ = ARRAY[1..v_len_in,1..v_len_out] OF neuron_;
|
||
note_array_ = ARRAY[1..5] OF INTEGER;
|
||
|
||
CONST
|
||
WA : W_A_ptr_ = NIL;
|
||
|
||
VAR
|
||
inf : FILE OF weight_array_;
|
||
Time_step : INTEGER;
|
||
ns : ARRAY[0..1] OF neuron_array_;
|
||
ii, jj, kk : INTEGER;
|
||
nbase, nindex : INTEGER;
|
||
|
||
FUNCTION Neuron_Output(act,cap :REAL):REAL;
|
||
|
||
BEGIN
|
||
neuron_output := 0.5 *(1 + tanh(act/cap));
|
||
END;
|
||
|
||
FUNCTION max_cell_in_column(col : INTEGER):INTEGER;
|
||
|
||
VAR
|
||
ii, jj : INTEGER;
|
||
Hi : REAL;
|
||
nsptr : INTEGER;
|
||
|
||
BEGIN {max_cell_in_column}
|
||
Hi := 0.0;
|
||
nsptr := time_step MOD 2;
|
||
FOR ii := 1 TO v_len_in DO BEGIN
|
||
IF (ns[nsptr,ii,col].o > Hi) THEN BEGIN
|
||
Hi := ns[nsptr,ii,col].o;
|
||
jj := ii;
|
||
END;
|
||
END;
|
||
max_cell_in_column := jj;
|
||
END; {max_cell_in_column}
|
||
|
||
FUNCTION done(epsi : REAL):BOOLEAN;
|
||
|
||
VAR
|
||
finish : BOOLEAN;
|
||
ii, jj : INTEGER;
|
||
t : REAL;
|
||
|
||
BEGIN
|
||
finish := FALSE;
|
||
ii := 1;
|
||
WHILE (NOT finish) AND (ii <= V_len_in) DO BEGIN
|
||
FOR jj := 1 TO 5 DO BEGIN
|
||
IF ABS(ns[0,ii,jj].o - ns[1,ii,jj].o) > epsi THEN
|
||
finish := TRUE;
|
||
END;
|
||
ii := ii + 1;
|
||
END;
|
||
done := NOT finish;
|
||
END;
|
||
|
||
FUNCTION Convert_to_weight_coord(note,posit : INTEGER):INTEGER;
|
||
|
||
BEGIN {Convert_to_weight_coord}
|
||
Convert_to_weight_coord := (v_len_in*(posit-1)+note);
|
||
END; {Convert_to_weight_coord}
|
||
|
||
|
||
FUNCTION delta_neuron_activation(a,r,i : REAL;
|
||
note,posit : INTEGER):REAL;
|
||
|
||
VAR
|
||
ii, jj : INTEGER;
|
||
tempr1, tempr2 : REAL;
|
||
sum : REAL;
|
||
di1,di2 : INTEGER;
|
||
current : INTEGER;
|
||
|
||
BEGIN {delta_neuron_activation}
|
||
current := time_step MOD 2;
|
||
sum := 0.0;
|
||
di1 := Convert_to_weight_coord(note,posit);
|
||
FOR ii := 1 TO v_len_in DO
|
||
FOR jj := 1 TO v_len_out DO BEGIN
|
||
di2 := Convert_to_weight_coord(ii,jj);
|
||
sum := sum
|
||
+ (WA^[di1,di2] * HTN_co_wt)
|
||
* ns[current,ii,jj].o;
|
||
END;
|
||
delta_neuron_activation :=
|
||
(-(ns[current,note,posit].a
|
||
/ (ns[current,note,posit].r * HTN_co_res))
|
||
+ (ns[current,note,posit].i * HTN_co_inp) + sum)
|
||
/ (ns[current,note,posit].c * HTN_co_cap);
|
||
END; {delta_neuron_activation}
|
||
|
||
|
||
FUNCTION iterate_htn(VAR nts : notes_):INTEGER;
|
||
|
||
VAR
|
||
II, JJ, next_time : INTEGER;
|
||
|
||
PROCEDURE display_neuron_activation;
|
||
|
||
CONST
|
||
column = 0;
|
||
row = 10;
|
||
|
||
VAR
|
||
ii, jj : INTEGER;
|
||
ts : INTEGER;
|
||
active : INTEGER;
|
||
|
||
BEGIN {display_neuron_activation}
|
||
ts := time_step;
|
||
FOR ii := 1 TO v_len_in DO BEGIN
|
||
{FOR ii}
|
||
ANSI_CUP(row+ii,0);
|
||
FOR jj := 1 TO v_len_out DO BEGIN
|
||
{FOR jj}
|
||
active := Round(ns[ts,ii,jj].o * 10);
|
||
IF active > 10 THEN active := 10;
|
||
IF active < 1 THEN active := 1;
|
||
Write(Copy(graphic_string,active,1),' ');
|
||
END; {FOR jj}
|
||
END; {FOR ii}
|
||
ANSI_CUP(23,0);
|
||
END; {display_neuron_activation}
|
||
|
||
PROCEDURE update_neuron_output;
|
||
|
||
VAR
|
||
ii, jj : INTEGER;
|
||
|
||
BEGIN
|
||
FOR ii := 1 TO v_len_in DO BEGIN
|
||
{FOR ii}
|
||
FOR jj := 1 TO v_len_out DO BEGIN
|
||
{FOR jj}
|
||
ns[time_step,ii,jj].o :=
|
||
neuron_output(ns[time_step,ii,jj].a,
|
||
ns[time_step,ii,jj].c);
|
||
END; {FOR jj}
|
||
END; {FOR ii}
|
||
END;
|
||
|
||
|
||
BEGIN {iterate_HTn}
|
||
|
||
time_step := 0;
|
||
{initialize the neuron arrays}
|
||
FOR ii := 1 TO 8 DO
|
||
FOR jj := 1 TO 5 DO BEGIN
|
||
ns[0,ii,jj].a := 0.5;
|
||
ns[0,ii,jj].o := 0.0;
|
||
ns[1,ii,jj].o := 0.0;
|
||
IF (nts[jj] = 0) THEN BEGIN
|
||
{randomize input}
|
||
ns[0,ii,jj].i := gaussian_noise(0.5,0.25);
|
||
ns[1,ii,jj].i := ns[0,ii,jj].i;
|
||
END
|
||
ELSE BEGIN
|
||
IF (nts[jj] = ii) THEN BEGIN
|
||
ns[0,ii,jj].i := 0.67
|
||
+ gaussian_noise(0.0,0.1);
|
||
ns[1,ii,jj].i := ns[0,ii,jj].i;
|
||
END
|
||
ELSE BEGIN
|
||
ns[0,ii,jj].i := 0.33
|
||
+ gaussian_noise(0.0,0.1);
|
||
ns[1,ii,jj].i := ns[0,ii,jj].i;
|
||
END;
|
||
END;
|
||
END;
|
||
{prevent premature end}
|
||
ns[1,1,1].o := 20;
|
||
update_neuron_output;
|
||
|
||
WHILE (NOT done(epsilon)) DO BEGIN
|
||
user_keys;
|
||
time_step := time_step MOD 2;
|
||
next_time := (time_step + 1) MOD 2;
|
||
{determine output term for neurons}
|
||
update_neuron_output;
|
||
FOR ii := 1 TO v_len_in DO BEGIN
|
||
{FOR ii}
|
||
FOR jj := 1 TO v_len_out DO BEGIN
|
||
{FOR jj}
|
||
ns[next_time,ii,jj].a := ns[time_step,ii,jj].a
|
||
+ HTN_co_iter
|
||
* delta_neuron_activation(ns[time_step,
|
||
ii,jj].a, ns[time_step,ii,jj].r,
|
||
ns[time_step,ii,jj].i,ii,jj);
|
||
END; {FOR jj}
|
||
END; {FOR ii}
|
||
display_neuron_activation;
|
||
time_step := time_step + 1;
|
||
END; {WHILE}
|
||
|
||
{**Change of note: Finding the highest activity in each column and
|
||
setting it for further processing will change the behavior of the
|
||
net and program. The change is being made to improve performance of
|
||
the ART1 network.**}
|
||
FOR ii := 1 TO v_len_out DO BEGIN
|
||
nts[ii] := max_cell_in_column(ii);
|
||
END;
|
||
|
||
iterate_htn := nts[v_len_out];
|
||
END; {Iterate_HTn}
|
||
|
||
BEGIN {HTn}
|
||
{ Initialized := False;}
|
||
IF (NOT Initialized) THEN{do initialize}
|
||
BEGIN {get weight matrix}
|
||
New(WA);
|
||
Assign(inf,'htn.dat');
|
||
Reset(inf);
|
||
Read(inf,WA^);
|
||
Close(inf);
|
||
Initialized := TRUE;
|
||
ANSI_CUP(8,0);
|
||
Write('HTN:');
|
||
ANSI_CUP(9,0);
|
||
Write('Node activity');
|
||
ANSI_CUP(11,12);
|
||
Write('R: ',global_resistance:5:3);
|
||
ANSI_CUP(12,12);
|
||
Write('C: ',global_capacitance:5:3);
|
||
ANSI_CUP(23,0);
|
||
END;
|
||
FOR ii := 1 TO 8 DO
|
||
FOR jj := 1 TO 5 DO BEGIN
|
||
ns[0,ii,jj].r := global_resistance;
|
||
ns[0,ii,jj].c := global_capacitance;
|
||
ns[1,ii,jj].r := global_resistance;
|
||
ns[1,ii,jj].c := global_capacitance;
|
||
END;
|
||
|
||
FOR ii := 1 TO v_len_out DO
|
||
{clear notes}
|
||
cma.notes[ii] := 0;
|
||
|
||
nbase := note_rec.c - v_len_out;
|
||
FOR nindex := 1 TO (v_len_out - 1) DO BEGIN
|
||
IF ((nbase + nindex) > 0) THEN
|
||
cma.notes[nindex] := note_rec.n[(nbase+nindex)];
|
||
END; {For}
|
||
|
||
cma.Candidate_note := iterate_htn(cma.notes);
|
||
cma.notes[v_len_out] := cma.candidate_note;
|
||
|
||
END; {HTn}
|
||
|
||
BEGIN {Bach}
|
||
Dump_Common(cmn);
|
||
HTn(cmn);
|
||
END; {Bach}
|
||
|
||
|
||
{----------------------------------------------------------}
|
||
|
||
PROCEDURE Salieri(VAR cmn : Common_Area_);
|
||
{Compares past information and proposed note generated by Bach with
|
||
rules of classical composition. A PDP network is used to do this.}
|
||
|
||
PROCEDURE Back_propagation(VAR cmn : Common_Area_);
|
||
{A PDP style back propagation network.}
|
||
|
||
CONST
|
||
Initialized : BOOLEAN = FALSE;
|
||
count : WORD = 1;
|
||
|
||
TYPE
|
||
bpnp_ = BP_node_ptr_;
|
||
wnp_ = weight_node_ptr_;
|
||
vnp_ = vector_node_ptr_;
|
||
|
||
VAR
|
||
ii, jj, kk : INTEGER;
|
||
Done : BOOLEAN;
|
||
tp1 : DVE_ptr_;
|
||
error_m, tne, sum : ARRAY[1..3] OF REAL;
|
||
ss : STRING;
|
||
binsum : ARRAY[1..3] OF INTEGER;
|
||
|
||
FUNCTION max (r1, r2 :REAL):REAL;
|
||
|
||
BEGIN
|
||
IF r1 >= r2 THEN max := r1
|
||
ELSE max := r2;
|
||
END;
|
||
|
||
PROCEDURE Set_input_vector_from_notes (vp : DVE_ptr_;
|
||
n : notes_);
|
||
|
||
VAR
|
||
ii : INTEGER;
|
||
vpt : DVE_ptr_;
|
||
vn : ARRAY[1..40] OF INTEGER;
|
||
|
||
BEGIN
|
||
|
||
FillChar (vn,SizeOf(vn),#0);
|
||
{Blank the current vector}
|
||
FOR ii := 1 TO 5 DO BEGIN
|
||
{Notes subscript}
|
||
IF n[ii] > 0 THEN vn [((ii-1)*8)+n[ii]] := 1;
|
||
END; {For notes subscript}
|
||
|
||
vpt := vp;
|
||
FOR ii := 1 TO snet.n_input DO BEGIN
|
||
vnp_(vpt^.dptr)^.v := vn[ii];
|
||
vpt := vpt^.right;
|
||
END; {FOR ii}
|
||
END;
|
||
|
||
BEGIN
|
||
IF NOT Initialized THEN BEGIN
|
||
snet.data_fname := 's61.dat';
|
||
|
||
ANSI_CUP(15,40);
|
||
|
||
Setup_BP_net (snet,snet.data_fname);
|
||
Write(snet.data_fname);
|
||
|
||
ANSI_CUP(16,40);
|
||
Set_BP_net_weights_from_file(snet,snet.wt_fname);
|
||
|
||
Write(snet.wt_fname);
|
||
Initialized := TRUE;
|
||
END;
|
||
|
||
{now set up current input vector}
|
||
Set_input_vector_from_notes(snet.vi,cmn.notes);
|
||
|
||
{get the supervisor's critique for the current sequence}
|
||
vnp_(snet.vts^.dptr)^.v := Classical_instructor (cmn.notes);
|
||
|
||
{Feed-forward, back-propagate, and make changes}
|
||
BP_train_and_change (snet);
|
||
|
||
{determine response of the net to the current sequence}
|
||
cmn.Is_classical := (vnp_(snet.vos^.dptr)^.v > 0.50);
|
||
|
||
{keep weight changes that have been made now and then}
|
||
IF (count MOD 49) = 0 THEN
|
||
Dump_BP_net_weights(snet,snet.wt_fname);
|
||
|
||
INC(count);
|
||
END;
|
||
|
||
BEGIN {Salieri}
|
||
Dump_common(cmn);
|
||
Back_propagation(cmn);
|
||
END; {Salieri}
|
||
|
||
|
||
{----------------------------------------------------------}
|
||
|
||
PROCEDURE Beethoven(VAR cmn : Common_Area_);
|
||
{}
|
||
|
||
PROCEDURE ART1(VAR cma : Common_Area_);
|
||
{Binary Adaptive Resonance Theory model}
|
||
{
|
||
Carpenter and Grossberg's ART1 paradigm
|
||
|
||
Copyright 1988, W.R. Elsberry & D.J. Blackwood
|
||
Written in Turbo Pascal 5.5, September 1988
|
||
|
||
}
|
||
{
|
||
Terminology:
|
||
|
||
STM = Short Term Memory
|
||
LTM = Long Term Memory
|
||
TD = Top-down
|
||
BU = Bottom-up
|
||
|
||
F1 layer = a vector of nodes which receive input from three sources:
|
||
External input, a binary vector
|
||
Gain control, an internal processing input
|
||
F2 layer, activation of category nodes through LTM traces
|
||
|
||
F2 layer = a set of nodes which have LTM memory traces associated
|
||
with them that relate to the BU activations to particular nodes in
|
||
the F2 level.
|
||
Inputs: F1 activation through BU LTM traces, Gain Control,
|
||
System Reset
|
||
|
||
}
|
||
|
||
|
||
{
|
||
Parameter constraints from Carpenter & Grossberg, 1987
|
||
|
||
A >= 0
|
||
mu1, mu2 >= 0 (Simpson)
|
||
|
||
C >= 0
|
||
epsilon1, epsilon2 >= 0 (Simpson)
|
||
|
||
MAX(1,D) < B < 1 + D
|
||
MAX(1,gamma1) < sigma1 < (1 + gamma1) (Simpson)
|
||
|
||
0 < e << 1
|
||
|
||
K = O(1)
|
||
|
||
L > 1
|
||
|
||
0 < p <= 1
|
||
0 < Vigilance <= 1 (Simpson)
|
||
|
||
0 < Z_IJ(0) < (L / (L-1+M))
|
||
0 < Wup(0) < (L / (L - 1 + Max_F1_nodes)) (Simpson)
|
||
|
||
1 >= Z_JI(0) > Z_BAR == ((B-1)/D)
|
||
1 >= Wdn(0) > ? == ((sigma2-1)/gamma2) (Simpson)
|
||
|
||
0 <= I,f,g,h <= 1
|
||
|
||
}
|
||
|
||
CONST
|
||
Initialized : BOOLEAN = FALSE;
|
||
Initial_Wup = 0.1;
|
||
Initial_Wdn = 0.9;
|
||
Number_committed_F2 : INTEGER = 0;
|
||
Vigilance : REAL = 0.9; {Determines what level of mismatch will
|
||
cause reset}
|
||
Time_slice : REAL = 0.1; {Factor to multiply deltas by}
|
||
|
||
{The following are part of the F1 STM recall equation}
|
||
mu1 : REAL = 1; {Positive constant controlling BU input & TD
|
||
feedback}
|
||
sigma1 : REAL = 1.4; {Positive constant regulating gain control}
|
||
epsilon1 : REAL = 1; {Positive constant regulating gain control}
|
||
gamma1 : REAL = 1; {Positive constant regulating TD and BU
|
||
feedback}
|
||
|
||
{The following are part of the F2 STM recall equation}
|
||
mu2 : REAL = 1; {Positive constant controlling BU input & TD
|
||
feedback}
|
||
sigma2 : REAL = 1.4; {Positive constant regulating gain control}
|
||
epsilon2 : REAL = 1; {Positive constant regulating gain control}
|
||
gamma2 : REAL = 1; {Positive constant regulating BU input}
|
||
|
||
|
||
{The following are part of the Bottom-Up LTM equation}
|
||
alpha1 : REAL = 1; {Positive constant for learning rate}
|
||
beta1 : REAL = 1; {Positive constant for passive decay}
|
||
|
||
{The following are part of the Top-Down LTM equation}
|
||
alpha2 : REAL = 1; {Positive constant for learning rate}
|
||
beta2 : REAL = 1; {Positive constant for passive decay}
|
||
|
||
VAR
|
||
i, j : INTEGER;
|
||
F2_winner : INTEGER; {Index of winning F2 node}
|
||
|
||
Input_on : BOOLEAN; {Is input currently being received?}
|
||
Resonance : BOOLEAN;
|
||
|
||
{The following are part of the match operation equation}
|
||
Vector_I : Vector_; {Binary input vector}
|
||
Vector_X : Vector_; {Binary expected vector}
|
||
|
||
PROCEDURE Build_Expected_Vector;
|
||
{}
|
||
|
||
CONST
|
||
low = 0.0;
|
||
high = 1.0;
|
||
{thresh = 0.5;}
|
||
|
||
VAR
|
||
ii, jj : INTEGER;
|
||
thresh : REAL;
|
||
|
||
BEGIN {Build_Expected_Vector}
|
||
thresh := 0.0;
|
||
|
||
WITH F2^[F2_winner] DO BEGIN
|
||
{with}
|
||
FOR ii := 1 TO Max_F1_nodes DO BEGIN
|
||
{}
|
||
thresh := thresh + Wdn[ii];
|
||
END; {}
|
||
thresh := thresh / Vector_length;
|
||
|
||
FOR ii := 1 TO Max_F1_nodes DO BEGIN
|
||
Vector_X[ii] := BYTE(Round (Threshold(low, high, thresh,
|
||
Wdn[ii]) ));
|
||
END;
|
||
END; {with}
|
||
END; {Build_Expected_Vector}
|
||
|
||
|
||
PROCEDURE Build_Input_Vector;
|
||
{}
|
||
|
||
VAR
|
||
ii, jj : INTEGER;
|
||
|
||
FUNCTION One_if_NZ(This, That : INTEGER) :INTEGER;
|
||
{}
|
||
|
||
VAR
|
||
ii : INTEGER;
|
||
|
||
BEGIN {}
|
||
ii := This AND That;
|
||
IF (ii <> 0) THEN {}
|
||
BEGIN
|
||
ii := 1;
|
||
END;
|
||
One_if_NZ := ii;
|
||
END; {}
|
||
|
||
BEGIN {Build_Input_Vector}
|
||
FillChar (vector_i,SizeOf(vector_i),#0);
|
||
{Blank the current vector}
|
||
FOR ii := 1 TO 5 DO BEGIN
|
||
{Notes subscript}
|
||
IF cma.notes[ii] > 0 THEN
|
||
vector_i [((ii-1)*8)+cma.notes[ii]] := 1;
|
||
END; {For notes subscript}
|
||
|
||
IF (cma.Is_classical) THEN
|
||
{}
|
||
BEGIN
|
||
Vector_I[Max_F1_nodes] := 1;
|
||
END
|
||
ELSE {}
|
||
BEGIN
|
||
Vector_I[Max_F1_nodes] := 0;
|
||
END;
|
||
END; {Build_Input_Vector}
|
||
|
||
|
||
PROCEDURE Display_vectors;
|
||
{}
|
||
|
||
VAR
|
||
vii : INTEGER;
|
||
|
||
BEGIN {}
|
||
ANSI_CUP(8,28);
|
||
Write('ART1: # Committed F2: ',Number_committed_F2,
|
||
' Vigilance: ',vigilance:5:4);
|
||
ANSI_CUP(9,37);
|
||
Write('F2 Winner : ',F2_winner:3);
|
||
|
||
ANSI_CUP(10,28);
|
||
Write('Expected Vector vs. Input Vector');
|
||
ANSI_CUP(12,28);
|
||
Write('IV: ');
|
||
FOR vii := 1 TO vector_length DO BEGIN
|
||
{}
|
||
IF ((vii MOD 8) = 1) AND (vii <> 1) THEN Write(' ');
|
||
Write(Vector_I[vii]);
|
||
END; {}
|
||
ANSI_CUP(11,28);
|
||
Build_Expected_Vector;
|
||
Write('EV: ');
|
||
FOR vii := 1 TO vector_length DO BEGIN
|
||
{}
|
||
IF ((vii MOD 8) = 1) AND (vii <> 1) THEN Write(' ');
|
||
Write(Vector_X[vii]);
|
||
END; {}
|
||
END; {}
|
||
|
||
PROCEDURE Clear_ART1;
|
||
{}
|
||
|
||
VAR
|
||
ii, jj : INTEGER;
|
||
|
||
BEGIN {Clear_ART1}
|
||
FOR ii := 1 TO Max_F2_nodes DO BEGIN
|
||
{Clear F2 node parameters}
|
||
WITH F2^[ii] DO BEGIN
|
||
Eligible := TRUE;
|
||
Curr_B := 0;
|
||
Last_B := 0;
|
||
END;
|
||
END; {Clear F2 node parameters}
|
||
FOR ii := 1 TO Max_F1_nodes DO BEGIN
|
||
{Clear F1 node parameters}
|
||
WITH F1^[ii] DO BEGIN
|
||
Curr_A := 0;
|
||
Last_A := 0;
|
||
END;
|
||
END; {Clear F1 node parameters}
|
||
F2_winner := 0;
|
||
END; {Clear_ART1}
|
||
|
||
PROCEDURE Initialize_ART1;
|
||
{}
|
||
|
||
VAR
|
||
ii, jj, kk : INTEGER;
|
||
|
||
BEGIN {Initialize_ART1}
|
||
Number_committed_F2 := 0;
|
||
New(F2);
|
||
New(F1);
|
||
FOR kk := 1 TO Max_F2_nodes DO BEGIN
|
||
{FOR}
|
||
WITH F2^[kk] DO BEGIN
|
||
{WITH}
|
||
Committed := FALSE;
|
||
FOR ii := 1 TO Vector_Length DO BEGIN
|
||
{For}
|
||
Wup[ii] := Initial_Wup;
|
||
Wdn[ii] := Initial_Wdn;
|
||
Last_B := 0.0;
|
||
Curr_B := 0.0;
|
||
END; {For}
|
||
END; {WITH}
|
||
END; {FOR}
|
||
FOR kk := 1 TO Max_F1_nodes DO BEGIN
|
||
{}
|
||
WITH F1^[kk] DO BEGIN
|
||
{}
|
||
Last_A := 0.0;
|
||
Curr_A := 0.0;
|
||
END; {}
|
||
END; {}
|
||
END; {Initialize_ART1}
|
||
|
||
|
||
FUNCTION Delta_STM_F1_node(nde : INTEGER):REAL;
|
||
{
|
||
Simpson (1988) Eq. 19
|
||
|
||
a_dot[nde] = - a[nde]
|
||
+ (1 - mu1 * a[nde]) *
|
||
(gamma1 * F2[f2_winner].wdn[nde] + Input[nde])
|
||
- (sigma1 + epsilon1 * a(nde) * (1 if there is a winner)
|
||
(0 otherwise)
|
||
|
||
t1 = - a[nde]
|
||
t2 = + (1 - mu1 * a[nde])
|
||
t3 = (gamma1 * F2[f2_winner].wdn[nde] + Input[nde])
|
||
|
||
t4 = (sigma1 + epsilon1 * a(nde)
|
||
t5 = (1 if there is a winner)
|
||
(0 otherwise)
|
||
so,
|
||
|
||
Delta_STM_F1_node := t1 + t2*t3 - t4*t5;
|
||
|
||
}
|
||
|
||
VAR
|
||
ii, jj : INTEGER;
|
||
t1, t2, t3, t4, t5 : REAL;
|
||
|
||
BEGIN {Delta_STM_F1_node}
|
||
t1 := 0;
|
||
t2 := 0;
|
||
t3 := 0;
|
||
t4 := 0;
|
||
t5 := 0;
|
||
|
||
WITH F1^[nde] DO BEGIN
|
||
t1 := - Last_A;
|
||
t2 := (1 - mu1*Last_A);
|
||
IF (F2_winner <> 0) THEN
|
||
{}
|
||
BEGIN {Make TD term}
|
||
t3 := F2^[F2_winner].Wdn[nde];
|
||
END;
|
||
t3 := (gamma1*t3 + Vector_I[nde]);
|
||
t4 := (sigma1 + epsilon1*Last_A);
|
||
IF (F2_winner > 0) THEN
|
||
{}
|
||
BEGIN
|
||
t5 := 1;
|
||
END
|
||
ELSE {}
|
||
BEGIN
|
||
t5 := 0;
|
||
END;
|
||
END;
|
||
Delta_STM_F1_node := t1 + t2*t3 - t4*t5;
|
||
END; {Delta_STM_F1_node}
|
||
|
||
|
||
FUNCTION Delta_STM_F2_node(nde : INTEGER):REAL;
|
||
{
|
||
Simpson (1988) Eq. 20
|
||
|
||
b_dot[nde] = - b[nde]
|
||
+ (1 - mu2 * b[nde])b*
|
||
(gamma2 * [sum over i of S(a[i] * F2[i].wup[nde] ]
|
||
+ f(b[nde])
|
||
- (sigma2 + epsilon2 * b(nde) *
|
||
[sum over k<>j of S(b[k]) ]
|
||
where,
|
||
t1 = - b[nde]
|
||
t2 = (1 - mu2 * b[nde])
|
||
t3 = (gamma2 * [sum over i of S(a[i] * F2[i].wup[nde] ] + f(b[nde])
|
||
t4 = (sigma2 + epsilon2 * b(nde)
|
||
t5 = [sum over k<>j of S(b[k]) ]
|
||
|
||
Delta_STM_F2_node := t1 + t2*t3 - t4*t5;
|
||
}
|
||
|
||
CONST
|
||
range = 1;
|
||
slope_mod = 1;
|
||
shift = 0;
|
||
|
||
VAR
|
||
ii, jj : INTEGER;
|
||
t1, t2, t3, t4, t5 : REAL;
|
||
|
||
BEGIN {Delta_STM_F2_node}
|
||
|
||
t1 := 0;
|
||
t2 := 0;
|
||
t3 := 0;
|
||
t4 := 0;
|
||
t5 := 0;
|
||
|
||
WITH F2^[nde] DO BEGIN
|
||
t1 := - Last_B;
|
||
t2 := (1 - mu2*Last_B);
|
||
|
||
FOR ii := 1 TO Max_F1_nodes DO BEGIN
|
||
{Make TD term}
|
||
t3 := t3 + sigmoid(1,1,0,F1^[ii].Curr_A)*Wup[ii];
|
||
END; {Make TD term}
|
||
IF (nde = F2_winner) THEN{}
|
||
BEGIN
|
||
jj := 1;
|
||
END
|
||
ELSE {}
|
||
BEGIN
|
||
jj := 0;
|
||
END;
|
||
|
||
t3 := (gamma2*t3 + jj);
|
||
t4 := (sigma2 + epsilon2*Last_B);
|
||
FOR ii := 1 TO number_Committed_F2 DO BEGIN
|
||
{for}
|
||
IF (Eligible) THEN BEGIN
|
||
IF (ii <> nde) THEN
|
||
t5 := t5 + Sigmoid(range, slope_mod, shift,
|
||
F2^[ii].Last_B);
|
||
END;
|
||
END; {for}
|
||
END;
|
||
Delta_STM_F2_node := t1 + t2*t3 - t4*t5;
|
||
END; {Delta_STM_F2_node}
|
||
|
||
FUNCTION Delta_LTM_Bottom_Up(F2_nde, F1_nde : INTEGER):REAL;
|
||
{
|
||
Simpson (1988) Eq. 16
|
||
|
||
wup_dot(ij) = alpha1 * f(b[j]) * (-beta1 * wup[ij] + S(a[i]) )
|
||
|
||
This corrects an error in the text!
|
||
}
|
||
|
||
CONST
|
||
range = 1;
|
||
slope_mod = 1;
|
||
shift = 0;
|
||
|
||
VAR
|
||
ii, jj : INTEGER;
|
||
t1, t2, t3,t4, t5 : REAL;
|
||
|
||
BEGIN {Delta_LTM_Bottom_Up}
|
||
IF (F2_winner = F2_nde) THEN{}
|
||
BEGIN
|
||
WITH F2^[F2_nde] DO BEGIN{}
|
||
Delta_LTM_Bottom_Up := alpha1 * ( -beta1 * Wup[F1_nde]
|
||
+ Sigmoid (range, slope_mod, shift,
|
||
F1^[F1_nde].curr_A) );
|
||
END;
|
||
END
|
||
ELSE BEGIN
|
||
Delta_LTM_Bottom_Up := 0;
|
||
END;
|
||
END; {Delta_LTM_Bottom_Up}
|
||
|
||
FUNCTION Delta_LTM_Top_Down(F2_nde, F1_nde : INTEGER):REAL;
|
||
{
|
||
Simpson (1988) Eq. 17
|
||
|
||
wdn_dot(ji) = alpha2 * f(b[j]) * (-beta2 * wdn[ji] + S(a[i]) )
|
||
|
||
This also corrects an error in the text!
|
||
}
|
||
|
||
CONST
|
||
range = 1;
|
||
slope_mod = 1;
|
||
shift = 0;
|
||
|
||
VAR
|
||
ii, jj : INTEGER;
|
||
t1, t2, t3,t4, t5 : REAL;
|
||
|
||
BEGIN {Delta_LTM_Top_Down}
|
||
IF (F2_winner = F2_nde) THEN{}
|
||
BEGIN
|
||
WITH F2^[F2_nde] DO BEGIN{}
|
||
Delta_LTM_Top_Down :=
|
||
alpha2 * ( -beta2 * Wdn[F1_nde] + Sigmoid(
|
||
range, slope_mod, shift, F1^[F1_nde].curr_A) );
|
||
END; {}
|
||
END
|
||
ELSE BEGIN
|
||
Delta_LTM_Top_Down := 0;
|
||
END;
|
||
END; {Delta_LTM_Top_Down}
|
||
|
||
FUNCTION Raw_match:INTEGER;
|
||
{
|
||
Result of bitwise AND of Vector_I and Vector_X
|
||
}
|
||
|
||
VAR
|
||
ii, jj : INTEGER;
|
||
|
||
BEGIN {Raw_match}
|
||
jj := 0;
|
||
FOR ii := 1 TO Vector_length DO BEGIN
|
||
{}
|
||
IF (Vector_I[ii] = 1) AND (Vector_X[ii] = 1) THEN
|
||
{}
|
||
BEGIN
|
||
jj := jj + 1;
|
||
END
|
||
ELSE {}
|
||
BEGIN
|
||
END;
|
||
END; {}
|
||
Raw_match := jj;
|
||
END; {Raw_match}
|
||
|
||
FUNCTION Ones_in_Vector_I:REAL;
|
||
{}
|
||
|
||
VAR
|
||
ii, jj : INTEGER;
|
||
|
||
BEGIN {Ones_in_Vector_I}
|
||
jj := 0;
|
||
FOR ii := 1 TO Vector_Length DO BEGIN
|
||
{}
|
||
jj := jj + Vector_I[ii];
|
||
END; {}
|
||
Ones_in_Vector_I := jj;
|
||
END; {Ones_in_Vector_I}
|
||
|
||
FUNCTION Match:BOOLEAN;
|
||
{
|
||
Return TRUE if Match between I and X exceeds vigilance
|
||
}
|
||
|
||
VAR
|
||
RM, OVI : REAL;
|
||
|
||
BEGIN {Match}
|
||
RM := Raw_Match;
|
||
OVI := Ones_in_Vector_I;
|
||
IF (OVI = 0) THEN {}
|
||
BEGIN
|
||
IF (RM > 0) THEN {}
|
||
BEGIN
|
||
Match := TRUE;
|
||
END
|
||
ELSE {}
|
||
BEGIN
|
||
Match := FALSE;
|
||
END;
|
||
END
|
||
ELSE {}
|
||
BEGIN
|
||
Match := ((RM/OVI) >= (Vigilance * ART_co_vigilance));
|
||
END;
|
||
END; {Match}
|
||
|
||
FUNCTION Saturated:BOOLEAN;
|
||
{}
|
||
|
||
BEGIN {Saturated}
|
||
Saturated := (Number_committed_F2 >= Max_F2_nodes);
|
||
END; {Saturated}
|
||
|
||
|
||
FUNCTION Find_F2_winner : INTEGER;
|
||
{}
|
||
|
||
VAR
|
||
ii, jj : INTEGER;
|
||
max_value : REAL;
|
||
Max_position : INTEGER;
|
||
Min_num : INTEGER;
|
||
|
||
BEGIN {Find_F2_winner}
|
||
{Find the maximum activation}
|
||
max_value := -1.0E38;
|
||
MAX_POSITION := 1;
|
||
IF (Number_Committed_F2 < Max_F2_nodes) THEN
|
||
{}
|
||
BEGIN
|
||
Min_num := Number_Committed_F2;
|
||
END
|
||
ELSE {}
|
||
BEGIN
|
||
Min_num := Max_F2_nodes;
|
||
END;
|
||
|
||
FOR jj := 1 TO Min_Num DO BEGIN
|
||
{FOR}
|
||
WITH F2^[jj] DO BEGIN {WITH}
|
||
IF (Eligible) AND (Committed) THEN BEGIN
|
||
{Eligible AND Committed}
|
||
IF (Curr_B > max_value) THEN BEGIN
|
||
{Current > Max}
|
||
max_value := Curr_B;
|
||
max_position := jj;
|
||
END; {Current > Max}
|
||
END; {Eligible AND Committed}
|
||
END; {WITH}
|
||
END; {FOR}
|
||
IF (Number_committed_F2 > 0) THEN
|
||
{}
|
||
BEGIN
|
||
Find_F2_winner := max_position;
|
||
ANSI_CUP(8,28);
|
||
Write
|
||
('ART1: # Committed F2: ',Number_committed_F2,
|
||
' Vigilance: ',vigilance:5:4);
|
||
ANSI_CUP(9,37);
|
||
Write('F2 Winner : ',max_position:3);
|
||
ANSI_CUP(23,0);
|
||
wait;
|
||
END
|
||
ELSE {}
|
||
BEGIN
|
||
Find_F2_winner := 0;
|
||
ANSI_CUP(9,37);
|
||
Write('F2 Winner : ',0:3);
|
||
ANSI_CUP(23,0);
|
||
END;
|
||
END; {Find_F2_winner}
|
||
|
||
FUNCTION Changed_STM_F1(epsilon : REAL) : BOOLEAN;
|
||
{}
|
||
|
||
VAR
|
||
ii, jj : INTEGER;
|
||
Temp : BOOLEAN;
|
||
rr : REAL;
|
||
|
||
BEGIN {Changed_STM_F1}
|
||
Temp := FALSE;
|
||
FOR II := 1 TO Vector_Length DO BEGIN
|
||
{For}
|
||
WITH F1^[ii] DO BEGIN {With}
|
||
rr := ABS(Curr_A - Last_A);
|
||
IF (rr > epsilon) THEN{Changed}
|
||
BEGIN
|
||
Temp := TRUE;
|
||
END;
|
||
END; {With}
|
||
END; {For}
|
||
Changed_STM_F1 := Temp;
|
||
END; {Changed_STM_F1}
|
||
|
||
FUNCTION Changed_STM_F2 (epsilon : REAL): BOOLEAN;
|
||
{}
|
||
|
||
VAR
|
||
ii, jj : INTEGER;
|
||
Temp : BOOLEAN;
|
||
rr : REAL;
|
||
|
||
BEGIN {Changed_STM_F2}
|
||
Temp := FALSE;
|
||
IF (F2_winner > 0) AND (F2_winner <= Max_F2_nodes) THEN BEGIN
|
||
WITH F2^[F2_winner] DO BEGIN
|
||
{With}
|
||
rr := ABS(Curr_B - Last_B);
|
||
IF (rr > epsilon) THEN{Changed}
|
||
BEGIN
|
||
Temp := TRUE;
|
||
END;
|
||
END; {With}
|
||
END
|
||
ELSE BEGIN
|
||
Temp := FALSE;
|
||
END;
|
||
|
||
Changed_STM_F2 := Temp;
|
||
END; {Changed_STM_F2}
|
||
|
||
PROCEDURE Do_resonate;
|
||
{}
|
||
|
||
CONST
|
||
Iter = 10;
|
||
E = 0.05;
|
||
|
||
VAR
|
||
ii, jj, End_loop : INTEGER;
|
||
|
||
BEGIN {Do_resonate}
|
||
End_loop := 0;
|
||
|
||
{While change in STM do alternate BU and TD STM and BU and TD LTM}
|
||
REPEAT {}
|
||
{BU STM}
|
||
FOR ii := 1 TO Vector_Length DO BEGIN
|
||
{For F1 STM}
|
||
WITH F1^[ii] DO BEGIN {With F1}
|
||
Last_A := Curr_A;
|
||
Curr_A := Last_A + time_slice * Delta_STM_F1_node(ii);
|
||
END; {With F1}
|
||
END; {For F1 STM}
|
||
|
||
{BU LTM}
|
||
FOR ii := 1 TO Vector_Length DO BEGIN
|
||
{For BU LTM}
|
||
WITH F2^[F2_winner] DO BEGIN
|
||
{With F2_winner}
|
||
Wup[ii] := Wup[ii] + time_slice
|
||
* Delta_LTM_Bottom_up(F2_winner,ii);
|
||
END; {With F2_winner}
|
||
END; {For BU LTM}
|
||
{ Display_vectors;}
|
||
|
||
{TD STM}
|
||
WITH F2^[F2_winner] DO BEGIN
|
||
{}
|
||
Last_B := Curr_B;
|
||
Curr_B := Last_B + time_slice
|
||
* Delta_STM_F2_node(F2_winner);
|
||
END; {}
|
||
|
||
{TD LTM}
|
||
|
||
FOR ii := 1 TO Vector_Length DO BEGIN
|
||
{For TD LTM}
|
||
WITH F2^[F2_winner] DO BEGIN
|
||
{With F2_winner}
|
||
Wdn[ii] := Wdn[ii] + time_slice
|
||
* Delta_LTM_Top_Down(F2_winner,ii);
|
||
END; {With F2_winner}
|
||
END; {For TD LTM}
|
||
{ Display_vectors;}
|
||
End_Loop := End_Loop + 1;
|
||
UNTIL ((NOT Changed_STM_F1(e)) AND (NOT Changed_STM_F2(e)))
|
||
OR (End_loop > Iter); {}
|
||
Display_vectors;
|
||
Resonance := TRUE;
|
||
|
||
END; {Do_resonate}
|
||
|
||
|
||
FUNCTION Exists_eligible : BOOLEAN;
|
||
{}
|
||
|
||
VAR
|
||
ii, jj : INTEGER;
|
||
Temp : BOOLEAN;
|
||
|
||
BEGIN {Exists_eligible}
|
||
Temp := FALSE;
|
||
FOR jj := 1 TO Number_committed_F2 DO BEGIN
|
||
{FOR}
|
||
WITH F2^[jj] DO BEGIN {WITH}
|
||
IF (Eligible) AND (Committed) THEN BEGIN
|
||
{Eligible AND Committed}
|
||
Temp := TRUE;
|
||
END; {Eligible AND Committed}
|
||
END; {WITH}
|
||
END; {FOR}
|
||
Exists_eligible := Temp;
|
||
END; {Exists_eligible}
|
||
|
||
PROCEDURE Encode_New_F2;
|
||
{}
|
||
|
||
VAR
|
||
ii, jj : INTEGER;
|
||
|
||
BEGIN {}
|
||
IF number_committed_F2 < Max_F2_nodes THEN BEGIN
|
||
{Find next uncommitted F2 node}
|
||
F2_winner := Number_committed_F2 + 1;
|
||
{Resonate uncommitted F2 node with F1}
|
||
Do_resonate;
|
||
F2^[F2_winner].Eligible := TRUE;
|
||
F2^[F2_winner].Committed := TRUE;
|
||
Number_committed_F2 := Number_committed_F2 + 1;
|
||
END; {IF }
|
||
END; {}
|
||
|
||
|
||
PROCEDURE Find_F1_activation;
|
||
|
||
VAR
|
||
i, j : INTEGER;
|
||
|
||
BEGIN
|
||
ANSI_CUP(14,37);
|
||
Write('Find F1 Activation':30);
|
||
ANSI_CUP(23,0);
|
||
FOR j := 1 TO 3 DO
|
||
FOR i := 1 TO Vector_Length DO BEGIN
|
||
{FOR}
|
||
WITH F1^[i] DO BEGIN {WITH}
|
||
Last_A := Curr_A;
|
||
Curr_A := Last_A + time_slice * Delta_STM_F1_Node(i);
|
||
END; {WITH}
|
||
END; {FOR}
|
||
END;
|
||
|
||
PROCEDURE Find_F2_activation;
|
||
|
||
VAR
|
||
i, J : INTEGER;
|
||
|
||
BEGIN
|
||
ANSI_CUP(14,37);
|
||
Write('Find F2 Activation':30);
|
||
ANSI_CUP(23,0);
|
||
FOR j := 1 TO Number_committed_F2 DO BEGIN
|
||
{FOR}
|
||
WITH F2^[j] DO BEGIN {WITH}
|
||
IF (Eligible) AND (Committed) THEN
|
||
{}
|
||
BEGIN
|
||
Last_B := Curr_B;
|
||
Curr_B := Last_B + time_slice * Delta_STM_F2_node(j);
|
||
END;
|
||
END; {WITH}
|
||
END; {FOR}
|
||
END;
|
||
|
||
|
||
|
||
BEGIN {ART1}
|
||
ANSI_CUP(8,28);
|
||
Write('ART1:');
|
||
ANSI_CUP(14,28);
|
||
Write('Process:');
|
||
ANSI_CUP(23,0);
|
||
Build_Input_vector;
|
||
IF (NOT Initialized) THEN BEGIN {do initialize}
|
||
ANSI_CUP(14,37);
|
||
Write('Initialize':30);
|
||
ANSI_CUP(23,0);
|
||
Initialize_ART1;
|
||
Initialized := TRUE;
|
||
END;
|
||
|
||
{Clear_ART}
|
||
ANSI_CUP(14,37);
|
||
Write('Clear':30);
|
||
ANSI_CUP(23,0);
|
||
Clear_ART1;
|
||
|
||
cma.Delta_Vigilance := FALSE;
|
||
cma.New_Category := FALSE;
|
||
|
||
REPEAT
|
||
user_keys;
|
||
Resonance := FALSE;
|
||
{Find current F1 activation}
|
||
{F1_i node activation * Wij}
|
||
Find_F1_activation;
|
||
{Send F1 activation to F2}
|
||
Find_F2_activation;
|
||
{If no committed F2 nodes, then
|
||
proceed to new encoding}
|
||
IF (NOT exists_eligible) OR (number_committed_F2 = 0) THEN
|
||
{}
|
||
BEGIN
|
||
ANSI_CUP(14,37);
|
||
Write('No comm. F2, encoding':30);
|
||
ANSI_CUP(23,0);
|
||
Encode_New_F2;
|
||
Resonance := TRUE;
|
||
cma.New_Category := TRUE;
|
||
END
|
||
ELSE BEGIN
|
||
{F2 competition}
|
||
{Determine maximum of
|
||
eligible F2 nodes}
|
||
ANSI_CUP(14,37);
|
||
Write('F2 Competition':30);
|
||
ANSI_CUP(23,0);
|
||
F2_winner := Find_F2_winner;
|
||
{F2 winner sends TD image back to F1}
|
||
{Activation of F2 winner * Wji}
|
||
Display_vectors; {Makes a call to Build_Expected_Vector}
|
||
{Compare Input vector to F2 TD vector}
|
||
IF (Match) THEN BEGIN {Resonate}
|
||
ANSI_CUP(14,37);
|
||
Write('Matched, now resonate':30);
|
||
ANSI_CUP(23,0);
|
||
|
||
Resonance := TRUE;
|
||
Do_resonate;
|
||
END {Resonate}
|
||
ELSE BEGIN {Mismatch}
|
||
ANSI_CUP(14,37);
|
||
Write('Mismatch':30);
|
||
ANSI_CUP(23,0);
|
||
{Make the F2 node ineligible}
|
||
F2^[F2_winner].Eligible := FALSE;
|
||
{Have we saturated?}
|
||
{Yes, lower vigilance and restart}
|
||
{ * While this is not part of the
|
||
Carpenter-Grossberg ART 1 architecture,
|
||
this modification we felt necessary for
|
||
the small number of category nodes which
|
||
we are using in the model. * }
|
||
|
||
IF (Saturated) AND (NOT exists_eligible) THEN
|
||
{If saturation reached decrease vigilance and
|
||
restart}
|
||
BEGIN {Saturation}
|
||
ANSI_CUP(14,37);
|
||
Write('Saturated, vigilance--':30);
|
||
ANSI_CUP(23,0); {vigilance is decreased}
|
||
Vigilance := Vigilance * 0.99;
|
||
ANSI_CUP(8,57);
|
||
Write('Vigilance: ',vigilance:5:4);
|
||
ANSI_CUP(23,0);
|
||
cma.Delta_Vigilance := TRUE;
|
||
{call clear_ART1}
|
||
Clear_ART1;
|
||
Find_F1_activation;
|
||
Find_F2_activation;{now find closest match and resonate}
|
||
F2_winner := Find_F2_winner;
|
||
|
||
Resonance := TRUE;
|
||
Do_resonate;
|
||
END {Saturation}
|
||
ELSE BEGIN {Not saturated or exists_eligible}
|
||
{Are there eligible F2 nodes?}
|
||
IF (Exists_eligible) THEN
|
||
{Yes, go on with current process}
|
||
BEGIN
|
||
ANSI_CUP(14,37);
|
||
Write('Search Eligible F2':30);
|
||
ANSI_CUP(23,0); {Just continue}
|
||
END
|
||
ELSE BEGIN
|
||
{No, form a new encoding if not saturated}
|
||
IF NOT saturated THEN BEGIN
|
||
ANSI_CUP(14,37);
|
||
Write('Encode new category':30);
|
||
ANSI_CUP(23,0);
|
||
Encode_New_F2;
|
||
Resonance := TRUE;
|
||
cma.New_Category := TRUE;
|
||
END; {IF NOT saturated}
|
||
END;
|
||
END; {Not saturated}
|
||
END; {Mismatch}
|
||
END; {ELSE}
|
||
UNTIL (Resonance);
|
||
{Prep info to pass back}
|
||
END; {ART1}
|
||
|
||
{----------------------------------------------------}
|
||
BEGIN {Beethoven}
|
||
Dump_common(cmn);
|
||
ART1(cmn);
|
||
END; {Beethoven}
|
||
|
||
|
||
|
||
|
||
{----------------------------------------------------------}
|
||
|
||
|
||
PROCEDURE Lobes;
|
||
{
|
||
Keeps track of played notes, maintaining sequence information.
|
||
Uses data from Beethoven to determine when to override Salieri.
|
||
}
|
||
|
||
CONST
|
||
Max_notes_in_composition = 152;
|
||
Object_threshold = 3;
|
||
Frustration_threshold = 10;
|
||
|
||
VAR
|
||
Common : Common_Area_;
|
||
Number_notes : INTEGER; {Note counter}
|
||
Objects : BOOLEAN;
|
||
Note_Played : BOOLEAN;
|
||
Generate_Candidate : BOOLEAN;
|
||
Need_Critique : BOOLEAN;
|
||
Need_Compose : BOOLEAN;
|
||
Since_Novelty, Frustration : INTEGER;
|
||
ii : INTEGER;
|
||
|
||
BEGIN {Lobes}
|
||
Randomize;
|
||
note_rec.c := 0;
|
||
Since_Novelty := 0;
|
||
Frustration := 0;
|
||
Common.notes[1] := 0;
|
||
Common.notes[2] := 0;
|
||
Common.notes[3] := 0;
|
||
Common.notes[4] := 0;
|
||
Common.notes[5] := 0;
|
||
Common.delta_vigilance := FALSE;
|
||
Common.new_category := FALSE;
|
||
Common.candidate_note := 0;
|
||
Common.is_classical := FALSE;
|
||
|
||
ANSI_CUP(14,37);
|
||
Write('Begin Simulation':30);
|
||
ANSI_CUP(23,0);
|
||
|
||
FOR Number_notes := 1 TO Max_notes_in_composition DO BEGIN
|
||
{}
|
||
user_keys;
|
||
|
||
Note_played := FALSE;
|
||
Generate_Candidate := TRUE;
|
||
Need_Critique := TRUE;
|
||
Need_Compose := TRUE;
|
||
|
||
REPEAT
|
||
IF Generate_candidate THEN
|
||
{Generate a candidate note, HTn}
|
||
BEGIN
|
||
Bach(Common);
|
||
ANSI_CUP(6,0);
|
||
Write('Candidate Note:');
|
||
ANSI_CUP(6,35);
|
||
Write(common.candidate_note);
|
||
ANSI_CUP(23,0);
|
||
END;
|
||
wait;
|
||
IF Need_Critique THEN BEGIN
|
||
{Find if it is a candidate sequence, PDP}
|
||
Salieri(Common);
|
||
ANSI_CUP(5,0);
|
||
Write('Candidate sequence classical?:');
|
||
ANSI_CUP(5,31);
|
||
Write(common.Is_Classical);
|
||
ANSI_CUP(23,0);
|
||
END;
|
||
wait;
|
||
IF Need_Compose THEN {Pass through ART and }
|
||
BEGIN
|
||
Beethoven(Common);
|
||
END;
|
||
wait; {IF Delta_vigilance or New_category,
|
||
then zero the count}
|
||
{Else increment the count}
|
||
IF (Common.Delta_vigilance OR Common.New_Category) THEN
|
||
{}
|
||
BEGIN
|
||
Since_Novelty := 0;
|
||
END
|
||
ELSE {}
|
||
BEGIN
|
||
Since_novelty := Since_Novelty + 1;
|
||
END;
|
||
IF (Common.Delta_vigilance) THEN BEGIN
|
||
INC(Frustration);
|
||
END;
|
||
|
||
{If count >= Object_threshold), then Objects
|
||
is true, reset count}
|
||
{Else Objects is false}
|
||
Objects := (Since_Novelty >= Object_threshold);
|
||
{OR (Frustration > Frustration_Threshold);}
|
||
IF Objects THEN since_novelty := 0;
|
||
IF (objects AND common.is_classical) OR ((NOT objects)
|
||
AND (NOT common.is_classical)) THEN BEGIN
|
||
generate_candidate := TRUE;
|
||
need_critique := TRUE;
|
||
need_compose := TRUE;
|
||
common.notes[v_len_out] := 0;
|
||
INC(Frustration);
|
||
END
|
||
ELSE BEGIN
|
||
record_a_note(Common);
|
||
note_played := TRUE;
|
||
Frustration := 0;
|
||
END;
|
||
UNTIL (Note_played); {A note has been played}
|
||
|
||
END; {}
|
||
|
||
END; {Lobes}
|
||
|
||
|
||
|
||
|
||
{----------------------------------------------------------}
|
||
|
||
BEGIN {Main}
|
||
|
||
WRITELN('Copyright 1989 by Wesley R. Elsberry');
|
||
DELAY(2000);
|
||
ANSI_CLRSCR;
|
||
|
||
Lobes;
|
||
|
||
END. {Main}
|
||
|
||
|