home *** CD-ROM | disk | FTP | other *** search
/ Mega CD-ROM 1 / megacd_rom_1.zip / megacd_rom_1 / MAGAZINE / DDJMAG / DDJ8910.ZIP / SWAINE.LST < prev   
File List  |  1989-09-07  |  7KB  |  128 lines
  1. _Programming Paradigms_
  2. by Michael Swaine
  3.  
  4. [LISTIN╟ ONE]
  5.  
  6. Program BackPropagationDemo;
  7.  
  8. Const NumOfRows    = 2;     (* Number of rows of cells.            *)
  9.       NumOfCols    = 2;     (* Number of columns of cells.         *)
  10.       LearningRate = 0.25;  (* Learning rate.                      *)
  11.       Criteria     = 0.005; (* Convergence criteria.               *)
  12.       Zero         = 0.05;  (* Anything below 0.05 counts as zero. *)
  13.       One          = 0.95;  (* Anything above 0.95 counts as one.  *)
  14.  
  15. Type CellRecord = Record
  16.                   Output : Real; (* Output of the current cell.             *)
  17.                   Error  : Real; (* Error signal for the current cell.      *)
  18.                   Weights: Array[0..NumOfCols] Of Real; (* Weights in cell. *)
  19.                   End;
  20.  
  21. Var CellArray     : Array[0..NumOfRows,0..NumOfCols] Of CellRecord; (* Cells. *)
  22.     Inputs        : Array[1..NumOfCols] Of Real; (* Input signals.           *)
  23.     DesiredOutputs: Array[1..NumOfCols] Of Real; (* Desired output signals.  *)
  24.  
  25. Procedure CalculateInputsAndOutputs( Iteration: Integer );
  26. Var I: Integer;
  27. Begin (* Calculate the inputs and desired outputs for the current iteration. *)
  28.       (* The inputs cycle through the 4 patterns (0.05,0.05), (0.95,0.05),   *)
  29.       (* (0.05,0.95), (0.95,0.95).  The corresponding desired outputs are    *)
  30.       (* (0.05,0.05), (0.05,0.95), (0.05,0.95), (0.95,0.05).  The first      *)
  31.       (* desired output is the logical AND of the inputs, and the second     *)
  32.       (* desired output is the logical XOR.                                  *)
  33. If (Iteration Mod 2) = 1 Then Inputs[1] := One Else Inputs[1] := Zero;
  34. If (Iteration Mod 4) > 1 Then Inputs[2] := One Else Inputs[2] := Zero;
  35. If (Inputs[1] > 0.5) And (Inputs[2] > 0.5) Then DesiredOutputs[1] := One
  36. Else DesiredOutputs[1] := Zero;
  37. If (Inputs[1] > 0.5) Xor (Inputs[2] > 0.5) Then DesiredOutputs[2] := One
  38. Else DesiredOutputs[2] := Zero;
  39. End;
  40.  
  41. Procedure UpdateCellOnForwardPass( Row, Column: Integer );
  42. Var J  : Integer;
  43.     Sum: Real;
  44. Begin (* Calculate the output of the cell at the specified row and column. *)
  45. With CellArray[Row,Column] Do
  46.      Begin
  47.      Sum := 0.0; (* Clear weighted sum of inputs. *)
  48.      For J := 0 To NumOfCols Do (* Form weighted sum of inputs. *)
  49.          Sum := Sum + Weights[J]*CellArray[Row-1,J].Output;
  50.      Output := 1.0/(1.0+Exp(-Sum)); (* Calculate output of cell.  This *)
  51.                                     (* is called a sigmoid function.   *)
  52.      Error := 0.0; (* Clear error for backward pass. *)
  53.      End;
  54. End;
  55.  
  56. Procedure UpdateCellOnBackwardPass( Row, Column: Integer );
  57. Var J: Integer;
  58. Begin (* Calculate error signals and update weights on the backward pass. *)èWith CellArray[Row,Column] Do
  59.      Begin
  60.      For J := 1 To NumOfCols Do      (* Back propagate the error to the cells *)
  61.          CellArray[Row-1,J].Error := (* below the current cell.               *)
  62.              CellArray[Row-1,J].Error+Error*Output*(1.0-Output)*Weights[J];
  63.      For J := 0 To NumOfCols Do (* Update the weights in the current cell. *)
  64.          Weights[J] :=
  65.           Weights[J] +
  66.           LearningRate*Error*Output*(1.0-Output)*CellArray[Row-1,J].Output;
  67.      End;
  68. End;
  69.  
  70. Var I, J, K            : Integer; (* I loops over rows, J loops over columns,*)
  71.                                   (* and K loops over weights.               *)
  72.     ConvergedIterations: Integer; (* Network must remain converged for four  *)
  73.                                   (* iterations (one for each input pattern).*)
  74.     Iteration          : Integer; (* Total number of iterations so far.      *)
  75.     ErrorSquared       : Real;    (* Error squared for current iteration.    *)
  76.  
  77. Begin
  78. ClrScr; (* Initialize the screen. *)
  79. Writeln('Iteration     Inputs    Desired Outputs   Actual Outputs');
  80. Iteration := 0;            (* Start at iteration 0. *)
  81. ConvergedIterations := 0;  (* The network hasn't converged yet. *)
  82. For I := 1 To NumOfRows Do (* Initialize the weights to small random numbers.*)
  83.     For J := 1 To NumOfCols Do
  84.         For K := 0 To NumOfCols Do
  85.             CellArray[I,J].Weights[K] := 0.2*Random-0.1;
  86. For I := 0 To NumOfRows Do (* Initialize outputs of dummy constant cells. *)
  87.     CellArray[I,0].Output := One;
  88. Repeat
  89.      CalculateInputsAndOutputs(Iteration);
  90.      For J := 1 To NumOfCols Do (* Copy inputs to dummy input cells. *)
  91.          CellArray[0,J].Output := Inputs[J];
  92.      For I := 1 To NumOfRows Do (* Propagate inputs forward through network. *)
  93.          For J := 1 To NumOfCols Do
  94.              UpdateCellOnForwardPass(I,J);
  95.      For J := 1 To NumOfCols Do (* Calculate error signals. *)
  96.          CellArray[NumOfRows,J].Error :=
  97.              DesiredOutputs[J]-CellArray[NumOfRows,J].Output;
  98.      For I := NumOfRows Downto 1 Do (* Propagate errors backward through *)
  99.          For J := 1 To NumOfCols Do (* network, and update weights.      *)
  100.              UpdateCellOnBackwardPass(I,J);
  101.      ErrorSquared := 0.0;       (* Clear error squared.     *)
  102.      For J := 1 To NumOfCols Do (* Calculate error squared. *)
  103.          ErrorSquared := ErrorSquared + Sqr(CellArray[NumOfRows,J].Error);
  104.      If ErrorSquared < Criteria Then (* If network has converged, increment  *)
  105.              ConvergedIterations := ConvergedIterations + 1 (* convergence   *)
  106.      Else ConvergedIterations := 0;  (* count, else clear convergence count. *)
  107.      If (Iteration Mod 100) < 4 Then (* Every 100 iterations, write out *)
  108.         Begin                        (* information on the 4 patterns.  *)
  109.         If (Iteration Mod 100) = 0 Then GotoXY(1,2);
  110.         Write('  ',Iteration:5,'     '); (* Write iteration number. *)
  111.         For J := 1 To NumOfCols Do (* Write out input pattern. *)
  112.             Write(Inputs[J]:4:2,' ');è        Write('     ');
  113.         For J := 1 To NumOfCols Do (* Write out desired outputs. *)
  114.             Write(DesiredOutputs[J]:4:2,' ');
  115.         Write('       ');
  116.         For J := 1 To NumOfCols Do (* Write out actual outputs. *)
  117.             Write(CellArray[NumOfRows,J].Output:4:2,' ');
  118.         Writeln;
  119.         End;
  120.      Iteration := Iteration + 1; (* Increment iteration count *)
  121. Until (ConvergedIterations = 4) Or (Iteration = 32767);
  122.       (* Stop when the network has converged on all 4 input patterns, or when*)
  123.       (* we are about to get integer overflow.                               *)
  124. If ConvergedIterations <> 4 (* Write a final message. *)
  125. Then Writeln('Network didn''t converge')
  126. Else Writeln('Network has converged to within criteria');
  127. End.
  128.