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.