{$M 35520, 0, 655360}

Program ART;



uses

  Graph,

  Crt;



const

  n = 6; {number of neurons available}

  m = 576; {components in the input vector}

  L = 2; {a constant > 1}

  InitConst = 0.1; {p. 137}

  Forever:  boolean = false;



type

  InputVec = array[1..m] of integer;

  RealNeuronVec = array[1..n] of real;

  IntNeuronVec = array[1..n] of integer;

  BinaryArray = array[1..n,1..m] of integer;

  RealArray = array[1..m,1..n] of real;



var

  XNum: integer;

  XFile: text;

  OutStr: string;

  NumWrong: integer;

  Vigilance:  real;

  Gain1:  integer;

  IOutVec,

  XVec,

  TempCVec,

  CVec,

  PVec:  InputVec;

  NOutVec,

  NetVec: RealNeuronVec;

  Gain2,

  RVec:  IntNeuronVec;

  TArray:  BinaryArray;

  BArray:  RealArray;

  sum: real;

  alpha, bravo, charlie, delta: integer;

  largest: integer;

  D, EN:  integer;

  S: real;

  ResetB:  boolean;



Procedure InitGraphics;

{***************************************************************************}

{*  Task:  This procedure switches from CRT mode text output to graphics.

{*  Author:  C1C David W. Croft, CS-36, x4306

{***************************************************************************}

var

  GraphDriver: integer;

  GraphMode: integer;

  ErrorCode: integer;

begin

  DetectGraph(GraphDriver, GraphMode);

  InitGraph(GraphDriver, GraphMode, '');

  ErrorCode := GraphResult;

  if ErrorCode <> grOk then

    begin

      Writeln('Graphics error:  ',GraphErrorMsg(ErrorCode));

      Writeln('Program aborted...');

      Halt(1);

    end;

end;



Procedure DrawScreens;

{***************************************************************************}

begin

  InitGraphics;

  for alpha := 0 to n-1+1 do

    Rectangle(alpha*25+alpha*60, 0, (alpha+1)*25+alpha*60, 25);

  OutTextXY(0,27,'Input');

  for alpha := 1 to n do

    begin

      str(alpha, OutStr);

      OutTextXY(alpha*25+alpha*60, 27, 'Neuron '+OutStr);

    end;

end;



Procedure DrawTArrays;

{***************************************************************************}

begin

  for alpha := 1 to n do

    begin

      SetFillStyle(SolidFill, Black);

      Bar((alpha*25+alpha*60)+1, 0+1, (alpha*25+alpha*60)+24, 0+24);

      SetFillStyle(SolidFill, White);

      delta := 0;

      for bravo := 1 to trunc(sqrt(m)) do

        for charlie := 1 to trunc(sqrt(m)) do

          begin

            delta := delta + 1;

            if TArray[alpha, delta] = 1 then

              line((alpha*25+alpha*60)+bravo, 0+charlie,(alpha*25+alpha*60)

                +bravo, 0+charlie);

          end;

    end;

end;



Procedure GetXVec(FileNum: integer);

{***************************************************************************}

begin

  readln;

  str(FileNum,OutStr);

  OutStr := 'XFILE'+OutStr+'.SYM';

  Assign(XFile, OutStr);

  Reset(XFile);

  for alpha := 1 to m do

    readln(XFile,XVec[alpha]);

  Close(XFile);

  charlie := 0;

  for alpha := 1 to trunc(sqrt(m)) do

    for bravo := 1 to trunc(sqrt(m)) do

      begin

        charlie := charlie + 1;

        if XVec[charlie] = 1 then

          line(alpha,bravo,alpha,bravo);

      end;

end;



Procedure MultIVecByRArray(InVec:  InputVec; InArray:  RealArray);

{***************************************************************************}

begin

  for alpha := 1 to n do

    begin

      NOutVec[alpha] := 0;

      for bravo := 1 to m do

        NOutVec[alpha] := NOutVec[alpha]+InVec[bravo]*InArray[bravo,alpha];

    end;

end;



Procedure MultNVecByBArray(InVec:  IntNeuronVec; InArray:  BinaryArray);

{***************************************************************************}

begin

  for alpha := 1 to m do

    begin

      IOutVec[alpha] := 0;

      for bravo := 1 to n do

        IOutVec[alpha] := IOutVec[alpha]+InVec[bravo]*InArray[bravo,alpha];

    end;

end;



Procedure MakePVec;

{***************************************************************************}

begin

  outtextxy(0,50,'P Vector');

  MultNVecByBArray(RVec, TArray);

  PVec := IOutVec;

end;



Procedure MakeGain1;

{***************************************************************************}

begin

  sum := 0;

  Gain1 := 1;

  for alpha := 1 to n do

    sum := sum + RVec[alpha];

  if sum > 0 then

    Gain1 := 0;

  str(Gain1, OutStr);

  outtextxy(0,70,'Gain1 = '+ OutStr);

end;



Procedure MakeCVec;

{***************************************************************************}

begin

  MakePVec;

  MakeGain1;

  outtextxy(0,090,'C Vector');

  for alpha := 1 to m do

    begin

      TempCVec[alpha] := Gain1 +  XVec[alpha] + PVec[alpha];

      if TempCVec[alpha] >= 2 then

        CVec[alpha] := 1

      else

        CVec[alpha] := 0;

    end;

end;





Procedure Train;

{***************************************************************************}

begin

  MakeCVec;

  for alpha := 1 to m do

    begin

      if CVec[alpha] <> XVec[alpha] then

        begin

          Randomize;

          CVec[alpha] := trunc(random+0.5);

        end;

      TArray[largest,alpha] := CVec[alpha];

    end;

  outtextxy(0,290,'New TArray');

  DrawTArrays;

  sum := 0;

  for alpha := 1 to m do

    sum := sum + CVec[alpha];

  outtextxy(0,310,'New BArray');

  for alpha := 1 to m do

    BArray[alpha,largest] := (L*CVec[alpha])/(L - 1 + sum);

end;



Procedure ResetRVec;

{***************************************************************************}

begin

  outtextxy(0,340,'Resetting RVec to zeroes.');

  for alpha := 1 to n do

    RVec[alpha] := 0;

end;



Procedure SwitchOrTrain;

{***************************************************************************}

begin

  if (S >= Vigilance) then

    begin

      Vigilance := 1;

      NumWrong := 0;

      ResetB := false;

      for alpha := 1 to n do

        Gain2[alpha] := 1;

      outtextxy(0,230,'I think you meant to enter this:');

      Train;

    end;



  if (S < Vigilance) and (ResetB = true) then

    begin

      outtextxy(0,250,'Wrong Neuron!');

      NumWrong := NumWrong + 1;

      Gain1 := 1;

      for alpha := 1 to n do

        RVec[alpha] := 0;

      Gain2[largest] := 0;

      ResetB := true;

    end;



  if ((S < Vigilance) and (NumWrong = m-1)) and (ResetB = true) then

    begin

      ResetB := true;

      NumWrong := 0;

      vigilance := vigilance - 1/m;

      Str(vigilance:4:2, OutStr);

      outtextxy(0,270,'Reseting G2 to 1s and lowering vigilance to '+OutStr);

      for alpha := 1 to n do

        Gain2[alpha] := 1;

    end;

  ResetRVec;

end;



Procedure Initialization;

{***************************************************************************}

begin

  Vigilance := 1;

  for alpha := 1 to n do

    for bravo := 1 to m do

      TArray[alpha,bravo] := 1;

  DrawTArrays;

  for alpha := 1 to m do

    for bravo := 1 to n do

      BArray[alpha,bravo] := InitConst*L/(L-1+m);

  XNum := 0;

end;



Procedure InitRecPhase;

{***************************************************************************}

begin

{Initial Recognition Phase}

  for alpha := 1 to n do

    Gain2[alpha] := 0;

  for alpha := 1 to m do

    XVec[alpha] := 0;

  RVec := Gain2; {zeroed}

end;



Procedure InitCompPhase;

{***************************************************************************}

begin

{Initial Comparison Phase}

  XNum := XNum + 1;

  GetXVec(XNum);

  ResetB := true;

  Gain1 := 1;  {assumes XVec has at least one component that}

  for alpha := 1 to n do

    Gain2[alpha] := 1;  {is a 1}

end;



{***************************************************************************}

{***************************************************************************}

{***************************************************************************}

begin

  DrawScreens;

  Initialization;

  InitRecPhase;

repeat

  InitCompPhase;

repeat {for Reset}

  MakeCVec;



{Recognition}

  OutTextXY(0,110,'Net Vec');

  MultIVecByRArray(CVec, BArray);

  NetVec := NOutVec;

  OutTextXY(0,130,'Net Vec with Gain');

  for alpha := 1 to n do

    begin

      NetVec[alpha] := NetVec[alpha]*Gain2[alpha];

    end;

  {Inhibit}

    largest := 1;

    for alpha := 1 to n do

      if (NetVec[alpha]*Gain2[alpha] >= NetVec[largest]) then

        largest := alpha;

  {check if none fired}

  {possibly takes the place of the function of Gain2}

    sum := 0;

    for alpha := 1 to m do

      sum := sum + NetVec[alpha];

    if sum = 0 then

      begin

        largest := 0;

        outTextXY(0,150,'None of them triggered!  Set to the first.');

        largest := 1;

      end;



  {set one the components of RVec to 1}

    OutTextXy(0,170,'This is the neuron that triggered first or best.');

    RVec[largest] := 1;

    Str(largest, OutStr);

    OutTextXY(0,190,OutStr);



{Comparison}

  MakeCVec;



{Reset}

  D := 0;

  for alpha := 1 to m do

    D := D + XVec[alpha];

  EN := 0;

  for alpha := 1 to m do

    EN := EN + CVec[alpha];

  S := EN/D;

  str(S:3:2, OutStr);

  OutTextXY(0,210,'S = '+OutStr);

  SwitchOrTrain;



  until not(ResetB);



  until Forever;



end.