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.