TriuneCadence/THES/HTNDATA.PP

PROGRAM HTN_data_build(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
       CRT, misc1, DOS;

    CONST
       row_inhibition : REAL = -0.08;
       col_inhibition : REAL = -0.08;
       seq_add : REAL = 0.0;

    TYPE
       REAL = SINGLE;
       file_string_ = STRING[127];
       data_array_ = ARRAY[1..64,1..64] OF REAL;

    VAR
       inf, outf : TEXT;
       outdatf : FILE OF data_array_;
       data : data_array_;
       ii, jj, kk, ll, mm, nn : INTEGER;
       inch : CHAR;
       line, value : file_string_;
       di1, di2 : INTEGER;
       note1, note2, posit1, posit2 : INTEGER;
       error : INTEGER;
       min, max, range : REAL;
       tii, tjj : INTEGER;
       tr, ts : REAL;
       sums : ARRAY[1..5,1..8] OF REAL;
       sumssum : REAL;


    PROCEDURE init_sums ;

       VAR
          ii, jj : INTEGER;

       BEGIN

          FOR ii := 1 TO 5 DO
             FOR jj := 1 TO 8 DO sums[ii,jj] := 0;
          END;

    FUNCTION maximum(r1,r2:REAL):REAL;

       BEGIN
          IF r1 >= r2 THEN maximum := r1
          ELSE maximum := r2;
          END;

    FUNCTION signum(x : REAL):REAL;

       BEGIN
          IF (x >= 0.0) THEN BEGIN
             signum := 1;
             END
          ELSE BEGIN
             signum := -1;
             END;
          END;

    PROCEDURE show_node_sums;

       VAR
          ii, jj : INTEGER;

       BEGIN
          init_sums;
          sumssum := 0;

          FOR ii := 1 TO 5 DO
             FOR jj := 1 TO 8 DO BEGIN
                FOR kk := 1 TO 5 DO
                   FOR ll := 1 TO 8 DO BEGIN
                      sums[ii,jj] := sums[ii,jj] + data[(8*(ii-1)+jj),
                           (8*(kk-1)+ll)];
                      END;
                END;

          FOR jj := 1 TO 8 DO BEGIN
             FOR ii := 1 TO 5 DO BEGIN
                WRITE(sums[ii,jj]:6:3,' ');
                sumssum := sumssum + sums[ii,jj];
                END;
             WRITELN;
             END;
          WRITELN (sumssum);
          WRITELN;

          END;

    PROCEDURE set_row_and_column_inhibition;

       VAR
          ii, jj, kk, ll : INTEGER;

       BEGIN

          FOR note1 := 1 TO 8 DO
             FOR posit1 := 1 TO 5 DO BEGIN
                di1 := (8*(posit1-1)+note1);
                FOR ii := 1 TO 8 DO{increase column inhibition}
                     BEGIN
                   IF (note1 <> ii) THEN BEGIN
                      di2 := (8*(posit1-1)+ii);
                      data[di1,di2] := data[di1,di2] + col_inhibition;
                      data[di2,di1] := data[di1,di2];
                      END;
                   END;
                FOR jj := 1 TO 5 DO BEGIN
                   IF (posit1 <> jj) THEN BEGIN
                      di2 := (8*(jj-1)+note1);
                      data[di1,di2] := data[di1,di2] + row_inhibition;
                      data[di2,di1] := data[di1,di2];
                      END
                   ELSE BEGIN
                      END;
                   END;
                END;

          END;

    PROCEDURE clear_diagonal;

       VAR
          ii, jj, kk, ll : INTEGER;

       BEGIN
          FOR ii := 1 TO 40 DO data[ii,ii] := 0.0;
          END;


    BEGIN
       col_inhibition := ((8.0+(8.0-5.0))/5.0) * row_inhibition;
       seq_add := -(row_inhibition/7.0);

       init_sums;

       NoSound;

       FOR ii := 1 TO 40 DO
          FOR jj := 1 TO 40 DO data[ii,jj] := 0.0;

       Assign(inf,'sequence.dat');
       Reset(inf);
       Assign(outdatf,'htn.dat');
       ReWRITE(outdatf);

       WHILE NOT Eof(inf) DO BEGIN {get a line}
          Readln(inf,line);
          WRITELN(line);           {increment connection values in the
                                      data array}
          FOR ii := 1 TO (Length(line)-1) DO BEGIN
             Val(Copy(line,ii,1),note1,error);
             Val(Copy(line,ii+1,1),note2,error);
             WRITELN(note1,',',note2);
             FOR posit1 := 1 TO 4 DO BEGIN
                di1 := (8*(posit1-1))+note1;
                di2 := (8*(posit1))+note2;
                data[di1,di2] := data[di1,di2] + seq_add;
                data[di2,di1] := data[di1,di2];
                                   {symmetric weights!}
                END;
             END;
          IF Length(line) >= 3 THEN
             FOR ii := 1 TO (Length(line)-2) DO BEGIN
                Val(Copy(line,ii,1),note1,error);
                Val(Copy(line,ii+2,1),note2,error);
                WRITELN(note1,',',note2);
                FOR posit1 := 1 TO 3 DO BEGIN
                   di1 := (8*(posit1-1))+note1;
                   di2 := (8*(posit1+1))+note2;
                   data[di1,di2] := data[di1,di2] + seq_add;
                   data[di2,di1] := data[di1,di2];
                   END;
                END;
          END;
       show_node_sums;

       set_row_and_column_inhibition;

       show_node_sums;

       clear_diagonal;
       show_node_sums;

       WRITE(outdatf,data);
       Close(inf);
       Close(outdatf);
       END.