Program Neural;



uses

  Crt;



const {Global}

  NumRows = 3;

  NumCols = 3;

  AdjRate = 0.1;

  Forever: boolean = false;



type {Global}

  GlobalArray = array[1..NumRows, 1..NumCols] of real;



var {Global}

  BinPic:  GlobalArray;

  InitWgt:  GlobalArray;

  alpha, bravo, charlie, delta: integer;

  OutArray,

  TargetArray,

  OutDiffArray,

  HidDiffArray,

  WgtHidArray,

  SqHidArray,

  WgtOutArray,

  SqOutArray,

  OneMinSqOut,

  OutDeltaArray,

  HidDeltaArray:  GlobalArray;

  pass: integer;



Procedure ZeroArray(var ArrayIn:  GlobalArray);

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

begin

  for alpha := 1 to NumRows do

    for bravo := 1 to NumCols do

      ArrayIn[alpha,bravo] := 0;

end;



Procedure GetBinPic;

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

var

  rows: integer;

begin

  ZeroArray(BinPic);

  clrscr;

  write('# of rows:  ');

  readln(rows);

  for alpha := 1 to rows do

      begin

        write('Element (Row = ',alpha,' Col = 1) -0.5 to +0.5:  ');

        readln(BinPic[alpha,1]);

      end;

end;



procedure GetInitWgt;

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

begin

  for alpha := 1 to NumRows do

    for bravo := 1 to NumCols do

      begin

        InitWgt[alpha,bravo] := (alpha*bravo+1)/100;

        repeat

          if InitWgt[alpha,bravo] >= 1 then

            InitWgt[alpha,bravo] := InitWgt[alpha,bravo]/10;

        until InitWgt[alpha,bravo] < 1;

      end;

end;



Procedure MultArrayElxEl(Array1, Array2:  GlobalArray);

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

begin

  for alpha := 1 to NumRows do

    for bravo := 1 to NumCols do

      OutArray[alpha,bravo] := Array1[alpha,bravo]*Array2[alpha,bravo];

end;



Procedure Display(ArrayIn:  GlobalArray);

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

begin

  for alpha := 1 to NumRows do

    begin

      for bravo := 1 to NumCols do

        write(ArrayIn[alpha,bravo]:6:3,' ');

      writeln;

    end;

  {readln;}

end;





Procedure MultiplyArrays(Array1, Array2:  GlobalArray);

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

var

  Dot: real;

begin

  for alpha := 1 to NumRows do

    for bravo := 1 to NumCols do

      begin

        dot := 0;

        for charlie := 1 to NumRows do

          Dot := Dot + Array1[alpha, charlie] * Array2[charlie, bravo];

        OutArray[alpha,bravo] := Dot;

      end;

end;



Procedure MakeSum(InArray:  GlobalArray);

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

var

  TempVec:  array[1..NumRows] of real;

begin

  for bravo := 1 to NumCols do

    begin

      TempVec[bravo] := 0;

      for alpha := 1 to NumRows do

         TempVec[bravo] := TempVec[bravo] + InArray[alpha,bravo];

    end;

  ZeroArray(OutArray);

  for alpha := 1 to NumRows do

    OutArray[alpha, 1] := TempVec[alpha];

end;



Procedure SigmoidArray(InArray:  GlobalArray);

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

begin

  for alpha := 1 to NumRows do

    OutArray[alpha, 1] := -0.5 + 1/(1 + Exp(-InArray[alpha, 1]));

end;



Procedure WeightArray(Array1, Array2:  GlobalArray);

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

begin

  for alpha := 1 to NumRows do

    for bravo := 1 to NumCols do

      OutArray[alpha, bravo] := Array1[1, bravo] * Array2[alpha,bravo];

end;



Procedure SumColumns(InArray:  GlobalArray);

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

var

  TempVec:  array[1..NumRows] of real;

begin

  for alpha := 1 to NumCols do

    begin

      TempVec[alpha] := 0;

      for bravo := 1 to NumRows do

        TempVec[alpha] := TempVec[alpha] + InArray[bravo, alpha];

    end;

  ZeroArray(OutArray);

  for alpha := 1 to NumCols do

    OutArray[alpha, 1] := TempVec[alpha];

end;



Procedure MultArraybyVec(InArray, InVec: GlobalArray);

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

begin

  ZeroArray(OutArray);

  for alpha := 1 to NumRows do

    for bravo := 1 to NumCols do

      OutArray[alpha,bravo] := InArray[alpha,bravo]*InVec[alpha,1];

end;



Procedure Threshhold(InArray: GlobalArray; Cutoff: real);

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

begin

  for alpha := 1 to NumRows do

    if InArray[alpha,1] > Cutoff then

      OutArray[alpha,1] := 1

    else

      OutArray[alpha,1] := 0;

end;



Procedure GetTargetArray;

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

begin

  ZeroArray(TargetArray);

  for alpha := 1 to NumRows do

    begin

      write('Target Element [row = ',alpha,' col = 1]:  ');

      readln(TargetArray[alpha,1]);

    end;

end;



Procedure SubtractArray(Array1, Array2:  GlobalArray);

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

begin

  for alpha := 1 to NumRows do

    for bravo := 1 to NumCols do

      OutDiffArray[alpha,bravo] := Array1[alpha,bravo]-Array2[alpha,bravo];

end;



Procedure AdjustWeight(DeltArray, OutpArray:  GlobalArray);

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

begin

  for alpha := 1 to NumRows do

    for bravo := 1 to NumCols do

      OutArray[alpha,bravo] := AdjRate * DeltArray[alpha,1] * OutpArray[alpha,1];

end;



Procedure AddArray(Array1, Array2:  GlobalArray);

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

begin

  for alpha := 1 to NumRows do

    for bravo := 1 to NumCols do

      OutArray[alpha,bravo] := Array1[alpha,bravo] + Array2[alpha,bravo];

end;



Procedure SubArrayFromOne(InArray:  GlobalArray);

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

begin

  for alpha := 1 to NumRows do

    for bravo := 1 to NumCols do

    OutArray[alpha,bravo] := 1 - InArray[alpha,bravo];

end;



Procedure TransposeArray(InArray:  GlobalArray);

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

begin

  for alpha := 1 to NumRows do

    for bravo := 1 to NumCols do

      OutArray[alpha,bravo] := InArray[bravo,alpha];

end;





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

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

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

begin

  GetBinPic;

  GetTargetArray;

  GetInitWgt;

  WgtOutArray := InitWgt;

  WgtHidArray := InitWgt;



  pass := 0;



  repeat



  pass := pass + 1;

  writeln('Input # ',pass);



  writeln('Input Array');

  Display(BinPic);



  writeln('Hidden Layer Weight Array');

  Display(WgtHidArray);



  MultiplyArrays(WgtHidArray, BinPic);

  writeln('Weighted and Summed Array of Hidden Layer');

  Display(OutArray);



  SigmoidArray(OutArray);

  writeln('Squashed Output Array of Hidden Layer');

  SqHidArray := OutArray;

  Display(SqHidArray);



  writeln('Weight Array of Output Layer');

  Display(WgtOutArray);



  MultiplyArrays(WgtOutArray,OutArray);

  writeln('Weighted and Summed Array of Output Layer');

  Display(OutArray);



  writeln('Output # ',pass);



  SigmoidArray(OutArray);

  writeln('Squashed Output of Output Layer');

  SqOutArray := OutArray;

  Display(SqOutArray);



  if (pass/100)=int(pass/100) then

    readln;



  SubArrayFromOne(SqOutArray);

  writeln('One minus Squashed Output Array of Output Layer');

  OneMinSqOut := OutArray;

  Display(OneMinSqOut);



  writeln('Target Array');

  Display(TargetArray);



  SubtractArray(TargetArray, SqOutArray);

  writeln('Difference Array');

  Display(OutDiffArray);



  MultArrayElxEl(SqOutArray,OneMinSqOut);

  MultArrayElxEl(OutArray,OutDiffArray);

  writeln('Delta Vector of Output Layer');

  OutDeltaArray := OutArray;

  Display(OutDeltaArray);



  writeln('Change to Output Layer Weight Array');

  TransposeArray(SqHidArray);

  Display(OutArray);

  MultiplyArrays(OutDeltaArray, OutArray);

  Display(OutArray);

  TransposeArray(OutArray);

  Display(OutArray);



  writeln('Old Output Layer Weights');

  Display(WgtOutArray);



  writeln('New Output Layer Weights');

  AddArray(WgtOutArray, OutArray);

  WgtOutArray := OutArray;

  Display(WgtOutArray);



  writeln('Delta Vector of Hidden Layer');

  TransposeArray(WgtOutArray);

  MultiplyArrays(OutDeltaArray,OutArray);

  HidDiffArray := OutArray;

  SubArrayFromOne(SqHidArray);

  MultArrayElxEl(SqHidArray,OutArray);

  MultArrayElxEl(HidDiffArray,OutArray);

  HidDeltaArray := OutArray;

  Display(OutArray);



  writeln('Change to Weight Array of Hidden Layer');

  TransposeArray(BinPic);

  Display(OutArray);

  MultiplyArrays(HidDeltaArray, OutArray);

  Display(OutArray);

  TransposeArray(OutArray);

  Display(OutArray);



  writeln('Old Hidden Layer Weights');

  Display(WgtHidArray);



  writeln('New Hidden Layer Weights');

  AddArray(WgtHidArray, OutArray);

  WgtHidArray := OutArray;

  Display(WgtHidArray);



  until Forever;



end.