252 lines
7.0 KiB
Plaintext
252 lines
7.0 KiB
Plaintext
|
||
PROGRAM Salieri_network_training_program (Input,Output);
|
||
|
||
{
|
||
|
||
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, struct, BP_unit, misc1, ANSI_Z, globals, clasinst;
|
||
|
||
{General}
|
||
|
||
TYPE
|
||
REAL = SINGLE;
|
||
bpnp_ = BP_node_ptr_;
|
||
wnp_ = weight_node_ptr_;
|
||
vnp_ = vector_node_ptr_;
|
||
|
||
seq_pop_rec_ = RECORD
|
||
n : notes_;
|
||
t : INTEGER;
|
||
e : REAL;
|
||
END;
|
||
|
||
seq_pop_ = ARRAY[0..99] OF seq_pop_rec_;
|
||
|
||
seq_pop_command_ = (init,replace);
|
||
|
||
VAR
|
||
snet, s31net, s46net : BP_net_;
|
||
ii, jj, kk : INTEGER;
|
||
Done : BOOLEAN;
|
||
cmn : common_area_;
|
||
notes : notes_;
|
||
tp1, tp2, tp3 : DVE_ptr_;
|
||
error_m, tne, sum : ARRAY[1..3] OF REAL;
|
||
ss : STRING;
|
||
binsum : ARRAY[1..3] OF INTEGER;
|
||
fpos, fneg : INTEGER;
|
||
tr : REAL;
|
||
sinch : CHAR;
|
||
scon : STRING;
|
||
sp : seq_pop_;
|
||
|
||
|
||
PROCEDURE maintain_seq_pop (VAR sp1 : seq_pop_;
|
||
spot : INTEGER;
|
||
cmd : seq_pop_command_);
|
||
|
||
VAR
|
||
ii, jj : INTEGER;
|
||
|
||
BEGIN
|
||
CASE cmd OF
|
||
init : BEGIN
|
||
FOR ii := 0 TO 99 DO BEGIN
|
||
FOR jj := 1 TO 5 DO BEGIN
|
||
sp1[ii].n[jj] := 0;
|
||
END;
|
||
sp1[ii].t := 0;
|
||
sp1[ii].e := 0.0;
|
||
END; {FOR ii}
|
||
END; {init}
|
||
replace : BEGIN
|
||
|
||
REPEAT
|
||
|
||
FOR jj := 1 TO 3 DO BEGIN
|
||
|
||
IF (jj = 1) THEN BEGIN
|
||
sp1[spot].n[jj] := Random(9);
|
||
END
|
||
ELSE BEGIN
|
||
IF (sp1[spot].n[jj-1] = 0) THEN BEGIN
|
||
sp1[spot].n[jj] := Random(9);
|
||
END
|
||
ELSE BEGIN
|
||
sp1[spot].n[jj] := Random(8) + 1;
|
||
END;
|
||
END;
|
||
END;
|
||
FOR jj := 4 TO v_len_out DO BEGIN
|
||
sp1[spot].n[jj] := Random(8) + 1;
|
||
END; {FOR jj}
|
||
sp1[spot].t := Classical_instructor(sp1[spot].n);
|
||
UNTIL (Odd(spot)) OR (sp1[spot].t = 1);
|
||
END; {replace}
|
||
ELSE
|
||
BEGIN
|
||
END;
|
||
END; {Case CMD}
|
||
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 40 DO BEGIN
|
||
vnp_(vpt^.dptr)^.v := vn[ii];
|
||
vpt := vpt^.right;
|
||
END; {FOR ii}
|
||
END;
|
||
|
||
|
||
BEGIN
|
||
Done := FALSE;
|
||
s46net.data_fname := 's61.dat';
|
||
|
||
ANSI_CUP(13,0);
|
||
Writeln(MemAvail:8);
|
||
|
||
Writeln(s46net.data_fname);
|
||
Setup_BP_net (s46net,s46net.data_fname);
|
||
|
||
Writeln;
|
||
|
||
Writeln(s46net.wt_fname);
|
||
Set_BP_net_weights_from_file(s46net,s46net.wt_fname);
|
||
|
||
|
||
ANSI_CLRSCR;
|
||
Writeln(MemAvail:8);
|
||
|
||
maintain_seq_pop(sp,0,init);
|
||
FOR ii := 1 TO 100 DO BEGIN
|
||
maintain_seq_pop(sp,ii-1,replace);
|
||
END;
|
||
|
||
REPEAT
|
||
IF dir_console_IO (sinch) THEN BEGIN
|
||
IF (UpCase(sinch) = 'Q') THEN BEGIN
|
||
Close (s46net.out_f);
|
||
EXIT;
|
||
END;
|
||
END;
|
||
|
||
FOR ii := 1 TO 3 DO BEGIN
|
||
error_m[ii] := 0;
|
||
sum[ii] := 0;
|
||
binsum[ii] := 0;
|
||
fpos := 0;
|
||
fneg := 0;
|
||
END;
|
||
|
||
FOR ii := 1 TO 100 DO BEGIN
|
||
IF dir_console_IO (sinch) THEN BEGIN
|
||
IF (UpCase(sinch) = 'Q') THEN BEGIN
|
||
Close (s46net.out_f);
|
||
EXIT;
|
||
END;
|
||
END;
|
||
|
||
|
||
|
||
Set_input_vector_from_notes (s46net.vi,sp[ii-1].n);
|
||
vnp_(s46net.vts^.dptr)^.v := sp[ii-1].t;
|
||
|
||
|
||
|
||
BP_train_and_change (s46net);
|
||
|
||
tne[3] := ABS(BP_net_error(s46net));
|
||
|
||
sp[ii-1].e := tne[3];
|
||
notes := sp[ii-1].n;
|
||
|
||
|
||
FOR kk := 3 TO 3 DO BEGIN
|
||
error_m[kk] := max_single(ABS(error_m[kk]),tne[kk]);
|
||
END;
|
||
|
||
IF ((tne[3] > 0.50) AND (vnp_(s46net.vts^.dptr)^.v = 1.0)) OR
|
||
((tne[3] >= 0.50) AND (vnp_(s46net.vts^.dptr)^.v = 0.0))
|
||
THEN BEGIN
|
||
INC(binsum[3]);
|
||
IF ((tne[3] > 0.50) AND (vnp_(s46net.vts^.dptr)^.v = 1.0))
|
||
THEN INC(fneg);
|
||
IF ((tne[3] >= 0.50) AND (vnp_(s46net.vts^.dptr)^.v = 0.0)
|
||
) THEN INC(fpos);
|
||
Write (s46net.out_f,'I ');
|
||
FOR kk := 1 TO 5 DO BEGIN
|
||
Write (s46net.out_f,(notes[kk]/1.0):1:1,' ');
|
||
END;
|
||
Writeln (s46net.out_f);
|
||
Writeln (s46net.out_f,'T ',vnp_(s46net.vts^.dptr)^.v:1:1);
|
||
END;
|
||
|
||
ANSI_CUP(20,0);
|
||
Write(ii:4,' Max Current Ave. Binary ');
|
||
FOR kk := 1 TO 5 DO Write(notes[kk]:1);
|
||
Write(' ',vnp_(s46net.vts^.dptr)^.v:2:1);
|
||
|
||
ANSI_CUP(24,17);
|
||
FOR kk := 1 TO 5 DO Write(notes[kk]:1);
|
||
|
||
|
||
FOR kk := 3 TO 3 DO BEGIN
|
||
ANSI_CUP(20+kk,0);
|
||
sum[kk] := sum[kk] + tne[kk];
|
||
Write(kk:4,' ',error_m[kk]:5:3,' ',tne[kk]:5:3,
|
||
' ',(sum[kk]/ii):5:3,' ',binsum[kk]:3);
|
||
END;
|
||
Write(' FPOS: ',fpos:3,' FNEG: ',fneg:3);
|
||
|
||
IF (sp[ii-1].e < Random) THEN BEGIN
|
||
maintain_seq_pop(sp,ii-1,replace);
|
||
END;
|
||
|
||
END; {FOR ii}
|
||
|
||
FOR kk := 3 TO 3 DO BEGIN
|
||
ANSI_CUP(14+kk,0);
|
||
Write(kk:4,' ',error_m[kk]:5:3,' ',(sum[kk]/100):5:3,' ',
|
||
binsum[kk]:3);
|
||
END;
|
||
Write(' FPOS: ',fpos:3,' FNEG: ',fneg:3);
|
||
|
||
Done := (error_m[3] <= s46net.errtol);
|
||
|
||
Dump_BP_net_weights(s46net,s46net.wt_fname);
|
||
|
||
UNTIL (Done);
|
||
Close (s46net.out_f);
|
||
END.
|
||
|
||
|
||
|