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}